---
title: "final_combined_analyses"
output:
  pdf_document: default
  html_document: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
```

```{r}
library(tidyverse)
library(parameters)

```

```{r}
humans <- read_csv("clean_data/combined_human_filtered_cleaned.csv")
computers <- read_csv("clean_data/computer_filtered_cleaned.csv")
```


```{r}
humans <- humans %>% mutate(agent = "human")
computers <- computers %>% mutate(agent = "computer")

hum_comp <- humans %>% merge(computers, all.x = TRUE, all.y = TRUE)

hum_comp <- hum_comp %>%
  mutate(qskin_type2 = factor(qskin, labels = c("light","light","light","dark","dark","dark"))) %>%
  mutate(qskin_type3 = factor(qskin, labels = c("I-II","I-II","III-IV","III-IV","V-VI","V-VI"))) %>%
  mutate(qskin = factor(qskin, labels = c("1","2","3","4","5","6"))) %>%
  mutate(qgender = factor(qgender)) %>%
  mutate(Model = factor(Model), qtype = factor(qtype)) %>%
  mutate(agent = factor(agent)) %>%
  mutate(rskin = factor(hum_comp$skin_tone, levels=c(1,2,3,4,5,6), labels=c("1","2","3","4","5","6"))) %>%
  mutate(rskin_type2 = factor(hum_comp$skin_tone, levels=c(1,2,3,4,5,6), labels=c("light","light","light","dark","dark","dark"))) %>%
  mutate(rskin_type3 = factor(hum_comp$skin_tone, levels=c(1,2,3,4,5,6), labels=c("I-II","I-II","III-IV","III-IV","V-VI","V-VI"))) %>%
  mutate(rgender = factor(gender))
  
```


## Verification is Easier Than Identification; Computers are More Accurate Than Humans

Humans achieved higher accuracy on verification ($78.9\%$) than identification ($68.3\%$, significant with a two-tailed matched-pair $t$-test with $p < 0.001$).

```{r}
hum_users <- hum_comp %>% filter(agent == "human") %>% distinct(user_id, .keep_all = TRUE)

t.test(hum_users$verif_accuracy, hum_users$ident_accuracy, paired = TRUE)
```

For computer models as a whole, this gap persists but is substantially narrowed -- performance on verification is $94.1\%$, with $92.5\%$ on identification ($p = 0.005$).

```{r}

t.test((hum_comp %>% 
        filter(agent == "computer", qtype == "verification") %>% group_by(Model) %>%
          summarise(accuracy = sum(answered_right)/n()))$accuracy, 
       (hum_comp %>% 
          filter(agent == "computer", qtype == "identification") %>% group_by(Model) %>% 
          summarise(accuracy = sum(answered_right)/n()))$accuracy, 
       paired = TRUE
)


```


The performance difference between machines and humans is highly significant ($p< 0.001$) on both tasks using unpaired $t$-tests which explore group-level changes between the two tasks.
```{r}
t.test((hum_comp %>% filter(agent == "human", qtype == "verification"))$answered_right, 
       (hum_comp %>% filter(agent == "computer", qtype == "verification"))$answered_right)

t.test((hum_comp %>% filter(agent == "human", qtype == "identification"))$answered_right, 
       (hum_comp %>% filter(agent == "computer", qtype == "identification"))$answered_right)
