H₃: Issue area

library(tidyverse)
library(targets)
library(tidybayes)
library(patchwork)
library(scales)
library(glue)
library(gt)
library(gtExtras)

tar_config_set(
  store = here::here("_targets"),
  script = here::here("_targets.R")
)

preds_all <- tar_read(preds_conditional_treatment_only)

invisible(list2env(tar_read(graphic_functions), .GlobalEnv))
invisible(list2env(tar_read(table_functions), .GlobalEnv))

theme_set(theme_ngo())

H_3a: Issue area

Hypothesis 3_a: Issue area

Donors will show increased willingness to donate to NGOs working in less contentious issue areas (emergency response and refugee relief) over more contentious issue areas (environment and human rights).

Estimand

\[ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Issue} = \text{More contentious} \right) \bigr] - \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Issue} = \text{Less contentious} \right) \bigr] \end{aligned} \]

h3a_mms <- preds_all %>% 
  group_by(feat_issue, .draw) %>% 
  summarize(avg = mean(.epred))

h3a_amces <- h3a_mms %>% 
  group_by(feat_issue) %>% 
  compare_levels(variable = avg, by = feat_issue, comparison = "control")

p_h3a_mms <- h3a_mms %>% 
  ggplot(aes(x = avg, y = feat_issue, fill = feat_issue)) +
  stat_halfeye() +
  geom_vline(xintercept = 0.25, color = clrs$prism[8], linetype = "dashed", linewidth = 0.25) +
  scale_x_continuous(labels = label_percent()) +
  scale_y_discrete(labels = label_wrap(10)) +
  scale_fill_manual(values = clrs$prism[c(2, 6, 8, 10)], guide = "none") +
  labs(
    x = "Overall average predicted probability",
    y = NULL,
    fill = NULL,
    title = "Estimated marginal means"
  )

p_h3a_amces <- h3a_amces %>% 
  ungroup() %>% 
  separate_wider_delim(
    feat_issue,
    delim = " - ", 
    names = c("feat_issue", "reference_level")
  ) %>% 
  add_row(avg = 0, feat_issue = unique(.$reference_level)) %>%
  mutate(feat_issue = factor(feat_issue, levels = levels(h3a_mms$feat_issue))) %>% 
  ggplot(aes(x = avg, y = feat_issue, fill = feat_issue)) +
  stat_halfeye() +
  geom_vline(xintercept = 0, color = clrs$prism[8], linetype = "dashed", linewidth = 0.25) +
  scale_x_continuous(labels = label_pp) +
  scale_y_discrete(labels = label_wrap(10)) +
  scale_fill_manual(values = clrs$prism[c(2, 6, 8, 10)], guide = "none") +
  labs(
    x = "Percentage point change in probability of choice selection",
    y = NULL,
    fill = NULL,
    title = "Average marginal component effects (AMCEs)"
  )

p_h3a_mms | p_h3a_amces

h3a_tbl_mm <- h3a_mms %>% 
  group_by(feat_issue) %>% 
  median_qi() %>% 
  mutate(nice = glue("{fmt_decimal(avg)}<br>{build_ci(.lower, .upper)}")) %>% 
  arrange(desc(feat_issue)) %>% 
  select(feat_issue, nice)

h3a_tbl_amces <- h3a_amces %>% 
  group_by(feat_issue) %>% 
  summarize(
    median_qi(avg),
    p_gt_0 = sum(avg > 0) / n()
  ) %>%
  mutate(p_neq_0 = ifelse(y >= 0, p_gt_0, 1 - p_gt_0)) %>% 
  mutate(nice = glue("{fmt_decimal(y)}<br>{build_ci(ymin, ymax)}")) %>% 
  mutate(feat_issue = str_replace(feat_issue, " - ", "−<br>")) %>% 
  mutate(across(starts_with("p_"), ~fmt_decimal(.))) %>% 
  arrange(desc(feat_issue)) %>% 
  select(contrast = feat_issue, amce_nice = nice, p_neq_0)

bind_cols(
  h3a_tbl_mm, 
  add_row(h3a_tbl_amces, contrast = "*(Reference)*")
) %>% 
  gt() %>% 
  sub_missing(columns = everything(), missing_text = "—") %>% 
  fmt_markdown(columns = c(nice, amce_nice, contrast)) %>%
  cols_align(align = "center", columns = everything()) %>% 
  cols_align(align = "left", columns = c(feat_issue, contrast)) %>% 
  cols_label(
    feat_issue = "Issue area", 
    nice = "Posterior EMM",
    contrast = "Contrast",
    amce_nice = "Posterior AMCE",
    p_neq_0 = "*p*~direction~",
    .fn = md
  ) %>% 
  tab_style(
    style = cell_text(v_align = "top"),
    locations = cells_body()
  ) %>% 
  tab_footnote(
    footnote = "Values are on the percentage-point scale; single value is posterior median; 95% credible interval in brackets.",
    locations = cells_column_labels(columns = c(nice, amce_nice))
  ) %>% 
  tab_footnote(
    footnote = md("The probability of direction (*p*~direction~) is the probability that the posterior AMCE is strictly positive or negative—it is the proportion of the posterior AMCE that is the sign of the median."),
    locations = cells_column_labels(columns = p_neq_0)
  ) %>% 
  gt_add_divider(columns = nice, style = "dashed", weight = px(1)) %>% 
  opt_footnote_marks(marks = "standard") %>% 
  opt_horizontal_padding(3) %>% 
  opts_theme()

