Tables

Table 1: Descriptive statistics by treatment

df.table1 <- df %>% 
  mutate(time_in_minutes = time_seconds/60) %>% 
  mutate(gender_ = case_when(gender == "Non-binary" ~ "Non-binary/not say",
                             gender == "Rather not say" ~ "Non-binary/not say",
                             TRUE ~ gender))
 
table1 <- table1(~ gender_ + age + income + identify_charity +  
         browser + as.factor(dana_reveal) + as.factor(test_button_click) | treatment, data=df.table1) %>% 
  as.data.frame() 

table1 <- rbind(table1[1:5,], table1[7,], table1[9:15,], table1[17,], table1[20,], table1[25,], table1[28,])
table1 <- rbind(table1[-1,], table1[1,]) # move nr of observations to bottom row
table1 <- table1[,2:5] 

p_gender <- round(chisq.test(df.table1$gender_, df.table1$treatment)$p.value,3)
p_age <- round(as.data.frame(summary(aov(age ~ treatment, data = df.table1))[[1]])[1,5],3)
p_income <- round(chisq.test(df.table1$income, df.table1$treatment)$p.value,3)
p_identify <- round(as.data.frame(summary(aov(identify_charity ~ treatment, data = df.table1))[[1]])[1,5],3)
p_browser <- round(chisq.test(df.table1$browser, df.table1$treatment)$p.value,3)
p_dana_reveal <- round(chisq.test(df.table1$dana_reveal, df.table1$treatment)$p.value,3)
p_test_button_click <- round(chisq.test(df.table1$test_button_click, df.table1$treatment)$p.value,3)

p_values <- rbind(p_gender, " ", " ", " ", 
                  p_age, p_income, " ", " ", " ", " ", " ", " ", 
                  p_identify, p_browser, p_dana_reveal, p_test_button_click, " ") %>% 
  as.data.frame() 
names(p_values) <- "p-value"

table1 <- cbind(table1, p_values)

rownames(table1) <- c("Gender (%)",
                            "Female","Male", "Non-binary/not say", 
                            "Age in years (SD)", 
                            "Monthly income (%)",
                            "less than 999",
                            "1000-1999",
                            "2000-2999",
                            "3000-3999",
                            "more than 4000",
                            "Rather not say",
                            "Identify with charity (SD)(a)",
                            "Browser type Desktop (%)",
                            "Reveal in DWK (%)",
                            "Press btn in the test round (%)",
                            "Observations")

kable(table1, format = "html", linesep = "",
                      caption = "Descriptive statistics by treatment", align = "c",
                      label = "descriptives") %>% 
    add_indent(c(2:4, 7:12)) %>%
    footnote(general = "The table reports the means for the continuous and the counts for the categorical variables with, respectively, SD and percentages in parentheses. The column p-value reports the results of a test comparing the different treatments. A Chi-squared test is used for categorical variables and an Anova for the continuous variables.") %>% 
    add_footnote("Response to the question *How much do you identify with the charity Red Cross?* ranging from -5 = not at all to 5 = very much.", notation = "alphabet")
Descriptive statistics by treatment
Baseline Request Request + Punishment Overall p-value
Gender (%) 0.054
Female 136 (45.0%) 316 (51.8%) 323 (53.8%) 775 (51.3%)
Male 161 (53.3%) 291 (47.7%) 273 (45.5%) 725 (47.9%)
Non-binary/not say 5 (1.7%) 3 (0.5%) 4 (0.7%) 12 (0.8%)
Age in years (SD) 39.5 (12.9) 39.1 (13.0) 39.0 (13.0) 39.1 (13.0) 0.825
Monthly income (%) 0.209
less than 999 29 (9.6%) 55 (9.0%) 47 (7.8%) 131 (8.7%)
1000-1999 68 (22.5%) 156 (25.6%) 130 (21.7%) 354 (23.4%)
2000-2999 80 (26.5%) 175 (28.7%) 162 (27.0%) 417 (27.6%)
3000-3999 61 (20.2%) 103 (16.9%) 123 (20.5%) 287 (19.0%)
more than 4000 51 (16.9%) 88 (14.4%) 88 (14.7%) 227 (15.0%)
Rather not say 13 (4.3%) 33 (5.4%) 50 (8.3%) 96 (6.3%)
Identify with charity (SD)(a) 0.185 (2.94) 0.210 (2.74) 0.157 (2.80) 0.184 (2.81) 0.947
Browser type Desktop (%) 281 (93.0%) 566 (92.8%) 517 (86.2%) 1364 (90.2%) 0.001
Reveal in DWK (%) 119 (39.4%) 256 (42.0%) 223 (37.2%) 598 (39.6%) 0.232
Press btn in the test round (%) 292 (96.7%) 579 (94.9%) 572 (95.3%) 1443 (95.4%) 0.477
Observations (N=302) (N=610) (N=600) (N=1512)
a Response to the question How much do you identify with the charity Red Cross? ranging from -5 = not at all to 5 = very much.
Note:
The table reports the means for the continuous and the counts for the categorical variables with, respectively, SD and percentages in parentheses. The column p-value reports the results of a test comparing the different treatments. A Chi-squared test is used for categorical variables and an Anova for the continuous variables.

Table 2: Senders’ beliefs about button pressing

df.beliefs <- df %>% 
  select(starts_with("belief_minus"), belief_plus0.5, belief_uninformed, button_role, button_click, pp_id, treatment) %>% 
  pivot_longer(starts_with("belief"),names_sep = "_", names_to = c("variable", "consequence"), values_to = "value") %>% 
  mutate(consequence = case_when(consequence == "minus2.5" ~ "-2.5",
                                 consequence == "minus1.0" ~ "-1.0",
                                 consequence == "minus0.5" ~ "-0.5",
                                 consequence == "plus0.5" ~ "+0.5",
                                 consequence == "uninformed" ~ "uninformed"),
         consequence = factor(consequence, levels = c("uninformed", "+0.5", "-0.5", "-1.0", "-2.5")))

df.beliefs <- df.beliefs %>%
    subset(button_role == "Sender")

df.beliefs %>%
    group_by(consequence) %>%
        summarise(
            Weight = mean(value),
            sd = sd(value),
            n = n(),
            se = sd / sqrt(n)
        )

plm.model <- plm(value~consequence,
                    data = df.beliefs, 
                    index = c("pp_id"), 
                    #subset = (treatment=="Request"), 
                    model="within",
                    effect="individual"
                )
robust_se <- coeftest(plm.model, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.model_b <- plm(value~consequence, 
                    data = df.beliefs, 
                    index = c("pp_id"), 
                    subset = (treatment=="Baseline"), 
                    model="within",
                    effect="individual"
                )
robust_se_b <- coeftest(plm.model_b, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.model_r <- plm(value~consequence, 
                    data = df.beliefs, 
                    index = c("pp_id"), 
                    subset = (treatment=="Request"), 
                    model="within",
                    effect="individual"
                )
robust_se_r <- coeftest(plm.model_r, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.model_rp <- plm(value~consequence, 
                    data = df.beliefs, 
                    index = c("pp_id"), 
                    subset = (treatment=="Request + Punishment"), 
                    model="within",
                    effect="individual"
                )
robust_se_rp <- coeftest(plm.model_rp, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE
stargazer(plm.model, plm.model_b, plm.model_r, plm.model_rp, 
          type = 'html', 
            se = list(robust_se[,2],robust_se_b[,2],robust_se_r[,2],robust_se_rp[,2]), 
            p=list(robust_se[,4],robust_se_b[,4],robust_se_r[,4],robust_se_rp[,4]), 
            star.cutoffs=c(0.1,0.05,0.01,0.001), 
            star.char = c("\\circ", "*", "**", "***"),
            # notes  = paste0("$^{",c("\\circ", "*", "**", "***"),"}$p$<$",c(0.1,0.05,0.01,0.001),"; ",collapse=''),
            notes.append = FALSE,
            omit.stat=c("f"),
            font.size = "footnotesize",
            table.placement = "H",
            label="reg:senders_beliefs_pressing", 
            dep.var.caption = "\\textit{Dependent variable}: Beliefs about Receivers' button pressing",
            # dep.var.labels = "Belief of \\% of Receivers pressing the button",
            dep.var.labels.include = FALSE,
            title = "Senders' beliefs about Receivers' button pressing, by consequence and treatment.", 
            column.labels = c("All tmts", "Baseline", "Request", "Req. + Pun."),
            notes = "Dependent variable: Response to the statement *I believe ... in 100 players will press the button.* Reference category: uninformed. Linear model with individual level fixed effects and heteroscedasticity robust standard errors in parentheses.",
            notes.align = "l"
            )
Senders’ beliefs about Receivers’ button pressing, by consequence and treatment.
Dependent variable: Beliefs about Receivers’ button pressing
All tmts Baseline Request Req. + Pun.
(1) (2) (3) (4)
consequence+0.5 5.344*** 4.715 4.593** 6.423***
(0.967) (2.496) (1.426) (1.511)
consequence-0.5 -23.134*** -20.808*** -24.636*** -22.777***
(0.981) (2.132) (1.517) (1.608)
consequence-1.0 -31.354*** -26.596*** -33.272*** -31.800***
(1.075) (2.360) (1.631) (1.776)
consequence-2.5 -40.458*** -36.172*** -42.466*** -40.573***
(1.210) (2.671) (1.868) (1.968)
Observations 3,780 755 1,525 1,500
R2 0.465 0.409 0.490 0.469
Adjusted R2 0.331 0.258 0.361 0.334
Note: Dependent variable: Response to the statement I believe … in 100 players will press the button. Reference category: uninformed. Linear model with individual level fixed effects and heteroscedasticity robust standard errors in parentheses.

Table 3: Ordered probit regressions of Sender-index

df2 <- df %>%
  mutate(group = case_when(request == "request_no_info" & treatment == "Request + Punishment" ~ 1,
                           request == "request_no_info" & treatment == "Request"~ 2,
                           treatment == "Baseline" ~ 3,
                           request == "request_info" & treatment == "Request" ~ 4,
                           request == "request_info" & treatment == "Request + Punishment" ~ 5
  ),
  h2_request_info = case_when(group > 3 ~ 1, TRUE ~ 0),
  h2_request_ignorance = case_when(group < 3  ~ 1, TRUE ~ 0),
  group = ordered(group, levels = c(1,2,3,4,5), labels = c("Request No Info + Pun", "Request No Info", "Baseline", "Request Info", "Request Info + Pun"))) %>% 
  group_by(group) %>% 
  arrange(sender_index,.by_group = TRUE) %>%
  ungroup()

df2 <- df2 %>%
  filter(button_role == "Sender" & !is.na(sender_index) & !is.na(income_c))

df2 <- df2 %>%
  mutate( # standardize the vars between 0 and 1 to get correct SE with polr
    age = (age - min(age)) / (max(age) - min(age)),
    identify_charity = (identify_charity - min(identify_charity)) / (max(identify_charity) - min(identify_charity)),
    income_c = (income_c - min(income_c)) / (max(income_c) - min(income_c)),
    uq_wrong_button = (uq_wrong_button - min(uq_wrong_button)) / (max(uq_wrong_button) - min(uq_wrong_button))
  )

df2_standardized_for_appendix <- df2

oprob4 <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button,
               data=subset(df2, treatment == "Baseline" | treatment == "Request"), Hess=TRUE, method="probit")

McFadden.oprob4 <- round(pR2(oprob4)["McFadden"],3)
LL.oprob4 <- round(pR2(oprob4)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4 <- vcovCL(oprob4, type = "HC1") # HC1 reproduces STATA default
robust_se4    <- sqrt(diag(cov_robust4))

# Model with Baseline and Request data + controls IVAN-----------------------------------------------------------------
oprob4a <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, dana_reveal == 0 & treatment !="Request + Punishment"), Hess=TRUE, method="probit")

McFadden.oprob4a <- round(pR2(oprob4a)["McFadden"],3)
LL.oprob4a <- round(pR2(oprob4a)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4a <- vcovCL(oprob4a, type = "HC1") # HC1 reproduces STATA default
robust_se4a    <- sqrt(diag(cov_robust4a))

# Model with Baseline and Request data + controls IVAN-----------------------------------------------------------------
oprob4b <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, dana_reveal == 1 & treatment !="Request + Punishment"), Hess=TRUE, method="probit")

McFadden.oprob4b <- round(pR2(oprob4b)["McFadden"],3)
LL.oprob4b <- round(pR2(oprob4b)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4b <- vcovCL(oprob4b, type = "HC1") # HC1 reproduces STATA default
robust_se4b    <- sqrt(diag(cov_robust4b))

# Model with All data + controls -----------------------------------------------------------------
oprob6 <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button,
               data=df2, Hess=TRUE, method="probit")

McFadden.oprob6 <- round(pR2(oprob6)["McFadden"],3)
LL.oprob6 <- round(pR2(oprob6)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6 <- vcovCL(oprob6, type = "HC1") # HC1 reproduces STATA default
robust_se6    <- sqrt(diag(cov_robust6))

# Model with All data + controls IVAN-----------------------------------------------------------------
oprob6a <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, dana_reveal == 0), Hess=TRUE, method="probit")

McFadden.oprob6a <- round(pR2(oprob6a)["McFadden"],3)
LL.oprob6a <- round(pR2(oprob6a)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6a <- vcovCL(oprob6a, type = "HC1") # HC1 reproduces STATA default
robust_se6a    <- sqrt(diag(cov_robust6a))

# Model with All data + controls IVAN-----------------------------------------------------------------
oprob6b <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, dana_reveal == 1), Hess=TRUE, method="probit")

McFadden.oprob6b <- round(pR2(oprob6b)["McFadden"],3)
LL.oprob6b <- round(pR2(oprob6b)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6b <- vcovCL(oprob6b, type = "HC1") # HC1 reproduces STATA default
robust_se6b    <- sqrt(diag(cov_robust6b))
# regression <- stargazer(oprob4, oprob4a, oprob4b, oprob6,oprob6a, oprob6b,
#                         type = "text",
#                         se = list(robust_se4, robust_se4a, robust_se4b, robust_se6, robust_se6a, robust_se6b),
#                         keep.stat = c("rsq", "n"),
#                         star.cutoffs=c(0.05,0.01,0.001),
#                         star.char = c("*", "**", "***"),
#                         notes.append = FALSE,
#                         omit.stat=c("f"),
#                         font.size = "scriptsize",
#                         table.placement = "H",
#                         label="reg:senders_index_oprobit",
#                         dep.var.caption = "\\textit{Dependent variable}: Sender-index",
#                         dep.var.labels.include = FALSE,
#                         title = "Ordered probit regressions of Sender-index",
#                         ord.intercepts = TRUE,
#                         keep = c('h2_request_info', 'h2_request_ignorance', 'identify_charity', "dana_reveal"),
#                         order = c(2,3,1,4,5,6),
#                         covariate.labels = c("Information preference  -     Request info",
#                                              "     Request ignorance",
#                                              "     Request info under punishment threat",
#                                              "     Request ignorance under punishment threat",
#                                              "Control variables  -   Identify with charity",
#                                              "    Revealed in DWK"),
#                         add.lines = list(c("Log likelihood",
#                                            LL.oprob4, LL.oprob4a, LL.oprob4b, LL.oprob6, LL.oprob6a, LL.oprob6b),
#                                          c("Pseudo $R^2$ (McFadden)",
#                                            McFadden.oprob4, McFadden.oprob4a, McFadden.oprob4b, McFadden.oprob6,
#                                            McFadden.oprob6a, McFadden.oprob6b),
# c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"),
# c("Revealed in DWK", "", "No", "Yes", "", "No", "Yes")
#                                          ),
#                         notes.align = "l",
#                         notes = "Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Request treatment. Model 4, 5 and 6 include all participants in the Request and Request + Punishment treatment. Robust standard errors in parentheses."
#                         )


regression <- stargazer(oprob4, oprob4a, oprob4b, oprob6,oprob6a, oprob6b,
                        type = "html",
                        se = list(robust_se4, robust_se4a, robust_se4b, robust_se6, robust_se6a, robust_se6b),
                        keep.stat = c("rsq", "n"),
                        star.cutoffs=c(0.05,0.01,0.001), 
                        star.char = c("*", "**", "***"),
                        notes.append = FALSE,
                        omit.stat=c("f"),
                        font.size = "scriptsize",
                        table.placement = "H",
                        label="reg:senders_index_oprobit_by_dwk", 
                        dep.var.caption = "\\textit{Dependent variable}: Sender-index",
                        dep.var.labels.include = FALSE,
                        title = "Ordered probit regressions of Sender-index",
                        ord.intercepts = TRUE,
                        keep = c('h2_request_info', 'h2_request_ignorance', 'identify_charity', "dana_reveal"),
                        order = c(2,3,1,4,5,6),
                        covariate.labels = c("**Information preference (ref = Baseline)**}    Request info",
                                             "     Request ignorance",
                                             "    Request info under punishment threat",
                                             "    Request ignorance under punishment threat",
                                             "**Control variables**    Identify with charity",
                                             "    Revealed in DWK"#,
                                             # "Cutoff point 1",
                                             # "Cutoff point 2",
                                             # "Cutoff point 3"
                                             ),
                        add.lines = list(c("Log likelihood", 
                                           LL.oprob4, LL.oprob4a, LL.oprob4b, LL.oprob6, LL.oprob6a, LL.oprob6b),
                                         c("Pseudo $R^2$ (McFadden)",
                                           McFadden.oprob4, McFadden.oprob4a, McFadden.oprob4b, McFadden.oprob6,
                                           McFadden.oprob6a, McFadden.oprob6b),
                                         c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"),
                                         c("Revealed in DWK", "", "No", "Yes", "", "No", "Yes")
                                         ),
                        notes.align = "l",
                        notes = "Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Baseline and Request treatments. Model 4, 5 and 6 include all participants across all treatments. Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).")
Ordered probit regressions of Sender-index
Dependent variable: Sender-index
(1) (2) (3) (4) (5) (6)
Information preference (ref = Baseline)} Request info -0.011 -0.111 0.085 -0.028 -0.072 0.023
(0.124) (0.162) (0.202) (0.122) (0.157) (0.197)
Request ignorance -0.130 -0.255 0.023 -0.150 -0.232 -0.063
(0.172) (0.227) (0.272) (0.169) (0.219) (0.273)
Request info under punishment threat 0.096 -0.048 0.356
(0.130) (0.164) (0.224)
Request ignorance under punishment threat 0.083 0.097 -0.008
(0.167) (0.228) (0.245)
Control variables Identify with charity 0.990*** 1.234*** 0.764* 0.731*** 0.884*** 0.555
(0.214) (0.269) (0.365) (0.167) (0.212) (0.287)
Revealed in DWK 0.257* 0.323***
(0.119) (0.094)
Log likelihood -522 -312.5 -203.6 -842.8 -523.1 -311.9
Pseudo R(McFadden) 0.038 0.048 0.028 0.029 0.028 0.026
Covariates Yes Yes Yes Yes Yes Yes
Revealed in DWK No Yes No Yes
Observations 412 244 168 667 402 265
Note: Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Baseline and Request treatments. Model 4, 5 and 6 include all participants across all treatments. Robust standard errors in parentheses (p<0.10; p<0.05; p<0.01; p<0.001).
# note.latex <- "\\multicolumn{7}{p{\\linewidth}} {\\textit{Notes:} Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Baseline and Request treatments. Model 4, 5 and 6 include all participants across all treatments. Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# regression[grepl("Note",regression)] <- note.latex
# # to move the table 1.5 cm into the left margin:
# regression[grepl("scriptsize", regression)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(regression, here("output", "tables", "oprob_senderindex_by_dwk.tex"))

