Load in Data

# need to change to right directory
df <- readRDS("intermediate_data_wide.rds")
df_long <- readRDS("intermediate_data_long.rds")

Analysis 1: Weighting of Treatment Effect of Emotions v. Facts Baseline

Using most precise specification above, re-weight sharing and accuracy discernment by multiplying the non-misinfo rate by 0.5, 0.6, …, 2 and plot treatment effect of Emotions v. Facts Baseline on y-axis, multiplier on x-axis

non_misinfo_w <- seq(0.5,2,0.1)
disc_table <- data.frame(matrix(NA,nrow(df),length(non_misinfo_w)))
colnames(disc_table) <- paste0("w_",non_misinfo_w)
disc_table$treatment <- df$treatment
disc_table$course <- df$course

acc_disc_table <- disc_table
for (w in non_misinfo_w){
    
    disc_post <- w * df$base_rate_post - df$misinfo_post
    disc_table[,paste0("w_",w)] <- disc_post
    
    acc_disc_post <- w * df$base_avg_acc_score_post - df$misinfo_avg_acc_score_post
    acc_disc_table[,paste0("w_",w)] <- acc_disc_post
}
estimate_plot_gen <- function(data,ylab,xlab,y_min,y_max,title, subtitle){
    
pic <- ggplot(data=data,aes(x=w,y=estimate,fill=grouping,color=grouping))+
        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.margin = margin(6, 6, 6, 6),
        legend.box.background = element_rect( fill="transparent"),legend.background = element_blank()) +
    
        geom_point() +
        geom_errorbar(aes(ymin=lb, ymax = estimate),width=0.05)+ 
        #geom_hline(yintercept = 1.96,color="black",size=1.5) +
        #geom_hline(yintercept = 1.65,color="darkgreen",size=1) +
        geom_hline(yintercept = 0,color="black") +
        geom_vline(xintercept = 1,color="gray70",linetype="dashed") +
        geom_vline(xintercept = 2,color="darkgreen",linetype="dashed") +
    
        scale_color_manual(name="Test:",values=c("Facts"= "royalblue3",
                                                 "Reasoning" = "turquoise2",
                                                 "Emotions"="pink2",
                                                 'Combo'="orange2"))+
        scale_fill_manual(name="Test:",values=c("Facts"= "royalblue3",
                                                 "Reasoning" = "turquoise2",
                                                 "Emotions"="pink2",
                                                 'Combo'="orange2"))+
    
        labs(y=ylab,x=xlab)+
        theme(axis.text.x = element_text(color = "black", angle = 0, hjust = .5, vjust = 5, face = "plain"),
        axis.text.y = element_text(color = "black", angle = 0, hjust = 0, vjust = .5, face = "plain",
                                   margin=unit(rep(0.5,4),"cm")),  
        axis.title.x = element_text(color = "black", angle = 0, hjust = .5, vjust = 3, face = "bold"),
        axis.title.y = element_text(color = "black",  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)) +
    
        ggtitle(title, subtitle = subtitle) +

        theme(plot.title = element_text(face='bold',  hjust=0.5, vjust=0.5),
              plot.subtitle = element_text(face='bold', hjust=0.5, vjust=0.5))
pic}

Versus No-Course Baseline

estimates_table <- data.frame(matrix(NA,length(non_misinfo_w),8))
rownames(estimates_table) <- paste0("w_",non_misinfo_w)
colnames(estimates_table) <- c("Facts Baseline","Reasoning", "Emotions","Combo",
                              "Facts_LB","Reasoning_LB","Emotions_LB","Combo_LB")

acc_estimates_table <- estimates_table
for (w in non_misinfo_w){
    temp_tab <- coef(summary(lm_robust(disc_table[,paste0("w_",w)] ~ relevel(disc_table[,"treatment"], ref = "No-course Baseline"),alpha=0.1)))
    estimates_table[paste0("w_",w),] <- temp_tab[2:5,c(1,5)]

    acc_temp_tab <- coef(summary(lm_robust(acc_disc_table[,paste0("w_",w)] ~ relevel(acc_disc_table[,"treatment"], ref = "No-course Baseline"),alpha=0.1)))
    acc_estimates_table[paste0("w_",w),] <- acc_temp_tab[2:5,c(1,5)]
}
estimates_for_plot <- data.frame(matrix(NA,4*nrow(estimates_table),4))
colnames(estimates_for_plot) <- c("estimate","lb","w","grouping")
estimates_for_plot$estimate <- c(estimates_table[,1],estimates_table[,2],estimates_table[,3],estimates_table[,4])
estimates_for_plot$lb <- c(estimates_table[,5],estimates_table[,6],estimates_table[,7],estimates_table[,8])
estimates_for_plot$w <- rep(non_misinfo_w, 4)
estimates_for_plot$grouping = rep(c("Facts","Reasoning", "Emotions","Combo"),each = nrow(estimates_table))
estimates_for_plot$grouping = factor(estimates_for_plot$grouping, levels = c("Facts","Reasoning", "Emotions","Combo"))
estimate_plot_gen(estimates_for_plot[estimates_for_plot$grouping == "Emotions",],"Treatment Effect","Multiplier for Non-Misinformation",-0.2,0.2,"Sharing Discernment", "versus No-Course Baseline")

ggsave("generated_figures/discernment_weight/emotionsVnocourse_sharing_discernment_with_weights.png",width=6,height=4)
acc_estimates_for_plot <- data.frame(matrix(NA,4*nrow(acc_estimates_table),4))
colnames(acc_estimates_for_plot) <- c("estimate","lb","w","grouping")
acc_estimates_for_plot$estimate <- c(acc_estimates_table[,1],acc_estimates_table[,2],acc_estimates_table[,3],acc_estimates_table[,4])
acc_estimates_for_plot$lb <- c(acc_estimates_table[,5],acc_estimates_table[,6],acc_estimates_table[,7],acc_estimates_table[,8])
acc_estimates_for_plot$w <- rep(non_misinfo_w, 4)
acc_estimates_for_plot$grouping <- rep(c("Facts","Reasoning", "Emotions","Combo"),each = nrow(acc_estimates_table))
acc_estimates_for_plot$grouping <- factor(acc_estimates_for_plot$grouping, levels = c("Facts","Reasoning", "Emotions","Combo"))
estimate_plot_gen(acc_estimates_for_plot[acc_estimates_for_plot$grouping == "Emotions",],"Treatment Effect","Multiplier for Non-Misinformation",-0.6,0.6,"Accuracy Discernment", "versus No-Course Baseline")

