groceryheist/ml_measurement_error_public
1
0
Fork 0
Code Activity

check in some old simulation updates and a dv examples with real data

Browse Source
This commit is contained in:
Nathan TeBlunthuis
2023-01-06 12:22:41 -08:00
parent d8bc08f18f
commit fa05dbab6b
11 changed files with 345 additions and 184 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
civil_comments/01_dv_example.R Normal file
View File

@@ -0,0 +1,54 @@
source('load_perspective_data.R')
source("../simulations/measerr_methods.R")
source("../simulations/RemembR/R/RemembeR.R")
change.remember.file("dv_perspective_example.RDS")
# for reproducibility
set.seed(1111)
## 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?
compare_dv_models <-function(pred_formula, outcome_formula, proxy_formula, df, sample.prop, remember_prefix){
pred_model <- glm(pred_formula, df, family=binomial(link='logit'))
remember(coef(pred_model), paste0(remember_prefix, "coef_pred_model"))
remember(diag(vcov((pred_model))), paste0(remember_prefix, "se_pred_model"))
coder_model <- glm(outcome_formula, df, family=binomial(link='logit'))
remember(coef(coder_model), paste0(remember_prefix, "coef_coder_model"))
remember(diag(vcov((coder_model))), paste0(remember_prefix, "se_coder_model"))
df_measerr_method <- copy(df)[sample(1:.N, sample.prop * .N), toxicity_coded_1 := toxicity_coded]
df_measerr_method <- df_measerr_method[,toxicity_coded := toxicity_coded_1]
sample_model <- glm(outcome_formula, df_measerr_method, family=binomial(link='logit'))
remember(coef(sample_model), paste0(remember_prefix, "coef_sample_model"))
remember(diag(vcov((sample_model))), paste0(remember_prefix, "se_sample_model"))
measerr_model <- measerr_mle_dv(df_measerr_method, outcome_formula, outcome_family=binomial(link='logit'), proxy_formula=proxy_formula, proxy_family=binomial(link='logit'))
inv_hessian = solve(measerr_model$hessian)
stderr = diag(inv_hessian)
remember(stderr, paste0(remember_prefix, "measerr_model_stderr"))
remember(measerr_model$par, paste0(remember_prefix, "measerr_model_par"))
}
print("running first example")
compare_dv_models(pred_formula = toxicity_pred ~ funny*white,
outcome_formula = toxicity_coded ~ funny*white, proxy_formula,
proxy_formula = toxicity_pred ~ toxicity_coded*funny*white,
df=df,
sample.prop=0.01,
remember_prefix='cc_ex_tox.funny.white')
print("running second example")
compare_dv_models(pred_formula = toxicity_pred ~ likes+race_disclosed,
outcome_formula = toxicity_coded ~ likes + race_disclosed, proxy_formula,
proxy_formula = toxicity_pred ~ toxicity_coded*likes*race_disclosed,
df=df,
sample.prop=0.01,
remember_prefix='cc_ex_tox.funny.race_disclosed')

89
civil_comments/design_example.R
View File

@@ -1,18 +1,5 @@
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]
set.seed(1111)
source('load_perspective_data.R')
## how accurate are the classifiers?
## the API claims that these scores are "probabilities"
@@ -27,21 +14,6 @@ F1 <- function(y, predictions){
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.
@@ -88,6 +60,7 @@ df <- df[,":="(identity_error = identity_attack_coded - identity_attack_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,
@@ -134,14 +107,62 @@ cortab['toxicity_coded',]
cortab['identity_error',]
cortab['white',]
glm(white ~ toxicity_coded + psychiatric_or_mental_illness, data = df, family=binomial(link='logit'))
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)])
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)
## 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')))
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)
summary(glm(white ~ toxicity_pred*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
summary(glm(white ~ toxicity_coded*male, data = df, family=binomial(link='logit')))
summary(glm(white ~ toxicity_pred*male, data = df, family=binomial(link='logit')))
summary(glm(toxicity_coded ~ white*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
summary(glm(toxicity_pred ~ white*psychiatric_or_mental_illness, data = df, family=binomial(link='logit')))
## 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?
summary(glm(toxicity_pred ~ funny*white, data=df, family=binomial(link='logit')))
summary(glm(toxicity_coded ~ funny*white, data=df, family=binomial(link='logit')))
source("../simulations/measerr_methods.R")
saved_model_file <- "measerr_model_tox.eq.funny.cross.white.RDS"
overwrite_model <- TRUE
# 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.
df_measerr_method <- copy(df)[sample(1:.N, 0.05 * .N), toxicity_coded_1 := toxicity_coded]
df_measerr_method <- df_measerr_method[,toxicity_coded := toxicity_coded_1]
summary(glm(toxicity_coded ~ funny*white, data=df_measerr_method[!is.na(toxicity_coded)], family=binomial(link='logit')))
if(!file.exists(saved_model_file) || (overwrite_model == TRUE)){
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)
saveRDS(measerr_model, saved_model_file)
} else {
measerr_model <- readRDS(saved_model_file)
}
inv_hessian <- solve(measerr_model$hessian)
se <- diag(inv_hessian)
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)
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)

41
civil_comments/load_perspective_data.R Normal file
View File

@@ -0,0 +1,41 @@
library(data.table)
library(MASS)
set.seed(1111)
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]
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
)]
gt.0.5 <- function(v) { v >= 0.5 }
dt.apply.any <- function(fun, ...){apply(apply(cbind(...), 2, fun),1,any)}
df <- df[,":="(gender_disclosed = dt.apply.any(gt.0.5, male, female, transgender, other_gender),
sexuality_disclosed = dt.apply.any(gt.0.5, heterosexual, bisexual, other_sexual_orientation),
religion_disclosed = dt.apply.any(gt.0.5, christian, jewish, hindu, buddhist, atheist, muslim, other_religion),
race_disclosed = dt.apply.any(gt.0.5, white, black, asian, latino, other_race_or_ethnicity),
disability_disclosed = dt.apply.any(gt.0.5,physical_disability, intellectual_or_learning_disability, psychiatric_or_mental_illness, other_disability))]
df <- df[,white:=gt.0.5(white)]