Table 4: Receivers’ button pressing by request and information obtained

# Prepare data
#--------------------------------------------------------------------------------------
df1 <- df %>% 
    filter(button_role == "Sender") %>% 
    mutate(consequence = paste0(substr(consequence, 0,1), substr(consequence, 3,6))) %>%
    mutate(consequence = as.numeric(consequence)) %>%
    select(group_id,consequence)

df2 <- df %>% 
    filter(button_role == "Receiver") %>%
    select(-consequence)

df2 <- left_join(df2, df1, by = "group_id") %>%
    mutate( charity_outcome = consequence*button_click, 
    group_5 = case_when(treatment == "Request + Punishment" & request == "request_info" ~ "Req_Info",
                              treatment == "Request" & request == "request_info" ~ "Req_Info",
                              treatment == "Request + Punishment" & request == "request_no_info" ~ "Req_Igno",
                              treatment == "Request" & request == "request_no_info" ~ "Req_Igno",
                              treatment == "Baseline" ~ "Baseline"),
         group_5 = factor(group_5, levels=c("Baseline",
                                             "Req_Info",
                                             "Req_Igno"
                                             )),
         treatment = ordered(treatment, levels=c("Baseline",
                                                 "Request",
                                                 "Request + Punishment"))
            )
#--------------------------------------------------------------------------------------



# regression table
#--------------------------------------------------------------------------------------
df_reg <- df2 %>%
  mutate(
    Base = if_else(group_5 == "Baseline", 1, 0),
    R_inf = if_else(group_5 == "Req_Info", 1, 0),
    R_ign = if_else(group_5 == "Req_Igno", 1, 0),
    msg = if_else(message != "no message", 1, 0)
  )

m1 <- lm(button_click ~
    group_5 * msg +
    identify_charity  + dana_reveal +  gender_f + age + income_c +  I(browser!="Desktop")
  , data = df_reg, subset = (message == "-2.50" | message == "no message")
)
robust_se1 <- coeftest(m1, vcov. = function(x) vcovHC(x, type = "HC1"))

m2 <- lm(button_click ~
    group_5 * msg +
    identify_charity  + dana_reveal +  gender_f + age + income_c +  I(browser!="Desktop")
  , data = df_reg, subset = (message == "-1.00" | message == "no message")
)
robust_se2 <- coeftest(m2, vcov. = function(x) vcovHC(x, type = "HC1"))

m3 <- lm(button_click ~
    group_5 * msg +
    identify_charity  + dana_reveal +  gender_f + age + income_c +  I(browser!="Desktop")
  , data = df_reg, subset = (message == "-0.50" | message == "no message")
)
robust_se3 <- coeftest(m3, vcov. = function(x) vcovHC(x, type = "HC1"))
# table_welfare <- stargazer(m1, m2, m3,
#   type = 'latex',
#   se = list(robust_se1[, 2], robust_se2[, 2], robust_se3[, 2]),
#   p = list(robust_se1[, 4], robust_se2[, 4], robust_se3[, 4]),
#   star.cutoffs = c(0.1, 0.05, 0.01, 0.001),
#   star.char = c("\\circ", "*", "**", "***"),
#   notes.append = FALSE,
#   keep.stat = c("rsq", "n", "adj.rsq"),
#   font.size = "footnotesize",
#   table.placement = "H",
#   label = "reg:welfare",
#   dep.var.caption = "\\textit{Dependent variable}: Button pressing",
#   dep.var.labels.include = FALSE,
#   title = "Receivers' button pressing by request and information obtained.", 
#   column.labels = c("Cons. -2.5", "Cons. -1.0", "Cons. -0.5"),
#   intercept.bottom = FALSE,
#   omit = c("gender_f", "age", "income_c", "browser", "identify_charity", "dana_reveal"),
#   covariate.labels = c("Constant",
#                        "\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                        "\\-\\hspace{0.3cm}Request Ignorance",
#                        "\\-\\textbf{Information (ref = Ignorance)} \\\\ \\-\\hspace{0.3cm}Information received",
#                        "\\-\\textbf{Interactions} \\\\ \\-\\hspace{0.3cm}Request Info $\\times$ Information received",
#                        "\\-\\hspace{0.3cm}Request Ignorance $\\times$ Information received")
# )

# note.latex <- "\\multicolumn{4}{p{.76\\linewidth}} {\\textit{Notes:} Dependent variable: Button pressed. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions.  Linear model with heteroscedasticity robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# table_welfare[grepl("Note", table_welfare)] <- note.latex
# table_welfare[grepl("scriptsize", table_welfare)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(table_welfare, here("output", "tables", "welfare_effect.tex"))

stargazer(m1, m2, m3,
  type = 'html',
  se = list(robust_se1[, 2], robust_se2[, 2], robust_se3[, 2]),
  p = list(robust_se1[, 4], robust_se2[, 4], robust_se3[, 4]),
  star.cutoffs = c(0.1, 0.05, 0.01, 0.001),
  star.char = c("\\circ", "*", "**", "***"),
  notes.append = FALSE,
  keep.stat = c("rsq", "n", "adj.rsq"),
  font.size = "footnotesize",
  table.placement = "H",
  label = "reg:welfare",
  dep.var.caption = "\\textit{Dependent variable}: Button pressing",
  dep.var.labels.include = FALSE,
  title = "Receivers' button pressing by request and information obtained.", 
  column.labels = c("Cons. -2.5", "Cons. -1.0", "Cons. -0.5"),
  intercept.bottom = FALSE,
  omit = c("gender_f", "age", "income_c", "browser", "identify_charity", "dana_reveal"),
  covariate.labels = c("Constant",
                       "**Information preference (ref = Baseline)**     Request info",
                       "    Request Ignorance",
                       "**Information (ref = Ignorance)**     Information received",
                       "**Interactions**     Request Info x Information received",
                       "    Request Ignorance x Information received"),
  notes = "Dependent variable: Button pressed. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions.  Linear model with heteroscedasticity robust standard errors in parentheses",
  notes.align = "l"
)
Receivers’ button pressing by request and information obtained.
Dependent variable: Button pressing
Cons. -2.5 Cons. -1.0 Cons. -0.5
(1) (2) (3)
Constant 1.019*** 1.012*** 1.020***
(0.061) (0.056) (0.057)
Information preference (ref = Baseline) Request info 0.011 0.021 0.013
(0.032) (0.032) (0.032)
Request Ignorance 0.016 0.019 0.026
(0.030) (0.030) (0.030)
Information (ref = Ignorance) Information received -0.546*** -0.393*** -0.192
(0.105) (0.109) (0.100)
Interactions Request Info x Information received 0.027 0.028 -0.126
(0.123) (0.127) (0.117)
Request Ignorance x Information received 0.362** 0.202 0.101
(0.134) (0.130) (0.114)
Observations 447 447 442
R2 0.374 0.223 0.181
Adjusted R2 0.358 0.203 0.160
Note: Dependent variable: Button pressed. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. Linear model with heteroscedasticity robust standard errors in parentheses

Figures

Figure 3: Percentage of Senders by sender-index in the Baseline treatment

df.switching <- df %>% 
  filter(!is.na(sender_index)) %>% 
  filter(button_role == "Sender") %>% 
  filter(treatment == "Baseline") %>% 
  select(starts_with("message_minus"), pp_id, sender_index) %>% 
  mutate(message_minus0.5 = case_when(message_minus0.5 == "True" ~ 1, message_minus0.5 == "False" ~ 0),
         message_minus1.0 = case_when(message_minus1.0 == "True" ~ 1, message_minus1.0 == "False" ~ 0),
         message_minus2.5 = case_when(message_minus2.5 == "True" ~ 1, message_minus2.5 == "False" ~ 0),
         switching = paste0(message_minus2.5, message_minus1.0, message_minus0.5),
         ) %>% 
  pivot_longer(starts_with("message_"),
               names_sep = "_", names_to = c("variable", "message"), values_to = "value") %>% 
  mutate(message = case_when(message == "minus2.5" ~ "-2.5",
                             message == "minus1.0" ~ "-1.0",
                             message == "minus0.5" ~ "-0.5"),
         message = factor(message, levels = c("-0.5", "-1.0", "-2.5")))

df.switching.sum <- df.switching %>% 
  select(pp_id, switching) %>% 
  distinct(.keep_all = TRUE) %>% 
  group_by(switching) %>% 
  tally() %>% 
  mutate(pct = n / sum(n),
         pct_label =scales::percent(n / sum(n), accuracy = 0.1, trim = FALSE)) 

top.fig <- ggplot(df.switching.sum, aes(c(1,1,1,1), pct, fill = switching))  +
  geom_col(width = 0.6, col = "black") +
  labs(fill = "", y = "% of Senders", x = "") + 
  theme_ridges(center_axis_labels = TRUE) + 
  theme(legend.position = "none", axis.text.x = element_blank(), strip.text.x = element_blank()) +
  geom_text(aes(label = pct_label), vjust = -0.5, nudge_x = 0) +
  facet_wrap(~switching, nrow = 1, strip.position = "bottom") +
  scale_fill_manual(values = c("#fef0d9", "#fdcc8a", "#fc8d59", "#d7301f")) +
  scale_y_continuous(breaks = c(seq(0,1, by = 0.1)), limits=c(0,0.5), labels = c(seq(0,1, by = 0.1))*100) 

bottom.fig <- ggplot(df.switching, aes(message, value, group = 1)) + 
  geom_line(size=1) + geom_point() + 
  facet_wrap(~switching, nrow = 1, strip.position = "bottom",
             labeller = labeller(switching = 
    c("000" = "\n0",
      "100" = "\n1",
      "110" = "\n2",
      "111" = "\n3"))) +
  labs(y = "Choice", x = "\nSender-index") +
  scale_y_continuous(breaks = c(seq(0,1, by = 1)), limits=c(0,1), labels = c("hide", "share")) +
  theme_ridges(center_axis_labels = TRUE) + 
  theme(legend.position = "none", 
        strip.background = element_blank(),
        strip.placement = "outside",
        axis.text.x = element_text(size= 8)
        ) 

plot_grid(top.fig, bottom.fig, ncol=1, align = "v", rel_heights = c(3, 2.2))

Figure 4: Percentage of Senders by sender-index and treatment

h4 <- df %>% 
  filter(button_role == "Sender") %>% 
  mutate(consequence = paste0(substr(consequence, 0,1), substr(consequence, 3,6)),
         consequence = as.numeric(consequence),
         group_h4 = case_when(treatment == "Request + Punishment" & request == "request_info" ~ "Punishment\n Information\n requested",
                              treatment == "Request" & request == "request_info" ~ "Request\n Information\n requested",
                              treatment == "Request + Punishment" & request == "request_no_info" ~ "Punishment\n Ignorance\n requested",
                              treatment == "Request" & request == "request_no_info" ~ "Request\n Ignorance\n requested",
                              treatment == "Baseline" ~ "Baseline"),
         group_h4 = ordered(group_h4, levels=c("Punishment\n Ignorance\n requested",
                                     "Request\n Ignorance\n requested", 
                                     "Baseline",
                                     "Request\n Information\n requested",
                                     "Punishment\n Information\n requested")),
         dummy_req = case_when(request == "request_info" ~ 1, TRUE ~ 0),
         dummy_pun = case_when(treatment == "Request + Punishment" ~ 1, TRUE ~ 0))

five_bars <- h4 %>% 
  filter(!is.na(sender_index)) %>% 
  select(sender_index, group_h4) %>% 
  group_by(group_h4, sender_index) %>% 
  tally() %>% 
  mutate(pct = n / sum(n),
         pct_label =scales::percent(n / sum(n), accuracy = 0.1, trim = FALSE),
         pct_label_plus_n = paste0(pct_label, " (n = ", n, ")")) %>% 
  mutate(sender_index_f = as.factor(sender_index))

ggplot(five_bars, aes(y=pct, x = sender_index, fill = sender_index_f)) +
  geom_bar(stat="identity", position = position_dodge(),color="black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1L)) +
  labs(y = "% of Senders", fill = "", x = "\nSender-index"
       # , title = "Percentage of Senders by sender-index, treatment and request"
       ) + 
  theme_bw() + theme(legend.position = "none") + facet_wrap(~group_h4, nrow = 1) +
  scale_fill_manual(values = c("#fef0d9", "#fdcc8a", "#fc8d59", "#d7301f")) 

Figure 5: Self-reported motivations to send, by sender-index

ra <- read.xlsx(here('input', "ra_coding_agreed_coded.xlsx"), 1) %>% 
  select(pp_id, send_motivation1_cat1, second.motivation) %>% 
  rename(send_motivation1_cat = send_motivation1_cat1,
         send_motivation1_cat2 = second.motivation) %>% 
  mutate(send_motivation1_cat = case_when(send_motivation1_cat == "procedural " ~ "procedural",
                                          send_motivation1_cat == "help the other player to be selfish " ~ "help the other player to be selfish",
                                          send_motivation1_cat == "unconditional charity help " ~ "unconditional charity help",
                                          send_motivation1_cat == "outcome-based" ~ "conditional charity help",
                                          TRUE ~ send_motivation1_cat),
         # merged conditional charity help and outcome-based, as they are the same
         send_motivation1_cat2 = case_when(send_motivation1_cat2 == "outcome-based" ~ "conditional charity help",
                                       TRUE ~ send_motivation1_cat2),
         send_motivation1_cat = ordered(send_motivation1_cat, levels = rev(c("unconditional charity help","conditional charity help", 
                                                                         "procedural", "requested", "no explanation", "help the other player to be selfish",
                                                                         "help all parties", "other"))))

ra2 <- read.xlsx(here('input', "ra_coding_agreed_coded2.xlsx"), 1) %>% 
  select(pp_id, send_motivation1_cat1, send_motivation1_cat1_secondmotivation) %>% 
  rename(send_motivation2_cat = send_motivation1_cat1,
         send_motivation2_cat2 = send_motivation1_cat1_secondmotivation) 


df <- merge(df, ra, by = "pp_id", all.x = T)
df <- merge(df, ra2, by = "pp_id", all.x = T)
rm(ra, ra2)

df5 <- df %>% 
  mutate(send_motivation1_cat_ = case_when(send_motivation1_cat == "help all parties" ~ "other",
                                           send_motivation1_cat == "help the other player to be selfish" ~ "other",
                                           TRUE ~ as.character(send_motivation1_cat)),
         send_motivation1_cat_ = ordered(send_motivation1_cat, levels = c("unconditional charity help",
                                                                          "conditional charity help",
                                                                          "procedural",
                                                                          "requested",
                                                                          "other")))
strategies <- df5 %>% 
  filter(button_role == "Sender" & sender_index > 0 
         & !is.na(send_motivation1_cat_)) %>% 
  select(send_motivation1_cat_, sender_index) %>% 
  group_by(send_motivation1_cat_, sender_index) %>% 
  tally() %>% 
  # complete(send_motivation1_cat_, fill = list(n = 0)) %>% 
  # ungroup() %>% 
  group_by(sender_index) %>% 
  mutate(pct_strategy = prop.table(n))

ggplot(data = strategies, aes(x=sender_index, y  = pct_strategy, fill = send_motivation1_cat_)) + 
 geom_bar(stat = "identity")+
 labs(x = "Sender-index", y = "", fill = "") +
  theme_bw() +
  scale_y_continuous(labels = scales::percent)

Figure 6: Consequence for the Charity. Average transfer of the Receiver

# bar graph means and se
df1 <- df %>% 
    filter(button_role == "Sender") %>% 
    mutate( consequence = paste0(substr(consequence, 0,1), substr(consequence, 3,6)),
            consequence = as.numeric(consequence)) %>%
    select(group_id,consequence, informed)

df2 <- df %>% 
    filter(button_role == "Receiver") %>%
    select(-consequence)

df2 <- left_join(df2, df1, by = "group_id") %>%
    mutate(charity_outcome = consequence*button_click, 
           group_5 = case_when(treatment == "Request + Punishment" & request == "request_info" ~ "Req. + Pun.\nInformation\nrequested",
                              treatment == "Request" & request == "request_info" ~ "Request\nInformation\nrequested",
                              treatment == "Request + Punishment" & request == "request_no_info" ~ "Req. + Pun.\nIgnorance\nrequested",
                              treatment == "Request" & request == "request_no_info" ~ "Request\nIgnorance\nrequested",
                              treatment == "Baseline" ~ "Baseline"),
         group_5 = ordered(group_5, levels=c("Baseline",
                                             "Request\nInformation\nrequested",
                                             "Request\nIgnorance\nrequested",
                                             "Req. + Pun.\nInformation\nrequested", 
                                             "Req. + Pun.\nIgnorance\nrequested"
                                             )),
           treatment = ordered(treatment, levels=c("Baseline",
                                                 "Request",
                                                 "Request + Punishment"))) %>% 
  rename(informed = informed.y) %>% 
  select(-informed.x)

df2_for_appendix <- df2


bar1 <- df2 %>% 
  group_by(treatment) %>% 
  summarise( 
    n=n(),
    mean=mean(charity_outcome),
    sd=sd(charity_outcome)
  ) %>%
  mutate( se=sd/sqrt(n))  %>%
  ggplot(aes(x=treatment, y = mean)) + geom_point(aes(colour=treatment, fill=treatment),pch=c(21,22,23),size=4) + 
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se,colour=treatment),width=0.2,lwd=0.7) +
  labs(x="", y = "Average earnings for charity \n") +
  scale_y_continuous(limits = c(-1, -0.3)) + labs(y = "Consequences for the Red Cross (in Pounds)\n", fill = "", x = "\nTreatment") +
  scale_x_discrete(labels = c("Baseline", "Request", "Req. +\nPun.")) + 
  theme_bw() + theme(legend.position = "none") + 
  scale_fill_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f")) + 
  scale_colour_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f"))