ggsave("generated_figures/discernment_weight/emotionsVnocourse_accuracy_discernment_with_weights.png",width=6,height=4)

Versus Facts Baseline

estimates_table <- data.frame(matrix(NA,length(non_misinfo_w),8))
rownames(estimates_table) <- paste0("w_",non_misinfo_w)
colnames(estimates_table) <- c("No-course Baseline","Reasoning", "Emotions","Combo",
                              "No-course_LB","Reasoning_LB","Emotions_LB","Combo_LB")

acc_estimates_table <- estimates_table
for (w in non_misinfo_w){
    temp_tab <- coef(summary(lm_robust(disc_table[,paste0("w_",w)] ~ relevel(disc_table[,"treatment"], ref = "Facts Baseline"),alpha=0.1)))
    estimates_table[paste0("w_",w),] <- temp_tab[2:5,c(1,5)]

    acc_temp_tab <- coef(summary(lm_robust(acc_disc_table[,paste0("w_",w)] ~ relevel(acc_disc_table[,"treatment"], ref = "Facts Baseline"),alpha=0.1)))
    acc_estimates_table[paste0("w_",w),] <- acc_temp_tab[2:5,c(1,5)]
}
estimates_for_plot <- data.frame(matrix(NA,4*nrow(estimates_table),4))
colnames(estimates_for_plot) <- c("estimate","lb","w","grouping")
estimates_for_plot$estimate <- c(estimates_table[,1],estimates_table[,2],estimates_table[,3],estimates_table[,4])
estimates_for_plot$lb <- c(estimates_table[,5],estimates_table[,6],estimates_table[,7],estimates_table[,8])
estimates_for_plot$w <- rep(non_misinfo_w, 4)
estimates_for_plot$grouping = rep(c("No-course","Reasoning", "Emotions","Combo"),each = nrow(estimates_table))
estimates_for_plot$grouping = factor(estimates_for_plot$grouping, levels = c("No-course","Reasoning", "Emotions","Combo"))
estimate_plot_gen(estimates_for_plot[estimates_for_plot$grouping == "Emotions",],"Treatment Effect","Multiplier for Non-Misinformation",-0.2,0.2,"Sharing Discernment", "versus Facts Baseline")

ggsave("generated_figures/discernment_weight/emotionsVfacts_sharing_discernment_with_weights.png",width=6,height=4)
acc_estimates_for_plot <- data.frame(matrix(NA,4*nrow(acc_estimates_table),4))
colnames(acc_estimates_for_plot) <- c("estimate","lb","w","grouping")
acc_estimates_for_plot$estimate <- c(acc_estimates_table[,1],acc_estimates_table[,2],acc_estimates_table[,3],acc_estimates_table[,4])
acc_estimates_for_plot$lb <- c(acc_estimates_table[,5],acc_estimates_table[,6],acc_estimates_table[,7],acc_estimates_table[,8])
acc_estimates_for_plot$w <- rep(non_misinfo_w, 4)
acc_estimates_for_plot$grouping <- rep(c("No-course","Reasoning", "Emotions","Combo"),each = nrow(acc_estimates_table))
acc_estimates_for_plot$grouping <- factor(acc_estimates_for_plot$grouping, levels = c("No-course","Reasoning", "Emotions","Combo"))
estimate_plot_gen(acc_estimates_for_plot[acc_estimates_for_plot$grouping == "Emotions",],"Treatment Effect","Multiplier for Non-Misinformation",-0.6,0.6,"Accuracy Discernment", "versus Facts Baseline")

ggsave("generated_figures/discernment_weight/emotionsVfacts_accuracy_discernment_with_weights.png",width=6,height=4)

Analysis 3: Surrogacy analysis

Surrogacy analysis is done by comparing the short-run vs long-run treatment effect. Under this setting, we are using the POST - PRE measure as the short-run treatment effect and the FOLLOWUP - PRE measure as the long-run treatment effect.

We do not have accuracy questions in the followup survey, thus we will not be able to run any short-run vs long-run surrogacy analysis on the accuracy measures.

We focus on the following 6 outcomes.

  1. Post misinfo-sharing (misinfo_post)
  2. Change in misinfo-sharing (misinfo_diff)
  3. Post non-misinfo-sharing (base_rate_post)
  4. Change in non-misinfo-sharing (base_rate_diff)
  5. Post sharing discernment (new_disc_post)
  6. Change in sharing discernment (new_disc_diff)
# filter only to users with entries in both post and follow-up
followup_users <- unique(df_long[df_long$pre_post == "followup", "user"])

# only followup users
df_long_followup <- df_long[df_long$user %in% followup_users,]
# change to wide format by aggregating on the user, pre_post, and post_is_misinfo level
df_wide_followup <- df_long_followup %>% 
  group_by(user, pre_post, post_is_misinfo) %>% 
  summarise(sharing = mean(share))
## `summarise()` has grouped output by 'user', 'pre_post'. You can override using
## the `.groups` argument.
df_wide_followup <- reshape2::dcast(df_wide_followup, user ~ pre_post + post_is_misinfo, value.var = "sharing")

