X-Git-Url: https://code.communitydata.science/ml_measurement_error_public.git/blobdiff_plain/fa05dbab6bd2c5db6ed4eccf38cff03bb4fd6683..refs/heads/master:/civil_comments/design_example.R diff --git a/civil_comments/design_example.R b/civil_comments/design_example.R index 1a83a81..4907688 100644 --- a/civil_comments/design_example.R +++ b/civil_comments/design_example.R @@ -5,95 +5,6 @@ source('load_perspective_data.R') ## 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) -} - - -## 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"] -df <- df[,white := white > 0.5] - -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. @@ -107,22 +18,6 @@ cortab['toxicity_coded',] cortab['identity_error',] cortab['white',] -cortab <- cor(df[,.(toxicity_error, - identity_error, - toxicity_coded, - funny, - approved, - sad, - wow, - likes, - disagree, - gender_disclosed, - sexuality_disclosed, - religion_disclosed, - race_disclosed, - disability_disclosed)]) - - ## 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? summary(glm(white ~ toxicity_coded*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))