Main Treatment Effects Figure
- 4 panels: one for each outcome in cross-sectional analysis
- y-axis: treatment effect relative to Facts baseline
- x-axis: No-course baseline, Emotions, Reasoning, Combo
- points: estimates and 95% confidence intervals using diff-in-means,
linear OLS with covariates (without accuracy nudge), AIPW
treatment_means <- readRDS("regression_analysis_wide/data/means_by_treatment_group.rds")
# 1 to 4 contain the outcomes of interests
treatment_means_diffinmean <- treatment_means[["models_wide"]]
treatment_means_allcov <- treatment_means[["models_all_covariates"]]
headers <- c("Conditional Misinfo Sharing Rate",
"Misinfo Sharing Rate",
"Non-Misinfo Sharing Rate",
"Sharing Discernment Score")
treatment_means_df <- c()
treatment_means_allcov_df <- c()
# Extract means and std error
for (o in 1:4){
treatment_means_df <- rbind(treatment_means_df,
data.frame(outcome = headers[o],
treatment = c("Facts Baseline", "No-course Baseline", "Reasoning", "Emotions", "Combo"),
mean = treatment_means_diffinmean[[o]]$coefficients[1:5],
se = treatment_means_diffinmean[[o]]$`std.error`[1:5]))
treatment_means_allcov_df <- rbind(treatment_means_allcov_df,
data.frame(outcome = headers[o],
treatment = c("Facts Baseline", "No-course Baseline", "Reasoning", "Emotions", "Combo"),
mean = treatment_means_allcov[[o]]$coefficients[1:5],
se = treatment_means_allcov[[o]]$`std.error`[1:5]))
}
row.names(treatment_means_df) <- NULL
row.names(treatment_means_allcov_df) <- NULL
wide <- readRDS("regression_analysis_wide/data/wide.rds")
tests_names_reg <- c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline")
#### Extrat difference-in-mean estimates
models_wide_te <- readRDS("regression_analysis_wide/data/models_wide_te.rds")
# 1 to 4 contain the outcomes of interests
models_wide_df <- c()
for (o in 1:4){
models_wide_df <- rbind(models_wide_df,
data.frame(outcome = headers[o],
test = tests_names_reg,
estimate = models_wide_te[[o]]$coefficients[2:5],
se = models_wide_te[[o]]$std.error[2:5]))
}
#### Extract all ocvariates estimates
models_all_covariates_te <- readRDS("regression_analysis_wide/data/models_all_covariates_te.rds")
# 1 to 4 contain the outcomes of interests
models_all_covariates_df <- c()
for (o in 1:4){
models_all_covariates_df <- rbind(models_all_covariates_df,
data.frame(outcome = headers[o],
test = tests_names_reg,
estimate = models_all_covariates_te[[o]]$coefficients[2:5],
se = models_all_covariates_te[[o]]$std.error[2:5]))
}
#### Extract AIPW estimates
# 1 to 4 contain the outcomes of interests
AIPW_tables <- readRDS("regression_analysis_wide/data/AIPW_tables_list.rds")
# 6 Reasoning, 7 Emotions, 8 Combo, 9 No-course Baseline in AIPW tables
tests_of_interest <- 6:9
tests_names <- c("Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline", "No-course Baseline vs Facts Baseline")
AIPW_tables_df <- c()
for (o in 1:4){
AIPW_tables_df <- rbind(AIPW_tables_df,
data.frame(outcome = headers[o],
test = tests_names,
estimate = AIPW_tables[[o]]$estimates[tests_of_interest],
se = AIPW_tables[[o]]$`std.err`[tests_of_interest]))
}
# Recall our test is done using Facts Baseline vs No-course Baseline (as the reference)
# Thus, we need to reverse the sign [only for AIPW table]
AIPW_tables_df[AIPW_tables_df$test == "No-course Baseline vs Facts Baseline", "estimate"] <- -AIPW_tables_df[AIPW_tables_df$test == "No-course Baseline vs Facts Baseline", "estimate"]
treatment_means_followup <- readRDS("regression_analysis_wide/followup/data/means_by_treatment_group_followup.rds")
treatment_means_allcov_followup <- treatment_means_followup[["models_wide"]]
headers <- c("Conditional Misinfo Sharing Rate",
"Misinfo Sharing Rate",
"Non-Misinfo Sharing Rate",
"Sharing Discernment Score")
treatment_means_followup_df <- c()
# Extract means and std error
for (o in 1:4){
treatment_means_followup_df <- rbind(treatment_means_followup_df,
data.frame(outcome = headers[o],
treatment = c("Facts Baseline", "No-course Baseline", "Reasoning", "Emotions", "Combo"),
mean = treatment_means_allcov_followup[[o]]$coefficients[1:5],
se = treatment_means_allcov_followup[[o]]$`std.error`[1:5]))
}
row.names(treatment_means_followup_df) <- NULL
wide_followup <- readRDS("regression_analysis_wide/followup/data/wide_followup.rds")
tests_names_reg <- c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline")
#### Extrat difference-in-mean estimates
models_wide_te_followup <- readRDS("regression_analysis_wide/followup/data/models_wide_te_followup.rds")
# 1 to 4 contain the outcomes of interests
models_wide_followup_df <- c()
for (o in 1:4){
models_wide_followup_df <- rbind(models_wide_followup_df,
data.frame(outcome = headers[o],
test = tests_names_reg,
estimate = models_wide_te_followup[[o]]$coefficients[2:5],
se = models_wide_te_followup[[o]]$std.error[2:5]))
}
#### Extract all ocvariates estimates
models_all_covariates_te_followup <- readRDS("regression_analysis_wide/followup/data/models_all_covariates_te_followup.rds")
# 1 to 4 contain the outcomes of interests
models_all_covariates_followup_df <- c()
for (o in 1:4){
models_all_covariates_followup_df <- rbind(models_all_covariates_followup_df,
data.frame(outcome = headers[o],
test = tests_names_reg,
estimate = models_all_covariates_te_followup[[o]]$coefficients[2:5],
se = models_all_covariates_te_followup[[o]]$std.error[2:5]))
}
#### Extract AIPW estimates
# 1 to 4 contain the outcomes of interests
AIPW_tables_followup <- readRDS("regression_analysis_wide/followup/data/AIPW_tables_list_followup.rds")
# 6 Reasoning, 7 Emotions, 8 Combo, 9 No-course Baseline in AIPW tables
tests_of_interest <- 6:9
tests_names <- c("Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline", "No-course Baseline vs Facts Baseline")
AIPW_tables_followup_df <- c()
for (o in 1:4){
AIPW_tables_followup_df <- rbind(AIPW_tables_followup_df,
data.frame(outcome = headers[o],
test = tests_names,
estimate = AIPW_tables_followup[[o]]$estimates[tests_of_interest],
se = AIPW_tables_followup[[o]]$`std.err`[tests_of_interest]))
}
# Recall our test is done using Facts Baseline vs No-course Baseline (as the reference)
# Thus, we need to reverse the sign [only for AIPW table]
AIPW_tables_followup_df[AIPW_tables_followup_df$test == "No-course Baseline vs Facts Baseline", "estimate"] <- -AIPW_tables_followup_df[AIPW_tables_followup_df$test == "No-course Baseline vs Facts Baseline", "estimate"]
# Plots outcome by assignment group and selected treatment effects #
plot_gen_conditional_misinfo = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
pic = ggplot(data=data,aes(x=treatment,y=mean))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(.9,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=12), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=mean-1.96*se, ymax = mean+1.96*se),width=0.1, size=0.5, position = position_dodge(1))
if (baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+sign(mean)*se),vjust = -2.5,size=num_size)+
geom_text(aes(label=paste("(",as.character(formatC(se,digits=4,format="f")),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=num_size-1)}
if (!baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+se),vjust = -1,size=num_size)
}
pic = pic + geom_hline(yintercept = 0)+
geom_segment(aes(x = 2, y = 1.12, xend = 5, yend = 1.12), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 1.12, xend = 2, yend = 0.7), color = "orange2",size=0.5)+
geom_segment(aes(x = 5, y = 1.12, xend = 5, yend = 0.6), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 1.02, xend = 4, yend = 1.02), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 1.02, xend = 2, yend = 0.7), color = "pink2",size=0.5)+
geom_segment(aes(x = 4, y = 1.02, xend = 4, yend = 0.6), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 0.92, xend = 3, yend = 0.92), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 2, y = 0.92, xend = 2, yend = 0.7), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 3, y = 0.92, xend = 3, yend = 0.65), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 1, y = 0.81, xend = 2, yend = 0.81), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 1, y = 0.81, xend = 1, yend = 0.75), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 2, y = 0.81, xend = 2, yend = 0.7), color = "royalblue3",size=0.5)+
annotate("text",x=4.5,y=1.175,label = paste0(formatC(tests$estimate[4],digits=3,format='f'), "\n(",formatC(tests$se[4],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=3.5,y=1.075,label = paste0(formatC(tests$estimate[3],digits=3,format='f'), "\n(",formatC(tests$se[3],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=2.5,y=0.975,label = paste0(formatC(tests$estimate[2],digits=3,format='f'), "\n(",formatC(tests$se[2],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=1.5,y=0.875,label = paste0(formatC(tests$estimate[1],digits=3,format='f'), "\n(",formatC(tests$se[1],digits=4,format='f'),")"),size=2.5) +
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 10, angle = 0, hjust = .5, vjust = 5, face = "plain"),
axis.text.y = element_text(color = "black", size = 10, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 12, angle = 0, hjust = .5, vjust = 3, face = "bold"),
axis.title.y = element_text(color = "black", size = 15, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank())+
scale_y_continuous(limits = c(y_min,y_max)) +
scale_x_discrete(limits = data$treatment) +
ggtitle(title) +
theme(plot.title = element_text(face='bold', size=12, hjust=0.5, vjust=0.5))
pic}
# Plots outcome by assignment group and selected treatment effects #
plot_gen_misinfo = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
pic = ggplot(data=data,aes(x=treatment,y=mean))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(.9,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=12), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=mean-1.96*se, ymax = mean+1.96*se),width=0.1, size=0.5, position = position_dodge(1))
if (baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+sign(mean)*se),vjust = -2.5,size=num_size)+
geom_text(aes(label=paste("(",as.character(formatC(se,digits=4,format="f")),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=num_size-1)}
if (!baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+se),vjust = -1,size=num_size)
}
pic = pic + geom_hline(yintercept = 0)+
geom_segment(aes(x = 2, y = 1.04, xend = 5, yend = 1.04), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 1.04, xend = 2, yend = 0.63), color = "orange2",size=0.5)+
geom_segment(aes(x = 5, y = 1.04, xend = 5, yend = 0.52), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 0.94, xend = 4, yend = 0.94), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 0.94, xend = 2, yend = 0.63), color = "pink2",size=0.5)+
geom_segment(aes(x = 4, y = 0.94, xend = 4, yend = 0.52), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 0.84, xend = 3, yend = 0.84), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 2, y = 0.84, xend = 2, yend = 0.63), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 3, y = 0.84, xend = 3, yend = 0.57), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 1, y = 0.73, xend = 2, yend = 0.73), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 1, y = 0.73, xend = 1, yend = 0.67), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 2, y = 0.73, xend = 2, yend = 0.63), color = "royalblue3",size=0.5)+
annotate("text",x=4.5,y=1.095,label = paste0(formatC(tests$estimate[4],digits=3,format='f'), "\n(",formatC(tests$se[4],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=3.5,y= 0.995,label = paste0(formatC(tests$estimate[3],digits=3,format='f'), "\n(",formatC(tests$se[3],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=2.5,y=0.895,label = paste0(formatC(tests$estimate[2],digits=3,format='f'), "\n(",formatC(tests$se[2],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=1.5,y=0.795,label = paste0(formatC(tests$estimate[1],digits=3,format='f'), "\n(",formatC(tests$se[1],digits=4,format='f'),")"),size=2.5) +
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 10, angle = 0, hjust = .5, vjust = 5, face = "plain"),
axis.text.y = element_text(color = "black", size = 10, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 12, angle = 0, hjust = .5, vjust = 3, face = "bold"),
axis.title.y = element_text(color = "black", size = 15, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank())+
scale_y_continuous(limits = c(y_min,y_max)) +
scale_x_discrete(limits = data$treatment) +
ggtitle(title) +
theme(plot.title = element_text(face='bold', size=12, hjust=0.5, vjust=0.5))
pic}
# Plots outcome by assignment group and selected treatment effects #
plot_gen_nonmisinfo = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
pic = ggplot(data=data,aes(x=treatment,y=mean))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(.9,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=12), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=mean-1.96*se, ymax = mean+1.96*se),width=0.1, size=0.5, position = position_dodge(1))
if (baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+sign(mean)*se),vjust = -2.5,size=num_size)+
geom_text(aes(label=paste("(",as.character(formatC(se,digits=4,format="f")),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=num_size-1)}
if (!baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+se),vjust = -1,size=num_size)
}
pic = pic + geom_hline(yintercept = 0)+
geom_segment(aes(x = 2, y = 1.2, xend = 5, yend = 1.2), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 1.2, xend = 2, yend = 0.78), color = "orange2",size=0.5)+
geom_segment(aes(x = 5, y = 1.2, xend = 5, yend = 0.7), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 1.09, xend = 4, yend = 1.09), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 1.09, xend = 2, yend = 0.78), color = "pink2",size=0.5)+
geom_segment(aes(x = 4, y = 1.09, xend = 4, yend = 0.7), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 0.98, xend = 3, yend = 0.98), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 2, y = 0.98, xend = 2, yend = 0.83), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 3, y = 0.98, xend = 3, yend = 0.75), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 1, y = 0.88, xend = 2, yend = 0.88), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 1, y = 0.88, xend = 1, yend = 0.82), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 2, y = 0.88, xend = 2, yend = 0.78), color = "royalblue3",size=0.5)+
annotate("text",x=4.5,y=1.255,label = paste0(formatC(tests$estimate[4],digits=3,format='f'), "\n(",formatC(tests$se[4],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=3.5,y= 1.145,label = paste0(formatC(tests$estimate[3],digits=3,format='f'), "\n(",formatC(tests$se[3],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=2.5,y=1.04,label = paste0(formatC(tests$estimate[2],digits=3,format='f'), "\n(",formatC(tests$se[2],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=1.5,y=0.945,label = paste0(formatC(tests$estimate[1],digits=3,format='f'), "\n(",formatC(tests$se[1],digits=4,format='f'),")"),size=2.5) +
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 10, angle = 0, hjust = .5, vjust = 5, face = "plain"),
axis.text.y = element_text(color = "black", size = 10, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 12, angle = 0, hjust = .5, vjust = 3, face = "bold"),
axis.title.y = element_text(color = "black", size = 15, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank())+
scale_y_continuous(limits = c(y_min,y_max)) +
scale_x_discrete(limits = data$treatment) +
ggtitle(title) +
theme(plot.title = element_text(face='bold', size=12, hjust=0.5, vjust=0.5))
pic}
# Plots outcome by assignment group and selected treatment effects #
plot_gen_discern = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
pic = ggplot(data=data,aes(x=treatment,y=mean))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(.9,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=12), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=mean-1.96*se, ymax = mean+1.96*se),width=0.1, size=0.5, position = position_dodge(1))
if (baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+sign(mean)*se),vjust = -2.5,size=num_size)+
geom_text(aes(label=paste("(",as.character(formatC(se,digits=4,format="f")),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=num_size-1)}
if (!baseline){
pic = pic + geom_text(aes(label=as.character(formatC(mean,digits=3,format="f")),y=mean+se),vjust = -1,size=num_size)
}
pic = pic + geom_hline(yintercept = 0)+
geom_segment(aes(x = 2, y = 0.46, xend = 5, yend = 0.46), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 0.46, xend = 2, yend = 0.23), color = "orange2",size=0.5)+
geom_segment(aes(x = 5, y = 0.46, xend = 5, yend = 0.23), color = "orange2",size=0.5)+
geom_segment(aes(x = 2, y = 0.38, xend = 4, yend = 0.38), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 0.38, xend = 2, yend = 0.23), color = "pink2",size=0.5)+
geom_segment(aes(x = 4, y = 0.38, xend = 4, yend = 0.25), color = "pink2",size=0.5)+
geom_segment(aes(x = 2, y = 0.3, xend = 3, yend = 0.3), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 2, y = 0.3, xend = 2, yend = 0.23), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 3, y = 0.3, xend = 3, yend = 0.23), color = "turquoise2",size=0.5)+
geom_segment(aes(x = 1, y = 0.28, xend = 2, yend = 0.28), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 1, y = 0.28, xend = 1, yend = 0.22), color = "royalblue3",size=0.5)+
geom_segment(aes(x = 2, y = 0.28, xend = 2, yend = 0.23), color = "royalblue3",size=0.5)+
annotate("text",x=4.5,y=0.505,label = paste0(formatC(tests$estimate[4],digits=3,format='f'), "\n(",formatC(tests$se[4],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=3.5,y= 0.425,label = paste0(formatC(tests$estimate[3],digits=3,format='f'), "\n(",formatC(tests$se[3],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=2.5,y=0.34,label = paste0(formatC(tests$estimate[2],digits=3,format='f'), "\n(",formatC(tests$se[2],digits=4,format='f'),")"),size=2.5) +
annotate("text",x=1.5,y=0.325,label = paste0(formatC(tests$estimate[1],digits=3,format='f'), "\n(",formatC(tests$se[1],digits=4,format='f'),")"),size=2.5) +
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 10, angle = 0, hjust = .5, vjust = 5, face = "plain"),
axis.text.y = element_text(color = "black", size = 10, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 12, angle = 0, hjust = .5, vjust = 3, face = "bold"),
axis.title.y = element_text(color = "black", size = 15, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank())+
scale_y_continuous(limits = c(y_min,y_max)) +
scale_x_discrete(limits = data$treatment) +
ggtitle(title) +
theme(plot.title = element_text(face='bold', size=12, hjust=0.5, vjust=0.5))
pic}
o <- "Sharing Discernment Score"
figure_data <- treatment_means_df[treatment_means_df$outcome == o,]
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
test_data <- AIPW_tables_df[AIPW_tables_df$outcome == o,]
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
figure_discern <- plot_gen_discern(figure_data, c("gray70","royalblue3","turquoise2","pink2","orange2"),
o,"Intervention assignment group",
-0.0003,0.55,"",3.5,TRUE,test_data)
figure_discern
o <- "Non-Misinfo Sharing Rate"
figure_data <- treatment_means_df[treatment_means_df$outcome == o,]
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
test_data <- AIPW_tables_df[AIPW_tables_df$outcome == o,]
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
figure_nonmisinfo <- plot_gen_nonmisinfo(figure_data, c("gray70","royalblue3","turquoise2","pink2","orange2"),
o,"Intervention assignment group",
-0.0003,1.3,"",3.5,TRUE,test_data)
figure_nonmisinfo
o <- "Misinfo Sharing Rate"
figure_data <- treatment_means_df[treatment_means_df$outcome == o,]
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
test_data <- AIPW_tables_df[AIPW_tables_df$outcome == o,]
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
figure_misinfo <- plot_gen_misinfo(figure_data, c("gray70","royalblue3","turquoise2","pink2","orange2"),
o,"Intervention assignment group",
-0.0003,1.15,"",3.5,TRUE,test_data)
figure_misinfo
o <- "Conditional Misinfo Sharing Rate"
figure_data <- treatment_means_df[treatment_means_df$outcome == o,]
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
test_data <- AIPW_tables_df[AIPW_tables_df$outcome == o,]
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
figure_conditional_misinfo <- plot_gen_conditional_misinfo(figure_data, c("gray70","royalblue3","turquoise2","pink2","orange2"),
o,"Intervention assignment group",
-0.0003,1.22,"",3.5,TRUE,test_data)
figure_conditional_misinfo
plot_gen_te <- function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
tests$treatment <- str_replace_all(tests$test, " vs Facts Baseline", "")
tests$treatment <- factor(tests$treatment, levels = c("No-course Baseline", "Reasoning", "Emotions", "Combo"))
pic = ggplot(data=tests,aes(x=treatment,y=estimate))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),
axis.line.x = element_line(colour="black"),
panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(.9,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=12), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
# geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=estimate-1.96*se, ymax = estimate+1.96*se),width=0.15, size=2, position = position_dodge(1),
colour=color) +
geom_point(size=5,colour=color)
pic = pic+
# dashed line
geom_hline(yintercept = 0, linetype="dashed")+
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 17, angle = 0, hjust = .5, vjust = .5, face = "plain"),
axis.text.y = element_text(color = "black", size = 20, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 27.5, angle = 0, hjust = .5, vjust = .5, face = "bold"),
axis.title.y = element_text(color = "black", size = 27.5, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank()
)+
scale_y_continuous(limits = c(y_min,y_max)) +
scale_x_discrete(limits = tests$treatment) +
ggtitle(title,
subtitle = paste0("Relative to Facts Baseline mean: ", round(data[data$treatment == "Facts Baseline", "mean"], 4))) +
theme(plot.title = element_text(face='bold', size=25, hjust=0.5, vjust=0.5),
plot.subtitle = element_text(face='bold', size=20))
pic}
for (o in headers){
figure_data <- treatment_means_df[treatment_means_df$outcome == o,]
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
test_data <- models_wide_df[models_wide_df$outcome == o,]
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
figure <- plot_gen_te(figure_data, c("royalblue3","turquoise2","pink2","orange2"),
o,"Intervention assignment group",
-0.17,0.17,"",3.5,TRUE,test_data)
print(figure)
ggsave(paste0("figures/", o, ".png"), plot = figure, width = 10, height = 8)
}
for (o in headers){
figure_data <- treatment_means_followup_df[treatment_means_followup_df$outcome == o,]
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
test_data <- models_wide_followup_df[models_wide_followup_df$outcome == o,]
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
figure <- plot_gen_te(figure_data, c("royalblue3","turquoise2","pink2","orange2"),
paste0(o, "\n(Follow-up)"),"Intervention assignment group",
-0.17,0.17,"",3.5,TRUE,test_data)
print(figure)
ggsave(paste0("figures/", o, "_followup.png"), plot = figure, width = 10, height = 8)
}
### Attempt at combining main and followup
plot_gen_te_combined <- function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
tests$treatment <- str_replace_all(tests$test, " vs Facts Baseline", "")
tests$treatment <- factor(tests$treatment, levels = c("No-course Baseline", "Reasoning", "Emotions", "Combo"))
pic = ggplot(data=tests,aes(x=treatment,y=estimate, color = followup))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),
axis.line.x = element_line(colour="black"),
panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(.9,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=12), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
# geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=estimate-1.96*se, ymax = estimate+1.96*se),width=0.3, size=1.5, position = position_dodge(0.5)) +
geom_point(size=5, position = position_dodge(0.5))
pic = pic+
# dashed line
geom_hline(yintercept = 0, linetype="dashed")+
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 17, angle = 0, hjust = 0.25, vjust = .5, face = "plain"),
axis.text.y = element_text(color = "black", size = 20, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 27.5, angle = 0, hjust = .5, vjust = .5, face = "bold"),
axis.title.y = element_text(color = "black", size = 27.5, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank()
)+
scale_y_continuous(limits = c(y_min,y_max)) +
scale_x_discrete(limits = tests$treatment) +
ggtitle(title,
subtitle = paste0("Relative to Facts Baseline mean: ",
round(data[data$treatment == "Facts Baseline" & data$followup == "main", "mean"], 4),
"(Main); ",
round(data[data$treatment == "Facts Baseline" & data$followup == "followup", "mean"], 4),
"(Follow-up)")) +
theme(plot.title = element_text(face='bold', size=25, hjust=0.5, vjust=0.5),
plot.subtitle = element_text(face='bold', size=17))
pic}
treatment_means_followup_df$followup <- "followup"
treatment_means_df$followup <- "main"
models_wide_followup_df$followup <- "followup"
models_wide_df$followup <- "main"
for (o in headers){
figure_data <- rbind(
treatment_means_followup_df[treatment_means_followup_df$outcome == o,],
treatment_means_df[treatment_means_df$outcome == o,])
# make sure treatment order
figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# reorder figure data
figure_data <- figure_data[order(figure_data$treatment),]
figure_data$followup <- factor(figure_data$followup, levels = c("main", "followup"))
test_data <- rbind(
models_wide_followup_df[models_wide_followup_df$outcome == o,],
models_wide_df[models_wide_df$outcome == o,])
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
test_data$followup <- factor(test_data$followup, levels = c("main", "followup"))
figure <- plot_gen_te_combined(figure_data, c("blue4","yellow2"),
o,"Intervention assignment group",
-0.17,0.17,"",3.5,TRUE,test_data)
print(figure)
ggsave(paste0("figures/", o, "_combined.png"), plot = figure, width = 10, height = 8)
}
### Attempt at combining diff_in_mean, OLS w/ covariates, and AIPW
plot_gen_te_main_figure <- function(color,ylab,xlab,y_min,y_max,title,num_size,baseline,tests){
tests$treatment <- str_replace_all(tests$test, " vs Facts Baseline", "")
tests$treatment <- factor(tests$treatment, levels = c("No-course Baseline", "Reasoning", "Emotions", "Combo"))
pic = ggplot(data=tests,aes(x=treatment,y=estimate, color = type))+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),
axis.line.x = element_line(colour="black"),
panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_blank(),
legend.position = c(1,.8),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),
legend.box.just = "right", legend.text = element_text(size=18), legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect( fill="transparent", size=1),legend.background = element_blank()) +
# geom_bar(stat='identity',width=0.5,color="black",fill=color) +
geom_errorbar(aes(ymin=estimate-1.96*se, ymax = estimate+1.96*se),width=0.4, size=1.5, position = position_dodge(0.5)) +
geom_point(size=5, position = position_dodge(0.5))
pic = pic+
# dashed line
geom_hline(yintercept = 0, linetype="dashed")+
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 19, angle = 0, hjust = 0.5, vjust = .5, face = "plain"),
axis.text.y = element_text(color = "black", size = 25, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 27.5, angle = 0, hjust = .5, vjust = .5, face = "bold"),
axis.title.y = element_text(color = "black", size = 27.5, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"),
axis.ticks.x=element_blank()
)+
scale_y_continuous(limits = c(y_min,y_max))
# scale_x_discrete(limits = tests$treatment, expand = c(0, -0.4))
# ggtitle(title,
# subtitle = paste0("Relative to Facts Baseline mean: ",
# round(data[data$treatment == "Facts Baseline" & data$followup == "main", "mean"], 4),
# "(Main); ",
# round(data[data$treatment == "Facts Baseline" & data$followup == "followup", "mean"], 4),
# "(Follow-up)")) +
# theme(plot.title = element_text(face='bold', size=25, hjust=0.5, vjust=0.5),
# plot.subtitle = element_text(face='bold', size=17))
pic}
models_wide_df$type <- "Diff-in-Mean"
models_all_covariates_df$type <- "OLS w/ All Covariates"
AIPW_tables_df$type <- "AIPW"
vars <- c( "outcome","test","estimate","se","type" )
for (o in headers){
# figure_data <- rbind(
# treatment_means_followup_df[treatment_means_followup_df$outcome == o,],
# treatment_means_df[treatment_means_df$outcome == o,])
# # make sure treatment order
# figure_data$treatment <- factor(figure_data$treatment, levels = c("No-course Baseline", "Facts Baseline", "Reasoning", "Emotions", "Combo"))
# # reorder figure data
# figure_data <- figure_data[order(figure_data$treatment),]
# figure_data$type <- factor(figure_data$type, levels = c("Diff-in-Mean", "OLS w/ All Covariates", "AIPW"))
test_data <- rbind(
models_wide_df[models_wide_followup_df$outcome == o, vars],
models_all_covariates_df[models_wide_df$outcome == o, vars],
AIPW_tables_df[AIPW_tables_df$outcome == o, vars])
# reorder test data
test_data$test <- factor(test_data$test, levels = c("No-course Baseline vs Facts Baseline", "Reasoning vs Facts Baseline", "Emotions vs Facts Baseline", "Combo vs Facts Baseline"))
test_data <- test_data[order(test_data$test),]
test_data$type <- factor(test_data$type, levels = c("Diff-in-Mean", "OLS w/ All Covariates", "AIPW"))
figure <- plot_gen_te_main_figure( c("blue4","yellow2"),
o,"Intervention assignment group",
-0.17,0.17,"",3.5,TRUE,test_data)
print(figure)
ggsave(paste0("figures/", o, "_mainfigure.png"), plot = figure, width = 10, height = 8)
}
Figure 5: Misinformation sharing for Treatment Courses only, by
assignment group
Sample includes 4,646 participants in the Reasoning, Emotions or
Combo intervention assignment groups who completed the post-survey and
shared at least one non-misinformation post in the pre-survey. Each
group of bars displays the Sharing Rate for misinformation posts of each
type, as defined in Equation \(\ref{eq:outcome}\), by participants in
their respective intervention assignment group, pooling participants in
the Accuracy Inter and Accuracy After groups. Above each bar, the
standard error is shown in parentheses below the Sharing Rate. The thin
black bars represent 95% confidence intervals. Differences in Sharing
Rates are shown above lines connecting the two relevant intervention
assignment groups, with standard errors in parentheses.
# Plots outcome by assignment group and selected treatment effects #
plot_gen_side_by_side = function(data,color,ylab,xlab,y_max,title,num_size,baseline,tests){
pic = ggplot(data=data,aes(x=grouping,y=mean,group=W,fill=W),xlab = n_tile)+
theme_bw()+
theme(axis.line.y = element_line(colour="black"),panel.border = element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
legend.title = element_text(size=40, face= "bold"),
legend.position = c(0.72,0.95),legend.justification = c("right", "bottom"),
legend.key = element_rect(colour = "transparent"),legend.direction="horizontal",
legend.box.just = "right", legend.text = element_text(size=40), legend.margin = margin(6, 6, 6, 6),
legend.background = element_rect(color = NA)) +
geom_bar(stat='identity',position=position_dodge(width=0.72),width=0.7,color="black",alpha=0.5) +
geom_errorbar(aes(ymin=mean-1.96*sd, ymax = mean+1.96*sd),width=0.3, size=1, position = position_dodge(0.7)) +
geom_hline(yintercept = 0) +
scale_fill_manual(name="Treatment course:",values=color) +
labs(y=ylab,x=xlab)+
theme(axis.text.x = element_text(color = "black", size = 40, angle = 0, hjust = .5, vjust = 5, face = "plain"),
axis.text.y = element_text(color = "black", size = 45, angle = 0, hjust = 0, vjust = .5, face = "plain",
margin=unit(rep(0.5,4),"cm")),
axis.title.x = element_text(color = "black", size = 55, angle = 0, hjust = .5, vjust = 3, face = "bold"),
axis.title.y = element_text(color = "black", size = 60, angle = 90, hjust = .5, vjust = .5, face = "bold"),
axis.ticks.length.y = unit(-0.25,"cm"), axis.ticks.x=element_blank())+
scale_y_continuous(limits = c(-0.0003,y_max)) +
scale_x_discrete(breaks=data$grouping) +
geom_segment(aes(x = 0.66, y = 0.7, xend = 1.12, yend = 0.7), color = "turquoise2",size=2)+
geom_segment(aes(x = 0.66, y = 0.7, xend = 0.66, yend = 0.64), color = "turquoise2",size=2)+
geom_segment(aes(x = 1.12, y = 0.7, xend = 1.12, yend = 0.64), color = "turquoise2",size=2)+
geom_segment(aes(x = 0.66, y = 0.83, xend = 1.33, yend = 0.83), color = "turquoise2",size=2)+
geom_segment(aes(x = 0.66, y = 0.83, xend = 0.66, yend = 0.64), color = "turquoise2",size=2)+
geom_segment(aes(x = 1.33, y = 0.83, xend = 1.33, yend = 0.64), color = "turquoise2",size=2)+
geom_segment(aes(x = 1.66, y = 0.7, xend = 1.99, yend = 0.7), color = "pink2",size=2)+
geom_segment(aes(x = 1.66, y = 0.7, xend = 1.66, yend = 0.64), color = "pink2",size=2)+
geom_segment(aes(x = 1.99, y = 0.7, xend = 1.99, yend = 0.64), color = "pink2",size=2)+
geom_segment(aes(x = 2.01, y = 0.7, xend = 2.33, yend = 0.7), color = "pink2",size=2)+
geom_segment(aes(x = 2.01, y = 0.7, xend = 2.01, yend = 0.64), color = "pink2",size=2)+
geom_segment(aes(x = 2.33, y = 0.7, xend = 2.33, yend = 0.64), color = "pink2",size=2)+
geom_segment(aes(x = 3.33, y = 0.7, xend = 2.88, yend = 0.7), color = "orange2",size=2)+
geom_segment(aes(x = 3.33, y = 0.7, xend = 3.33, yend = 0.64), color = "orange2",size=2)+
geom_segment(aes(x = 2.88, y = 0.7, xend = 2.88, yend = 0.64), color = "orange2",size=2)+
geom_segment(aes(x = 2.66, y = 0.83, xend = 3.33, yend = 0.83), color = "orange2",size=2)+
geom_segment(aes(x = 2.66, y = 0.83, xend = 2.66, yend = 0.64), color = "orange2",size=2)+
geom_segment(aes(x = 3.33, y = 0.83, xend = 3.33, yend = 0.64), color = "orange2",size=2)+
annotate("text",x=3.115,y=0.755,label = paste0(formatC(tests$estimates[6],digits=3,format='f'), "\n(",formatC(tests$std.err[6],digits=4,format='f'),")"),size=12) +
annotate("text",x=3,y=0.885,label = paste0(formatC(tests$estimates[5],digits=3,format='f'), "\n(",formatC(tests$std.err[5],digits=4,format='f'),")"),size=12) +
annotate("text",x=2.17,y=0.755,label = paste0(formatC(tests$estimates[4],digits=3,format='f'), "\n(",formatC(tests$std.err[4],digits=4,format='f'),")"),size=12) +
annotate("text",x=1.83,y=0.755,label = paste0(formatC(tests$estimates[3],digits=3,format='f'), "\n(",formatC(tests$std.err[3],digits=4,format='f'),")"),size=12) +
annotate("text",x=1,y=0.885,label = paste0(formatC(tests$estimates[2],digits=3,format='f'), "\n(",formatC(tests$std.err[2],digits=4,format='f'),")"),size=12) +
annotate("text",x=0.885,y=0.755,label = paste0(formatC(tests$estimates[1],digits=3,format='f'), "\n(",formatC(tests$std.err[1],digits=4,format='f'),")"),size=12) +
ggtitle(title) +
theme(plot.title = element_text(face='bold', size=50, hjust=0.5, vjust=0.5))
if (baseline){
pic = pic + geom_text(aes(group=W,label=formatC(mean,digits=3,format="f"),y=mean+2*sd), position = position_dodge(0.72),vjust = -2.5,size=num_size)+
geom_text(aes(group=W,label=paste("(",formatC(sd,digits=4,format='f'),")",sep=""),y=mean+2*sd), position = position_dodge(0.72),vjust = -1,size=num_size-1)}
if (!baseline){
pic = pic + geom_text(aes(group=W,label=as.character(formatC(mean,digits=3,format="f")),y=mean+2*sd), position = position_dodge(0.72),vjust = -1,size=num_size)
}
pic}
# Pre-allocate dataframe #
figure_5_data = data.frame(matrix(NA,9,3))
colnames(figure_5_data) = c("mean","sd","base_perc")
# Fill means and standard errors #
figure_5_data[1:3,1] = aggregate(share_post~treatment,course_tests_data_by_type_final[course_tests_data_by_type_final$type_post=="Reasoning posts" &
course_tests_data_by_type_final$treatment %in% c("Reasoning","Emotions","Combo"),],mean)[,2]
figure_5_data[4:6,1] = aggregate(share_post~treatment,course_tests_data_by_type_final[course_tests_data_by_type_final$type_post=="Emotions posts" &
course_tests_data_by_type_final$treatment %in% c("Reasoning","Emotions","Combo"),],mean)[,2]
figure_5_data[7:9,1] = aggregate(share_post~treatment,course_tests_data_by_type_final[course_tests_data_by_type_final$type_post =="Combo posts" &
course_tests_data_by_type_final$treatment %in% c("Reasoning","Emotions","Combo"),],mean)[,2]
figure_5_data[1:3,2] = aggregate(share_post~treatment,course_tests_data_by_type_final[course_tests_data_by_type_final$type_post=="Reasoning posts" &
course_tests_data_by_type_final$treatment %in% c("Reasoning","Emotions","Combo"),],se_binary)[,2]
figure_5_data[4:6,2] = aggregate(share_post~treatment,course_tests_data_by_type_final[course_tests_data_by_type_final$type_post=="Emotions posts" &
course_tests_data_by_type_final$treatment %in% c("Reasoning","Emotions","Combo"),],se_binary)[,2]
figure_5_data[7:9,2] = aggregate(share_post~treatment,course_tests_data_by_type_final[course_tests_data_by_type_final$type_post =="Combo posts" &
course_tests_data_by_type_final$treatment %in% c("Reasoning","Emotions","Combo"),],se_binary)[,2]
# Add grouping variables #
figure_5_data$W = factor(rep(c("Reasoning","Emotions","Combo"),3),levels = c("Reasoning","Emotions","Combo"))
figure_5_data$grouping = factor(rep(c("Reasoning posts","Emotions posts","Combo posts"),each=3),levels = c("Reasoning posts","Emotions posts","Combo posts"))
# Extract relevant treatment effect estimates #
tests_figure_5 = data.frame(matrix(NA),6,2)
tests_figure_5 = main_tests$tests[c("Test 13","Test 14","Test 16","Test 17","Test 19","Test 20"),c("estimates","std.err")]
figure_5 = plot_gen_side_by_side(figure_5_data,c("turquoise2","pink2","orange2"),"Sharing Rate",
"Post type",1,"",12,TRUE,tests_figure_5)
figure_5
ggsave("figures/misinfo_sharing_by_assignment_group.png", plot = figure_5, width = 30, height = 15)
Panel Regression Table
panel_2 <- readRDS("regression_analysis_long/data/panel_2.rds")
cov_estimates_list <- readRDS("regression_analysis_long/data/cov_estimates_list.rds")
panel <- readRDS("regression_analysis_long/data/panel.rds")
# cov_estimates_list_all <- readRDS("regression_analysis_long/data/cov_estimates_list_all.rds")
# cov_roose_all_list <- readRDS("regression_analysis_long/data/cov_roose_all_list.rds")
# models_cov <- list('cov1_lm','cov2_lm','cov3_lm','cov4_lm','cov5_lm','cov6_lm')
# models_cov <- lapply(1:length(models_cov),
# function(x) readRDS(paste0("regression_analysis_long/R2_outofsample/R2oos_cov_2treat_",x, "_5.rds")))
#
R2oos_cov_alltreat_all <- c("", "", "", "", "", "")
R2oos_cov_2treat_all <- c("", "", "", "", "", "")
covariate_list <- c(demographics_demeaned_treatment,
sharing_demeaned_treatment,
sharing_tactic_demeaned_treatment,
demographics_sharing_demeaned_treatment,
all_covariates_demeaned_treatment)
panel_3 <- panel %>% filter(treatment %in% c("Reasoning","Facts Baseline"))
panel_3$treatment <- factor(panel_3$treatment, levels = c('Facts Baseline','Reasoning'))
panel_4 <- panel %>% filter(treatment %in% c("Combo","Facts Baseline"))
panel_4$treatment <- factor(panel_4$treatment, levels = c('Facts Baseline','Combo'))
panel_5 <- panel %>% filter(treatment %in% c("No-course Baseline","Facts Baseline"))
panel_5$treatment <- factor(panel_5$treatment, levels = c('Facts Baseline','No-course Baseline'))
cov_estimates_list_reasoning <- list()
for (cov_list in covariate_list) {
# Demographics
formula_cov1_lm <- paste0("share ~ treatment*post*post_is_misinfo "," + ",cov_list)
cov1_lm <- feols(as.formula(formula_cov1_lm),panel_3)
formula_cov2_lm <- paste0("share ~ treatment*post*post_is_misinfo "," + ",cov_list," | user")
cov2_lm <- feols(as.formula(formula_cov2_lm),panel_3)
# Misinfo and Non-misinfo sharing rates
formula_cov3_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(fact) "," + ",cov_list," | user")
cov3_lm <- feols(as.formula(formula_cov3_lm),panel_3)
# Misinfo, Non-misinfo, and Tactic sharing rates
formula_cov4_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(type) "," + ",cov_list," | user")
cov4_lm <- feols(as.formula(formula_cov4_lm),panel_3)
# Demographics and Misinfo and Non-misinfo sharing rates
formula_cov5_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(fact)*factor(type) "," + ",cov_list," | user")
cov5_lm <- feols(as.formula(formula_cov5_lm),panel_3)
# Demographics, Misinfo and Non-misinfo sharing rates, and Tactic sharing rates
formula_cov6_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(post_id) "," + ",cov_list," | user")
cov6_lm <- feols(as.formula(formula_cov6_lm),panel_3)
cov_estimates_list_reasoning[[length(cov_estimates_list_reasoning) + 1]] <- list(cov1_lm,cov2_lm,cov3_lm,cov4_lm,cov5_lm,cov6_lm)
}
cov_estimates_list_combo <- list()
for (cov_list in covariate_list) {
# Demographics
formula_cov1_lm <- paste0("share ~ treatment*post*post_is_misinfo "," + ",cov_list)
cov1_lm <- feols(as.formula(formula_cov1_lm),panel_4)
formula_cov2_lm <- paste0("share ~ treatment*post*post_is_misinfo "," + ",cov_list," | user")
cov2_lm <- feols(as.formula(formula_cov2_lm),panel_4)
# Misinfo and Non-misinfo sharing rates
formula_cov3_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(fact) "," + ",cov_list," | user")
cov3_lm <- feols(as.formula(formula_cov3_lm),panel_4)
# Misinfo, Non-misinfo, and Tactic sharing rates
formula_cov4_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(type) "," + ",cov_list," | user")
cov4_lm <- feols(as.formula(formula_cov4_lm),panel_4)
# Demographics and Misinfo and Non-misinfo sharing rates
formula_cov5_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(fact)*factor(type) "," + ",cov_list," | user")
cov5_lm <- feols(as.formula(formula_cov5_lm),panel_4)
# Demographics, Misinfo and Non-misinfo sharing rates, and Tactic sharing rates
formula_cov6_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(post_id) "," + ",cov_list," | user")
cov6_lm <- feols(as.formula(formula_cov6_lm),panel_4)
cov_estimates_list_combo[[length(cov_estimates_list_combo) + 1]] <- list(cov1_lm,cov2_lm,cov3_lm,cov4_lm,cov5_lm,cov6_lm)
}
cov_estimates_list_nocourse <- list()
for (cov_list in covariate_list) {
# Demographics
formula_cov1_lm <- paste0("share ~ treatment*post*post_is_misinfo "," + ",cov_list)
cov1_lm <- feols(as.formula(formula_cov1_lm),panel_5)
formula_cov2_lm <- paste0("share ~ treatment*post*post_is_misinfo "," + ",cov_list," | user")
cov2_lm <- feols(as.formula(formula_cov2_lm),panel_5)
# Misinfo and Non-misinfo sharing rates
formula_cov3_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(fact) "," + ",cov_list," | user")
cov3_lm <- feols(as.formula(formula_cov3_lm),panel_5)
# Misinfo, Non-misinfo, and Tactic sharing rates
formula_cov4_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(type) "," + ",cov_list," | user")
cov4_lm <- feols(as.formula(formula_cov4_lm),panel_5)
# Demographics and Misinfo and Non-misinfo sharing rates
formula_cov5_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(fact)*factor(type) "," + ",cov_list," | user")
cov5_lm <- feols(as.formula(formula_cov5_lm),panel_5)
# Demographics, Misinfo and Non-misinfo sharing rates, and Tactic sharing rates
formula_cov6_lm <- paste0("share ~ treatment*post*post_is_misinfo + factor(post_id) "," + ",cov_list," | user")
cov6_lm <- feols(as.formula(formula_cov6_lm),panel_5)
cov_estimates_list_nocourse[[length(cov_estimates_list_nocourse) + 1]] <- list(cov1_lm,cov2_lm,cov3_lm,cov4_lm,cov5_lm,cov6_lm)
}
cov <- 5
# Print model
headers <- c("Share (binary indicator)")
model_list <- cov_estimates_list[[cov]]
names <- unique(c(names(cov_estimates_list[[cov]][[1]]$coefficients),
names(cov_estimates_list[[cov]][[2]]$coefficients),
names(cov_estimates_list[[cov]][[3]]$coefficients),
names(cov_estimates_list[[cov]][[4]]$coefficients),
names(cov_estimates_list[[cov]][[5]]$coefficients),
names(cov_estimates_list[[cov]][[6]]$coefficients)))
variable_labels_wide <- variable_mapping_long[names]
# remova NA
variable_labels_wide <- variable_labels_wide[!is.na(variable_labels_wide)]
# remove blankrows
coef_names <- names
matrix_coeff_na <- expand.grid(coef_name = coef_names, model = seq(length(model_list)))
matrix_coeff_na$var <- 0
matrix_coeff_na$var_na <- 0
for (m in 1:length(model_list)) {
na_coeff <- names(model_list[[m]]$coefficients)[is.na(model_list[[m]]$coefficients)]
for (c in na_coeff) {
matrix_coeff_na$var[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1 # 1 if variable is in the model (not all models have all variables)
matrix_coeff_na$var_na[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1
}
}
matrix_coeff_na <- matrix_coeff_na %>% group_by(coef_name) %>% mutate(var = sum(var), var_na = sum(var_na)) %>% distinct(coef_name,var,var_na)
rows_to_omit <- as.vector(unique(matrix_coeff_na$coef_name[matrix_coeff_na$var_na != 0])) # omit if NA in all models
rows_to_omit <- gsub("\\^\\s","^",paste0("^",rows_to_omit,"$", collapse = "|"))
rows_to_omit <- gsub("\\(","\\\\(",gsub("\\)","\\\\)",rows_to_omit))
# keep variables
# keep <- c("treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]")
keep <- list(
# "treatmentReasoning:post:post_is_misinfo" = "Reasoning x 1[Post-treatment] x 1[Misinfo]",
# "treatmentReasoning:post" = "Reasoning x 1[Post-treatment]",
# "treatmentReasoning:post_is_misinfo" = "Reasoning x 1[Misinfo]",
"treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
"treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
"treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]"
# "treatmentCombo:post:post_is_misinfo" = "Combo x 1[Post-treatment] x 1[Misinfo]",
# "treatmentCombo:post" = "Combo x 1[Post-treatment]",
# "treatmentCombo:post_is_misinfo" = "Combo x 1[Misinfo]",
)
custom.gof.rows <- list("Fixed Effect" = function(x) {
if (sum(grepl("post_id", formula(x)[[3]]))> 0) return ("Post ID")
if (sum(grepl("fact", formula(x)[[3]]) & grepl("type", formula(x)[[3]]))> 0) return ("Domain x Tactic")
if (sum(grepl("fact", formula(x)[[3]]))> 0) return ("Domain")
if (sum(grepl("type", formula(x)[[3]]))> 0) return ("Tactic")
return ("")
})
Emotions
etable(model_list,
title = paste("Linear Regression:", headers,
"vs. Treatment for different set of fixed effects\n<br>Covariates: Demographics + Sharing rates"),
dict = variable_labels_wide,
headers = c("Baseline<br>(1)",
"User ID FE<br>(2)",
"User ID FE +<br>Post domain FE<br>(3)",
"User ID FE +<br>Post tactic FE<br>(4)",
"User ID FE +<br>Post domain x Post tactic<br>(5)",
"User ID FE +<br>Post ID FE<br>(6)"),
keep = paste0("%", names(keep)),
signif.code = c("***" = 0.02, "**" = 0.1, "*" = 0.2),
notes = "Significance levels: \\*p<0.10, \\*\\*p<0.05, \\*\\*\\*p<0.01 one-sided test.",
extralines = list("Fixed Effect" = c("", "", "Domain", "Tactic", "Domain x Tactic", "Post ID")),
digits = 4,tex = F)
## model 1
## Baseline<br>(1)
## Dependent Var.: share
##
## Emotions x 1[Post-treatment] -0.0938*** (0.0115)
## Emotions x 1[Misinfo] -0.0039 (0.0100)
## Emotions x 1[Post-treatment] x 1[Misinfo] -0.0202* (0.0141)
## Fixed Effect
## Fixed-Effects: -------------------
## user No
## ________________________________________ ___________________
## S.E. type IID
## Observations 65,268
## R2 0.27443
## Within R2 --
##
## model 2
## User ID FE<br>(2)
## Dependent Var.: share
##
## Emotions x 1[Post-treatment] -0.0938*** (0.0132)
## Emotions x 1[Misinfo] -0.0039 (0.0100)
## Emotions x 1[Post-treatment] x 1[Misinfo] -0.0202* (0.0136)
## Fixed Effect
## Fixed-Effects: -------------------
## user Yes
## ________________________________________ ___________________
## S.E. type by: user
## Observations 65,268
## R2 0.34226
## Within R2 0.05688
##
## model 3
## User ID FE +<br>Post domain FE<br>(3)
## Dependent Var.: share
##
## Emotions x 1[Post-treatment] -0.0948*** (0.0129)
## Emotions x 1[Misinfo] -0.0015 (0.0097)
## Emotions x 1[Post-treatment] x 1[Misinfo] -0.0221** (0.0129)
## Fixed Effect Domain
## Fixed-Effects: -------------------
## user Yes
## ________________________________________ ___________________
## S.E. type by: user
## Observations 65,268
## R2 0.39387
## Within R2 0.13089
##
## model 4
## User ID FE +<br>Post tactic FE<br>(4)
## Dependent Var.: share
##
## Emotions x 1[Post-treatment] -0.0938*** (0.0132)
## Emotions x 1[Misinfo] -0.0039 (0.0100)
## Emotions x 1[Post-treatment] x 1[Misinfo] -0.0202* (0.0136)
## Fixed Effect Tactic
## Fixed-Effects: -------------------
## user Yes
## ________________________________________ ___________________
## S.E. type by: user
## Observations 65,268
## R2 0.34309
## Within R2 0.05808
##
## model 5
## User ID FE +<br>Post domain x Post tactic<br>(5)
## Dependent Var.: share
##
## Emotions x 1[Post-treatment] -0.0956*** (0.0128)
## Emotions x 1[Misinfo] -0.0024 (0.0096)
## Emotions x 1[Post-treatment] x 1[Misinfo] -0.0246** (0.0127)
## Fixed Effect Domain x Tactic
## Fixed-Effects: -------------------
## user Yes
## ________________________________________ ___________________
## S.E. type by: user
## Observations 65,268
## R2 0.41539
## Within R2 0.16175
##
## model 6
## User ID FE +<br>Post ID FE<br>(6)
## Dependent Var.: share
##
## Emotions x 1[Post-treatment] -0.0956*** (0.0128)
## Emotions x 1[Misinfo] -0.0024 (0.0096)
## Emotions x 1[Post-treatment] x 1[Misinfo] -0.0246** (0.0127)
## Fixed Effect Post ID
## Fixed-Effects: -------------------
## user Yes
## ________________________________________ ___________________
## S.E. type by: user
## Observations 65,268
## R2 0.41539
## Within R2 0.16175
## ---
## Signif. codes: 0 '***' 0.02 '**' 0.1 '*' 0.2 ' ' 1
texreg::texreg(model_list,
custom.header = list("Share (binary indicator)" = 1:length(model_list)),
custom.model.names = c("\\makecell{Baseline \\\\ (1)}",
"\\makecell{User ID FE \\\\ (2)}",
"\\makecell{User ID FE + \\\\ Post domain FE \\\\ (3)}",
"\\makecell{User ID FE + \\\\ Post tactic FE \\\\ (4)}",
"\\makecell{User ID FE + \\\\ Post domain x Post tactic \\\\ (5)}",
"\\makecell{User ID FE + \\\\ Post ID FE \\\\ (6)}"),
stars = c(0.20, 0.10, 0.02),
custom.note = "Significance levels: \\*p<0.10, \\*\\*p<0.05, \\*\\*\\*p<0.01 one-sided test.",
caption = paste("Linear Regression:", headers, "vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]"),
caption.above = TRUE,
doctype = FALSE,
html.tag = FALSE,
table.tag = FALSE,
single.row = FALSE,
include.groups = FALSE,
digits = 4,
custom.coef.names = variable_labels_wide,
custom.coef.map = keep,
custom.gof.rows = list("Fixed Effects" = c("",rep("user",length(model_list)-1)),
"Fixed Effects" = c("","","Domain","Tactic","Domain x Tactic","Post ID"),
"Covariates" = c("",rep("Demographics + Sharing rates",length(model_list)-1)),
"Clustered Std. Errors" = rep("user",length(model_list)),
"Out-of-sample R^2" = c(R2oos_cov_2treat_all)),
reorder.gof = c(6,7,8,9,10,5,1,2,3,4))
##
## \begin{table}
## \caption{Linear Regression: Share (binary indicator) vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]}
## \begin{center}
## \begin{tabular}{l c c c c c c}
## \hline
## & \multicolumn{6}{c}{Share (binary indicator)} \\
## \cline{2-7}
## & \makecell{Baseline \\ (1)} & \makecell{User ID FE \\ (2)} & \makecell{User ID FE + \\ Post domain FE \\ (3)} & \makecell{User ID FE + \\ Post tactic FE \\ (4)} & \makecell{User ID FE + \\ Post domain x Post tactic \\ (5)} & \makecell{User ID FE + \\ Post ID FE \\ (6)} \\
## \hline
## Emotions x 1[Post-treatment] x 1[Misinfo] & $-0.0202^{*}$ & $-0.0202^{*}$ & $-0.0221^{**}$ & $-0.0202^{*}$ & $-0.0246^{**}$ & $-0.0246^{**}$ \\
## & $(0.0141)$ & $(0.0136)$ & $(0.0129)$ & $(0.0136)$ & $(0.0127)$ & $(0.0127)$ \\
## Emotions x 1[Post-treatment] & $-0.0938^{***}$ & $-0.0938^{***}$ & $-0.0948^{***}$ & $-0.0938^{***}$ & $-0.0956^{***}$ & $-0.0956^{***}$ \\
## & $(0.0115)$ & $(0.0132)$ & $(0.0129)$ & $(0.0132)$ & $(0.0128)$ & $(0.0128)$ \\
## Emotions x 1[Misinfo] & $-0.0039$ & $-0.0039$ & $-0.0015$ & $-0.0039$ & $-0.0024$ & $-0.0024$ \\
## & $(0.0100)$ & $(0.0100)$ & $(0.0097)$ & $(0.0100)$ & $(0.0096)$ & $(0.0096)$ \\
## \hline
## Num. obs. & $65268$ & $65268$ & $65268$ & $65268$ & $65268$ & $65268$ \\
## R$^2$ (full model) & $0.2744$ & $0.3423$ & $0.3939$ & $0.3431$ & $0.4154$ & $0.4154$ \\
## R$^2$ (proj model) & $$ & $0.0569$ & $0.1309$ & $0.0581$ & $0.1618$ & $0.1618$ \\
## Adj. R$^2$ (full model) & $0.2738$ & $0.3035$ & $0.3580$ & $0.3044$ & $0.3804$ & $0.3804$ \\
## Adj. R$^2$ (proj model) & $$ & $0.0568$ & $0.1306$ & $0.0579$ & $0.1609$ & $0.1609$ \\
## Out-of-sample R$^2$ & & & & & & \\
## Fixed Effects & & user & user & user & user & user \\
## Fixed Effects & & & Domain & Tactic & Domain x Tactic & Post ID \\
## Covariates & & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates \\
## Clustered Std. Errors & user & user & user & user & user & user \\
## \hline
## \multicolumn{7}{l}{\scriptsize{Significance levels: \*p<0.10, \*\*p<0.05, \*\*\*p<0.01 one-sided test.}}
## \end{tabular}
## \label{table:coefficients}
## \end{center}
## \end{table}
Reasoning
cov <- 5
# Print model
headers <- c("Share (binary indicator)")
model_list <- cov_estimates_list_reasoning[[cov]]
names <- unique(c(names(cov_estimates_list_reasoning[[cov]][[1]]$coefficients),
names(cov_estimates_list_reasoning[[cov]][[2]]$coefficients),
names(cov_estimates_list_reasoning[[cov]][[3]]$coefficients),
names(cov_estimates_list_reasoning[[cov]][[4]]$coefficients),
names(cov_estimates_list_reasoning[[cov]][[5]]$coefficients),
names(cov_estimates_list_reasoning[[cov]][[6]]$coefficients)))
variable_labels_wide <- variable_mapping_long[names]
# remova NA
variable_labels_wide <- variable_labels_wide[!is.na(variable_labels_wide)]
# remove blankrows
coef_names <- names
matrix_coeff_na <- expand.grid(coef_name = coef_names, model = seq(length(model_list)))
matrix_coeff_na$var <- 0
matrix_coeff_na$var_na <- 0
for (m in 1:length(model_list)) {
na_coeff <- names(model_list[[m]]$coefficients)[is.na(model_list[[m]]$coefficients)]
for (c in na_coeff) {
matrix_coeff_na$var[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1 # 1 if variable is in the model (not all models have all variables)
matrix_coeff_na$var_na[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1
}
}
matrix_coeff_na <- matrix_coeff_na %>% group_by(coef_name) %>% mutate(var = sum(var), var_na = sum(var_na)) %>% distinct(coef_name,var,var_na)
rows_to_omit <- as.vector(unique(matrix_coeff_na$coef_name[matrix_coeff_na$var_na != 0])) # omit if NA in all models
rows_to_omit <- gsub("\\^\\s","^",paste0("^",rows_to_omit,"$", collapse = "|"))
rows_to_omit <- gsub("\\(","\\\\(",gsub("\\)","\\\\)",rows_to_omit))
# keep variables
# keep <- c("treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]")
keep <- list(
"treatmentReasoning:post:post_is_misinfo" = "Reasoning x 1[Post-treatment] x 1[Misinfo]",
"treatmentReasoning:post" = "Reasoning x 1[Post-treatment]",
"treatmentReasoning:post_is_misinfo" = "Reasoning x 1[Misinfo]"
# "treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]"
#
# "treatmentCombo:post:post_is_misinfo" = "Combo x 1[Post-treatment] x 1[Misinfo]",
# "treatmentCombo:post" = "Combo x 1[Post-treatment]",
# "treatmentCombo:post_is_misinfo" = "Combo x 1[Misinfo]",
)
custom.gof.rows <- list("Fixed Effect" = function(x) {
if (sum(grepl("post_id", formula(x)[[3]]))> 0) return ("Post ID")
if (sum(grepl("fact", formula(x)[[3]]) & grepl("type", formula(x)[[3]]))> 0) return ("Domain x Tactic")
if (sum(grepl("fact", formula(x)[[3]]))> 0) return ("Domain")
if (sum(grepl("type", formula(x)[[3]]))> 0) return ("Tactic")
return ("")
})
texreg::texreg(model_list,
custom.header = list("Share (binary indicator)" = 1:length(model_list)),
custom.model.names = c("\\makecell{Baseline \\\\ (1)}",
"\\makecell{User ID FE \\\\ (2)}",
"\\makecell{User ID FE + \\\\ Post domain FE \\\\ (3)}",
"\\makecell{User ID FE + \\\\ Post tactic FE \\\\ (4)}",
"\\makecell{User ID FE + \\\\ Post domain x Post tactic \\\\ (5)}",
"\\makecell{User ID FE + \\\\ Post ID FE \\\\ (6)}"),
stars = c(0.20, 0.10, 0.02),
custom.note = "Significance levels: \\*p<0.10, \\*\\*p<0.05, \\*\\*\\*p<0.01 one-sided test.",
caption = paste("Linear Regression:", headers, "vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]"),
caption.above = TRUE,
doctype = FALSE,
html.tag = FALSE,
table.tag = FALSE,
single.row = FALSE,
include.groups = FALSE,
digits = 4,
custom.coef.names = variable_labels_wide,
custom.coef.map = keep,
custom.gof.rows = list("Fixed Effects" = c("",rep("user",length(model_list)-1)),
"Fixed Effects" = c("","","Domain","Tactic","Domain x Tactic","Post ID"),
"Covariates" = c("",rep("Demographics + Sharing rates",length(model_list)-1)),
"Clustered Std. Errors" = rep("user",length(model_list)),
"Out-of-sample R^2" = c(R2oos_cov_2treat_all)),
reorder.gof = c(6,7,8,9,10,5,1,2,3,4))
##
## \begin{table}
## \caption{Linear Regression: Share (binary indicator) vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]}
## \begin{center}
## \begin{tabular}{l c c c c c c}
## \hline
## & \multicolumn{6}{c}{Share (binary indicator)} \\
## \cline{2-7}
## & \makecell{Baseline \\ (1)} & \makecell{User ID FE \\ (2)} & \makecell{User ID FE + \\ Post domain FE \\ (3)} & \makecell{User ID FE + \\ Post tactic FE \\ (4)} & \makecell{User ID FE + \\ Post domain x Post tactic \\ (5)} & \makecell{User ID FE + \\ Post ID FE \\ (6)} \\
## \hline
## Reasoning x 1[Post-treatment] x 1[Misinfo] & $0.0154$ & $0.0154$ & $0.0130$ & $0.0154$ & $0.0109$ & $0.0109$ \\
## & $(0.0143)$ & $(0.0139)$ & $(0.0132)$ & $(0.0139)$ & $(0.0130)$ & $(0.0130)$ \\
## Reasoning x 1[Post-treatment] & $-0.0777^{***}$ & $-0.0777^{***}$ & $-0.0786^{***}$ & $-0.0777^{***}$ & $-0.0785^{***}$ & $-0.0785^{***}$ \\
## & $(0.0117)$ & $(0.0130)$ & $(0.0128)$ & $(0.0130)$ & $(0.0127)$ & $(0.0127)$ \\
## Reasoning x 1[Misinfo] & $-0.0196^{**}$ & $-0.0196^{**}$ & $-0.0143^{*}$ & $-0.0196^{**}$ & $-0.0152^{*}$ & $-0.0152^{*}$ \\
## & $(0.0101)$ & $(0.0101)$ & $(0.0097)$ & $(0.0101)$ & $(0.0096)$ & $(0.0096)$ \\
## \hline
## Num. obs. & $62640$ & $62640$ & $62640$ & $62640$ & $62640$ & $62640$ \\
## R$^2$ (full model) & $0.2820$ & $0.3481$ & $0.3995$ & $0.3486$ & $0.4198$ & $0.4198$ \\
## R$^2$ (proj model) & $$ & $0.0476$ & $0.1227$ & $0.0484$ & $0.1524$ & $0.1524$ \\
## Adj. R$^2$ (full model) & $0.2814$ & $0.3097$ & $0.3639$ & $0.3102$ & $0.3850$ & $0.3850$ \\
## Adj. R$^2$ (proj model) & $$ & $0.0475$ & $0.1224$ & $0.0482$ & $0.1515$ & $0.1515$ \\
## Out-of-sample R$^2$ & & & & & & \\
## Fixed Effects & & user & user & user & user & user \\
## Fixed Effects & & & Domain & Tactic & Domain x Tactic & Post ID \\
## Covariates & & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates \\
## Clustered Std. Errors & user & user & user & user & user & user \\
## \hline
## \multicolumn{7}{l}{\scriptsize{Significance levels: \*p<0.10, \*\*p<0.05, \*\*\*p<0.01 one-sided test.}}
## \end{tabular}
## \label{table:coefficients}
## \end{center}
## \end{table}
Combo
cov <- 5
# Print model
headers <- c("Share (binary indicator)")
model_list <- cov_estimates_list_combo[[cov]]
names <- unique(c(names(cov_estimates_list_combo[[cov]][[1]]$coefficients),
names(cov_estimates_list_combo[[cov]][[2]]$coefficients),
names(cov_estimates_list_combo[[cov]][[3]]$coefficients),
names(cov_estimates_list_combo[[cov]][[4]]$coefficients),
names(cov_estimates_list_combo[[cov]][[5]]$coefficients),
names(cov_estimates_list_combo[[cov]][[6]]$coefficients)))
variable_labels_wide <- variable_mapping_long[names]
# remova NA
variable_labels_wide <- variable_labels_wide[!is.na(variable_labels_wide)]
# remove blankrows
coef_names <- names
matrix_coeff_na <- expand.grid(coef_name = coef_names, model = seq(length(model_list)))
matrix_coeff_na$var <- 0
matrix_coeff_na$var_na <- 0
for (m in 1:length(model_list)) {
na_coeff <- names(model_list[[m]]$coefficients)[is.na(model_list[[m]]$coefficients)]
for (c in na_coeff) {
matrix_coeff_na$var[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1 # 1 if variable is in the model (not all models have all variables)
matrix_coeff_na$var_na[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1
}
}
matrix_coeff_na <- matrix_coeff_na %>% group_by(coef_name) %>% mutate(var = sum(var), var_na = sum(var_na)) %>% distinct(coef_name,var,var_na)
rows_to_omit <- as.vector(unique(matrix_coeff_na$coef_name[matrix_coeff_na$var_na != 0])) # omit if NA in all models
rows_to_omit <- gsub("\\^\\s","^",paste0("^",rows_to_omit,"$", collapse = "|"))
rows_to_omit <- gsub("\\(","\\\\(",gsub("\\)","\\\\)",rows_to_omit))
# keep variables
# keep <- c("treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]")
keep <- list(
# "treatmentReasoning:post:post_is_misinfo" = "Reasoning x 1[Post-treatment] x 1[Misinfo]",
# "treatmentReasoning:post" = "Reasoning x 1[Post-treatment]",
# "treatmentReasoning:post_is_misinfo" = "Reasoning x 1[Misinfo]"
# "treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]"
#
"treatmentCombo:post:post_is_misinfo" = "Combo x 1[Post-treatment] x 1[Misinfo]",
"treatmentCombo:post" = "Combo x 1[Post-treatment]",
"treatmentCombo:post_is_misinfo" = "Combo x 1[Misinfo]"
)
custom.gof.rows <- list("Fixed Effect" = function(x) {
if (sum(grepl("post_id", formula(x)[[3]]))> 0) return ("Post ID")
if (sum(grepl("fact", formula(x)[[3]]) & grepl("type", formula(x)[[3]]))> 0) return ("Domain x Tactic")
if (sum(grepl("fact", formula(x)[[3]]))> 0) return ("Domain")
if (sum(grepl("type", formula(x)[[3]]))> 0) return ("Tactic")
return ("")
})
texreg::texreg(model_list,
custom.header = list("Share (binary indicator)" = 1:length(model_list)),
custom.model.names = c("\\makecell{Baseline \\\\ (1)}",
"\\makecell{User ID FE \\\\ (2)}",
"\\makecell{User ID FE + \\\\ Post domain FE \\\\ (3)}",
"\\makecell{User ID FE + \\\\ Post tactic FE \\\\ (4)}",
"\\makecell{User ID FE + \\\\ Post domain x Post tactic \\\\ (5)}",
"\\makecell{User ID FE + \\\\ Post ID FE \\\\ (6)}"),
stars = c(0.20, 0.10, 0.02),
custom.note = "Significance levels: \\*p<0.10, \\*\\*p<0.05, \\*\\*\\*p<0.01 one-sided test.",
caption = paste("Linear Regression:", headers, "vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]"),
caption.above = TRUE,
doctype = FALSE,
html.tag = FALSE,
table.tag = FALSE,
single.row = FALSE,
include.groups = FALSE,
digits = 4,
custom.coef.names = variable_labels_wide,
custom.coef.map = keep,
custom.gof.rows = list("Fixed Effects" = c("",rep("user",length(model_list)-1)),
"Fixed Effects" = c("","","Domain","Tactic","Domain x Tactic","Post ID"),
"Covariates" = c("",rep("Demographics + Sharing rates",length(model_list)-1)),
"Clustered Std. Errors" = rep("user",length(model_list)),
"Out-of-sample R^2" = c(R2oos_cov_2treat_all)),
reorder.gof = c(6,7,8,9,10,5,1,2,3,4))
##
## \begin{table}
## \caption{Linear Regression: Share (binary indicator) vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]}
## \begin{center}
## \begin{tabular}{l c c c c c c}
## \hline
## & \multicolumn{6}{c}{Share (binary indicator)} \\
## \cline{2-7}
## & \makecell{Baseline \\ (1)} & \makecell{User ID FE \\ (2)} & \makecell{User ID FE + \\ Post domain FE \\ (3)} & \makecell{User ID FE + \\ Post tactic FE \\ (4)} & \makecell{User ID FE + \\ Post domain x Post tactic \\ (5)} & \makecell{User ID FE + \\ Post ID FE \\ (6)} \\
## \hline
## Combo x 1[Post-treatment] x 1[Misinfo] & $-0.0127$ & $-0.0127$ & $-0.0139$ & $-0.0127$ & $-0.0189^{*}$ & $-0.0189^{*}$ \\
## & $(0.0142)$ & $(0.0138)$ & $(0.0132)$ & $(0.0138)$ & $(0.0130)$ & $(0.0130)$ \\
## Combo x 1[Post-treatment] & $-0.0884^{***}$ & $-0.0884^{***}$ & $-0.0883^{***}$ & $-0.0884^{***}$ & $-0.0885^{***}$ & $-0.0885^{***}$ \\
## & $(0.0116)$ & $(0.0131)$ & $(0.0128)$ & $(0.0131)$ & $(0.0127)$ & $(0.0127)$ \\
## Combo x 1[Misinfo] & $0.0040$ & $0.0040$ & $0.0062$ & $0.0040$ & $0.0065$ & $0.0065$ \\
## & $(0.0100)$ & $(0.0099)$ & $(0.0097)$ & $(0.0099)$ & $(0.0096)$ & $(0.0096)$ \\
## \hline
## Num. obs. & $63540$ & $63540$ & $63540$ & $63540$ & $63540$ & $63540$ \\
## R$^2$ (full model) & $0.2860$ & $0.3539$ & $0.4019$ & $0.3547$ & $0.4216$ & $0.4216$ \\
## R$^2$ (proj model) & $$ & $0.0526$ & $0.1229$ & $0.0537$ & $0.1519$ & $0.1519$ \\
## Adj. R$^2$ (full model) & $0.2854$ & $0.3159$ & $0.3665$ & $0.3166$ & $0.3870$ & $0.3870$ \\
## Adj. R$^2$ (proj model) & $$ & $0.0525$ & $0.1226$ & $0.0536$ & $0.1510$ & $0.1510$ \\
## Out-of-sample R$^2$ & & & & & & \\
## Fixed Effects & & user & user & user & user & user \\
## Fixed Effects & & & Domain & Tactic & Domain x Tactic & Post ID \\
## Covariates & & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates \\
## Clustered Std. Errors & user & user & user & user & user & user \\
## \hline
## \multicolumn{7}{l}{\scriptsize{Significance levels: \*p<0.10, \*\*p<0.05, \*\*\*p<0.01 one-sided test.}}
## \end{tabular}
## \label{table:coefficients}
## \end{center}
## \end{table}
No-course
cov <- 5
# Print model
headers <- c("Share (binary indicator)")
model_list <- cov_estimates_list_nocourse[[cov]]
names <- unique(c(names(cov_estimates_list_nocourse[[cov]][[1]]$coefficients),
names(cov_estimates_list_nocourse[[cov]][[2]]$coefficients),
names(cov_estimates_list_nocourse[[cov]][[3]]$coefficients),
names(cov_estimates_list_nocourse[[cov]][[4]]$coefficients),
names(cov_estimates_list_nocourse[[cov]][[5]]$coefficients),
names(cov_estimates_list_nocourse[[cov]][[6]]$coefficients)))
variable_labels_wide <- variable_mapping_long[names]
# remova NA
variable_labels_wide <- variable_labels_wide[!is.na(variable_labels_wide)]
# remove blankrows
coef_names <- names
matrix_coeff_na <- expand.grid(coef_name = coef_names, model = seq(length(model_list)))
matrix_coeff_na$var <- 0
matrix_coeff_na$var_na <- 0
for (m in 1:length(model_list)) {
na_coeff <- names(model_list[[m]]$coefficients)[is.na(model_list[[m]]$coefficients)]
for (c in na_coeff) {
matrix_coeff_na$var[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1 # 1 if variable is in the model (not all models have all variables)
matrix_coeff_na$var_na[matrix_coeff_na$coef_name == c & matrix_coeff_na$model == m] <- 1
}
}
matrix_coeff_na <- matrix_coeff_na %>% group_by(coef_name) %>% mutate(var = sum(var), var_na = sum(var_na)) %>% distinct(coef_name,var,var_na)
rows_to_omit <- as.vector(unique(matrix_coeff_na$coef_name[matrix_coeff_na$var_na != 0])) # omit if NA in all models
rows_to_omit <- gsub("\\^\\s","^",paste0("^",rows_to_omit,"$", collapse = "|"))
rows_to_omit <- gsub("\\(","\\\\(",gsub("\\)","\\\\)",rows_to_omit))
# keep variables
# keep <- c("treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]")
keep <- list(
"treatmentNo-course Baseline:post:post_is_misinfo" = "No-course Baseline x 1[Post-treatment] x 1[Misinfo]",
"treatmentNo-course Baseline:post" = "No-course Baseline x 1[Post-treatment]",
"treatmentNo-course Baseline:post_is_misinfo" = "No-course Baseline x 1[Misinfo]"
# "treatmentEmotions:post:post_is_misinfo" = "Emotions x 1[Post-treatment] x 1[Misinfo]",
# "treatmentEmotions:post" = "Emotions x 1[Post-treatment]",
# "treatmentEmotions:post_is_misinfo" = "Emotions x 1[Misinfo]"
#
# "treatmentCombo:post:post_is_misinfo" = "Combo x 1[Post-treatment] x 1[Misinfo]",
# "treatmentCombo:post" = "Combo x 1[Post-treatment]",
# "treatmentCombo:post_is_misinfo" = "Combo x 1[Misinfo]",
)
custom.gof.rows <- list("Fixed Effect" = function(x) {
if (sum(grepl("post_id", formula(x)[[3]]))> 0) return ("Post ID")
if (sum(grepl("fact", formula(x)[[3]]) & grepl("type", formula(x)[[3]]))> 0) return ("Domain x Tactic")
if (sum(grepl("fact", formula(x)[[3]]))> 0) return ("Domain")
if (sum(grepl("type", formula(x)[[3]]))> 0) return ("Tactic")
return ("")
})
texreg::texreg(model_list,
custom.header = list("Share (binary indicator)" = 1:length(model_list)),
custom.model.names = c("\\makecell{Baseline \\\\ (1)}",
"\\makecell{User ID FE \\\\ (2)}",
"\\makecell{User ID FE + \\\\ Post domain FE \\\\ (3)}",
"\\makecell{User ID FE + \\\\ Post tactic FE \\\\ (4)}",
"\\makecell{User ID FE + \\\\ Post domain x Post tactic \\\\ (5)}",
"\\makecell{User ID FE + \\\\ Post ID FE \\\\ (6)}"),
stars = c(0.20, 0.10, 0.02),
custom.note = "Significance levels: \\*p<0.10, \\*\\*p<0.05, \\*\\*\\*p<0.01 one-sided test.",
caption = paste("Linear Regression:", headers, "vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]"),
caption.above = TRUE,
doctype = FALSE,
html.tag = FALSE,
table.tag = FALSE,
single.row = FALSE,
include.groups = FALSE,
digits = 4,
custom.coef.names = variable_labels_wide,
custom.coef.map = keep,
custom.gof.rows = list("Fixed Effects" = c("",rep("user",length(model_list)-1)),
"Fixed Effects" = c("","","Domain","Tactic","Domain x Tactic","Post ID"),
"Covariates" = c("",rep("Demographics + Sharing rates",length(model_list)-1)),
"Clustered Std. Errors" = rep("user",length(model_list)),
"Out-of-sample R^2" = c(R2oos_cov_2treat_all)),
reorder.gof = c(6,7,8,9,10,5,1,2,3,4))
##
## \begin{table}
## \caption{Linear Regression: Share (binary indicator) vs. Treatment for different set of fixed effects [Covariates: Demographics + Sharing rates]}
## \begin{center}
## \begin{tabular}{l c c c c c c}
## \hline
## & \multicolumn{6}{c}{Share (binary indicator)} \\
## \cline{2-7}
## & \makecell{Baseline \\ (1)} & \makecell{User ID FE \\ (2)} & \makecell{User ID FE + \\ Post domain FE \\ (3)} & \makecell{User ID FE + \\ Post tactic FE \\ (4)} & \makecell{User ID FE + \\ Post domain x Post tactic \\ (5)} & \makecell{User ID FE + \\ Post ID FE \\ (6)} \\
## \hline
## No-course Baseline x 1[Post-treatment] x 1[Misinfo] & $0.0033$ & $0.0033$ & $0.0049$ & $0.0033$ & $0.0042$ & $0.0042$ \\
## & $(0.0143)$ & $(0.0140)$ & $(0.0133)$ & $(0.0140)$ & $(0.0131)$ & $(0.0131)$ \\
## No-course Baseline x 1[Post-treatment] & $0.0514^{***}$ & $0.0514^{***}$ & $0.0511^{***}$ & $0.0514^{***}$ & $0.0506^{***}$ & $0.0506^{***}$ \\
## & $(0.0117)$ & $(0.0126)$ & $(0.0124)$ & $(0.0126)$ & $(0.0123)$ & $(0.0123)$ \\
## No-course Baseline x 1[Misinfo] & $0.0051$ & $0.0051$ & $0.0046$ & $0.0051$ & $0.0046$ & $0.0046$ \\
## & $(0.0101)$ & $(0.0101)$ & $(0.0098)$ & $(0.0101)$ & $(0.0097)$ & $(0.0097)$ \\
## \hline
## Num. obs. & $61524$ & $61524$ & $61524$ & $61524$ & $61524$ & $61524$ \\
## R$^2$ (full model) & $0.2867$ & $0.3484$ & $0.3985$ & $0.3489$ & $0.4195$ & $0.4195$ \\
## R$^2$ (proj model) & $$ & $0.0312$ & $0.1057$ & $0.0320$ & $0.1369$ & $0.1369$ \\
## Adj. R$^2$ (full model) & $0.2861$ & $0.3100$ & $0.3629$ & $0.3105$ & $0.3846$ & $0.3846$ \\
## Adj. R$^2$ (proj model) & $$ & $0.0311$ & $0.1054$ & $0.0318$ & $0.1359$ & $0.1359$ \\
## Out-of-sample R$^2$ & & & & & & \\
## Fixed Effects & & user & user & user & user & user \\
## Fixed Effects & & & Domain & Tactic & Domain x Tactic & Post ID \\
## Covariates & & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates & Demographics + Sharing rates \\
## Clustered Std. Errors & user & user & user & user & user & user \\
## \hline
## \multicolumn{7}{l}{\scriptsize{Significance levels: \*p<0.10, \*\*p<0.05, \*\*\*p<0.01 one-sided test.}}
## \end{tabular}
## \label{table:coefficients}
## \end{center}
## \end{table}