colnames(df_wide_followup) <- c("user","base_rate_followup", "misinfo_followup", "base_rate_post", "misinfo_post","base_rate_pre", "misinfo_pre")
df_wide_followup <- left_join(df_wide_followup, df[, c("user","treatment")], by = "user")
# the following section should match the same from df_wide
df_wide_followup$base_rate_diff <- df_wide_followup$base_rate_post - df_wide_followup$base_rate_pre
df_wide_followup$misinfo_diff <- df_wide_followup$misinfo_post - df_wide_followup$misinfo_pre

# new discernment
df_wide_followup$new_disc_pre <- df_wide_followup$base_rate_pre - df_wide_followup$misinfo_pre
df_wide_followup$new_disc_post <- df_wide_followup$base_rate_post - df_wide_followup$misinfo_post
df_wide_followup$new_disc_diff <- df_wide_followup$new_disc_post - df_wide_followup$new_disc_pre


### These are new measures created for followup only
# followup diff
df_wide_followup$base_rate_followup_diff <- df_wide_followup$base_rate_followup - df_wide_followup$base_rate_pre
df_wide_followup$misinfo_followup_diff <- df_wide_followup$misinfo_followup - df_wide_followup$misinfo_pre

# discernment followup
df_wide_followup$new_disc_followup <- df_wide_followup$base_rate_followup - df_wide_followup$misinfo_followup
df_wide_followup$new_disc_followup_diff <- df_wide_followup$new_disc_followup - df_wide_followup$new_disc_pre
outcomes_surrogacy <- c("misinfo_post","misinfo_diff",
                        "base_rate_post","base_rate_diff",
                        "new_disc_post","new_disc_diff")
surrogacy_data <- data.frame(matrix(NA,6 * length(outcomes_surrogacy),6))
colnames(surrogacy_data) <- c("outcome", "group","n",
                              "shortrun_mean","longrun_mean", "inter_correlation")
surrogacy_data$outcome <- rep(outcomes_surrogacy, each = 6)
surrogacy_data$group <- rep(c("No-course Baseline","Facts Baseline", "Reasoning","Emotions","Combo", "All"), length(outcomes_surrogacy))

for (outcome in outcomes_surrogacy){
  for (group in c("No-course Baseline","Facts Baseline", "Reasoning","Emotions","Combo", "All")){
      if (str_detect(outcome, "post")){
        # substitute post with followup
        outcome_followup <- str_replace(outcome, "post", "followup")
      } else if (str_detect(outcome, "diff")){
        # substitute diff with followup_diff
        outcome_followup <- str_replace(outcome, "diff", "followup_diff")
      }
          
      if (group == "All"){
        surrogacy_data[surrogacy_data$outcome == outcome & 
                         surrogacy_data$group == group,"n"] <-nrow(df_wide_followup)
        surrogacy_data[surrogacy_data$outcome == outcome &
                         surrogacy_data$group == group,
                       "shortrun_mean"] <- mean(df_wide_followup[, outcome], na.rm = T)
        surrogacy_data[surrogacy_data$outcome == outcome &
                         surrogacy_data$group == group,
                       "longrun_mean"] <- mean(df_wide_followup[, outcome_followup], na.rm = T)
        surrogacy_data[surrogacy_data$outcome == outcome &
                         surrogacy_data$group == group,
                       "inter_correlation"] <- cor(df_wide_followup[, outcome], df_wide_followup[, outcome_followup], use = "complete.obs")
      } else {
          surrogacy_data[surrogacy_data$outcome == outcome & 
                           surrogacy_data$group == group,"n"] <- nrow(df_wide_followup[df_wide_followup$treatment == group,])
          surrogacy_data[surrogacy_data$outcome == outcome &
                           surrogacy_data$group == group,"shortrun_mean"] <- mean(df_wide_followup[df_wide_followup$treatment == group, outcome], na.rm = T)
          surrogacy_data[surrogacy_data$outcome == outcome &
                           surrogacy_data$group == group,"longrun_mean"] <- mean(df_wide_followup[df_wide_followup$treatment == group, outcome_followup], na.rm = T)
          surrogacy_data[surrogacy_data$outcome == outcome &
                           surrogacy_data$group == group,"inter_correlation"] <- cor(df_wide_followup[df_wide_followup$treatment == group, outcome], df_wide_followup[df_wide_followup$treatment == group, outcome_followup], use = "complete.obs")
      }
  }
}
for (outcome in outcomes_surrogacy){
  # save to local tables
  kable(surrogacy_data[surrogacy_data$outcome == outcome,], digits = 4, row.names = FALSE) %>% 
    print()

    # save_kable(file = paste0("generated_tables/surrogacy/surrogacy_",outcome,".png"))
}
## 
## 
## |outcome      |group              |    n| shortrun_mean| longrun_mean| inter_correlation|
## |:------------|:------------------|----:|-------------:|------------:|-----------------:|
## |misinfo_post |No-course Baseline |  964|        0.5278|       0.4063|            0.3882|
## |misinfo_post |Facts Baseline     | 1069|        0.4565|       0.3948|            0.5051|
## |misinfo_post |Reasoning          | 1072|        0.3952|       0.3417|            0.5130|
## |misinfo_post |Emotions           | 1122|        0.3477|       0.2965|            0.5038|
## |misinfo_post |Combo              | 1089|        0.3650|       0.3098|            0.5440|
## |misinfo_post |All                | 5316|        0.4154|       0.3480|            0.5019|
## 
## 
## |outcome      |group              |    n| shortrun_mean| longrun_mean| inter_correlation|
## |:------------|:------------------|----:|-------------:|------------:|-----------------:|
## |misinfo_diff |No-course Baseline |  964|       -0.0097|      -0.1312|            0.4462|
## |misinfo_diff |Facts Baseline     | 1069|       -0.0641|      -0.1258|            0.5015|
## |misinfo_diff |Reasoning          | 1072|       -0.1326|      -0.1861|            0.6078|
## |misinfo_diff |Emotions           | 1122|       -0.1679|      -0.2191|            0.6092|
## |misinfo_diff |Combo              | 1089|       -0.1604|      -0.2156|            0.5952|
## |misinfo_diff |All                | 5316|       -0.1097|      -0.1770|            0.5609|
## 
## 
## |outcome        |group              |    n| shortrun_mean| longrun_mean| inter_correlation|
## |:--------------|:------------------|----:|-------------:|------------:|-----------------:|
## |base_rate_post |No-course Baseline |  964|        0.6698|       0.6971|            0.2865|
## |base_rate_post |Facts Baseline     | 1069|        0.5965|       0.6745|            0.2788|
## |base_rate_post |Reasoning          | 1072|        0.5519|       0.6259|            0.2816|
## |base_rate_post |Emotions           | 1122|        0.5202|       0.6194|            0.2945|
## |base_rate_post |Combo              | 1089|        0.5216|       0.6318|            0.2748|
## |base_rate_post |All                | 5316|        0.5694|       0.6484|            0.2883|
## 
## 
## |outcome        |group              |    n| shortrun_mean| longrun_mean| inter_correlation|
## |:--------------|:------------------|----:|-------------:|------------:|-----------------:|
## |base_rate_diff |No-course Baseline |  964|       -0.0315|      -0.0041|            0.3972|
## |base_rate_diff |Facts Baseline     | 1069|       -0.0798|      -0.0019|            0.3774|
## |base_rate_diff |Reasoning          | 1072|       -0.1533|      -0.0793|            0.3935|
## |base_rate_diff |Emotions           | 1122|       -0.1533|      -0.0541|            0.4417|
## |base_rate_diff |Combo              | 1089|       -0.1549|      -0.0447|            0.3668|
## |base_rate_diff |All                | 5316|       -0.1168|      -0.0377|            0.3990|
## 
## 
## |outcome       |group              |    n| shortrun_mean| longrun_mean| inter_correlation|
## |:-------------|:------------------|----:|-------------:|------------:|-----------------:|
## |new_disc_post |No-course Baseline |  964|        0.1419|       0.2908|           -0.0056|
## |new_disc_post |Facts Baseline     | 1069|        0.1400|       0.2797|            0.0201|
## |new_disc_post |Reasoning          | 1072|        0.1567|       0.2842|            0.0089|
## |new_disc_post |Emotions           | 1122|        0.1725|       0.3229|            0.0187|
## |new_disc_post |Combo              | 1089|        0.1566|       0.3220|            0.0197|
## |new_disc_post |All                | 5316|        0.1540|       0.3004|            0.0141|
## 
## 
## |outcome       |group              |    n| shortrun_mean| longrun_mean| inter_correlation|
## |:-------------|:------------------|----:|-------------:|------------:|-----------------:|
## |new_disc_diff |No-course Baseline |  964|       -0.0218|       0.1271|            0.3686|
## |new_disc_diff |Facts Baseline     | 1069|       -0.0157|       0.1239|            0.3524|
## |new_disc_diff |Reasoning          | 1072|       -0.0207|       0.1068|            0.3356|
## |new_disc_diff |Emotions           | 1122|        0.0146|       0.1650|            0.3399|
## |new_disc_diff |Combo              | 1089|        0.0055|       0.1710|            0.3349|
## |new_disc_diff |All                | 5316|       -0.0071|       0.1394|            0.3465|