# bar graph means
bar2 <- df2 %>% 
  group_by(group_5) %>% 
  summarise( 
    n=n(),
    mean=mean(charity_outcome),
    sd=sd(charity_outcome),
    treatment = unique(treatment)
  ) %>%
  mutate( se=sd/sqrt(n))  %>%
  ggplot(aes(x=group_5, y = mean)) + geom_point(aes(colour=treatment,fill=treatment),pch=c(19,24,25,24,25),size=4) + 
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se,colour=treatment),width=0.2,lwd=0.7) + scale_y_continuous(limits = c(-1, -0.3)) + 
  labs(y = "", fill = "", x = "\nTreatment and request") + 
  theme_bw() + theme(legend.position = "none", axis.text.y = element_blank(), strip.text.y = element_blank()) + 
  scale_fill_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f")) + 
  scale_colour_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f"))


plot_grid(bar1, bar2, ncol=2, align = "h", rel_widths = c(1, 2))

# now splitting by those receiving info and those not


bar1_inf <- df2 %>% 
  filter(informed == 1) %>% 
  group_by(treatment) %>% 
  summarise( 
    n=n(),
    mean=mean(charity_outcome),
    sd=sd(charity_outcome)
  ) %>%
  mutate( se=sd/sqrt(n))  %>%
  ggplot(aes(x=treatment, y = mean)) + geom_point(aes(colour=treatment, fill=treatment),pch=c(21,22,23),size=4) + 
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se,colour=treatment),width=0.2,lwd=0.7) +
  labs(x="", y = "Average earnings for charity \n") +
  scale_y_continuous(limits = c(-1, -0.3)) + labs(y = "Informed", fill = "", x = "") +
  scale_x_discrete(labels = c("Baseline", "Request", "Req. +\nPun.")) + 
  theme_bw() + theme(legend.position = "none") + 
  scale_fill_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f")) + 
  scale_colour_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f"))


# bar graph means
bar2_inf <- df2 %>% 
  filter(informed == 1) %>% 
  group_by(group_5) %>% 
  summarise( 
    n=n(),
    mean=mean(charity_outcome),
    sd=sd(charity_outcome),
    treatment = unique(treatment)
  ) %>%
  mutate( se=sd/sqrt(n))  %>%
  ggplot(aes(x=group_5, y = mean)) + geom_point(aes(colour=treatment,fill=treatment),pch=c(19,24,25,24,25),size=4) + 
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se,colour=treatment),width=0.2,lwd=0.7) + scale_y_continuous(limits = c(-1, -0.3)) + 
  labs(y = "", fill = "", x = "") + 
  theme_bw() + theme(legend.position = "none", axis.text.y = element_blank(), strip.text.y = element_blank()) + 
  scale_fill_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f")) + 
  scale_colour_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f"))

bar1_uninf <- df2 %>% 
  filter(informed == 0) %>% 
  group_by(treatment) %>% 
  summarise( 
    n=n(),
    mean=mean(charity_outcome),
    sd=sd(charity_outcome)
  ) %>%
  mutate( se=sd/sqrt(n))  %>%
  ggplot(aes(x=treatment, y = mean)) + geom_point(aes(colour=treatment, fill=treatment),pch=c(21,22,23),size=4) + 
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se,colour=treatment),width=0.2,lwd=0.7) +
  labs(x="", y = "Average earnings for charity \n") +
  scale_y_continuous(limits = c(-1, -0.3)) + labs(y = "Uninformed", fill = "", x = "\nTreatment") +
  scale_x_discrete(labels = c("Baseline", "Request", "Req. +\nPun.")) + 
  theme_bw() + theme(legend.position = "none") + 
  scale_fill_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f")) + 
  scale_colour_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f"))


# bar graph means
bar2_uninf <- df2 %>% 
  filter(informed == 0) %>% 
  group_by(group_5) %>% 
  summarise( 
    n=n(),
    mean=mean(charity_outcome),
    sd=sd(charity_outcome),
    treatment = unique(treatment)
  ) %>%
  mutate( se=sd/sqrt(n))  %>%
  ggplot(aes(x=group_5, y = mean)) + geom_point(aes(colour=treatment,fill=treatment),pch=c(19,24,25,24,25),size=4) + 
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se,colour=treatment),width=0.2,lwd=0.7) + scale_y_continuous(limits = c(-1, -0.3)) + 
  labs(y = "", fill = "", x = "\nTreatment and request") + 
  theme_bw() + theme(legend.position = "none", axis.text.y = element_blank(), strip.text.y = element_blank()) + 
  scale_fill_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f")) + 
  scale_colour_manual(values = c("#fdcc8a", "#fc8d59", "#d7301f"))


plots <- plot_grid(bar1_inf, bar2_inf, bar1_uninf, bar2_uninf, ncol=2, align = "h", rel_widths = c(2, 2))
title <- ggdraw() + draw_label("Figure 6 split by those receiving info (top) and those who did not (bottom)", fontface='bold')
g <- plot_grid(title, plots, ncol = 1, rel_heights = c(1,15))


ggsave(here("output", "figures", "figure6_split.pdf"), g, device = 'pdf', 
            width = 20, height = 15, units = "cm") # use jpg if you want to have high quality in PPT


rm(plots, title, g, bar1_inf, bar2_inf, bar1_uninf, bar2_uninf)

In-text statistics and footnotes

3.1.2 Receiver’s behavior

click_pct <-round(addmargins(table(df$button_click))["1"]/addmargins(table(df$button_role))["Receiver"]*100,1)

# to get the n of people who received each message:
# table(subset(df, button_role == "Receiver")$message)

df.buttonclicks <- df %>% 
  select(button_click, message, button_role) %>% 
  filter(button_role == "Receiver") %>%
  mutate(message = ordered(message, levels = c("-2.50", "-1.00", "-0.50", "+0.50", "no message"),
                           labels = c("-2.50 \n (n=112)", "-1.00 \n (n=112)", "-0.50 \n (n=107)", "+0.50 \n (n=61)", "??? \n (n=364)"))) %>%
  group_by(message, button_click) %>% 
  tally() %>% 
  mutate(pct = n / sum(n), # n gives the number of people who clicked
         pct_label =scales::percent(n / sum(n), accuracy = 0.1, trim = FALSE),
         pct_label_plus_n = paste0(pct_label, " (n = ", n, ")")) %>% 
  filter(button_click == 1)

Indeed, almost all Receivers press the button when uninformed (96.4%; n = 364) across all treatments.

Moreover, all 61 Receivers that saw good news — i.e.,saw that the button increased the donation by an additional £0.5 — pressed the button. Finally, we observed that the likelihood of pressing the button decreases with the severity of the negative consequence for the charity: 73.8% (n = 107) of the informed Receivers clicked the button when the consequences were -0.5 pounds, 66.1% (n = 112) when they were -1.0 pounds, and 51.8% (n = 112) when they were -2.5 pounds.

3.1.3 Sender’s beliefs

uninf_pct <- round(mean(df$belief_uninformed, na.rm = T),1)
uninf_sd <- round(sd(df$belief_uninformed, na.rm = T),1)

On average, before making any decisions, Senders believe that 80% (SD = 18.1) of the Receivers press the button when not informed about the consequences.

3.2 Information Sharing in the Baseline Treatment

df.messages <- df %>% 
  filter(button_role == "Sender" & treatment == "Baseline") %>% 
  select(starts_with("message_")) 

mcnemar_2.5_1.0_p <- round(mcnemar.test(table(df.messages$message_minus2.5, df.messages$message_minus1.0))$p.value,3)
mcnemar_2.5_1.0_chi <- round(mcnemar.test(table(df.messages$message_minus2.5, df.messages$message_minus1.0))$statistic,3)
mcnemar_1.0_0.5_p <- round(mcnemar.test(table(df.messages$message_minus1.0, df.messages$message_minus0.5))$p.value,3)
mcnemar_1.0_0.5_chi <- round(mcnemar.test(table(df.messages$message_minus1.0, df.messages$message_minus0.5))$statistic,3)
# mcnemar_0.5_0.5_p <- round(mcnemar.test(table(df.messages$message_minus0.5, df.messages$message_plus0.5))$p.value,3)
# mcnemar_0.5_0.5_chi <- round(mcnemar.test(table(df.messages$message_minus0.5, df.messages$message_plus0.5))$statistic,3)


df.messages <- df.messages %>% 
  pivot_longer(everything(),names_sep = "_", names_to = c("variable", "message"), values_to = "value") %>% 
  mutate(message = case_when(message == "plus0.5" ~ "+0.5",
                             message == "minus2.5" ~ "-2.5",
                             message == "minus1.0" ~ "-1.0",
                             message == "minus0.5" ~ "-0.5"),
         message = factor(message, levels = rev(c("+0.5", "-0.5", "-1.0", "-2.5")))) %>% 
  group_by(message, value) %>% 
  tally() %>% 
  mutate(pct = n / sum(n),
         pct_label =scales::percent(n / sum(n), accuracy = 0.1, trim = FALSE)) %>% 
  filter(value == "True")

A positive consequence of £0.5 is shared by 32.5% of Senders. Negative consequences of -0.5, -1.0 and -2.5 pounds are shared by 40.4%, 57.6% and 71.5% of Senders, respectively. These percentages are increasing significantly with level of consequence (Pairwise McNemar test -0.5 to -1.0: \(\chi^2\) = 19.531, \(p < 0.001\); pairwise McNemar test -1.0 to -2.5: \(\chi^2\) = 17.391, \(p < 0.001\)).

invalid_num <- df %>% 
  filter(button_role == "Sender" & is.na(sender_index)) %>% 
  tally()

Only 40 out of 756 Senders decide to share information for less serious consequences but not for more serious ones.

