library(data.table) library(MASS) scores <- fread("perspective_scores.csv") scores <- scores[,id:=as.character(id)] df <- fread("all_data.csv") # only use the data that has identity annotations df <- df[identity_annotator_count > 0] (df[!(df$id %in% scores$id)]) df <- df[scores,on='id',nomatch=NULL] ## how accurate are the classifiers? ## the API claims that these scores are "probabilities" ## say we care about the model of the classification, not the probability F1 <- function(y, predictions){ tp <- sum( (predictions == y) & (predictions==1)) fn <- sum( (predictions != y) & (predictions!=1)) fp <- sum( (predictions != y) & (predictions==1)) precision <- tp / (tp + fp) recall <- tp / (tp + fn) return (2 * precision * recall ) / (precision + recall) } df[, ":="(identity_attack_pred = identity_attack_prob >=0.5, insult_pred = insult_prob >= 0.5, profanity_pred = profanity_prob >= 0.5, severe_toxicity_pred = severe_toxicity_prob >= 0.5, threat_pred = threat_prob >= 0.5, toxicity_pred = toxicity_prob >= 0.5, identity_attack_coded = identity_attack >= 0.5, insult_coded = insult >= 0.5, profanity_coded = obscene >= 0.5, severe_toxicity_coded = severe_toxicity >= 0.5, threat_coded = threat >= 0.5, toxicity_coded = toxicity >= 0.5 )] ## toxicity is about 93% accurate, with an f1 of 0.8 ## identity_attack has high accuracy 97%, but an unfortunant f1 of 0.5. ## threat has high accuracy 99%, but a really bad looking f1 of 0.48. accuracies <- df[,.(identity_attack_acc = mean(identity_attack_pred == identity_attack_coded), insult_pred_acc = mean(insult_pred == insult_coded), profanity_acc = mean(profanity_pred == profanity_coded), severe_toxicity_acc = mean(severe_toxicity_pred == severe_toxicity_coded), theat_acc = mean(threat_pred == threat_coded), toxicity_acc = mean(toxicity_pred == toxicity_coded))] f1s <- df[,.(identity_attack_f1 = F1(identity_attack_coded,identity_attack_pred), insult_f1 = F1(insult_coded,insult_pred), profanity_f1 = F1(profanity_coded,profanity_pred), severe_toxicity_f1 = F1(severe_toxicity_coded,severe_toxicity_pred), theat_f1 = F1(threat_coded,threat_pred), toxicity_f1 = F1(toxicity_coded,toxicity_pred))] positive_cases <- df[,.(identity_attacks = sum(identity_attack_coded), insults = sum(insult_coded), profanities = sum(profanity_coded), severe_toxic_comments = sum(severe_toxicity_coded), threats = sum(threat_coded), toxic_comments = sum(toxicity_coded))] ## there are 50,000 toxic comments, 13000 identity attacks, 30000 insults, 3000 profanities, 8 severe toxic, and 1000 threats. proportions_cases <- df[,.(prop_identity = mean(identity_attack_coded), prop_insults = mean(insult_coded), prop_profanity = mean(profanity_coded), prop_severe = mean(severe_toxicity_coded), prop_threats = mean(threat_coded), prop_toxic = mean(toxicity_coded))] ## at 11% of comments, "toxicity" seems not so badly skewed. Try toxicity first, and if it doesn't work out try insults. ## now look for an example where differential error affects an identity, or a reaction. df <- df[,":="(identity_error = identity_attack_coded - identity_attack_pred, insult_error = insult_coded - insult_pred, profanity_error = profanity_coded - profanity_pred, severe_toxic_error = severe_toxicity_coded - severe_toxicity_pred, threat_error = threat_coded - threat_pred, toxicity_error = toxicity_coded - toxicity_pred)] ## what's correlated with toxicity_error ? df <- df[,approved := rating == "approved"] cortab <- cor(df[,.(toxicity_error, identity_error, toxicity_coded, funny, approved, sad, wow, likes, disagree, male, female, transgender, other_gender, heterosexual, bisexual, other_sexual_orientation, christian, jewish, hindu, buddhist, atheist, other_religion, black, white, asian, latino, other_race_or_ethnicity, physical_disability, intellectual_or_learning_disability, psychiatric_or_mental_illness, other_disability)]) ## toxicity error is weakly correlated pearson's R = 0.1 with both "white" and "black". ## compare regressions with "white" or "black" as the outcome and "toxicity_coded" or "toxicity_pred" as a predictor. ## here's a great example with presumambly non-differential error: about what identities is toxicity found humorous? ## a bunch of stars reappear when you used the ground-truth data instead of the predictions. ## pro/con of this example: will have to implement family='poisson'. ## shouldn't be that bad though haha. cortab['toxicity_error',] cortab['toxicity_error','funny'] cortab['toxicity_coded',] cortab['identity_error',] cortab['white',] glm(white ~ toxicity_coded + psychiatric_or_mental_illness, data = df, family=binomial(link='logit')) glm(white ~ toxicity_pred + psychiatric_or_mental_illness, data = df, family=binomial(link='logit')) m1 <- 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_coded, data = df) m2 <- 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) 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) glm(white ~ disagree, data = df, family=binomial(link='logit')) ## example with differential error glm(white ~ toxicity_coded + toxicity_error, data=df,family=binomial(link='logit')) glm(toxicity_coded ~ white, data = df, family=binomial(link='logit')) glm(toxicity_pred ~ white, data = df, family=binomial(link='logit'))