Analysis 4: Accuracy Nudge Analysis

For each outcome, create a bar graph with:

Replace Emotions course with Facts Baseline and with all courses except No-course Baseline.

Outcomes

  1. Primary outcome (pre_spec_outcome_rates)
  2. Post misinfo-sharing(misinfo_post)
  3. Change in misinfo-sharing (misinfo_diff)
  4. Post non-misinfo-sharing (base_rate_post)
  5. Change in non-misinfo-sharing (base_rate_diff)
  6. Post sharing discernment (new_disc_post)
  7. Post total score on misinfo posts (misinfo_total_acc_score_post)
  8. Change in total score on misinfo posts (misinfo_total_acc_score_diff)
  9. Post positive accuracy score on misinfo posts (count_misinfo_positive_acc_score_post)
  10. Change in positive accuracy score on misinfo posts (count_misinfo_positive_acc_score_diff)
  11. Post total score on non-misinfo posts (base_total_acc_score_post)
  12. Change in total score on non-misinfo posts (base_total_acc_score_diff)
  13. Post positive accuracy score on non-misinfo posts (count_base_positive_acc_score_post)
  14. Change in positive accuracy score on non-misinfo posts (count_base_positive_acc_score_diff)
  15. Post accuracy discernment (new_acc_post)
outcomes <- c("pre_spec_outcome_rates",
              "misinfo_post","misinfo_diff",
              "base_rate_post","base_rate_diff",
              "new_disc_post",
              "misinfo_avg_acc_score_post",
              "misinfo_avg_acc_score_diff",
              "misinfo_avg_positive_acc_score_post",
              "misinfo_avg_positive_acc_score_diff",
              "base_avg_acc_score_post",
              "base_avg_acc_score_diff",
              "base_avg_positive_acc_score_post",
              "base_avg_positive_acc_score_diff",
              "new_acc_post")

Full Table

Section below generate the full 15 outcomes x 4 groups comparison tables with the corresponding difference-in-means and diff-in-diff tests.