Issue area	Posterior EMM*	Contrast	Posterior AMCE*	pdirection†
Refugee relief	0.227 [0.218, 0.235]	Refugee relief− Emergency response	−0.056 [−0.068, −0.044]	1.000
Human rights	0.270 [0.261, 0.280]	Human rights− Emergency response	−0.012 [−0.025, 0.000]	0.972
Environment	0.241 [0.232, 0.250]	Environment− Emergency response	−0.042 [−0.054, −0.029]	1.000
Emergency response	0.283 [0.273, 0.292]	(Reference)	—	—
* Values are on the percentage-point scale; single value is posterior median; 95% credible interval in brackets.
† The probability of direction (pdirection) is the probability that the posterior AMCE is strictly positive or negative—it is the proportion of the posterior AMCE that is the sign of the median.

H_3b: Relationship with host government and issue area

Hypothesis 3_b: Relationship with host government and issue area

Donors will show increased willingness to donate to NGOs facing government crackdown/criticism working in less contentious issue areas (emergency response and refugee relief) over more contentious issue areas (environment and human rights)

Mechanisms: Perceptions of deservingness of NGOs dealing with emergency response and refugee relief. Donors are also more likely to donate to programs that are compatible with government preferences and have easily measurable outputs, which environment and human rights programs often lack. NGOs working on more contentious issue areas may be expelled or shut down, which would be a waste of donor resources, make it less likely that they donate to these groups.

Estimand

\[ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Issue} = \text{More contentious} \mid \text{Relationship = Under crackdown or Criticized} \right) \bigr] - \\ &\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Issue} = \text{Less contentnious} \mid \text{Relationship = Under crackdown or Criticized} \right) \bigr] \end{aligned} \]

h3b_mms <- preds_all %>% 
  group_by(feat_issue, feat_govt, .draw) %>% 
  summarize(avg = mean(.epred))

h3b_amces <- h3b_mms %>% 
  group_by(feat_govt) %>% 
  compare_levels(variable = avg, by = feat_issue, comparison = "control")

p_h3b_mms <- h3b_mms %>% 
  ggplot(aes(x = avg, y = feat_issue, fill = feat_issue)) +
  stat_halfeye() +
  geom_vline(xintercept = 0.25, color = clrs$prism[8], linetype = "dashed", linewidth = 0.25) +
  scale_x_continuous(labels = label_percent()) +
  scale_y_discrete(labels = label_wrap(10)) +
  scale_fill_manual(values = clrs$prism[c(2, 6, 8, 10)], guide = "none") +
  facet_wrap(vars(feat_govt), ncol = 1) +
  labs(
    x = "Overall average predicted probability",
    y = NULL,
    fill = NULL,
    title = "Estimated marginal means"
  ) +
  theme(
    legend.position = "top",
    legend.justification = "left",
    legend.margin = margin(l = -7, t = 0)
  )

p_h3b_amces <- h3b_amces %>% 
  ungroup() %>% 
  separate_wider_delim(
    feat_issue,
    delim = " - ", 
    names = c("feat_issue", "reference_level")
  ) %>% 
  add_row(avg = 0, feat_issue = "Emergency response", feat_govt = "Friendly relationship with government") %>%
  add_row(avg = 0, feat_issue = "Emergency response", feat_govt = "Criticized by government") %>%
  add_row(avg = 0, feat_issue = "Emergency response", feat_govt = "Under government crackdown") %>%
  mutate(feat_issue = factor(feat_issue, levels = levels(h3b_mms$feat_issue))) %>% 
  mutate(feat_govt = factor(feat_govt, levels = levels(h3b_mms$feat_govt))) %>% 
  ggplot(aes(x = avg, y = feat_issue, fill = feat_issue)) +
  stat_halfeye() +
  geom_vline(xintercept = 0, color = clrs$prism[8], linetype = "dashed", linewidth = 0.25) +
  scale_x_continuous(labels = label_pp) +
  scale_y_discrete(labels = label_wrap(10)) +
  scale_fill_manual(values = clrs$prism[c(2, 6, 8, 10)], guide = "none") +
  facet_wrap(vars(feat_govt), ncol = 1) +
  labs(
    x = "Percentage point change in probability of choice selection",
    y = NULL,
    fill = NULL,
    title = "Difference in estimated marginal means"
  )

p_h3b_mms | p_h3b_amces