On the one hand, one forth (26.5%of the Senders never share information with the Receiver (sender-index = 0), another 39.5% of Senders always share information about the consequences (sender-index = 3).

3.3 The Effect of Requests

df2 <- df %>%
  mutate(group = case_when(request == "request_no_info" & treatment == "Request + Punishment" ~ 1,
                           request == "request_no_info" & treatment == "Request"~ 2,
                           treatment == "Baseline" ~ 3,
                           request == "request_info" & treatment == "Request" ~ 4,
                           request == "request_info" & treatment == "Request + Punishment" ~ 5
  ),
  h2_request_info = case_when(group > 3 ~ 1, TRUE ~ 0),
  h2_request_ignorance = case_when(group < 3  ~ 1, TRUE ~ 0),
  group = ordered(group, levels = c(1,2,3,4,5), labels = c("Request No Info + Pun", "Request No Info", "Baseline", "Request Info", "Request Info + Pun"))) %>% 
  group_by(group) %>% 
  arrange(sender_index,.by_group = TRUE)

h2_trend <- df2 %>%
  filter(button_role == "Sender") %>%
  select(sender_index, group, treatment) %>%
  filter(treatment == "Baseline" | treatment == "Request")

# https://www.rdocumentation.org/packages/PMCMRplus/versions/1.9.6/topics/jonckheereTest
jt <- jonckheereTest(h2_trend$sender_index, h2_trend$group, alternative = c("greater"), nperm=NULL)

# sender-index averages
sender_index_average <- df %>% 
  filter((treatment == "Baseline" | treatment == "Request") & !is.na(sender_index)) %>% 
  select(request, sender_index, treatment) %>% 
  group_by(request, treatment) %>% 
  summarise(average = mean(sender_index))

# even more strict comparison: a chi-square test
footnote6_chi <- chisq.test(table(h2_trend$sender_index, h2_trend$group,exclude = c("Request No Info + Pun","Request Info + Pun",NA)))

# percentages request
request <- df %>% 
  filter(treatment == "Request" & button_role == "Sender") %>% 
  group_by(request) %>% 
  tally() %>% 
  mutate(pct = round(n / sum(n) * 100, 1))

In this treatment, the majority of Senders (225; 73.8%) received a Request for information,while the rest (80; 26.2%) received a request for ignorance.

Indeed, a non-parametric Jonckheere-Terpstra trend test fails to reject the hypothesis of no difference in the sender-index across different requests (z = 0.31, p = 0.377).

The average sender-index gives a similar picture, with an average of 1.73 when information is requested, of 1.65 when ignorance is requested, and of 1.71 when the request was not present.

Footnote 12 Also testing the more general assumption of a difference across distributions does not support the idea that the request has an effect on the decision to share information. A \(\chi^2\) test cannot reject the null hypothesis of no differences in the distribution of the sender index (\(\chi^2\)(6) = 2.38, p = 0.882)

3.4 The effect of adding punishment

# descriptives about requests and punishment

request_pun <- df %>% 
  filter(treatment == "Request + Punishment" & button_role == "Sender") %>% 
  group_by(request) %>% 
  tally() %>% 
  mutate(pct = round(n / sum(n) * 100, 1))

pun_pct <-  round(prop.table(table((df$punishment)))["1"] * 100, 1)

follow_request <- df %>% 
  filter(treatment == "Request + Punishment" & button_role == "Sender") %>% 
  select(punished, selected_message, request) %>% 
  mutate(message_informative = case_when(selected_message == "no message" ~ "No \nmessage", TRUE ~ "Informative \nmessage"),
         punished_f = as.factor(case_when(punished == 0 ~ "No", TRUE ~ "Yes"))) %>% 
  group_by(message_informative, request) %>% 
  tally()

punishment <- df %>% 
    filter(treatment == "Request + Punishment" & button_role == "Sender") %>% 
  select(punished, selected_message, request) %>% 
  mutate(message_informative = case_when(selected_message == "no message" ~ "No \nmessage", TRUE ~ "Informative \nmessage"),
         punished_f = as.factor(case_when(punished == 0 ~ "No", TRUE ~ "Yes"))) %>% 
  group_by(message_informative, request, punished_f) %>% 
  tally() %>% 
  complete(punished_f, fill = list(n = 0)) %>% 
  mutate(pct_punished = prop.table(n)) %>% 
  filter(punished_f == "Yes")

Footnote 13 The distribution of requests observed in the punishment treatment is similar to the one observed in the treatment without punishment. In Request + Punishment treatment, 206 Senders (68.7%) received a request for information and 94 (31.3%) received a request for ignorance. 52 (17.3%) of the 300 Receivers punished the Sender for (not) responding to their request.

# non-parametric Request Info Punishment > Request info
h3_request_info <- df %>%
  filter(treatment == "Request" | treatment == "Request + Punishment",
         request == "request_info",
         button_role == "Sender") %>%
  select(treatment, request, sender_index)

test_info <- wilcox.test(h3_request_info$sender_index ~ h3_request_info$treatment, alternative = "less") 

# non-parametric Request Ignorance Punishment < Request Ignorance
h3_request_ignorance <- df %>%
  filter(treatment == "Request" | treatment == "Request + Punishment",
         request == "request_no_info",
         button_role == "Sender") %>%
  select(treatment, request, sender_index)

test_no_info <- wilcox.test(h3_request_ignorance$sender_index ~ h3_request_ignorance$treatment, alternative = "greater") 

Indeed, a one-sided Wilcoxon rank-sum test fails to reject the null hypothesis that punishment has no effect on the sender-index both when ignorance is requested (p = 0.865) and when information is requested (p = 0.164).

h3_trend <- df2 %>%
  filter(button_role == "Sender") %>%
  select(sender_index, group, treatment)

footnote8_jt <- jonckheereTest(h3_trend$sender_index, h3_trend$group, alternative = c("greater"), nperm=NULL)
footnote8_chisq <- chisq.test(table(h3_trend$sender_index, h3_trend$group,exclude = c(NA)))

Footnote 14 A Jonckheere-Terpstra trend test using all 5 combinations of treatments and requests does not reject the null hypothesis that the sender-index is not increasing in the pressure to follow the request (z = 0.38, p = 0.352). Similarly, a \(\chi^2\) test cannot reject the null hypothesis of no differences in the distributions of the sender-index across all 5 combinations of requests and treatments (\(\chi^2\) (12) = 7.58, p = 0.817).

3.5 The role of Sender beliefs

Coefficients (percentage point changes) can be found in Appendix Table D1 and Table D2.

3.6 Stated motives for sharing information

# motives for sharing
share_positive_pct <-  df %>% 
  filter(button_role == "Sender") %>% 
  group_by(message_plus0.5) %>% 
  tally() %>% 
  mutate(pct = round(prop.table(n) *100,1))
  
df.motivations <- df %>% 
filter(button_role == "Sender" & sender_index >0 & !is.na(send_motivation1_cat)) %>% 
select(send_motivation1_cat, sender_index) %>% 
group_by(send_motivation1_cat) %>% 
tally() %>% 
mutate(pct = n / sum(n),
       pct_label =scales::percent(n / sum(n), accuracy = 0.1, trim = FALSE),
       pct_label_plus_n = paste0(pct_label, " (n = ", n, ")")) 

Indeed, the questionnaire reveals that the main motivations to send are a wish to help the charity either unconditionally (30.3% “I wanted Red Cross to get as much money as possible”), or conditional on the impact not being too negative (30.1% “when the consequence was too large”).

For instance, 38.6% of Senders share even when the externality is positive, and information does not change the Receiver’s decision. Indeed, we find that a large number of Senders mention such procedural concerns (28.8%% “it is the right thing to do”), Indeed, a few Senders mention helping the other player explicitly in the questionnaire ( 1.3%% “probably they would be happy to be informed, instead of feeling bad”). At the same time, some Senders appear to be doing the opposite, and use information as a way to make Receivers feel bad about pressing the button ( 0.4%% “to make them feel guilty”)

# motives for not sharing

strategies_notsend <- df %>% 
  filter(button_role == "Sender" #& sender_index > 0 
         & !is.na(send_motivation2_cat)) %>% 
  select(send_motivation2_cat, sender_index) %>% 
  mutate(send_motivation2_cat = case_when(send_motivation2_cat == "no explanation" ~ "other",
                                          send_motivation2_cat == "other" ~ "other",
                                          TRUE ~ as.character(send_motivation2_cat))) %>% 
  group_by(send_motivation2_cat, sender_index) %>% 
  tally() %>% 
  # complete(send_motivation2_cat, fill = list(n = 0)) %>% # only necessary if a category is empty
  # ungroup() %>%   
  group_by(sender_index) %>% 
  mutate(pct_strategy = round(prop.table(n) *100,1)) 


strategies_notsend1 <- strategies_notsend %>% mutate(sender_index = 1, n = 0, pct_strategy = 0)
strategies_notsend2 <- strategies_notsend %>% mutate(sender_index = 2, n = 0, pct_strategy = 0)
strategies_notsend3 <- strategies_notsend %>% mutate(sender_index = 3, n = 0, pct_strategy = 0)
strategies_notsend <- rbind(strategies_notsend, strategies_notsend1, strategies_notsend2, strategies_notsend3) %>% 
  mutate(send_motivation2_cat = ordered(send_motivation2_cat, levels = c("own interest",
                                                                  "help the other player to be selfish",
                                                                  "indifference",
                                                                   "procedural",
                                                                   "requested",
                                                                   "other"),
                                        labels = c("own interest",
                                                   "help the other player to be\n selfish",
                                                   "indifference",
                                                   "procedural",
                                                   "requested",
                                                   "other")))

Furthermore, we asked the 156 respondents with a sender-index of 0 why they did not send at all. Their main motivations are a request for ignorance (30.1%) and the cost of sending (29.5%, ‘I wanted to maximise my return’), followed by procedural motivations (14.7%, to see what they would do’) and indifference (14.1%, the other person would be just as likely to press the button’). Nine participants (5.8%) indicated that they wanted to help the other person to be selfish, and another 5.8% indicated various other reasons.

3.7 Receiver behavior and consequences for the charity

df1 <- df %>% 
  filter(button_role == "Sender") %>% 
  mutate(   consequence = paste0(substr(consequence, 0,1), substr(consequence, 3,6)),
          consequence = as.numeric(consequence)) %>%
  select(group_id,consequence)

df2 <- df %>% 
  filter(button_role == "Receiver") %>%
  select(-consequence)

df2 <- left_join(df2, df1, by = "group_id") %>%
  mutate(   charity_outcome = consequence*button_click, 
          group_5 = case_when(treatment == "Request + Punishment" & request == "request_info" ~ "Req. + Pun.\nInformation\nrequested",
                              treatment == "Request" & request == "request_info" ~ "Request\nInformation\nrequested",
                              treatment == "Request + Punishment" & request == "request_no_info" ~ "Req. + Pun.\nIgnorance\nrequested",
                              treatment == "Request" & request == "request_no_info" ~ "Request\nIgnorance\nrequested",
                              treatment == "Baseline" ~ "Baseline"),
          group_5 = ordered(group_5, levels=c("Req. + Pun.\nIgnorance\nrequested",
                                              "Request\nIgnorance\nrequested", 
                                              "Baseline",
                                              "Request\nInformation\nrequested",
                                              "Req. + Pun.\nInformation\nrequested"))
  )
rm(df1)

# Different outcomes by tmt
payoff_charity_model <- lm(df2$charity_outcome~df2$treatment)
payoff_charity <- summary(payoff_charity_model)
footnote9 <- chisq.test(table(df2$charity_outcome,df2$treatment))

overall_p <- function(my_model) {
    f <- summary(my_model)$fstatistic
    p <- pf(f[1],f[2],f[3],lower.tail=F)
    attributes(p) <- NULL
    return(p)
}

payoff_charity_p <- round(overall_p(payoff_charity_model),3)

Statistically, we cannot reject the null hypothessis that the aggregated outcome is the same across the three treatments (F(2,753) = 0.87, p = 0.419)

Footnote 16 Comparing the distribution of payoffs leads to the same conclusion (\(\chi^2\)(8) = 4.55, p = 0.804).

# # Different outcomes by tmt and request
payoff_charity5_model <- lm(df2$charity_outcome~relevel(factor(df2$group_5,ordered=F),ref="Baseline"))
payoff_charity5 <- summary(payoff_charity5_model)
footnote10 <- chisq.test(table(df2$charity_outcome,df2$group_5))
payoff_charity5_p <- round(overall_p(payoff_charity5_model),3)

A that the distribution of charity outcomes is the same across all five groups shows a significant difference in the outcomes for the charity (\(\chi^2\)(16) = 34.13, p = 0.005).

Appendix

Figure A1: Percentage of Senders by switching structure

weird <- df %>% 
  filter(button_role == "Sender") %>% 
  select(starts_with("message_"), -message_sent_selected, pp_id) %>% 
  mutate(message_minus0.5 = case_when(message_minus0.5 == "True" ~ 1, message_minus0.5 == "False" ~ 0),
         message_minus1.0 = case_when(message_minus1.0 == "True" ~ 1, message_minus1.0 == "False" ~ 0),
         message_minus2.5 = case_when(message_minus2.5 == "True" ~ 1, message_minus2.5 == "False" ~ 0),
         message_plus0.5 = case_when(message_plus0.5 == "True" ~ 1, message_plus0.5 == "False" ~ 0),
         index = paste0(message_minus2.5, message_minus1.0, message_minus0.5, message_plus0.5)) %>% 
  pivot_longer(starts_with("message_"),
               names_sep = "_", names_to = c("variable", "message"), values_to = "value") %>% 
  mutate(message = case_when(message == "minus2.5" ~ "-2.5",
                           message == "minus1.0" ~ "-1.0",
                           message == "minus0.5" ~ "-0.5",
                           message == "plus0.5" ~ "+0.5"),
         message = factor(message, levels = c("+0.5", "-0.5", "-1.0", "-2.5")))
  
weird.sum <- weird %>% 
  select(index, pp_id) %>% 
  group_by(index, pp_id) %>% 
  distinct() %>% 
  group_by(index) %>% 
  tally() %>% 
  mutate(pct = n / sum(n),
         pct_label =scales::percent(n / sum(n), accuracy = 0.1, trim = FALSE),
         valid = case_when(index == "0000" ~ "0",
                           index == "0001" ~ "0",
                           index == "1001" ~ "1",
                           index == "1000" ~ "1",
                           index == "1100" ~ "2",
                           index == "1101" ~ "2",
                           index == "1110" ~ "3",
                           index == "1111" ~ "3",
                           TRUE ~ "invalid"),
         index = rev(index))  
  

right.fig <- ggplot(weird.sum, aes(index, pct, fill = valid))  +
  geom_col(width = 0.7) +
  labs(fill = "Sender-index", x = "", y = "") + 
  theme_ridges(center_axis_labels = TRUE) + 
  theme(legend.position = "right", 
        legend.title = element_text(size=11),
        legend.text = element_text(size=9),
        axis.text.y = element_blank(), 
        axis.text.x = element_blank(), 
        axis.title.x = element_text(color="white")) +
  geom_text(aes(label = pct_label), hjust = -0.5, nudge_y = 0) +
  scale_y_continuous(breaks = c(seq(0,1, by = 0.1)), limits=c(0,0.35)) + coord_flip() +
  scale_fill_manual(values = c("#fef0d9", "#fdcc8a", "#fc8d59", "#d7301f", "grey"))

left.fig <- ggplot(weird, aes(message, value, group = 1)) + 
  geom_line(size=1) + geom_point() + 
  facet_wrap(~index, ncol = 1, strip.position = "left") +
  labs(y = "", x = "") +
  scale_y_continuous(breaks = c(seq(0,1, by = 1)), limits=c(0,1), labels = c("hide", "share")) +
  theme_ridges(center_axis_labels = TRUE) + theme(legend.position = "none", 
                                                  strip.background = element_blank(),
                                                  strip.placement = "outside",
                                                  strip.text = element_blank(),
                                                  axis.text.x = element_text(size=7), 
                                                  axis.text.y = element_text(size=5)) 

grid.arrange(left.fig, right.fig, ncol = 2, widths = c(2,5))

Table B1: OLS regressions of Sender-index

############################ Table B1 (= Table 3 as OLS) for Robustness checks (as preregistered)
############################
df2 <- df %>%
  mutate(group = case_when(request == "request_no_info" & treatment == "Request + Punishment" ~ 1,
                           request == "request_no_info" & treatment == "Request"~ 2,
                           treatment == "Baseline" ~ 3,
                           request == "request_info" & treatment == "Request" ~ 4,
                           request == "request_info" & treatment == "Request + Punishment" ~ 5
  ),
  h2_request_info = case_when(group > 3 ~ 1, TRUE ~ 0),
  h2_request_ignorance = case_when(group < 3  ~ 1, TRUE ~ 0),
  group = ordered(group, levels = c(1,2,3,4,5), labels = c("Request No Info + Pun", "Request No Info", "Baseline", "Request Info", "Request Info + Pun"))) %>% 
  group_by(group) %>% 
  arrange(sender_index,.by_group = TRUE)

# Baseline data model 2 -----------------------------------------------------------------
m1 <- lm(sender_index ~ 
           identify_charity  + dana_reveal +
           gender_f + age + income_c + 
           I(browser!="Desktop") + uq_wrong_button,
         data=subset(df2, treatment == "Baseline"))

# Model with Baseline and Request data -----------------------------------------------------------------
m2 <- lm(sender_index ~ I(h2_request_info*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request")),
         data=subset(df2, treatment == "Baseline" | treatment == "Request"))

# Model with Baseline and Request data + controls -----------------------------------------------------------------
m3 <- lm(sender_index ~ I(h2_request_info*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request")) +
           identify_charity  + dana_reveal +
           gender_f + age + income_c + 
           I(browser!="Desktop") + uq_wrong_button,
         data=subset(df2, treatment == "Baseline" | treatment == "Request"))

# Model with All data -----------------------------------------------------------------
m4 <- lm(sender_index ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
           I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")),
         data=df2)

# Model with All data + controls -----------------------------------------------------------------
m5 <- lm(sender_index ~I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
           I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
           identify_charity  + dana_reveal +
           gender_f + age + income_c + 
           I(browser!="Desktop") + uq_wrong_button,
         data=df2)
 stargazer(m1, m2, m3, m4, m5, 
            type = 'html',
            keep.stat = c("rsq", "n"),
            star.cutoffs=c(0.1,0.05,0.01,0.001), 
            star.char = c("\\circ", "*", "**", "***"),
            notes.append = FALSE,
            omit.stat=c("f"),
            font.size = "scriptsize",
            table.placement = "H",
            label="reg:senders_index_ols", 
            intercept.bottom = FALSE,
            dep.var.caption = "\\textit{Dependent variable}: Sender-index",
            dep.var.labels.include = FALSE,
            title = "OLS regressions of Sender-index",
            order = c(1,10,11,9,12,2:8,13:15),
            omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button"),
            covariate.labels = c("Constant", 
                                 "**Information preference**     Request Info", 
                                 "    Request Ignorance", 
                                 "    Request Info under punishment threat", 
                                 "    Request Ignorance under punishment threat",
                                 "**Control variables**    Identify with charity", 
                                 "    Revealed in DWK"),
           notes.align = "l",
           notes = "OLS model of the Sender-index. Model 1 includes observations in the Baseline treatment. Models 2 and 3 include observations in the Baseline and Request treatments. Models 4 and 5 include all observations. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.")
OLS regressions of Sender-index
Dependent variable: Sender-index
(1) (2) (3) (4) (5)
Constant 1.252** 1.714*** 1.225*** 1.714*** 1.164***
(0.395) (0.102) (0.248) (0.103) (0.209)
Information preference Request Info 0.015 -0.010 0.015 -0.030
(0.133) (0.133) (0.133) (0.133)
Request Ignorance -0.065 -0.166 -0.065 -0.190
(0.175) (0.176) (0.175) (0.176)
Request Info under punishment threat 0.122 0.086
(0.137) (0.140)
Request Ignorance under punishment threat 0.162 0.076
(0.167) (0.169)
Control variables Identify with charity 0.104** 0.105*** 0.079***
(0.036) (0.021) (0.017)
Revealed in DWK 0.162 0.251* 0.330***
(0.215) (0.124) (0.097)
Observations 140 438 412 716 667
R2 0.129 0.001 0.099 0.003 0.074
Note: OLS model of the Sender-index. Model 1 includes observations in the Baseline treatment. Models 2 and 3 include observations in the Baseline and Request treatments. Models 4 and 5 include all observations. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.

Table B2: Tobit regressions of Sender-index

# following https://rdrr.io/cran/AER/man/tobit.html 
# Baseline data model 2 -----------------------------------------------------------------
m1 <- tobit(sender_index ~ identify_charity  + dana_reveal + gender_f + age + income_c + I(browser!="Desktop") + uq_wrong_button,
            data=subset(df2, treatment == "Baseline"), left=0)

# Model with Baseline and Request data -----------------------------------------------------------------
m2 <- tobit(sender_index ~ I(h2_request_info*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request")),
            data=subset(df2, treatment == "Baseline" | treatment == "Request"), left=0)

# Model with Baseline and Request data + controls -----------------------------------------------------------------
m3 <- tobit(sender_index ~ I(h2_request_info*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request")) +
              identify_charity  + dana_reveal +
              gender_f + age + income_c + 
              I(browser!="Desktop") + uq_wrong_button,
            data=subset(df2, treatment == "Baseline" | treatment == "Request"), left=0)

# Model with All data -----------------------------------------------------------------
m4 <- tobit(sender_index ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
              I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")),
            data=df2, left=0)

# Model with All data + controls -----------------------------------------------------------------
m5 <- tobit(sender_index ~I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
              I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
              identify_charity  + dana_reveal +
              gender_f + age + income_c + 
              I(browser!="Desktop") + uq_wrong_button,
            data=df2, left=0)
stargazer(m1, m2, m3, m4, m5, type = 'html',
                        keep.stat = c("rsq", "n"),
                        star.cutoffs=c(0.1,0.05,0.01,0.001), 
                        star.char = c("\\circ", "*", "**", "***"),
                        notes.append = FALSE,
                        omit.stat=c("f"),
                        font.size = "scriptsize",
                        table.placement = "H",
                        label="reg:senders_index_tobit", 
                        intercept.bottom = FALSE,
                        dep.var.caption = "\\textit{Dependent variable}: Sender-index",
                        dep.var.labels.include = FALSE,
                        title = "Tobit regressions of Sender-index",
                        order = c(1,10,11,9,12,2:8,13:15),
                        omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button"),
            covariate.labels = c("Constant", 
                                 "**Information preference**     Request Info", 
                                 "    Request Ignorance", 
                                 "    Request Info under punishment threat", 
                                 "    Request Ignorance under punishment threat",
                                 "**Control variables**    Identify with charity", 
                                 "    Revealed in DWK"),
          notes.align = "l",
          notes = "Tobit model of the Sender-index (left = 0). Model 1 includes observations in the Baseline treatment. Models 2 and 3 include observations in the Baseline and Request treatments. Models 4 and 5 include all observations.  Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.")
Tobit regressions of Sender-index
Dependent variable: Sender-index
(1) (2) (3) (4) (5)
Constant 0.846 1.480*** 0.842* 1.483*** 0.771**
(0.518) (0.139) (0.334) (0.137) (0.277)
Information preference Request Info 0.028 -0.017 0.027 -0.042
(0.179) (0.177) (0.177) (0.176)
Request Ignorance -0.114 -0.247 -0.113 -0.277
(0.236) (0.235) (0.234) (0.233)
Request Info under punishment threat 0.157 0.117
(0.182) (0.184)
Request Ignorance under punishment threat 0.177 0.071
(0.222) (0.222)
Control variables Identify with charity 0.130** 0.142*** 0.104***
(0.047) (0.029) (0.023)
Revealed in DWK 0.260 0.322* 0.410**
(0.276) (0.164) (0.128)
Observations 140 438 412 716 667
Note: Tobit model of the Sender-index (left = 0). Model 1 includes observations in the Baseline treatment. Models 2 and 3 include observations in the Baseline and Request treatments. Models 4 and 5 include all observations. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.

Table B3: Probit regressions of Sender-index

# preregistration Q8 "We will do robustness checks with an alternative sender-index, 
# which is 1 if the sender sends information for the worst outcome, and zero otherwise."
# note that we now do consider the 40 'weird' cases

df2 <- df2 %>% 
  mutate(sender_index_binary = case_when(message_minus2.5 == "True" ~ 1,
                                         button_role == "Receiver" ~ NA_real_,
                                         TRUE ~ 0))

# Baseline data model 1 -----------------------------------------------------------------
prob1 <- glm(sender_index_binary ~ dana_reveal + 
               gender_f + age + income_c + 
               I(browser!="Desktop") + uq_wrong_button,
             data=subset(df2, treatment == "Baseline"), family = binomial(link = "probit"))

McFadden.prob1 <- round(pR2(prob1)["McFadden"],3)
LL.prob1 <- round(pR2(prob1)["llh"],1)
cov_robust1 <- vcovCL(prob1, type = "HC1") # HC1 reproduces STATA default
robust_se1    <- sqrt(diag(cov_robust1))

# Baseline data model 2 -----------------------------------------------------------------
prob2 <- glm(sender_index_binary ~ 
               identify_charity  + dana_reveal +
               gender_f + age + income_c + 
               I(browser!="Desktop") + uq_wrong_button,
             data=subset(df2, treatment == "Baseline"), family = binomial(link = "probit"))

McFadden.prob2 <- round(pR2(prob2)["McFadden"],3)
LL.prob2 <- round(pR2(prob2)["llh"],1)
cov_robust2 <- vcovCL(prob2, type = "HC1") # HC1 reproduces STATA default
robust_se2    <- sqrt(diag(cov_robust2))

# Model with Baseline and Request data -----------------------------------------------------------------
prob3 <- glm(sender_index_binary ~ I(h2_request_info*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request")),
             data=subset(df2, treatment == "Baseline" | treatment == "Request"), family = binomial(link = "probit"))

McFadden.prob3 <- round(pR2(prob3)["McFadden"],3)
LL.prob3 <- round(pR2(prob3)["llh"],1)
cov_robust3 <- vcovCL(prob3, type = "HC1") # HC1 reproduces STATA default
robust_se3    <- sqrt(diag(cov_robust3))

# Model with Baseline and Request data + controls -----------------------------------------------------------------
prob4 <- glm(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request")) +
               identify_charity  + dana_reveal +
               gender_f + age + income_c + 
               I(browser!="Desktop") + uq_wrong_button,
             data=subset(df2, treatment == "Baseline" | treatment == "Request"), family = binomial(link = "probit"))

McFadden.prob4 <- round(pR2(prob4)["McFadden"],3)
LL.prob4 <- round(pR2(prob4)["llh"],1)
cov_robust4 <- vcovCL(prob4, type = "HC1") # HC1 reproduces STATA default
robust_se4    <- sqrt(diag(cov_robust4))

# Model with All data -----------------------------------------------------------------
prob5 <- glm(sender_index_binary ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
               I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")),
             data=df2, family = binomial(link = "probit"))

McFadden.prob5 <- round(pR2(prob5)["McFadden"],3)
LL.prob5 <- round(pR2(prob5)["llh"],1)
cov_robust5 <- vcovCL(prob5, type = "HC1") # HC1 reproduces STATA default
robust_se5    <- sqrt(diag(cov_robust5))

# Model with All data + controls -----------------------------------------------------------------
prob6 <- glm(sender_index_binary ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
               I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
               identify_charity  + dana_reveal +
               gender_f + age + income_c + 
               I(browser!="Desktop") + uq_wrong_button,
             data=df2, family = binomial(link = "probit"))

McFadden.prob6 <- round(pR2(prob6)["McFadden"],3)
LL.prob6 <- round(pR2(prob6)["llh"],1)
cov_robust6 <- vcovCL(prob6, type = "HC1") # HC1 reproduces STATA default
robust_se6    <- sqrt(diag(cov_robust6))
stargazer(prob2, prob3, prob4, prob5, prob6,
                        intercept.bottom = FALSE,
                        type = "html",
                        se = list(robust_se2, robust_se3, robust_se4, robust_se5, robust_se6),
                        keep.stat = c("rsq", "n"),
                        star.cutoffs=c(0.1,0.05,0.01,0.001), 
                        star.char = c("\\circ", "*", "**", "***"),
                        model.names = FALSE,
                        omit.stat=c("f"),
                        font.size = "scriptsize",
                        table.placement = "H",
                        label="reg:senders_index_binary", 
                        title = "Probit regressions of binary Sender-index",
                        omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button"),
                        order = c(1,10,11,9,12,2:3), 
                        dep.var.caption = "\\textit{Dependent variable}: Sender-index binary",
                        dep.var.labels.include = FALSE,
            covariate.labels = c("Constant", 
                                 "**Information preference (ref = Baseline)**     Request Info", 
                                 "    Request Ignorance", 
                                 "    Request Info under punishment threat", 
                                 "    Request Ignorance under punishment threat",
                                 "**Control variables**    Identify with charity", 
                                 "    Revealed in DWK"),
                        add.lines = list(c("Log likelihood", 
                                           LL.prob2, LL.prob3, LL.prob4, LL.prob5, LL.prob5),
                                         c("Pseudo $R^2$ (McFadden)",
                                           McFadden.prob2, McFadden.prob3, McFadden.prob4, McFadden.prob5, McFadden.prob6),
                                         c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes")
                                         ),
          notes.align = "l",
          notes = "Probit model of binary Sender-index (1 if sender sends worst outcome, 0 otherwise) - note that this includes the 40 responses which were considered invalid for the regular sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1 includes observations in the Baseline treatment. Models 2 and 3 include observations in the Baseline and Request treatments. Models 4 and 5 include all observations. Robust standard errors in parentheses."
)
Probit regressions of binary Sender-index
Dependent variable: Sender-index binary
(1) (2) (3) (4) (5)
Constant 0.216 0.569*** 0.307 0.569*** 0.102
(0.479) (0.109) (0.291) (0.109) (0.233)
Information preference (ref = Baseline) Request Info 0.027 -0.030 0.027 -0.056
(0.141) (0.154) (0.141) (0.148)
Request Ignorance -0.115 -0.253 -0.115 -0.253
(0.182) (0.200) (0.182) (0.191)
Request Info under punishment threat 0.039 0.021
(0.143) (0.156)
Request Ignorance under punishment threat 0.024 -0.066
(0.176) (0.192)
Control variables Identify with charity 0.082 0.096*** 0.059**
(0.043) (0.025) (0.019)
Revealed in DWK 0.190 0.188 0.242*
(0.260) (0.144) (0.109)
Log likelihood -78.8 -273.1 -226.6 -449.1 -449.1
Pseudo R(McFadden) 0.06 0.001 0.056 0.001 0.033
Covariates Yes Yes Yes Yes Yes
Observations 143 456 412 756 703
Note: p<0.1; p<0.05; p<0.01
Probit model of binary Sender-index (1 if sender sends worst outcome, 0 otherwise) - note that this includes the 40 responses which were considered invalid for the regular sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1 includes observations in the Baseline treatment. Models 2 and 3 include observations in the Baseline and Request treatments. Models 4 and 5 include all observations. Robust standard errors in parentheses.

Table B4: Table 3 with only desktop users

# We need to run it with people who did not use tablets or mobile devices

df3 <- df2_standardized_for_appendix %>% 
  filter(browser == "Desktop")

oprob4 <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 uq_wrong_button,
               data=subset(df3, treatment == "Baseline" | treatment == "Request"), Hess=TRUE, method="probit")

McFadden.oprob4 <- round(pR2(oprob4)["McFadden"],3)
LL.oprob4 <- round(pR2(oprob4)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4 <- vcovCL(oprob4, type = "HC1") # HC1 reproduces STATA default
robust_se4    <- sqrt(diag(cov_robust4))

# Model with Baseline and Request data + controls IVAN-----------------------------------------------------------------
oprob4a <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  uq_wrong_button,
                data=subset(df3, dana_reveal == 0 & treatment !="Request + Punishment"), Hess=TRUE, method="probit")

McFadden.oprob4a <- round(pR2(oprob4a)["McFadden"],3)
LL.oprob4a <- round(pR2(oprob4a)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4a <- vcovCL(oprob4a, type = "HC1") # HC1 reproduces STATA default
robust_se4a    <- sqrt(diag(cov_robust4a))

# Model with Baseline and Request data + controls IVAN-----------------------------------------------------------------
oprob4b <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  uq_wrong_button,
                data=subset(df3, dana_reveal == 1 & treatment !="Request + Punishment"), Hess=TRUE, method="probit")

McFadden.oprob4b <- round(pR2(oprob4b)["McFadden"],3)
LL.oprob4b <- round(pR2(oprob4b)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4b <- vcovCL(oprob4b, type = "HC1") # HC1 reproduces STATA default
robust_se4b    <- sqrt(diag(cov_robust4b))

# Model with All data + controls -----------------------------------------------------------------
oprob6 <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 uq_wrong_button,
               data=df3, Hess=TRUE, method="probit")

McFadden.oprob6 <- round(pR2(oprob6)["McFadden"],3)
LL.oprob6 <- round(pR2(oprob6)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6 <- vcovCL(oprob6, type = "HC1") # HC1 reproduces STATA default
robust_se6    <- sqrt(diag(cov_robust6))

# Model with All data + controls IVAN-----------------------------------------------------------------
oprob6a <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  uq_wrong_button,
                data=subset(df3, dana_reveal == 0), Hess=TRUE, method="probit")

McFadden.oprob6a <- round(pR2(oprob6a)["McFadden"],3)
LL.oprob6a <- round(pR2(oprob6a)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6a <- vcovCL(oprob6a, type = "HC1") # HC1 reproduces STATA default
robust_se6a    <- sqrt(diag(cov_robust6a))

# Model with All data + controls IVAN-----------------------------------------------------------------
oprob6b <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                  identify_charity  + 
                  gender_f + age + income_c + 
                  uq_wrong_button,
                data=subset(df3, dana_reveal == 1), Hess=TRUE, method="probit")

McFadden.oprob6b <- round(pR2(oprob6b)["McFadden"],3)
LL.oprob6b <- round(pR2(oprob6b)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6b <- vcovCL(oprob6b, type = "HC1") # HC1 reproduces STATA default
robust_se6b    <- sqrt(diag(cov_robust6b))


#LATEX TABLE
# 
# regression <- stargazer(oprob4, oprob4a, oprob4b, oprob6,oprob6a, oprob6b,
#                         type = "latex",
#                         # report=('vc*p'), # if you want to check the p-values
#                         se = list(robust_se4, robust_se4a, robust_se4b, robust_se6, robust_se6a, robust_se6b),
#                         keep.stat = c("rsq", "n"),
#                         star.cutoffs=c(0.05,0.01,0.001), 
#                         star.char = c("*", "**", "***"),
#                         notes.append = FALSE,
#                         omit.stat=c("f"),
#                         font.size = "scriptsize",
#                         table.placement = "H",
#                         label="reg:senders_index_oprobit_desktop", 
#                         dep.var.caption = "\\textit{Dependent variable}: Sender-index",
#                         dep.var.labels.include = FALSE,
#                         title = "Ordered probit regressions of Sender-index, subsample of desktop users",
#                         ord.intercepts = TRUE,
#                         keep = c('h2_request_info', 'h2_request_ignorance', 'identify_charity', "dana_reveal"),
#                         order = c(2,3,1,4,5,6),
#                         covariate.labels = c("\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                                              "\\-\\hspace{0.3cm}Request ignorance",
#                                              "\\-\\hspace{0.3cm}Request info under punishment threat",
#                                              "\\-\\hspace{0.3cm}Request ignorance under punishment threat",
#                                              "\\-\\textbf{Control variables} \\\\ \\-\\hspace{0.3cm}Identify with charity",
#                                              "\\-\\hspace{0.3cm}Revealed in DWK",
#                                              "Cutoff point 1",
#                                              "Cutoff point 2",
#                                              "Cutoff point 3"),
#                         add.lines = list(c("Log likelihood", 
#                                            LL.oprob4, LL.oprob4a, LL.oprob4b, LL.oprob6, LL.oprob6a, LL.oprob6b),
#                                          c("Pseudo $R^2$ (McFadden)",
#                                            McFadden.oprob4, McFadden.oprob4a, McFadden.oprob4b, McFadden.oprob6, McFadden.oprob6a, McFadden.oprob6b),
#                                          c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"),
#                                          c("Revealed in DWK", "", "No", "Yes", "", "No", "Yes")
#                         )
# )
# 
# 
# note.latex <- "\\multicolumn{7}{p{\\linewidth}} {\\textit{Notes:} Ordinal probit model of the Sender-index, desktop users only. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. 
# Model 1, 2 and 3 include all participants in the Baseline and Request treatments. Model 4, 5 and 6 include all participants across all treatments.
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# regression[grepl("Note",regression)] <- note.latex
# # to move the table 1.5 cm into the left margin:
# regression[grepl("scriptsize", regression)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(regression, here("output", "tables", "oprob_senderindex_desktop.tex"))
stargazer(oprob4, oprob4a, oprob4b, oprob6,oprob6a, oprob6b,
                        type = "html",
                        # report=('vc*p'), # if you want to check the p-values
                        se = list(robust_se4, robust_se4a, robust_se4b, robust_se6, robust_se6a, robust_se6b),
                        keep.stat = c("rsq", "n"),
                        star.cutoffs=c(0.05,0.01,0.001), 
                        star.char = c("*", "**", "***"),
                        notes.append = FALSE,
                        omit.stat=c("f"),
                        font.size = "scriptsize",
                        table.placement = "H",
                        label="reg:senders_index_oprobit_desktop", 
                        dep.var.caption = "\\textit{Dependent variable}: Sender-index",
                        dep.var.labels.include = FALSE,
                        title = "Ordered probit regressions of Sender-index, subsample of desktop users",
                        ord.intercepts = TRUE,
                        keep = c('h2_request_info', 'h2_request_ignorance', 'identify_charity', "dana_reveal"),
                        order = c(2,3,1,4,5,6),
                        covariate.labels = c("**Information preference (ref = Baseline)**    Request info",
                                             "    Request ignorance",
                                             "    Request info under punishment threat",
                                             "    Request ignorance under punishment threat",
                                             "**Control variables**    Identify with charity",
                                             "    Revealed in DWK",
                                             "Cutoff point 1",
                                             "Cutoff point 2",
                                             "Cutoff point 3"),
                        add.lines = list(c("Log likelihood", 
                                           LL.oprob4, LL.oprob4a, LL.oprob4b, LL.oprob6, LL.oprob6a, LL.oprob6b),
                                         c("Pseudo $R^2$ (McFadden)",
                                           McFadden.oprob4, McFadden.oprob4a, McFadden.oprob4b, McFadden.oprob6, McFadden.oprob6a, McFadden.oprob6b),
                                         c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"),
                                         c("Revealed in DWK", "", "No", "Yes", "", "No", "Yes")
                        )
)
Ordered probit regressions of Sender-index, subsample of desktop users
Dependent variable: Sender-index
(1) (2) (3) (4) (5) (6)
Information preference (ref = Baseline) Request info -0.005 -0.114 0.077 -0.027 -0.101 0.026
(0.129) (0.169) (0.206) (0.127) (0.166) (0.202)
Request ignorance -0.142 -0.290 0.045 -0.169 -0.281 -0.027
(0.175) (0.231) (0.282) (0.174) (0.225) (0.281)
Request info under punishment threat 0.131 -0.034 0.312
(0.137) (0.176) (0.230)
Request ignorance under punishment threat 0.072 0.063 -0.003
(0.174) (0.238) (0.256)
Control variables Identify with charity 0.924*** 1.133*** 0.730* 0.721*** 0.885*** 0.538
(0.216) (0.272) (0.369) (0.173) (0.223) (0.291)
Revealed in DWK 0.241* 0.267**
(0.122) (0.097)
Log likelihood -492.9 -292.4 -195 -769.4 -464.8 -299.1
Pseudo R(McFadden) 0.034 0.045 0.022 0.028 0.033 0.016
Covariates Yes Yes Yes Yes Yes Yes
Revealed in DWK No Yes No Yes
Observations 386 228 158 606 359 247
Note: p<0.05; p<0.01; p<0.001

Table B5: Table 3 split by gender instead of DWK

df2 <- df2_standardized_for_appendix

oprob4 <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button,
               data=subset(df2, treatment == "Baseline" | treatment == "Request"), Hess=TRUE, method="probit")

McFadden.oprob4 <- round(pR2(oprob4)["McFadden"],3)
LL.oprob4 <- round(pR2(oprob4)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4 <- vcovCL(oprob4, type = "HC1") # HC1 reproduces STATA default
robust_se4    <- sqrt(diag(cov_robust4))

# Model with Baseline and Request data + controls IVAN-----------------------------------------------------------------
oprob4a <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) +
                  identify_charity  + 
                  dana_reveal + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, gender_f == 0 & treatment !="Request + Punishment"), Hess=TRUE, method="probit")

McFadden.oprob4a <- round(pR2(oprob4a)["McFadden"],3)
LL.oprob4a <- round(pR2(oprob4a)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4a <- vcovCL(oprob4a, type = "HC1") # HC1 reproduces STATA default
robust_se4a    <- sqrt(diag(cov_robust4a))

# Model with Baseline and Request data + controls IVAN-----------------------------------------------------------------
oprob4b <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) +
                  identify_charity  + 
                  dana_reveal + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, gender_f == 1 & treatment !="Request + Punishment"), Hess=TRUE, method="probit")

McFadden.oprob4b <- round(pR2(oprob4b)["McFadden"],3)
LL.oprob4b <- round(pR2(oprob4b)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust4b <- vcovCL(oprob4b, type = "HC1") # HC1 reproduces STATA default
robust_se4b    <- sqrt(diag(cov_robust4b))

# Model with All data + controls -----------------------------------------------------------------
oprob6 <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button,
               data=df2, Hess=TRUE, method="probit")

McFadden.oprob6 <- round(pR2(oprob6)["McFadden"],3)
LL.oprob6 <- round(pR2(oprob6)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6 <- vcovCL(oprob6, type = "HC1") # HC1 reproduces STATA default
robust_se6    <- sqrt(diag(cov_robust6))

# Model with All data + controls IVAN-----------------------------------------------------------------
oprob6a <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                  identify_charity  + 
                  dana_reveal + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, gender_f == 0), Hess=TRUE, method="probit")

