civil_comments/design_example.R

   1 set.seed(1111)
   2 source('load_perspective_data.R')
   3 ## how accurate are the classifiers?
   4
   5 ## the API claims that these scores are "probabilities"
   6 ## say we care about the model of the classification, not the probability
   7
   8 F1 <- function(y, predictions){
   9     tp <- sum( (predictions == y) & (predictions==1))
  10     fn <- sum( (predictions != y) & (predictions!=1))
  11     fp <- sum( (predictions != y) & (predictions==1))
  12     precision <- tp / (tp + fp)
  13     recall <- tp / (tp + fn)
  14     return (2 * precision * recall ) / (precision + recall)
  15 }
  16
  17
  18 ## toxicity is about 93% accurate, with an f1 of 0.8
  19 ## identity_attack has high accuracy 97%, but an unfortunant f1 of 0.5.
  20 ## threat has high accuracy 99%, but a really bad looking f1 of 0.48.
  21 accuracies <- df[,.(identity_attack_acc = mean(identity_attack_pred == identity_attack_coded),
  22                     insult_pred_acc = mean(insult_pred == insult_coded),
  23                     profanity_acc = mean(profanity_pred == profanity_coded),
  24                     severe_toxicity_acc = mean(severe_toxicity_pred == severe_toxicity_coded),
  25                     theat_acc = mean(threat_pred == threat_coded),
  26                     toxicity_acc = mean(toxicity_pred == toxicity_coded))]
  27
  28 f1s <- df[,.(identity_attack_f1 = F1(identity_attack_coded,identity_attack_pred),
  29                     insult_f1 = F1(insult_coded,insult_pred),
  30                     profanity_f1 = F1(profanity_coded,profanity_pred),
  31                     severe_toxicity_f1 = F1(severe_toxicity_coded,severe_toxicity_pred),
  32                     theat_f1 = F1(threat_coded,threat_pred),
  33                     toxicity_f1 = F1(toxicity_coded,toxicity_pred))]
  34
  35 positive_cases <- df[,.(identity_attacks = sum(identity_attack_coded),
  36                         insults = sum(insult_coded),
  37                         profanities = sum(profanity_coded),
  38                         severe_toxic_comments = sum(severe_toxicity_coded),
  39                         threats = sum(threat_coded),
  40                         toxic_comments = sum(toxicity_coded))]
  41
  42 ## there are 50,000 toxic comments, 13000 identity attacks, 30000 insults, 3000 profanities, 8 severe toxic, and 1000 threats.
  43
  44 proportions_cases <- df[,.(prop_identity = mean(identity_attack_coded),
  45                            prop_insults = mean(insult_coded),
  46                            prop_profanity = mean(profanity_coded),
  47                            prop_severe = mean(severe_toxicity_coded),
  48                            prop_threats = mean(threat_coded),
  49                            prop_toxic = mean(toxicity_coded))]
  50
  51 ## at 11% of comments, "toxicity" seems not so badly skewed. Try toxicity first, and if it doesn't work out try insults.
  52
  53 ## now look for an example where differential error affects an identity, or a reaction.
  54 df <- df[,":="(identity_error = identity_attack_coded - identity_attack_pred,
  55                insult_error = insult_coded - insult_pred,
  56                profanity_error = profanity_coded - profanity_pred,
  57                severe_toxic_error = severe_toxicity_coded - severe_toxicity_pred,
  58                threat_error = threat_coded - threat_pred,
  59                toxicity_error = toxicity_coded - toxicity_pred)]
  60
  61 ## what's correlated with toxicity_error ?
  62 df <- df[,approved := rating == "approved"]
  63 df <- df[,white := white > 0.5]
  64
  65 cortab <- cor(df[,.(toxicity_error,
  66                     identity_error,
  67                     toxicity_coded,
  68                     funny,
  69                     approved,
  70                     sad,
  71                     wow,
  72                     likes,
  73                     disagree,
  74                     male,
  75                     female,
  76                     transgender,
  77                     other_gender,
  78                     heterosexual,
  79                     bisexual,
  80                     other_sexual_orientation,
  81                     christian,
  82                     jewish,
  83                     hindu,
  84                     buddhist,
  85                     atheist,
  86                     other_religion,
  87                     black,
  88                     white,
  89                     asian,
  90                     latino,
  91                     other_race_or_ethnicity,
  92                     physical_disability,
  93                     intellectual_or_learning_disability,
  94                     psychiatric_or_mental_illness,
  95                     other_disability)])
  96
  97 ## toxicity error is weakly correlated pearson's R = 0.1 with both "white" and "black".
  98
  99 ## compare regressions with "white" or "black" as the outcome and "toxicity_coded" or "toxicity_pred" as a predictor.
 100 ## here's a great example with presumambly non-differential error: about what identities is toxicity found humorous?
 101 ## a bunch of stars reappear when you used the ground-truth data instead of the predictions.
 102 ## pro/con of this example: will have to implement family='poisson'.
 103 ## shouldn't be that bad though haha.
 104 cortab['toxicity_error',]
 105 cortab['toxicity_error','funny']
 106 cortab['toxicity_coded',]
 107 cortab['identity_error',]
 108 cortab['white',]
 109
 110 cortab <- cor(df[,.(toxicity_error,
 111                     identity_error,
 112                     toxicity_coded,
 113                     funny,
 114                     approved,
 115                     sad,
 116                     wow,
 117                     likes,
 118                     disagree,
 119                     gender_disclosed,
 120                     sexuality_disclosed,
 121                     religion_disclosed,
 122                     race_disclosed,
 123                     disability_disclosed)])
 124
 125
 126 ## here's a simple example, is P(white | toxic and mentally ill) > P(white | toxic or mentally ill). Are people who discuss their mental illness in a toxic way more likely to be white compared to those who just talk about their mental illness or are toxic?
 127 summary(glm(white ~ toxicity_coded*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
 128
 129 summary(glm(white ~ toxicity_pred*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
 130
 131 summary(glm(white ~ toxicity_coded*male, data = df, family=binomial(link='logit')))
 132
 133 summary(glm(white ~ toxicity_pred*male, data = df, family=binomial(link='logit')))
 134
 135 summary(glm(toxicity_coded ~ white*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
 136
 137 summary(glm(toxicity_pred ~ white*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
 138
 139
 140 ## another simple enough example: is P(toxic | funny and white) > P(toxic | funny nand white)? Or, are funny comments more toxic when people disclose that they are white?
 141
 142 summary(glm(toxicity_pred ~ funny*white, data=df, family=binomial(link='logit')))
 143 summary(glm(toxicity_coded ~ funny*white, data=df, family=binomial(link='logit')))
 144
 145 source("../simulations/measerr_methods.R")
 146
 147 saved_model_file <- "measerr_model_tox.eq.funny.cross.white.RDS"
 148 overwrite_model <- TRUE
 149
 150 # it works so far with a 20% and 15% sample. Smaller is better. let's try a 10% sample again. It didn't work out. We'll go forward with a 15% sample.
 151 df_measerr_method <- copy(df)[sample(1:.N, 0.05 * .N), toxicity_coded_1 := toxicity_coded]
 152 df_measerr_method <- df_measerr_method[,toxicity_coded := toxicity_coded_1]
 153 summary(glm(toxicity_coded ~ funny*white, data=df_measerr_method[!is.na(toxicity_coded)], family=binomial(link='logit')))
 154
 155 if(!file.exists(saved_model_file) || (overwrite_model == TRUE)){
 156     measerr_model <- measerr_mle_dv(df_measerr_method,toxicity_coded ~ funny*white,outcome_family=binomial(link='logit'), proxy_formula=toxicity_pred ~ toxicity_coded*funny*white)
 157 saveRDS(measerr_model, saved_model_file)
 158 } else {
 159     measerr_model <- readRDS(saved_model_file)
 160 }
 161
 162 inv_hessian <- solve(measerr_model$hessian)
 163 se <- diag(inv_hessian)
 164
 165 lm2 <- glm.nb(funny ~ (male + female + transgender + other_gender + heterosexual + bisexual + other_sexual_orientation + christian + jewish + hindu + buddhist + atheist + other_religion + asian + latino + other_race_or_ethnicity + physical_disability + intellectual_or_learning_disability + white + black + psychiatric_or_mental_illness)*toxicity_pred, data = df)
 166 m3 <- glm.nb(funny ~ (male + female + transgender + other_gender + heterosexual + bisexual + other_sexual_orientation + christian + jewish + hindu + buddhist + atheist + other_religion + asian + latino + other_race_or_ethnicity + physical_disability + intellectual_or_learning_disability + white + black + psychiatric_or_mental_illness)*toxicity, data = df)
 167
 168
 169 glm(white ~ disagree, data = df, family=binomial(link='logit'))
 170
 171 ## example with differential error
 172
 173 glm(white ~ toxicity_coded + toxicity_error, data=df,family=binomial(link='logit'))
 174
 175 glm(toxicity_coded ~ white, data = df, family=binomial(link='logit'))
 176
 177 glm(toxicity_pred ~ white, data = df, family=binomial(link='logit'))