h3b_tbl_mm <- h3b_mms %>% 
  group_by(feat_govt, feat_issue) %>% 
  median_qi() %>% 
  mutate(nice = glue("{fmt_decimal(avg)}<br>{build_ci(.lower, .upper)}")) %>% 
  arrange(desc(feat_govt), desc(feat_issue)) %>% 
  select(feat_issue, feat_govt, nice)

h3b_tbl_amces <- h3b_amces %>% 
  group_by(feat_govt, feat_issue) %>% 
  summarize(
    median_qi(avg),
    p_gt_0 = sum(avg > 0) / n()
  ) %>%
  ungroup() %>% 
  mutate(p_neq_0 = ifelse(y >= 0, p_gt_0, 1 - p_gt_0)) %>% 
  mutate(nice = glue("{fmt_decimal(y)}<br>{build_ci(ymin, ymax)}")) %>% 
  mutate(feat_issue = str_replace(feat_issue, " - ", "−<br>")) %>% 
  mutate(across(starts_with("p_"), ~fmt_decimal(.))) %>% 
  arrange(desc(feat_govt)) %>% 
  select(contrast = feat_issue, diff_nice = nice, p_neq_0)

bind_cols(
  h3b_tbl_mm, 
  h3b_tbl_amces %>% 
    add_row(contrast = NA, .after = 3) %>% 
    add_row(contrast = NA, .after = 7) %>% 
    add_row(contrast = NA, .after = 12)
) %>% 
  mutate(feat_govt = fct_relabel(feat_govt, ~paste("Relationship with government:", .x))) %>% 
  group_by(feat_govt) %>% 
  gt() %>% 
  sub_missing(columns = everything(), missing_text = "—") %>% 
  fmt_markdown(columns = c(nice, diff_nice, contrast)) %>%
  cols_align(align = "center", columns = everything()) %>% 
  cols_align(align = "left", columns = c(feat_issue, contrast)) %>% 
  cols_label(
    feat_issue = "Issue", 
    nice = "Posterior EMM",
    contrast = "Contrast",
    diff_nice = "Posterior ∆",
    p_neq_0 = "*p*~direction~",
    .fn = md
  ) %>% 
  tab_style(
    style = cell_text(v_align = "top"),
    locations = cells_body()
  ) %>% 
  tab_style(
    style = cell_fill(color = "grey90"),
    locations = cells_row_groups()
  ) %>% 
  tab_footnote(
    footnote = "Values are on the percentage-point scale; single value is posterior median; 95% credible interval in brackets.",
    locations = cells_column_labels(columns = c(nice, diff_nice))
  ) %>% 
  tab_footnote(
    footnote = md("The probability of direction (*p*~direction~) is the probability that the posterior difference in marginal means is strictly positive or negative—it is the proportion of the posterior difference in marginal means that is the sign of the median."),
    locations = cells_column_labels(columns = p_neq_0)
  ) %>% 
  gt_add_divider(columns = nice, style = "dashed", weight = px(1)) %>% 
  opt_footnote_marks(marks = "standard") %>% 
  opt_horizontal_padding(3) %>% 
  opts_theme()

Issue	Posterior EMM*	Contrast	Posterior ∆*	pdirection†
Relationship with government: Under government crackdown
Refugee relief	0.184 [0.174, 0.193]	Environment− Emergency response	−0.037 [−0.048, −0.026]	1.000
Human rights	0.222 [0.212, 0.233]	Human rights− Emergency response	−0.011 [−0.022, 0.000]	0.972
Environment	0.196 [0.187, 0.206]	Refugee relief− Emergency response	−0.049 [−0.060, −0.039]	1.000
Emergency response	0.233 [0.223, 0.244]	—	—	—
Relationship with government: Criticized by government
Refugee relief	0.216 [0.206, 0.226]	Environment− Emergency response	−0.041 [−0.053, −0.029]	1.000
Human rights	0.259 [0.248, 0.270]	Human rights− Emergency response	−0.012 [−0.025, 0.000]	0.971
Environment	0.230 [0.219, 0.240]	Refugee relief− Emergency response	−0.055 [−0.067, −0.043]	1.000
Emergency response	0.271 [0.259, 0.282]	—	—	—
Relationship with government: Friendly relationship with government
Refugee relief	0.281 [0.269, 0.293]	Environment− Emergency response	−0.047 [−0.061, −0.033]	1.000
Human rights	0.330 [0.318, 0.343]	Human rights− Emergency response	−0.014 [−0.028, 0.000]	0.974
Environment	0.297 [0.285, 0.309]	Refugee relief− Emergency response	−0.064 [−0.078, −0.050]	1.000
Emergency response	0.344 [0.332, 0.357]	—	—	—
* Values are on the percentage-point scale; single value is posterior median; 95% credible interval in brackets.
† The probability of direction (pdirection) is the probability that the posterior difference in marginal means is strictly positive or negative—it is the proportion of the posterior difference in marginal means that is the sign of the median.