McFadden.oprob6a <- round(pR2(oprob6a)["McFadden"],3)
LL.oprob6a <- round(pR2(oprob6a)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6a <- vcovCL(oprob6a, type = "HC1") # HC1 reproduces STATA default
robust_se6a    <- sqrt(diag(cov_robust6a))

# Model with All data + controls IVAN-----------------------------------------------------------------
oprob6b <- polr(sender_index_f ~ I(h2_request_info*(treatment == "Request + Punishment")) + I(h2_request_info*(treatment == "Request")) + 
                  I(h2_request_ignorance*(treatment == "Request")) + I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                  identify_charity  + 
                  dana_reveal + age + income_c + 
                  I(browser!="Desktop") + uq_wrong_button,
                data=subset(df2, gender_f == 1), Hess=TRUE, method="probit")

McFadden.oprob6b <- round(pR2(oprob6b)["McFadden"],3)
LL.oprob6b <- round(pR2(oprob6b)["llh"],1)
# HC robust standard errors (for ordered probit you need CL)
cov_robust6b <- vcovCL(oprob6b, type = "HC1") # HC1 reproduces STATA default
robust_se6b    <- sqrt(diag(cov_robust6b))


# LATEX TABLE

# regression <- stargazer(oprob4, oprob4a, oprob4b, oprob6,oprob6a, oprob6b,
#                         type = "latex",
#                         # report=('vc*p'), # if you want to check the p-values
#                         se = list(robust_se4, robust_se4a, robust_se4b, robust_se6, robust_se6a, robust_se6b),
#                         keep.stat = c("rsq", "n"),
#                         star.cutoffs=c(0.05,0.01,0.001), 
#                         star.char = c("*", "**", "***"),
#                         notes.append = FALSE,
#                         omit.stat=c("f"),
#                         font.size = "scriptsize",
#                         table.placement = "H",
#                         label="reg:senders_index_oprobit_gender", 
#                         dep.var.caption = "\\textit{Dependent variable}: Sender-index",
#                         dep.var.labels.include = FALSE,
#                         title = "Ordered probit regressions of Sender-index, split by gender",
#                         ord.intercepts = TRUE,
#                         keep = c('h2_request_info', 'h2_request_ignorance', 'identify_charity', "gender_f"),
#                         order = c(2,3,1,4,5,6),
#                         covariate.labels = c("\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                                              "\\-\\hspace{0.3cm}Request ignorance",
#                                              "\\-\\hspace{0.3cm}Request info under punishment threat",
#                                              "\\-\\hspace{0.3cm}Request ignorance under punishment threat",
#                                              "\\-\\textbf{Control variables} \\\\ \\-\\hspace{0.3cm}Identify with charity",
#                                              "\\-\\hspace{0.3cm}Female",
#                                              "Cutoff point 1",
#                                              "Cutoff point 2",
#                                              "Cutoff point 3"),
#                         add.lines = list(c("Log likelihood", 
#                                            LL.oprob4, LL.oprob4a, LL.oprob4b, LL.oprob6, LL.oprob6a, LL.oprob6b),
#                                          c("Pseudo $R^2$ (McFadden)",
#                                            McFadden.oprob4, McFadden.oprob4a, McFadden.oprob4b, McFadden.oprob6,
#                                            McFadden.oprob6a, McFadden.oprob6b),
#                                          c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"),
#                                          c("Gender", "Both", "Male", "Female", "Both", "Male", "Female")
#                                          ),
#                         notes.align = "l",
#                         notes = "Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Request treatment. Model 4, 5 and 6 include all participants in the Request and Request + Punishment treatment. Robust standard errors in parentheses.")

# note.latex <- "\\multicolumn{7}{p{\\linewidth}} {\\textit{Notes:} Ordinal probit model of the Sender-index. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. 
# Model 1, 2 and 3 include all participants in the Baseline and Request treatments. Model 4, 5 and 6 include all participants across all treatments.
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# regression[grepl("Note",regression)] <- note.latex
# # to move the table 1.5 cm into the left margin:
# regression[grepl("scriptsize", regression)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(regression, here("output", "tables", "oprob_senderindex_gender.tex"))
stargazer(oprob4, oprob4a, oprob4b, oprob6,oprob6a, oprob6b,
                        type = "html",
                        # report=('vc*p'), # if you want to check the p-values
                        se = list(robust_se4, robust_se4a, robust_se4b, robust_se6, robust_se6a, robust_se6b),
                        keep.stat = c("rsq", "n"),
                        star.cutoffs=c(0.05,0.01,0.001), 
                        star.char = c("*", "**", "***"),
                        notes.append = FALSE,
                        omit.stat=c("f"),
                        font.size = "scriptsize",
                        table.placement = "H",
                        label="reg:senders_index_oprobit_gender", 
                        dep.var.caption = "\\textit{Dependent variable}: Sender-index",
                        dep.var.labels.include = FALSE,
                        title = "Ordered probit regressions of Sender-index, split by gender",
                        ord.intercepts = TRUE,
                        keep = c('h2_request_info', 'h2_request_ignorance', 'identify_charity', "gender_f"),
                        order = c(2,3,1,4,5,6),
                        covariate.labels = c("**Information preference (ref = Baseline)**    Request info",
                                             "    Request ignorance",
                                             "    Request info under punishment threat",
                                             "    Request ignorance under punishment threat",
                                             "**Control variables**    Identify with charity",
                                             "    Revealed in DWK",
                                             "Cutoff point 1",
                                             "Cutoff point 2",
                                             "Cutoff point 3"),
                        add.lines = list(c("Log likelihood", 
                                           LL.oprob4, LL.oprob4a, LL.oprob4b, LL.oprob6, LL.oprob6a, LL.oprob6b),
                                         c("Pseudo $R^2$ (McFadden)",
                                           McFadden.oprob4, McFadden.oprob4a, McFadden.oprob4b, McFadden.oprob6,
                                           McFadden.oprob6a, McFadden.oprob6b),
                                         c("Covariates", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"),
                                         c("Gender", "Both", "Male", "Female", "Both", "Male", "Female")
                                         ),
                        notes.align = "l",
                        notes = "Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Request treatment. Model 4, 5 and 6 include all participants in the Request and Request + Punishment treatment. Robust standard errors in parentheses.")
Ordered probit regressions of Sender-index, split by gender
Dependent variable: Sender-index
(1) (2) (3) (4) (5) (6)
Information preference (ref = Baseline) Request info -0.011 0.151 -0.211 -0.028 0.145 -0.215
(0.124) (0.187) (0.184) (0.122) (0.180) (0.179)
Request ignorance -0.130 -0.179 -0.077 -0.150 -0.185 -0.158
(0.172) (0.246) (0.255) (0.169) (0.238) (0.252)
Request info under punishment threat 0.096 -0.032 0.138
(0.130) (0.188) (0.191)
Request ignorance under punishment threat 0.083 0.224 -0.081
(0.167) (0.242) (0.242)
Control variables Identify with charity 0.990*** 0.845** 1.223*** 0.731*** 0.788*** 0.756**
(0.214) (0.301) (0.308) (0.167) (0.232) (0.238)
Revealed in DWK 0.089 0.143
(0.113) (0.089)
Log likelihood -522 -255.5 -261.7 -842.8 -401.3 -435.8
Pseudo R(McFadden) 0.038 0.045 0.045 0.029 0.037 0.03
Covariates Yes Yes Yes Yes Yes Yes
Gender Both Male Female Both Male Female
Observations 412 203 209 667 318 349
Note: Ordinal probit model of the Sender-index. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Model 1, 2 and 3 include all participants in the Request treatment. Model 4, 5 and 6 include all participants in the Request and Request + Punishment treatment. Robust standard errors in parentheses.

Table B6: Table 3 with probability weighting

df2 <- df2_standardized_for_appendix %>% 
  mutate(browser_mob = if_else(browser != "Desktop", 1, 0))


# Estimate models with weighted regression --- MOD 1
#------------------------------------------------------------------------------------------------------

#take the subset of the data for estimating the model
tmp <- df2[df2$treatment == "Baseline" | df2$treatment == "Request",]

# look at imbalance and prepare the weights for ATE
bal.tab(group ~ gender_f + browser_mob,
        data = tmp, estimand = "ATE",
        #focal = "Baseline",
        thresholds = c(m = .05))

#compute the weights
w.out <- weightit(group ~ gender_f + browser_mob,
                  data = tmp, estimand = "ATE",
                  #focal = "Baseline",
                  method = "glm")
summary(w.out)

bal.tab(w.out, stats = c("m", "v"), thresholds = c(m = .05))    

#estimate mod 1 tab 3
m1 <- ordinal_weightit(sender_index_f ~ I(h2_request_info*(treatment == "Request")) + 
                 I(h2_request_ignorance*(treatment == "Request")) + 
                   identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button,
                 link = "probit",
                 data = tmp,
                 vcov = "HC0",
                 weightit = w.out
                 )            



# Estimate models with weighted regression --- MOD 4
#------------------------------------------------------------------------------------------------------

#take the subset of the data for estimating the model
tmp <- df2

# look at imbalance and prepare the weights for ATE
bal.tab(group ~ gender_f + browser_mob,
        data = tmp, estimand = "ATE",
        #focal = "Baseline",
        thresholds = c(m = .05))

#compute the weights
w.out <- weightit(group ~ gender_f + browser_mob,
                  data = tmp, estimand = "ATE",
                  #focal = "Baseline",
                  method = "glm")
summary(w.out)

bal.tab(w.out, stats = c("m", "v"), thresholds = c(m = .05))    

#estimate model
m2 <- ordinal_weightit(sender_index_f ~  
                         I(h2_request_info*(treatment == "Request + Punishment")) + 
                         I(h2_request_info*(treatment == "Request")) + 
                         I(h2_request_ignorance*(treatment == "Request")) + 
                         I(h2_request_ignorance*(treatment == "Request + Punishment")) +
                   identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button,
                 link = "probit",
                 data = df2,
                 vcov = "HC0",
                 weightit = w.out
                 )            

# texreg(caption = "Ordered probit regressions of Sender-index, probability weighted by gender and browser type",
#                      caption.above = TRUE,
#                      list(m1, m2),
#                      custom.model.names = c("(1)", "(2)"),
#                      custom.coef.map = list('I(h2_request_info * (treatment == "Request"))' = "\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                           'I(h2_request_ignorance * (treatment == "Request"))' = "\\-\\hspace{0.3cm}Request ignorance",
#                           'I(h2_request_info * (treatment == "Request + Punishment"))' = "\\-\\hspace{0.3cm}Request info under punishment threat",
#                           'I(h2_request_ignorance * (treatment == "Request + Punishment"))' = "\\-\\hspace{0.3cm}Request ignorance under punishment threat",
#                           'identify_charity' = "\\-\\textbf{Control variables} \\\\ \\-\\hspace{0.3cm}Identify with charity",
#                           'dana_reveal' = "\\-\\hspace{0.3cm}Revealed in DWK"),
#                      label = "reg:robustness_weighted",
#                      custom.header = list("\\textit{Dependent variable}: Sender-index" =1:2),
#                      # custom.gof.names = c("Observations"),
#                      digits = 3,
#                      custom.note = "Ordered probit model with probability weighting of gender and browser type. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions.
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).}"
# 
#                      )