generate_acc_data_with_tests <- function(course, outcomes){
  acc_nudge_data <- data.frame(matrix(NA,6*length(outcomes),10))
  colnames(acc_nudge_data) <- c("outcome", "Group 1", "Group 2", 
                                "No.Obs 1", "No.Obs 2", 
                                "Estimate 1", "Estimate 2",
                                "Difference-in-Means", "p-value", "row")
  acc_nudge_data[,1] <- rep(outcomes,each = 6)
  acc_nudge_data[, "Group 1"] <- rep(rep(c("Acc. After,\nNo-course Baseline", paste0("Acc. After,\n", course), " "), each = 2), length(outcomes))
  acc_nudge_data[, "Group 2"] <- rep(rep(c("Acc. Inter,\nNo-course Baseline", paste0("Acc. Inter,\n", course), " "), each = 2), length(outcomes))
  acc_nudge_data[, "row"] <- rep(c("Mean", "Std. Err"), 3*length(outcomes))
  
  for (outcome in outcomes){
    if (outcome %in% c("pre_spec_outcome_rates", "misinfo_post","misinfo_diff", "misinfo_avg_acc_score_post",
                "misinfo_avg_acc_score_diff",
                "misinfo_avg_positive_acc_score_post",
                "misinfo_avg_positive_acc_score_diff")){
      alt <- "greater"
    } else {
      alt <- "less"
    }
    # number of observations
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == "Acc. After,\nNo-course Baseline" &
                     acc_nudge_data$row == "Mean","No.Obs 1"] <- sum(!is.na(df[(df$treatment == "No-course Baseline") & (df$accuracy == "Accuracy After"), outcome]))
    # estimates
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == "Acc. After,\nNo-course Baseline" &
                     acc_nudge_data$row == "Mean","Estimate 1"] <- mean(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy After",outcome], na.rm = T)
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == "Acc. After,\nNo-course Baseline" &
                     acc_nudge_data$row == "Std. Err","Estimate 1"] <- sd(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy After",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == "No-course Baseline") & (df$accuracy == "Accuracy After"), outcome])))
    # number of observations
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 2` == "Acc. Inter,\nNo-course Baseline" &
                     acc_nudge_data$row == "Mean","No.Obs 2"] <- sum(!is.na(df[(df$treatment == "No-course Baseline") & (df$accuracy == "Accuracy Inter"), outcome]))
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 2` == "Acc. Inter,\nNo-course Baseline" &
                     acc_nudge_data$row == "Mean","Estimate 2"] <- mean(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy Inter",outcome], na.rm = T)
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 2` == "Acc. Inter,\nNo-course Baseline" &
                     acc_nudge_data$row == "Std. Err","Estimate 2"] <- sd(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy Inter",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == "No-course Baseline") & (df$accuracy == "Accuracy Inter"), outcome])))
    
    # difference in mean test
    no_course_test <- t.test(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy After",outcome],
           df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy Inter",outcome],
           alternative = alt)
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == "Acc. After,\nNo-course Baseline" &
                     acc_nudge_data$row == "Mean","Difference-in-Means"] <- no_course_test$estimate[2] - no_course_test$estimate[1]
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == "Acc. After,\nNo-course Baseline" &
                     acc_nudge_data$row == "Mean","p-value"] <- no_course_test$p.value
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == "Acc. After,\nNo-course Baseline" &
                     acc_nudge_data$row == "Std. Err","Difference-in-Means"] <- no_course_test$stderr
    
    #### again for emotions
    # number of observations
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == paste0("Acc. After,\n", course) &
                     acc_nudge_data$row == "Mean","No.Obs 1"] <- sum(!is.na(df[(df$treatment == course ) & (df$accuracy == "Accuracy After"), outcome]))
    # estimates
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == paste0("Acc. After,\n", course) &
                     acc_nudge_data$row == "Mean","Estimate 1"] <- mean(df[df$treatment == course & df$accuracy == "Accuracy After",outcome], na.rm = T)
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == paste0("Acc. After,\n", course) &
                     acc_nudge_data$row == "Std. Err","Estimate 1"] <- sd(df[df$treatment == course & df$accuracy == "Accuracy After",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == course) & (df$accuracy == "Accuracy After"), outcome])))
    # number of observations
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 2` == paste0("Acc. Inter,\n", course) &
                     acc_nudge_data$row == "Mean","No.Obs 2"] <- sum(!is.na(df[(df$treatment == course) & (df$accuracy == "Accuracy Inter"), outcome]))
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 2` == paste0("Acc. Inter,\n", course) &
                     acc_nudge_data$row == "Mean","Estimate 2"] <- mean(df[df$treatment == course & df$accuracy == "Accuracy Inter",outcome], na.rm = T)
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 2` == paste0("Acc. Inter,\n", course) &
                     acc_nudge_data$row == "Std. Err","Estimate 2"] <- sd(df[df$treatment == course & df$accuracy == "Accuracy Inter",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == course) & (df$accuracy == "Accuracy Inter"), outcome])))
    
    # difference in mean test
    emotions_test <- t.test(df[df$treatment == course & df$accuracy == "Accuracy After",outcome],
           df[df$treatment == course & df$accuracy == "Accuracy Inter",outcome],
           alternative = alt)
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == paste0("Acc. After,\n", course) &
                     acc_nudge_data$row == "Mean","Difference-in-Means"] <- emotions_test$estimate[2] - emotions_test$estimate[1]
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == paste0("Acc. After,\n", course) &
                     acc_nudge_data$row == "Mean","p-value"] <- emotions_test$p.value
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == paste0("Acc. After,\n", course) &
                     acc_nudge_data$row == "Std. Err","Difference-in-Means"] <- emotions_test$stderr
    
    
    
    # diff in diff test
    diff_in_diff_test <- df[df$treatment == course | df$treatment == "No-course Baseline",] %>%
      lm_robust(data = ., formula = as.formula(paste0(outcome, " ~ accuracy * treatment"))) %>%
      summary() %>%
      coef()
    acc_nudge_data[acc_nudge_data$outcome == outcome & 
                     acc_nudge_data$`Group 1` == " " &
                     acc_nudge_data$row == "Mean","Difference-in-Means"] <- diff_in_diff_test[4, 1]
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == " " &
                     acc_nudge_data$row == "Std. Err","Difference-in-Means"] <- diff_in_diff_test[4, 2]
    acc_nudge_data[acc_nudge_data$outcome == outcome &
                     acc_nudge_data$`Group 1` == " " &
                     acc_nudge_data$row == "Mean","p-value"] <- diff_in_diff_test[4, 4]
  }
  
  # rounding
  acc_nudge_data[acc_nudge_data$row == "Mean", c("Estimate 1", "Estimate 2", "Difference-in-Means", "p-value")] <- 
    round(acc_nudge_data[acc_nudge_data$row == "Mean", c("Estimate 1", "Estimate 2", "Difference-in-Means", "p-value")], 4)
  acc_nudge_data[acc_nudge_data$row == "Std. Err", c("Estimate 1", "Estimate 2", "Difference-in-Means", "p-value")] <- 
    round(acc_nudge_data[acc_nudge_data$row == "Std. Err", c("Estimate 1", "Estimate 2", "Difference-in-Means", "p-value")], 4)
  
  return (acc_nudge_data)

}
emotions_nudge <- generate_acc_data_with_tests("Emotions", outcomes)
facts_nudge <- generate_acc_data_with_tests("Facts Baseline", outcomes)
combo_nudge <- generate_acc_data_with_tests("Combo", outcomes)
reasoning_nudge <- generate_acc_data_with_tests("Reasoning", outcomes)
process_nudge_table <- function(nudge_table){
  # add () to the standard errors if not NA
  nudge_table$`Estimate 1`[nudge_table$row == "Std. Err"] <- ifelse(!is.na(nudge_table$`Estimate 1`[nudge_table$row == "Std. Err"]), paste0("(", nudge_table$`Estimate 1`[nudge_table$row == "Std. Err"], ")"), NA)
  nudge_table$`Estimate 2`[nudge_table$row == "Std. Err"] <- ifelse(!is.na(nudge_table$`Estimate 2`[nudge_table$row == "Std. Err"]), paste0("(", nudge_table$`Estimate 2`[nudge_table$row == "Std. Err"], ")"), NA)
  nudge_table$`Difference-in-Means`[nudge_table$row == "Std. Err"] <- ifelse(!is.na(nudge_table$`Difference-in-Means`[nudge_table$row == "Std. Err"]), paste0("(", nudge_table$`Difference-in-Means`[nudge_table$row == "Std. Err"], ")"), NA)
  
  nudge_table[nudge_table$row == "Std. Err", c("Group 1", "Group 2")] <- NA
  # Fill NA with ""
  nudge_table[is.na(nudge_table)] <- ""
  # drop the column "row"
  nudge_table <- nudge_table[, -which(names(nudge_table) == "row")]
  return (nudge_table)
  
}
# output and save
emotions_output <- process_nudge_table(emotions_nudge) 
facts_output <- process_nudge_table(facts_nudge)
combo_output <- process_nudge_table(combo_nudge)
reasoning_output <- process_nudge_table(reasoning_nudge)
kbl(emotions_output, digits = 4, row.names = FALSE) %>%
  kable_styling(full_width = F) %>%
  save_kable(file = "generated_tables/accuracy_nudge/emotions_nudge.png")