```

Furthermore, even when controlling for demographic effects in a logistic model, humans have a much lower odds compared to computers of getting a question right (OR = $0.17$ for verification, $p < 0.001$, OR = $0.11$ for identification, $p < 0.001$).  
```{r}
model <- glm(answered_right ~ agent + 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

model <- glm(answered_right ~ agent + 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

```

# Humans and Computers Perform Better on Male Subjects

For identification questions, we do not observe statistically significant performance gaps for the MobileFaceNet models ($p = 0.3043$ for ArcFace and $p = 0.4752$ for CosFace), but we do observe statistically significant disparities in favor of males for each of the four ResNet models (all $p< 0.04$). 
```{r}
model_gender_t_test <- function(model, task) {
  print(t.test((hum_comp %>% filter(Model == model, qtype == task, qgender == "Male"))$answered_right, 
               (hum_comp %>% filter(Model == model, qtype == task, qgender == "Female"))$answered_right))
}

for (model in c( "MobileFaceNetArcFace","MobileFaceNetCosFace",
                 "ResNet18ArcFace", "ResNet18CosFace",
                 "ResNet50ArcFace", "ResNet50CosFace")) {
  print(model)
  model_gender_t_test(model,"identification")
  
}
```

Similarly, in logistic regression, we observe an odds ratio for computer models on male identification subjects of $1.76$ ($p < 0.001$).
```{r}
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
```

Humans also have  significantly ($p<0.001$) better accuracy on identification questions with male subjects: $75.7\%$ on male subjects versus $61.4\%$ on female subjects. The same holds true for humans on verification questions: they attain an accuracy of $81.6\%$ on male subjects, versus $76.1\%$ on female subjects ($p < 0.001$).
```{r}
t.test((hum_comp %>% filter(agent == "human", qtype == "identification", qgender == "Male"))$answered_right, 
       (hum_comp %>% filter(agent == "human", qtype == "identification", qgender == "Female"))$answered_right)

t.test((hum_comp %>% filter(agent == "human", qtype == "verification", qgender == "Male"))$answered_right, 
       (hum_comp %>% filter(agent == "human", qtype == "verification", qgender == "Female"))$answered_right)
```

The results of the human-only logistic models confirm human biases towards male subjects in both verification (OR = $1.39$, $p < 0.001$) and identification (OR = $1.97$, $p < 0.001$).
```{r}
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

```


Academic models are found, through logistic regression, to exhibit a statistically significant difference in performance between verification questions with male or female subjects (OR = $1.28$, $p = 0.03$).
```{r}
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

```

# Humans and Computers Perform Worse on Darker-Skinned Subjects

Humans collectively perform $5.2\%$ worse on dark-skinned subjects than dark-skinned subjects for verification questions ($80.9\%$ versus $76.7\%$, $p < 0.001$). On identification questions, this gap is widened to $11.7\%$ in favor of light-skinned subjects ($72.7\%$ versus $64.2\%$, $p < 0.001$).
```{r}
t.test((hum_comp %>% filter(agent == "human", qtype == "verification", qskin_type2 == "light"))$answered_right, (hum_comp %>% filter(agent == "human", qtype == "verification", qskin_type == "dark"))$answered_right)
t.test((hum_comp %>% filter(agent == "human", qtype == "identification", qskin_type2 == "light"))$answered_right, (hum_comp %>% filter(agent == "human", qtype == "identification", qskin_type == "dark"))$answered_right)
```

Even when controlling for the demographics of the respondent,  logistic regressions yield the same conclusions: odds ratio of dark-skinned compared to light-skinned question subjects for verification is  $0.78$ ($p < 0.001$) while for identification is $0.67$ ($p < 0.001$).  
```{r}
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

```

When we aggregate the Fitzpatrick scale as three groups, I-II, III-VI, and V-VI, verification logistic regression finds statistically significant biases in favor of Fitzpatrick types I-II, over both III-VI and V-VI questions compared (OR = 0.93, $p = 0.023$ for III-VI; OR=0.85, $p<0.001$ for V-VI). For the identification task, even when controlling for respondent demographic, question subjects with Fitzpatrick values I-II have higher correct responses than that of values III-VI and V-VI (OR = 0.92, $p = 0.04$ for III-VI; OR=0.70, $p<0.001$ for V-VI).
```{r}
model <- glm(answered_right ~ 
               qgender + qskin_type3 + rgender + rskin_type3, family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
model <- glm(answered_right ~ 
               qgender + qskin_type3 + rgender + rskin_type3, family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

```

When we aggregate the Fitzpatrick scale as just ``light'' and ``dark'', we observe a statistically significant performance disparity of $1.6\%$ in favor of light-skinned question subjects on the verification task ($p = 0.02$); for identification, we do not find evidence of a skin type bias ($p=0.17$).
```{r}
t.test((hum_comp %>% filter(agent == "computer", qtype == "verification", qskin_type2 == "light"))$answered_right, (hum_comp %>% filter(agent == "computer", qtype == "verification", qskin_type2 == "dark"))$answered_right)
t.test((hum_comp %>% filter(agent == "computer", qtype == "identification", qskin_type2 == "light"))$answered_right, (hum_comp %>% filter(agent == "computer", qtype == "identification", qskin_type2 == "dark"))$answered_right)
```

When we aggregate the Fitzpatrick scale into three categories, (I-II),(III-IV), and (V-VI), we see a disparity for both tasks between the lightest (I-II) and darkest groups (V-VI) ($p=0.004$ and $p=0.04$ for verification and identification respectively).
```{r}
t.test((hum_comp %>% filter(agent == "computer", qtype == "verification", qskin_type3 == "I-II"))$answered_right, (hum_comp %>% filter(agent == "computer", qtype == "verification", qskin_type3 == "V-VI"))$answered_right)
t.test((hum_comp %>% filter(agent == "computer", qtype == "identification", qskin_type3 == "I-II"))$answered_right, (hum_comp %>% filter(agent == "computer", qtype == "identification", qskin_type3 == "V-VI"))$answered_right)
```

Subject Fitzpatrick type is revealed to be significantly different, even when controlling for gender, between the types I-II and V-VI (OR = 0.78, $p = 0.042$ for identification; OR=0.67, $p=0.005$ for verification). This means that I-II and III-VI do not show statistically significant differences for academically-trained models (OR = 1.07, $p = 0.591$ for identification; OR=0.93, $p=0.632$ for verification).
```{r}
model <- glm(answered_right ~ 
               qgender + qskin_type3 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
model <- glm(answered_right ~ 
               qgender + qskin_type3 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

```


# Human Test-Takers Perform Better on Subjects of Similar Demographic
humans perform significantly better on questions where the subjects match their gender identity ($1.0\%$, $p = 0.02$), skin type ($1.5\%$, $p = 0.002$), and gender identity and skin type ($1.3\%$, $p = 0.009$).
```{r}
t.test((hum_comp %>% filter(qtype == "verification", gender_match == "TRUE"))$answered_right, 
       (hum_comp %>% filter(qtype == "verification", gender_match == "FALSE"))$answered_right)
t.test((hum_comp %>% filter(qtype == "verification", skin_match == 1))$answered_right, 
       (hum_comp %>% filter(qtype == "verification", skin_match == 0))$answered_right)
t.test((hum_comp %>% filter(qtype == "verification", demo_match_soft == 1))$answered_right, 
       (hum_comp %>% filter(qtype == "verification", demo_match_soft == 0))$answered_right)

```

On the identification task, humans perform significantly better on questions where subjects match their skin type ($3.3\%$, $p = 0.011$) and both their gender identity and Fitzpatrick type ($4.7\%$, $p < 0.001$).
```{r}
t.test((hum_comp %>% filter(qtype == "identification", skin_match == 1))$answered_right, 
       (hum_comp %>% filter(qtype == "identification", skin_match == 0))$answered_right)
t.test((hum_comp %>% filter(qtype == "identification", demo_match_soft == 1))$answered_right, 
       (hum_comp %>% filter(qtype == "identification", demo_match_soft == 0))$answered_right)

```



# Humans and Machines Exhibit Comparable Levels of Disparity

For verification, we observe that the magnitude of the gender disparities are similar (OR 95\% confidence intervals for humans are [1.33, 1.46] and for academic models are [1.02, 1.61]). For identification, we observe that the magnitude of the gender disparities are also similar (OR 95\% confidence intervals for humans are [1.84,2.10] and for academic models are [1.43,2.17]).
```{r}
print("human, id")
model <- glm(answered_right ~ 
               qgender + qskin_type3 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
print("machine, id")
model <- glm(answered_right ~ 
               qgender + qskin_type3 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

print("human, ver")
model <- glm(answered_right ~ 
               qgender + qskin_type3 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
print("machine, ver")
model <- glm(answered_right ~ 
               qgender + qskin_type3 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
```

As for the skin type disparity, we see similar overlapping confidence intervals between humans and machines for both skin type as binary (light/dark) and the three types.
```{r}
print("human, id")
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
print("machine, id")
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "identification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))

print("human, ver")
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'human', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
print("machine, ver")
model <- glm(answered_right ~ 
               qgender + qskin_type2 , family = "binomial", 
             data = hum_comp %>% filter(agent == 'computer', qtype == "verification"))

print(model_parameters(model, df_method = "wald", exponentiate = TRUE))
```