# LATEX
# regression <- texreg(caption = "Ordered probit regressions of Sender-index, probability weighted by gender and browser type",
#                      caption.above = TRUE,
#                      list(m1, m2),
#                      custom.model.names = c("(1)", "(2)"),
#                      custom.coef.map = list('I(h2_request_info * (treatment == "Request"))' = "\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                           'I(h2_request_ignorance * (treatment == "Request"))' = "\\-\\hspace{0.3cm}Request ignorance",
#                           'I(h2_request_info * (treatment == "Request + Punishment"))' = "\\-\\hspace{0.3cm}Request info under punishment threat",
#                           'I(h2_request_ignorance * (treatment == "Request + Punishment"))' = "\\-\\hspace{0.3cm}Request ignorance under punishment threat",
#                           'identify_charity' = "\\-\\textbf{Control variables} \\\\ \\-\\hspace{0.3cm}Identify with charity",
#                           'dana_reveal' = "\\-\\hspace{0.3cm}Revealed in DWK"),
#                      label = "reg:robustness_weighted",
#                      custom.header = list("\\textit{Dependent variable}: Sender-index" =1:2),
#                      custom.gof.names = c("Observations"),
#                      digits = 3,
#                      custom.note = "Ordered probit model with probability weighting of gender and browser type. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. 
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).}"
#                      
#                      )

# note.latex <- "\\multicolumn{3}{p{\\linewidth}} {\\textit{Notes:} Ordered probit model with probability weighting of gender and browser type. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. 
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# 
# regression <- str_replace(regression, "{l}", "{\linewidth}")
# 
# 
# # to move the table 1.5 cm into the left margin:
# # regression[grepl("scriptsize", regression)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(regression, here("output", "tables", "robustness_weighted_.tex")) # adjusted slightly manually to get it right
htmlreg(caption = "Ordered probit regressions of Sender-index, probability weighted by gender and browser type",
                     caption.above = TRUE,
                     list(m1, m2),
                     custom.model.names = c("(1)", "(2)"),
                     custom.coef.map = list('I(h2_request_info * (treatment == "Request"))' = "**Information preference (ref = Baseline)**    Request info",
                          'I(h2_request_ignorance * (treatment == "Request"))' = "    Request ignorance",
                          'I(h2_request_info * (treatment == "Request + Punishment"))' = "    Request info under punishment threat",
                          'I(h2_request_ignorance * (treatment == "Request + Punishment"))' = "    Request ignorance under punishment threat",
                          'identify_charity' = "**Control variables**    Identify with charity",
                          'dana_reveal' = "    Revealed in DWK"),
                     label = "reg:robustness_weighted",
                     custom.header = list("\\textit{Dependent variable}: Sender-index" =1:2),
                     # custom.gof.names = c("Observations"),
                     digits = 3,
                     custom.note = "Ordered probit model with probability weighting of gender and browser type. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions.
Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).}"

                     )
Ordered probit regressions of Sender-index, probability weighted by gender and browser type
  : Sender-index
  (1) (2)
Information preference (ref = Baseline) Request info -0.011 -0.025
  (0.122) (0.119)
Request ignorance -0.117 -0.124
  (0.166) (0.166)
Request info under punishment threat   0.104
    (0.127)
Request ignorance under punishment threat   0.080
    (0.164)
Control variables Identify with charity 0.926*** 0.667***
  (0.230) (0.188)
Revealed in DWK 0.230 0.285**
  (0.130) (0.103)
nobs 412 667
Ordered probit model with probability weighting of gender and browser type. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. Robust standard errors in parentheses (\(^{\circ}\)\(p<0.10\); \(^{*}\)\(p<0.05\); \(^{**}\)\(p<0.01\); \(^{***}\) \(p<0.001\)).}

Figure B1: Plotting by externality levels

df1 <- df %>% 
    filter(button_role == "Sender") %>% 
    mutate(consequence = paste0(substr(consequence, 0,1), substr(consequence, 3,6))) %>%
    mutate(consequence = as.numeric(consequence)) %>%
    select(group_id,consequence)

df2 <- df %>% 
    filter(button_role == "Receiver") %>%
    select(-consequence)

df2 <- left_join(df2, df1, by = "group_id") %>%
    mutate( charity_outcome = consequence*button_click, 
    group_5 = case_when(treatment == "Request + Punishment" & request == "request_info" ~ "Information\n requested",
                              treatment == "Request" & request == "request_info" ~ "Information\n requested",
                              treatment == "Request + Punishment" & request == "request_no_info" ~ "Ignorance\n requested",
                              treatment == "Request" & request == "request_no_info" ~ "Ignorance\n requested",
                              treatment == "Baseline" ~ "Baseline"),
         group_5 = factor(group_5, levels=c("Baseline",
                                             "Information\n requested",
                                             "Ignorance\n requested"
                                             )),
         treatment = ordered(treatment, levels=c("Baseline",
                                                 "Request",
                                                 "Request + Punishment"))
            )

# Figures
#--------------------------------------------------------------------------------------
df2 <- df2 %>%
  mutate(message = case_when(message == "-0.50" ~ "Red Cross -0.50 Pounds",
                             message == "-1.00" ~ "Red Cross -1.00 Pounds",
                             message == "-2.50" ~ "Red Cross -2.50 Pounds",
                             message == "+0.50" ~ "Red Cross +0.50 Pounds",
                             TRUE ~ "No message")) 

df_fig <- df2 %>% 
  filter(message == "Red Cross +0.50 Pounds" | message == "No message") %>%
  group_by(message, group_5) %>%
  summarise(
    n = n(),
    mean = mean(button_click),
    sd = sd(button_click)
  )