kbl(facts_output, digits = 4, row.names = FALSE) %>%
  kable_styling(full_width = F) %>%
  save_kable(file = "generated_tables/accuracy_nudge/facts_nudge.png")

kbl(combo_output, digits = 4, row.names = FALSE) %>%
  kable_styling(full_width = F) %>%
  save_kable(file = "generated_tables/accuracy_nudge/combo_nudge.png")

kbl(reasoning_output, digits = 4, row.names = FALSE) %>%
  kable_styling(full_width = F) %>%
  save_kable(file = "generated_tables/accuracy_nudge/reasoning_nudge.png")

Specific Figures of Interest

generate_acc_data <- function(course, outcomes){
  acc_nudge_data <- data.frame(matrix(NA,4*length(outcomes),4))
  colnames(acc_nudge_data) <- c("label", "outcome", "mean","std.err")
  acc_nudge_data[,1] <- rep(c("Acc. After,\nNo-course Baseline","Acc. Inter,\nNo-course Baseline",
                         paste0("Acc. After,\n", course, " Course"),
                         paste0("Acc. Inter,\n", course, " Course")), 15)
  acc_nudge_data[,2] <- rep(outcomes,each = 4)

  for (outcome in outcomes){
      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == "Acc. After,\nNo-course Baseline","mean"] <- mean(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy After",outcome], na.rm = T)
      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == "Acc. After,\nNo-course Baseline","std.err"] <- sd(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy After",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == "No-course Baseline") & (df$accuracy == "Accuracy After"), outcome])))

      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == "Acc. Inter,\nNo-course Baseline","mean"] <- mean(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy Inter",outcome], na.rm = T)
      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == "Acc. Inter,\nNo-course Baseline","std.err"] <- sd(df[df$treatment == "No-course Baseline" & df$accuracy == "Accuracy Inter",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == "No-course Baseline") & (df$accuracy == "Accuracy Inter"), outcome])))

      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == paste0("Acc. After,\n", course, " Course"),"mean"] <- mean(df[df$treatment == course & df$accuracy == "Accuracy After",outcome], na.rm = T)
      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == paste0("Acc. After,\n", course, " Course"),"std.err"] <- sd(df[df$treatment == course & df$accuracy == "Accuracy After",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == course) & (df$accuracy == "Accuracy After"), outcome])))

      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == paste0("Acc. Inter,\n", course, " Course"),"mean"] <- mean(df[df$treatment == course & df$accuracy == "Accuracy Inter",outcome], na.rm = T)
      acc_nudge_data[acc_nudge_data$outcome == outcome & acc_nudge_data$label == paste0("Acc. Inter,\n", course, " Course"),"std.err"] <- sd(df[df$treatment == course & df$accuracy == "Accuracy Inter",outcome], na.rm = T)/sqrt(sum(!is.na(df[(df$treatment == course) & (df$accuracy == "Accuracy Inter"), outcome])))
  }

  acc_nudge_data$label <- factor(acc_nudge_data$label,
                                 levels = c("Acc. After,\nNo-course Baseline",
                                            "Acc. Inter,\nNo-course Baseline",
                                            paste0("Acc. After,\n", course, " Course"),
                                            paste0("Acc. Inter,\n", course, " Course")))
  return(acc_nudge_data)
}
emotions_acc_nudge_data <- generate_acc_data("Emotions", outcomes)
facts_acc_nudge_data <- generate_acc_data("Facts Baseline", outcomes)
combo_acc_nudge_data <- generate_acc_data("Combo", outcomes)
reasoning_acc_nudge_data <- generate_acc_data("Reasoning", outcomes)