f <- ggplot(df_fig, aes(y = mean, x = group_5, fill = message)) +
  geom_bar(stat="identity", position = position_dodge(),color="black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1L)) +
  labs(y = "Button clicked %", fill = "", x = "\nTreatment and request"
       # , title = "Percentage of Senders by sender-index, treatment and request"
       ) + 
  theme_bw() + theme(legend.position = "top") + 
  scale_fill_manual(values = c("#fdcc8a", "#d7301f")) 

ggsave(here("output", "figures", "exposure_selection_press_plus05.pdf"), f, device = 'pdf', 
            width = 20, height = 10, units = "cm") # use jpg if you want to have high quality in PPT
#f

f_plus05 <- f + labs(x = "", title = "Consequence +0.50 Pounds") + theme(legend.position = "right")

####################################### -0.5

df_fig <- df2 %>% 
  filter(message == "Red Cross -0.50 Pounds" | message == "No message") %>%
  group_by(message, group_5) %>%
  summarise(
    n = n(),
    mean = mean(button_click),
    sd = sd(button_click)
  )

f <- ggplot(df_fig, aes(y = mean, x = group_5, fill = message)) +
  geom_bar(stat="identity", position = position_dodge(),color="black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1L)) +
  labs(y = "Button clicked %", fill = "", x = "\nTreatment and request"
       # , title = "Percentage of Senders by sender-index, treatment and request"
       ) + 
  theme_bw() + theme(legend.position = "top") + 
  scale_fill_manual(values = c("#fdcc8a", "#d7301f")) 

ggsave(here("output", "figures", "exposure_selection_press_minus05.pdf"), f, device = 'pdf', 
            width = 20, height = 10, units = "cm") # use jpg if you want to have high quality in PPT
#f

f_min05 <- f + labs(x = "", title = "Consequence -0.50 Pounds") + theme(legend.position = "right")

####################################### 1.0

df_fig <- df2 %>%
  filter(message == "Red Cross -1.00 Pounds" | message == "No message") %>%
  group_by(message, group_5) %>%
  summarise(
    n = n(),
    mean = mean(button_click),
    sd = sd(button_click)
  )

f <- ggplot(df_fig, aes(y = mean, x = group_5, fill = message)) +
  geom_bar(stat="identity", position = position_dodge(),color="black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1L)) +
  labs(y = "Button clicked %", fill = "", x = "\nTreatment"
       # , title = "Percentage of Senders by sender-index, treatment and request"
       ) + 
  theme_bw() + theme(legend.position = "top") + 
  scale_fill_manual(values = c("#fdcc8a", "#d7301f")) 

ggsave(here("output", "figures", "exposure_selection_press_minus10.pdf"), f, device = 'pdf', 
            width = 20, height = 10, units = "cm") # use jpg if you want to have high quality in PPT
#f

f_min10 <- f + labs(x = "", title = "Consequence -1.00 Pounds") + theme(legend.position = "right")


####################################### -2.5

df_fig <- df2 %>%
  filter(message == "Red Cross -2.50 Pounds" | message == "No message") %>%
  group_by(message, group_5) %>%
  summarise(
    n = n(),
    mean = mean(button_click),
    sd = sd(button_click)
  )

f <- ggplot(df_fig, aes(y = mean, x = group_5, fill = message)) +
  geom_bar(stat="identity", position = position_dodge(),color="black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1L)) +
  labs(y = "Button clicked %", fill = "", x = "\nTreatment"
       # , title = "Percentage of Senders by sender-index, treatment and request"
       ) + 
  theme_bw() + theme(legend.position = "top") + 
  scale_fill_manual(values = c("#fdcc8a", "#d7301f")) 


ggsave(here("output", "figures", "exposure_selection_press_minus25.pdf"), f, device = 'pdf', 
            width = 20, height = 10, units = "cm") # use jpg if you want to have high quality in PPT
#f

f_min25 <- f + labs(x = "", title = "Consequence -2.50 Pounds") + theme(legend.position = "right")

####################################### all together

f_all <- grid.arrange(f_plus05, f_min05, f_min10, f_min25, ncol =1)

# ggsave(here("output", "figures", "exposure_selection_press_all.pdf"), f_all, device = 'pdf', 
#             width = 20, height = 25, units = "cm") # use jpg if you want to have high quality in PPT

Table C1: OLS regression of the outcome for the charity

df2 <- df2_for_appendix

outcome.lm1<-lm(charity_outcome~relevel(factor(df2$group_5,ordered=F),ref="Baseline")
                ,data=df2)
robust_se1 <- coeftest(outcome.lm1, vcov.=function(x) vcovHC(x, "HC1")) #stata like robust SE
summary(outcome.lm1)

outcome.lm2<-lm(charity_outcome~relevel(factor(df2$group_5,ordered=F),ref="Baseline") +
                identify_charity + dana_reveal+ gender_f + age + income_c +
                I(browser!="Desktop"),data=df2)
robust_se2 <- coeftest(outcome.lm2, vcov.=function(x) vcovHC(x, "HC1")) #stata like robust SE
summary(outcome.lm2)
stargazer(outcome.lm1, outcome.lm2, 
          type = 'html',
            se = list(robust_se1[,2], robust_se2[,2]),
            keep.stat = c("rsq", "n", "adj.rsq"),
            star.cutoffs=c(0.1,0.05,0.01,0.001),
            star.char = c("\\circ", "*", "**", "***"),
            omit.stat=c("f"),
            font.size = "scriptsize",
            table.placement = "H",
            label="reg:charity_outcomes",
            dep.var.caption = "\\textit{Dependent variable}: Charity outcome in pound", 
            dep.var.labels.include = FALSE,
            title = "OLS regression of the outcome for the charity",
            omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button"),
            intercept.bottom = FALSE,
            covariate.labels = c("Constant",
                                 "**Information preference**     Request Info",
                                 "    Request Ignorance",
                                 "    Request Info under punishment threat",
                                 "    Request Ignorance under punishment threat",
                                 "**Control variables**    Identify with charity",
                                 "    Revealed in DWK"),
          # notes = "OLS regression of the outcome for the charity. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.",
          notes.align = "l")
OLS regression of the outcome for the charity
Dependent variable: Charity outcome in pound
(1) (2)
Constant -0.477*** -0.661***
(0.068) (0.148)
Information preference Request Info -0.017 -0.055
(0.089) (0.090)
Request Ignorance -0.254 -0.207
(0.134) (0.137)
Request Info under punishment threat -0.084 -0.119
(0.096) (0.098)
Request Ignorance under punishment threat -0.204 -0.175
(0.117) (0.127)
Control variables Identify with charity 0.031*
(0.012)
Revealed in DWK 0.186*
(0.073)
Observations 756 713
R2 0.009 0.036
Adjusted R2 0.004 0.022
Note: p<0.1; p<0.05; p<0.01
# 
# regression <- stargazer(outcome.lm1, outcome.lm2, 
#           type = 'latex',
#             se = list(robust_se1[,2], robust_se2[,2]),
#             keep.stat = c("rsq", "n", "adj.rsq"),
#             star.cutoffs=c(0.1,0.05,0.01,0.001),
#             star.char = c("\\circ", "*", "**", "***"),
#             omit.stat=c("f"),
#             font.size = "scriptsize",
#             table.placement = "H",
#             label="reg:charity_outcomes",
#             dep.var.caption = "\\textit{Dependent variable}: Charity outcome in pound", 
#             dep.var.labels.include = FALSE,
#             title = "OLS regression of the outcome for the charity",
#             omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button"),
#             intercept.bottom = FALSE,
#             covariate.labels = c("Constant",
#                                   "\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                                              "\\-\\hspace{0.3cm}Request ignorance",
#                                              "\\-\\hspace{0.3cm}Request info under punishment threat",
#                                              "\\-\\hspace{0.3cm}Request ignorance under punishment threat",
#                                              "\\-\\textbf{Control variables} \\\\ \\-\\hspace{0.3cm}Identify with charity",
#                                              "\\-\\hspace{0.3cm}Revealed in DWK"),
#           # notes = "OLS regression of the outcome for the charity. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.",
#           notes.align = "l")
# 
# 
# 
# note.latex <- "\\multicolumn{3}{p{\\linewidth}} {\\textit{Notes:} OLS regression of the outcome for the charity. Model 1 includes all observations. Model 2 excludes participants with incomplete answers for 'identify with charity'. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Robust standard errors in parentheses.
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# regression[grepl("Note",regression)] <- note.latex
# # to move the table 1.5 cm into the left margin:
# regression[grepl("scriptsize", regression)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(regression, here("output", "tables", "charity_outcomes.tex"))

Figure D1: Differences in beliefs

df1 <- df %>%
  select(starts_with("belief_pun"), starts_with("belief_push"), pp_id, request, sender_index, treatment,gender_f,age,income_c,browser) %>%
  #filter(belief_pun0 != "") %>%
  pivot_longer(starts_with("belief_"),names_sep = "_", names_to = c("variable", "consequence"), values_to = "value") %>%
  mutate(belief_type = case_when(grepl("pun", consequence) ~ "Punishment",
                                 grepl("push", consequence) ~ "Push the button"),
         consequence = case_when(grepl("0", consequence) ~ "???",
                                 grepl("1", consequence) ~ "-2.5",
                                 grepl("2", consequence) ~ "-1.0",
                                 grepl("3", consequence) ~ "-0.5",
                                 grepl("4", consequence) ~ "+0.5"),
         consequence = factor(consequence, levels = rev(c("???", "+0.5", "-0.5", "-1.0", "-2.5"))),
         request = case_when(request == "request_no_info" ~ "Ignorance requested",
                             request == "request_info" ~ "Information requested")
        )


df2 <- df %>%
  select(starts_with("message_minus"), starts_with("message_plus"), pp_id, belief_pun0, belief_push0,treatment) %>%
  #filter(belief_pun0 != "") %>%
  pivot_longer(starts_with("message_"),names_sep = "_", names_to = c("variable", "consequence"), values_to = "value") %>%
  mutate(consequence = case_when(grepl("minus2.5", consequence) ~ "-2.5",
                                 grepl("minus1.0", consequence) ~ "-1.0",
                                 grepl("minus0.5", consequence) ~ "-0.5",
                                 grepl("plus0.5", consequence) ~ "+0.5"),
         consequence = factor(consequence, levels = rev(c("???", "+0.5", "-0.5", "-1.0", "-2.5")))
         )

df.beliefspun <- left_join(df1, df2, by = c("pp_id","consequence")) %>%
  select(!c("variable.x","variable.y","treatment.x")) %>%
  rename(belief = value.x,
         share = value.y,
         treatment = treatment.y
  )

# Figure with averages of belief differences
#---------------------------------------------------------------------------------------------------------------
g0 <- df.beliefspun %>%
    filter(belief_type == "Push the button" & treatment != "Baseline" & !is.na(sender_index) & consequence != "+0.5") %>%
    group_by(belief_type,request,treatment,consequence) %>%
    summarise(
      n=n(),
      mean=mean(belief-belief_push0),
      sd=sd(belief-belief_push0)
    ) %>%
    mutate( se=sd/sqrt(n)) %>%
    ggplot(aes(x=consequence, y = mean, col=request, shape = request)) +
    geom_point(size=4,position=position_dodge(width = 0.4)) +
    geom_errorbar(aes(ymin = mean - se, ymax = mean + se),width=0.2,lwd=0.7,position=position_dodge(width = 0.4)) +
    scale_color_manual(labels = c("Ignorance", "Information"),
                      values = c("#a6611a", "#018571")) +
    geom_hline(yintercept = 0,lty=3) +
    theme_bw() + facet_wrap(~treatment, nrow=1) +
    scale_y_continuous(breaks = c(seq(-50,50, by = 20)), limits=c(-50,10)) +
    labs(y = "Pushing the button more when... \n\n <- hiding info ---------------- sharing info ->\n",
         fill = "", x = "\nConsequences",
         title="Pressing the button") +
    theme(legend.position = "none",
          axis.title.y = element_text(size= 10),
          plot.title = element_text(hjust = 0.5))

g1 <- df.beliefspun %>%
    filter(belief_type == "Punishment" & treatment == "Request + Punishment" & !is.na(sender_index) & consequence != "+0.5") %>%
    group_by(belief_type,request,treatment,consequence) %>%
    summarise(
      n=n(),
      mean=mean(belief-belief_pun0),
      sd=sd(belief-belief_pun0)
    ) %>%
    mutate( se=sd/sqrt(n)) %>%
    ggplot(aes(x=consequence, y = mean, col=request, shape=request)) +
    geom_point(size=4,position=position_dodge(width = 0.4)) +
    geom_errorbar(aes(ymin = mean - se, ymax = mean + se, col = request), width=0.2,lwd=0.7,position=position_dodge(width = 0.4)) +
    scale_color_manual(labels = c("Ignorance", "Information"),
                      values = c("#a6611a", "#018571")) +
    geom_hline(yintercept = 0,lty=3) +
    theme_bw() +
    facet_wrap(~"Request + Punishment", nrow=1) +
      scale_y_continuous(breaks = c(seq(-50,50, by = 20)), limits=c(-50,10)) +
      labs(y = "Expect more punishment when... \n\n <- hiding info ---------------- sharing info ->\n",
           fill = "", x = "\nConsequences",
           title="Punishment") +
    theme(legend.position = "none",
          axis.title.y = element_text(size= 10),
          plot.title = element_text(hjust = 0.5))

library(cowplot)
f <- plot_grid(g0, g1, ncol=2, align = "h", rel_widths = c(1.8, 1))

# function to extract legend from plot
get_only_legend <- function(plot) {
  plot_table <- ggplot_gtable(ggplot_build(plot))
  legend_plot <- which(sapply(plot_table$grobs, function(x) x$name) == "guide-box")
  legend <- plot_table$grobs[[legend_plot]]
  return(legend)
}

plot1_legend <- df.beliefspun %>%
  group_by(belief_type,sender_index,request,treatment,consequence) %>%
  summarise(
    n=n(),
    mean=mean(belief-belief_pun0),
    sd=sd(belief-belief_pun0)
  ) %>%
  mutate( se=sd/sqrt(n),
          sender_index = factor(sender_index),
          request = case_when(request == "Ignorance requested" ~ "Ignorance",
                              request == "Information requested" ~ "Information")
  ) %>%
  filter(belief_type == "Punishment" & treatment == "Request + Punishment" & !is.na(sender_index) & consequence != "+0.5") %>%
  ggplot(aes(x=consequence, y = mean, fill=request, col=request, shape = request)) +
  geom_point(size=4,position=position_dodge(width = 0.4)) +
  geom_errorbar(aes(ymin = mean - se, ymax = mean + se, col = request),width=0.2,lwd=0.7,position=position_dodge(width = 0.4)) +
  geom_hline(yintercept = 0,lty=3) +
  scale_color_manual(labels = c("Ignorance", "Information"),
                     values = c("#a6611a", "#018571")) +
  theme_bw() + facet_wrap(~sender_index, nrow=1) +
  scale_y_continuous(breaks = c(seq(-50,50, by = 20)), limits=c(-45,15)) +
  labs(fill = "Request received",
       col = "Request received",
       shape = "Request received") +
  theme(legend.position = "bottom")

# extract legend from plot1 using above function
legend <- get_only_legend(plot1_legend)

plot_grid(f, legend, ncol=1, rel_heights = c(10,1))

Table D1: OLS regression of the Risk Difference of button pressing and punishment

df.regbelpun <- df.beliefspun %>%
    mutate(more_pun_when_share = belief-belief_pun0,
           more_push_when_share = belief-belief_push0,
           share = if_else(share=="False",1,0),
           request = factor(request, levels = c("Information requested", "Ignorance requested")),
           #consequence = fct_relevel(consequence, "-0.5","-1.0","-2.5")
    )

plm.m1 <- plm(more_push_when_share~request+consequence+
                    gender_f + age + income_c + I(browser!="Desktop"),
                    data = df.regbelpun,
                    index = c("pp_id"),
                    subset=(treatment=="Request"&belief_type=="Push the button"&consequence!="+0.5"),
                    model="random",
                    effect="individual"
                )

summary(plm.m1)
robust_se1 <- coeftest(plm.m1, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.m2 <- plm(more_push_when_share~request*consequence +
                    gender_f + age + income_c +
                    I(browser!="Desktop"),
                    data = df.regbelpun,
                    index = c("pp_id"),
                    subset=(treatment=="Request"&belief_type=="Push the button"&consequence!="+0.5"),
                    model="random",
                    effect="individual"
                )

summary(plm.m2)
robust_se2 <- coeftest(plm.m2, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.m3 <- plm(more_push_when_share~request+consequence+
                    gender_f + age + income_c + I(browser!="Desktop"),
                    data = df.regbelpun,
                    index = c("pp_id"),
                    subset=(treatment=="Request + Punishment"&belief_type=="Push the button"&consequence!="+0.5"),
                    model="random",
                    effect="individual"
                )

summary(plm.m3)
robust_se3 <- coeftest(plm.m3, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.m4 <- plm(more_push_when_share~request*consequence +
                    gender_f + age + income_c +
                    I(browser!="Desktop"),
                    data = df.regbelpun,
                    index = c("pp_id"),
                    subset=(treatment=="Request + Punishment"&belief_type=="Push the button"&consequence!="+0.5"),
                    model="random",
                    effect="individual"
                )

summary(plm.m4)
robust_se4 <- coeftest(plm.m4, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.m1b <- plm(more_pun_when_share~request+consequence+
                    gender_f + age + income_c + I(browser!="Desktop"),
                    data = df.regbelpun,
                    index = c("pp_id"),
                    subset=(treatment=="Request + Punishment"&belief_type=="Punishment"&consequence!="+0.5"),
                    model="random",
                    effect="individual"
                )

summary(plm.m1b)
robust_se1b <- coeftest(plm.m1b, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE

plm.m2b <- plm(more_pun_when_share~request*consequence +
                    gender_f + age + income_c +
                    I(browser!="Desktop"),
                    data = df.regbelpun,
                    index = c("pp_id"),
                    subset=(treatment=="Request + Punishment"&belief_type=="Punishment"&consequence!="+0.5"),
                    model="random",
                    effect="individual"
                )

summary(plm.m2b)
robust_se2b <- coeftest(plm.m2b, vcov.=function(x) vcovHC(x, type="sss")) #stata like robust SE


# LATEX table

# regression <- stargazer(plm.m1,plm.m2,plm.m3,plm.m4,plm.m1b,plm.m2b,
#           type = 'latex', 
#         se = list(robust_se1[,2],robust_se2[,2],robust_se3[,2],robust_se4[,2],robust_se1b[,2],robust_se2b[,2]),
#         keep.stat = c("rsq", "n", "adj.rsq"),
#         star.cutoffs=c(0.1,0.05,0.01,0.001),
#         star.char = c("\\circ", "*", "**", "***"),
#         font.size = "tiny",
#         table.placement = "H",
#         label="reg:belief_push_pun",
#         dep.var.caption = "\\textit{Dependent variable}: Risk Difference of the beliefs",
#         dep.var.labels.include = TRUE,
#         dep.var.labels = c("Push the button","Punishment"),
#         column.labels = c("Req.", "Req.", "Req + Pun.", "Req. + Pun.", "Req + Pun.", "Req. + Pun."),
#         title = "OLS regression of the Risk Difference of the Senders' belief about pressing the button and punishment",
#         order = c(10, 1:3,8:9,4:7),
#     omit = c("gender_f", "age", "income_c", "browser"),
#         covariate.labels = c("Constant",
#                              "Request Ignorance",
#                              "Consequence -1.0",
#                              "Consequence -0.5",
#                              "Request Igno  $\\times$ -1.0",
#                              "Request Igno  $\\times$ -0.5")
#         )
# 
# 
# note.latex <- "\\multicolumn{7}{p{\\linewidth}} {\\textit{Notes:} OLS regressions with random effects at individual level of the risk difference (RD) of the Senders' beliefs that the receiver presses the button (model 1 to 4) and the belief that the receiver would punish (model 5 and 6). The dependent variable is the difference of the belief when sharing and when not sharing information. Robust standard errors in parentheses. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. 
# Robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# regression[grepl("Note",regression)] <- note.latex
# # to move the table 1.5 cm into the left margin:
# regression[grepl("scriptsize", regression)] <- "\\scriptsize \\hspace*{-1.5cm}"
# 
# writeLines(regression, here("output", "tables", "belief_push_pun2.tex"))
stargazer(plm.m1,plm.m2,plm.m3,plm.m4,plm.m1b,plm.m2b,
          type = 'html', 
        se = list(robust_se1[,2],robust_se2[,2],robust_se3[,2],robust_se4[,2],robust_se1b[,2],robust_se2b[,2]),
        keep.stat = c("rsq", "n", "adj.rsq"),
        star.cutoffs=c(0.1,0.05,0.01,0.001),
        star.char = c("\\circ", "*", "**", "***"),
        font.size = "tiny",
        table.placement = "H",
        label="reg:belief_push_pun",
        dep.var.caption = "\\textit{Dependent variable}: Risk Difference of the beliefs",
        dep.var.labels.include = TRUE,
        dep.var.labels = c("Push the button","Punishment"),
        column.labels = c("Req.", "Req.", "Req + Pun.", "Req. + Pun.", "Req + Pun.", "Req. + Pun."),
        title = "OLS regression of the Risk Difference of the Senders' belief about pressing the button and punishment",
        order = c(10, 1:3,8:9,4:7),
    omit = c("gender_f", "age", "income_c", "browser"),
        covariate.labels = c("Constant",
                             "Request Information",
                             "Consequence -1.0",
                             "Consequence -0.5",
                             "Request Info  X -1.0",
                             "Request Info  X -0.5"),
        notes = "OLS regressions with random effects at individual level of the risk difference (RD) of the Senders' beliefs that the receiver presses the button (model 1 to 4) and the belief that the receiver would punish (model 5 and 6). The dependent variable is the difference of the belief when sharing and when not sharing information. Robust standard errors in parentheses. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. Robust standard errors in parentheses ",
        notes.align = "l"
        )
OLS regression of the Risk Difference of the Senders’ belief about pressing the button and punishment
Dependent variable: Risk Difference of the beliefs
Push the button Punishment
Req. Req. Req + Pun. Req. + Pun. Req + Pun. Req. + Pun.
(1) (2) (3) (4) (5) (6)
Constant -47.312*** -47.897*** -31.711*** -32.946*** -16.230 -16.157
(7.605) (7.672) (9.552) (9.569) (11.049) (11.051)
Request Information 8.953 11.167 -1.316 2.514 -2.383 -2.609
(4.739) (5.854) (5.071) (5.850) (5.040) (5.674)
Consequence -1.0 10.482*** 11.062*** 9.558*** 11.380*** 1.420 1.374
(1.136) (1.279) (1.287) (1.671) (1.511) (1.940)
Consequence -0.5 23.539*** 24.713*** 21.598*** 23.481*** 1.457 1.283
(1.755) (1.928) (2.031) (2.515) (1.931) (2.461)
Request Info X -1.0 -2.196 -5.649* 0.143
(2.728) (2.488) (3.027)
Request Info X -0.5 -4.446 -5.841 0.537
(4.351) (4.233) (3.908)
Observations 852 852 828 828 828 828
R2 0.262 0.264 0.175 0.178 0.006 0.006
Adjusted R2 0.256 0.256 0.168 0.169 -0.003 -0.005
Note: p<0.1; p<0.05; p<0.01
OLS regressions with random effects at individual level of the risk difference (RD) of the Senders’ beliefs that the receiver presses the button (model 1 to 4) and the belief that the receiver would punish (model 5 and 6). The dependent variable is the difference of the belief when sharing and when not sharing information. Robust standard errors in parentheses. Covariates suppressed for brevity: revealed in DWK, age, income, browser type, comprehension questions. Robust standard errors in parentheses

Table D2: Effect of beliefs on the decision to share information

#------------------------------------------------------------------------------------------------------
#------------------------------------------------------------------------------------------------------
#------------------------------------------------------------------------------------------------------
# Prepare beliefs data
#------------------------------------------------------------------------------------------------------
#------------------------------------------------------------------------------------------------------
#------------------------------------------------------------------------------------------------------
df1 <- df %>%
  select(starts_with("belief_pun"), starts_with("belief_push"), pp_id, request, sender_index, treatment, gender_f, age, income_c,browser, button_role, identify_charity, dana_reveal, uq_wrong_button) %>%
  #filter(belief_pun0 != "") %>%
  pivot_longer(starts_with("belief_"),names_sep = "_", names_to = c("variable", "consequence"), values_to = "value") %>%
  mutate(belief_type = case_when(grepl("pun", consequence) ~ "Punishment",
                                 grepl("push", consequence) ~ "Push the button"),
         consequence = case_when(grepl("0", consequence) ~ "???",
                                 grepl("1", consequence) ~ "-2.5",
                                 grepl("2", consequence) ~ "-1.0",
                                 grepl("3", consequence) ~ "-0.5",
                                 grepl("4", consequence) ~ "+0.5"),
         consequence = factor(consequence, levels = rev(c("???", "+0.5", "-0.5", "-1.0", "-2.5"))),
         request = case_when(request == "request_no_info" ~ "Ignorance requested",
                             request == "request_info" ~ "Information requested")
        )


df2 <- df %>%
  select(starts_with("message_minus"), starts_with("message_plus"), pp_id, belief_pun0, belief_push0,treatment) %>%
  #filter(belief_pun0 != "") %>%
  pivot_longer(starts_with("message_"),names_sep = "_", names_to = c("variable", "consequence"), values_to = "value") %>%
  mutate(consequence = case_when(grepl("minus2.5", consequence) ~ "-2.5",
                                 grepl("minus1.0", consequence) ~ "-1.0",
                                 grepl("minus0.5", consequence) ~ "-0.5",
                                 grepl("plus0.5", consequence) ~ "+0.5"),
         consequence = factor(consequence, levels = rev(c("???", "+0.5", "-0.5", "-1.0", "-2.5")))
         )

df.beliefspun <- left_join(df1, df2, by = c("pp_id","consequence")) %>%
  select(!c("variable.x","variable.y","treatment.x")) %>%
  rename(belief = value.x,
         share = value.y,
         treatment = treatment.y
  )

df2 <- df.beliefspun %>%
  filter(belief_type == "Push the button" & button_role == "Sender" & consequence != "???") %>%
  mutate(group = case_when(request == "Ignorance requested" & treatment == "Request + Punishment" ~ 1,
                           request == "Ignorance requested" & treatment == "Request"~ 2,
                           treatment == "Baseline" ~ 3,
                           request == "Information requested" & treatment == "Request" ~ 4,
                           request == "Information requested" & treatment == "Request + Punishment" ~ 5
  ),
  share = if_else(share == "True", 1, 0),
  group = factor(group, levels = c(3,1,2,4,5), labels = c("Baseline", "Request No Info + Pun", "Request No Info", "Request Info", "Request Info + Pun")),
  belief = belief / 100,
  belief_push0 = belief_push0 / 100,
  belief_gap = belief - belief_push0
  )


m1 <- lm(share ~ group + belief_gap +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button
         , data = df2, subset = consequence == "-2.5")
robust_se1 <- coeftest(m1, vcov. = function(x) vcovHC(x, type = "HC1"))

m2 <- lm(share ~ group + belief_gap +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button         
         , data = df2, subset = consequence == "-1.0")
robust_se2 <- coeftest(m2, vcov. = function(x) vcovHC(x, type = "HC1"))

m3 <- lm(share ~ group + belief_gap +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button         
         , data = df2, subset = consequence == "-0.5")
robust_se3 <- coeftest(m3, vcov. = function(x) vcovHC(x, type = "HC1"))

m4 <- lm(share ~ group + belief_gap +
                 identify_charity  + dana_reveal +
                 gender_f + age + income_c + 
                 I(browser!="Desktop") + uq_wrong_button         
         , data = df2, subset = consequence == "+0.5")
robust_se4 <- coeftest(m4, vcov. = function(x) vcovHC(x, type = "HC1"))
# 
# table_welfare <- stargazer(m1, m2, m3, m4,
#                            type = 'latex',
#   se = list(robust_se1[, 2], robust_se2[, 2], robust_se3[, 2], robust_se4[, 2]),
#   p = list(robust_se1[, 4], robust_se2[, 4], robust_se3[, 4], robust_se4[, 4]),
#   star.cutoffs = c(0.1, 0.05, 0.01, 0.001),
#   star.char = c("\\circ", "*", "**", "***"),
#   notes.append = FALSE,
#   keep.stat = c("rsq", "n", "adj.rsq"),
#   font.size = "scriptsize",
#   table.placement = "H",
#   label = "reg:effectbeliefson sharing",
#   dep.var.caption = "\\textit{Dependent variable}: Information sharing",
#   dep.var.labels.include = FALSE,
#   title = "Senders' information sharing by request and beliefs.", 
#   column.labels = c("Cons. -2.5", "Cons. -1.0", "Cons. -0.5", "Cons. +0.5"),
#   intercept.bottom = FALSE,
#   order = c(1,4,3,5,2,6:9),  
#   omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button")
#   ,
#   covariate.labels = c("\\-\\hspace{0.3cm}Constant",
#   "\\-\\textbf{Information preference (ref = Baseline)} \\\\ \\-\\hspace{0.3cm}Request info",
#                        "\\-\\hspace{0.3cm}Request ignorance",
#                        "\\-\\hspace{0.3cm}Request info under punishment threat",
#                        "\\-\\hspace{0.3cm}Request ignorance under punishment threat",
#                        "\\-\\textbf{Beliefs} \\\\ \\-\\hspace{0.3cm}Belief when informed - Belief when not informed",
#                        "\\-\\textbf{Control variables} \\\\ \\-\\hspace{0.3cm}Identify with charity",
#                        "\\-\\hspace{0.3cm}Revealed in DWK")
# )
# 
# note.latex <- "\\multicolumn{5}{p{\\linewidth}} {\\textit{Notes:} Dependent variable: Shared information. Reference category: Baseline. Covariates suppressed for brevity: gender, age, income, browser type, comprehension questions. Linear model with heteroscedasticity robust standard errors in parentheses ($^{\\circ}$$p<0.10$; $^{*}$$p<0.05$;  $^{**}$$p<0.01$; $^{***}$ $p<0.001$).} \\\\"
# table_welfare[grepl("Note", table_welfare)] <- note.latex
# # to move the table 1.5 cm into the left margin:
# table_welfare[grepl("scriptsize", table_welfare)] <- "\\scriptsize \\hspace*{-1.5cm}"
# writeLines(table_welfare, here("output", "tables", "effect_belief_on_sharing.tex"))
#--------------------------------------------------------------------------------------
stargazer(m1, m2, m3, m4,
                           type = 'html',
  se = list(robust_se1[, 2], robust_se2[, 2], robust_se3[, 2], robust_se4[, 2]),
  p = list(robust_se1[, 4], robust_se2[, 4], robust_se3[, 4], robust_se4[, 4]),
  star.cutoffs = c(0.1, 0.05, 0.01, 0.001),
  star.char = c("\\circ", "*", "**", "***"),
  notes.append = FALSE,
  keep.stat = c("rsq", "n", "adj.rsq"),
  font.size = "scriptsize",
  table.placement = "H",
  label = "reg:effectbeliefson sharing",
  dep.var.caption = "\\textit{Dependent variable}: Information sharing",
  dep.var.labels.include = FALSE,
  title = "Senders' information sharing by request and beliefs.", 
  column.labels = c("Cons. -2.5", "Cons. -1.0", "Cons. -0.5", "Cons. +0.5"),
  intercept.bottom = FALSE,
  order = c(1,4,3,5,2,6:9),  
  omit = c("gender_f", "age", "income_c", "browser", "uq_wrong_button"),
  covariate.labels = c("    Constant",
                        "**Information preference (ref = Baseline)}**    Request info",
                       "    Request ignorance",
                       "    Request info under punishment threat",
                       "    Request ignorance under punishment threat",
                       "**Beliefs**    Belief press when informed",
                       "    Belief press when not informed",
                       "**Control variables**    Identify with charity",
                       "    Revealed in DWK")
)
Senders’ information sharing by request and beliefs.
Dependent variable: Information sharing
Cons. -2.5 Cons. -1.0 Cons. -0.5 Cons. +0.5
(1) (2) (3) (4)
Constant 0.493*** 0.278*** 0.226** 0.295***
(0.079) (0.080) (0.079) (0.080)
Information preference (ref = Baseline)} Request info -0.021 -0.016 0.003 0.034
(0.047) (0.051) (0.052) (0.052)
Request ignorance -0.072 -0.083 0.016 -0.018
(0.065) (0.067) (0.069) (0.067)
Request info under punishment threat 0.010 0.002 0.074 0.123*
(0.049) (0.053) (0.055) (0.055)
Request ignorance under punishment threat -0.015 0.010 0.080 0.054
(0.061) (0.065) (0.068) (0.066)
Beliefs Belief press when informed -0.138** -0.212*** -0.125* 0.138*
(0.043) (0.052) (0.055) (0.057)
Belief press when not informed 0.020** 0.028*** 0.027*** 0.020**
(0.006) (0.007) (0.007) (0.006)
Control variables Identify with charity 0.067* 0.108** 0.122** 0.018
(0.034) (0.037) (0.039) (0.038)
Observations 703 703 703 703
R2 0.053 0.086 0.068 0.040
Adjusted R2 0.036 0.070 0.051 0.023
Note: p<0.1; p<0.05; p<0.01

SessionInfo

sessionInfo()
## R version 4.4.1 (2024-06-14 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 22631)
## 
## Matrix products: default
## 
## 
## locale:
## [1] LC_COLLATE=Dutch_Netherlands.utf8  LC_CTYPE=Dutch_Netherlands.utf8   
## [3] LC_MONETARY=Dutch_Netherlands.utf8 LC_NUMERIC=C                      
## [5] LC_TIME=Dutch_Netherlands.utf8    
## 
## time zone: Europe/Amsterdam
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] modelsummary_2.2.0 texreg_1.39.4      cobalt_4.5.5       WeightIt_1.3.2    
##  [5] AER_1.2-14         survival_3.6-4     car_3.1-3          carData_3.0-5     
##  [9] lmtest_0.9-40      zoo_1.8-12         sandwich_3.1-1     pscl_1.5.9        
## [13] multiwayvcov_1.2.3 MASS_7.3-60.2      cowplot_1.1.3      kableExtra_1.4.0  
## [17] ggsignif_0.6.4     plm_2.6-4          stargazer_5.2.3    PMCMRplus_1.9.12  
## [21] gridExtra_2.3      knitr_1.48         table1_1.4.3       ggridges_0.5.6    
## [25] anytime_0.3.9      numbers_0.8-5      openxlsx_4.2.7.1   here_1.0.1        
## [29] lubridate_1.9.3    forcats_1.0.0      stringr_1.5.1      dplyr_1.1.4       
## [33] purrr_1.0.2        readr_2.1.5        tidyr_1.3.1        tibble_3.2.1      
## [37] ggplot2_3.5.1      tidyverse_2.0.0   
## 
## loaded via a namespace (and not attached):
##  [1] Rdpack_2.6.1        rlang_1.1.4         magrittr_2.0.3     
##  [4] compiler_4.4.1      BWStest_0.2.3       systemfonts_1.1.0  
##  [7] vctrs_0.6.5         kSamples_1.2-10     pkgconfig_2.0.3    
## [10] crayon_1.5.3        fastmap_1.2.0       backports_1.5.0    
## [13] labeling_0.4.3      utf8_1.2.4          rmarkdown_2.28     
## [16] tzdb_0.4.0          ragg_1.3.3          miscTools_0.6-28   
## [19] xfun_0.47           cachem_1.1.0        Rmpfr_0.9-5        
## [22] jsonlite_1.8.8      SuppDists_1.1-9.8   collapse_2.0.16    
## [25] highr_0.11          gmp_0.7-5           chk_0.9.2          
## [28] broom_1.0.7         parallel_4.4.1      R6_2.5.1           
## [31] tables_0.9.31       bslib_0.8.0         stringi_1.8.4      
## [34] boot_1.3-30         jquerylib_0.1.4     Rcpp_1.0.13        
## [37] Matrix_1.7-0        splines_4.4.1       timechange_0.3.0   
## [40] tidyselect_1.2.1    rstudioapi_0.16.0   abind_1.4-8        
## [43] yaml_2.3.10         maxLik_1.5-2.1      lattice_0.22-6     
## [46] withr_3.0.1         evaluate_1.0.0      zip_2.3.1          
## [49] xml2_1.3.6          pillar_1.9.0        insight_0.20.5     
## [52] generics_0.1.3      rprojroot_2.0.4     hms_1.1.3          
## [55] munsell_0.5.1       scales_1.3.0        glue_1.7.0         
## [58] tools_4.4.1         data.table_1.16.0   mvtnorm_1.3-1      
## [61] grid_4.4.1          rbibutils_2.3       bdsmatrix_1.3-7    
## [64] colorspace_2.1-1    nlme_3.1-164        Formula_1.2-5      
## [67] cli_3.6.3           textshaping_0.4.0   fansi_1.0.6        
## [70] viridisLite_0.4.2   svglite_2.1.3       gtable_0.3.5       
## [73] sass_0.4.9          digest_0.6.37       farver_2.1.2       
## [76] memoise_2.0.1       htmltools_0.5.8.1   lifecycle_1.0.4    
## [79] httr_1.4.7          multcompView_0.1-10