Generate Figures of Interest

We focus on three outcomes and compare between Emotions and No-course Baseline.

  1. Pre-specified Outcome
  2. Post-Suvrey Misinfomation Sharing
  3. Post-Survey Sharing Discernment
plot_gen_prespec = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline, tests){

pic = ggplot(data=data,aes(x=label,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(), legend.margin = margin(6, 6, 6, 6),
        legend.box.background = element_rect( fill="transparent"),legend.background = element_blank()) +

        geom_bar(stat='identity',width=0.75,color="black",fill=color) +
        geom_errorbar(aes(ymin=mean-1.96*std.err, ymax = mean+1.96*std.err),width=0.1, position = position_dodge(1))

        if (baseline){

        pic = pic + geom_text(aes(label=formatC(mean,digits=3,format="f"),y=mean+sign(mean)*std.err),vjust = -3.75,size=num_size)+
        geom_text(aes(label=paste("(",formatC(std.err,digits=4,format="f"),")",sep=""),y=mean+sign(mean)*std.err),vjust = -3.25,size=num_size-1)}

        pic = pic + labs(y=ylab,x=xlab)+
        geom_segment(aes(x = 3, y = 0.75, xend = 4, yend = 0.75), color = "springgreen4")+
        geom_segment(aes(x = 3, y = 0.75, xend = 3, yend = 0.65), color = "springgreen4")+
        geom_segment(aes(x = 4, y = 0.75, xend = 4, yend = 0.65), color = "springgreen4")+

        geom_segment(aes(x = 1.5, y = 1.06, xend = 3.5, yend = 1.06), color = "springgreen3")+
        geom_segment(aes(x = 1.5, y = 1.06, xend = 1.5, yend = 1.04), color = "springgreen3")+
        geom_segment(aes(x = 3.5, y = 1.06, xend = 3.5, yend = 0.89), color = "springgreen3")+

        geom_segment(aes(x = 1, y = 0.9, xend = 2, yend = 0.9), color = "springgreen2")+
        geom_segment(aes(x = 1, y = 0.9, xend = 1, yend = 0.85), color = "springgreen2")+
        geom_segment(aes(x = 2, y = 0.9, xend = 2, yend = 0.85), color = "springgreen2")+

    
        annotate("text",x=2.5,y=1.12,
                 label = paste0(formatC(tests$estimates[3],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[3],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
        annotate("text",x=3.5,y=0.81,
                 label = paste0(formatC(tests$estimates[2],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[2],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
        annotate("text",x=1.5,y=0.96,
                 label = paste0(formatC(tests$estimates[1],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[1],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
          
        theme(axis.text.x = element_text(color = "black", angle = 0,
                                         hjust = .5, vjust = 5, face = "plain"),
        axis.text.y = element_text(color = "black", angle = 0,
                                   hjust = 0, vjust = .5, face = "plain",
                                   margin=unit(rep(0.5,4),"cm")),
        axis.title.x = element_text(color = "black", angle = 0,
                                    hjust = .5, vjust = 3, face = "bold"),
        axis.title.y = element_text(color = "black", 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$label) +
        ggtitle(title) +
        theme(plot.title = element_text(face='bold', hjust=0.5, vjust=0.5)) 
        

    return (pic)
}
get_test_outcome <- function(nudge_data, outcome, course){
  tests <- nudge_data[nudge_data$outcome == outcome, "Difference-in-Means"]
# 3 x 2 matrix
  tests <- matrix(tests, nrow = 3, byrow = T)
  tests <- data.frame(estimates = tests[,1], std.err = tests[,2])
  row.names(tests) <- c("No-course", course, "DiD")
  return (tests)
}
emotion_tests <- get_test_outcome(emotions_nudge, "pre_spec_outcome_rates", "Emotions")

plot_gen_prespec(emotions_acc_nudge_data[emotions_acc_nudge_data$outcome == "pre_spec_outcome_rates",],c("ivory1","springgreen1","ivory4","springgreen4"), "Pre-specified Outcome", "Assignment Group",0,1.15,"Accuracy Nudge Analysis",3,TRUE, emotion_tests)

ggsave(paste0("generated_figures/accuracy_nudge/emotions_prespec.png"),width=6,height=4)
plot_gen_misinfo = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline, tests){

pic = ggplot(data=data,aes(x=label,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(), legend.margin = margin(6, 6, 6, 6),
        legend.box.background = element_rect( fill="transparent"),legend.background = element_blank()) +

        geom_bar(stat='identity',width=0.75,color="black",fill=color) +
        geom_errorbar(aes(ymin=mean-1.96*std.err, ymax = mean+1.96*std.err),width=0.1, position = position_dodge(1))

        if (baseline){

        pic = pic + geom_text(aes(label=formatC(mean,digits=3,format="f"),y=mean+sign(mean)*std.err),vjust = -3.75,size=num_size)+
        geom_text(aes(label=paste("(",formatC(std.err,digits=4,format="f"),")",sep=""),y=mean+sign(mean)*std.err),vjust = -3.25,size=num_size-1)}

        pic = pic + labs(y=ylab,x=xlab)+
         geom_segment(aes(x = 3, y = 0.65, xend = 4, yend = 0.65), color = "springgreen4")+
        geom_segment(aes(x = 3, y = 0.65, xend = 3, yend = 0.55), color = "springgreen4")+
        geom_segment(aes(x = 4, y = 0.65, xend = 4, yend = 0.5), color = "springgreen4")+

        geom_segment(aes(x = 1.5, y = 1, xend = 3.5, yend = 1), color = "springgreen3")+
        geom_segment(aes(x = 1.5, y = 1, xend = 1.5, yend = 0.95), color = "springgreen3")+
        geom_segment(aes(x = 3.5, y = 1, xend = 3.5, yend = 0.75), color = "springgreen3")+

        geom_segment(aes(x = 1, y = 0.85, xend = 2, yend = 0.85), color = "springgreen2")+
        geom_segment(aes(x = 1, y = 0.85, xend = 1, yend = 0.75), color = "springgreen2")+
        geom_segment(aes(x = 2, y = 0.85, xend = 2, yend = 0.7), color = "springgreen2")+

    
        annotate("text",x=2.5,y=1.075,
                 label = paste0(formatC(tests$estimates[3],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[3],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
        annotate("text",x=3.5,y=0.7,
                 label = paste0(formatC(tests$estimates[2],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[2],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
        annotate("text",x=1.5,y=0.9,
                 label = paste0(formatC(tests$estimates[1],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[1],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
          
        theme(axis.text.x = element_text(color = "black", angle = 0,
                                         hjust = .5, vjust = 5, face = "plain"),
        axis.text.y = element_text(color = "black", angle = 0,
                                   hjust = 0, vjust = .5, face = "plain",
                                   margin=unit(rep(0.5,4),"cm")),
        axis.title.x = element_text(color = "black", angle = 0,
                                    hjust = .5, vjust = 3, face = "bold"),
        axis.title.y = element_text(color = "black", 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$label) +
        ggtitle(title) +
        theme(plot.title = element_text(face='bold', hjust=0.5, vjust=0.5)) 
        

    return (pic)
}
emotion_tests <- get_test_outcome(emotions_nudge, "misinfo_post", "Emotions")

plot_gen_misinfo(emotions_acc_nudge_data[emotions_acc_nudge_data$outcome == "misinfo_post",],c("ivory1","springgreen1","ivory4","springgreen4"), "Post-Survey Misinformation Sharing", "Assignment Group",0,1.1,"Accuracy Nudge Analysis",3,TRUE, emotion_tests)

ggsave(paste0("generated_figures/accuracy_nudge/emotions_misinfo_post.png"),width=6,height=4)
plot_gen_disc = function(data,color,ylab,xlab,y_min,y_max,title,num_size,baseline, tests){

pic = ggplot(data=data,aes(x=label,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(), legend.margin = margin(6, 6, 6, 6),
        legend.box.background = element_rect( fill="transparent"),legend.background = element_blank()) +

        geom_bar(stat='identity',width=0.75,color="black",fill=color) +
        geom_errorbar(aes(ymin=mean-1.96*std.err, ymax = mean+1.96*std.err),width=0.1, position = position_dodge(1))

        if (baseline){

        pic = pic + geom_text(aes(label=formatC(mean,digits=3,format="f"),y=mean+sign(mean)*std.err),vjust = -3.75,size=num_size)+
        geom_text(aes(label=paste("(",formatC(std.err,digits=4,format="f"),")",sep=""),y=mean+sign(mean)*std.err),vjust = -3.25,size=num_size-1)}

        pic = pic + labs(y=ylab,x=xlab)+
        geom_segment(aes(x = 3, y = 0.35, xend = 4, yend = 0.35), color = "springgreen4")+
        geom_segment(aes(x = 3, y = 0.35, xend = 3, yend = 0.30), color = "springgreen4")+
        geom_segment(aes(x = 4, y = 0.35, xend = 4, yend = 0.30), color = "springgreen4")+

        geom_segment(aes(x = 1.5, y = 0.50, xend = 3.5, yend = 0.50), color = "springgreen3")+
        geom_segment(aes(x = 1.5, y = 0.50, xend = 1.5, yend = 0.45), color = "springgreen3")+
        geom_segment(aes(x = 3.5, y = 0.50, xend = 3.5, yend = 0.45), color = "springgreen3")+

        geom_segment(aes(x = 1, y = 0.35, xend = 2, yend = 0.35), color = "springgreen2")+
        geom_segment(aes(x = 1, y = 0.35, xend = 1, yend = 0.25), color = "springgreen2")+
        geom_segment(aes(x = 2, y = 0.35, xend = 2, yend = 0.25), color = "springgreen2")+

    
        annotate("text",x=2.5,y=0.55,
                 label = paste0(formatC(tests$estimates[3],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[3],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
        annotate("text",x=3.5,y=0.40,
                 label = paste0(formatC(tests$estimates[2],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[2],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
        annotate("text",x=1.5,y=0.40,
                 label = paste0(formatC(tests$estimates[1],digits=3,format='f'), 
                                "\n(",formatC(tests$std.err[1],digits=4,format='f'),")"),
                 size = num_size - 0.5) +
          
        theme(axis.text.x = element_text(color = "black", angle = 0,
                                         hjust = .5, vjust = 5, face = "plain"),
        axis.text.y = element_text(color = "black", angle = 0,
                                   hjust = 0, vjust = .5, face = "plain",
                                   margin=unit(rep(0.5,4),"cm")),
        axis.title.x = element_text(color = "black", angle = 0,
                                    hjust = .5, vjust = 3, face = "bold"),
        axis.title.y = element_text(color = "black", 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$label) +
        ggtitle(title) +
        theme(plot.title = element_text(face='bold', hjust=0.5, vjust=0.5)) 
        

    return (pic)
}
emotion_tests <- get_test_outcome(emotions_nudge, "new_disc_post", "Emotions")

plot_gen_disc(emotions_acc_nudge_data[emotions_acc_nudge_data$outcome == "new_disc_post",],c("ivory1","springgreen1","ivory4","springgreen4"), "Post-Survey Sharing Discernment", "Assignment Group",0,0.6,"Accuracy Nudge Analysis",3,TRUE, emotion_tests)

ggsave(paste0("generated_figures/accuracy_nudge/emotions_disc_post.png"),width=6,height=4)