H₄: Funding sources

Code

library(tidyverse)
library(targets)
library(tidybayes)
library(patchwork)
library(scales)
library(ggh4x)
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_4a: Funding sources

Hypothesis 4_a: Funding sources

Donors will show increased willingness to donate to NGOs that are funded primarily by numerous small private donors compared to NGOs that are funded by a handful of wealthy private donors and government grants

Mechanisms: Perception of efficacy - your contribution matters as a small donor. Government funding may also imply lack of independence of government which can reduce the efficiency of an organization.

Estimand

\[ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Funding} = \text{Few wealthy donors or Government} \right) \bigr] - \\ &\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Funding} = \text{Many small donors} \right) \bigr] \end{aligned} \]

Code

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

h4a_amces <- h4a_mms %>% 
  group_by(feat_funding_short) %>% 
  compare_levels(variable = avg, by = feat_funding_short, comparison = "control")

Code

p_h4a_mms <- h4a_mms %>% 
  ggplot(aes(x = avg, y = feat_funding_short, fill = feat_funding_short)) +
  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(11)) +
  scale_fill_manual(values = clrs$prism[c(3, 6, 5)], guide = "none") +
  labs(
    x = "Overall average predicted probability",
    y = NULL,
    fill = NULL,
    title = "Estimated marginal means"
  )

p_h4a_amces <- h4a_amces %>% 
  ungroup() %>% 
  separate_wider_delim(
    feat_funding_short,
    delim = " - ", 
    names = c("feat_funding_short", "reference_level")
  ) %>% 
  add_row(avg = 0, feat_funding_short = unique(.$reference_level)) %>%
  mutate(feat_funding_short = factor(feat_funding_short, levels = levels(h4a_mms$feat_funding_short))) %>% 
  ggplot(aes(x = avg, y = feat_funding_short, fill = feat_funding_short)) +
  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(11)) +
  scale_fill_manual(values = clrs$prism[c(3, 6, 5)], guide = "none") +
  labs(
    x = "Percentage point change in probability of choice selection",
    y = NULL,
    fill = NULL,
    title = "Average marginal component effects (AMCEs)"
  )

p_h4a_mms | p_h4a_amces

Code

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

h4a_tbl_amces <- h4a_amces %>% 
  group_by(feat_funding_short) %>% 
  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_funding_short = str_replace(feat_funding_short, " - ", "−<br>")) %>% 
  mutate(across(starts_with("p_"), ~fmt_decimal(.))) %>% 
  arrange(desc(feat_funding_short)) %>% 
  select(contrast = feat_funding_short, amce_nice = nice, p_neq_0)

bind_cols(
  h4a_tbl_mm, 
  add_row(h4a_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_funding_short, contrast)) %>% 
  cols_label(
    feat_funding_short = "Funding source", 
    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()

Funding source	Posterior EMM^*	Contrast	Posterior AMCE^*	p_direction^†
Government grants	0.245 [0.238, 0.253]	Handful of wealthy private donors− Many small donors	−0.042 [−0.052, −0.031]	1.000
Handful of wealthy private donors	0.239 [0.232, 0.247]	Government grants− Many small donors	−0.035 [−0.046, −0.025]	1.000
Many small donors	0.281 [0.273, 0.289]	(Reference)	—	—
^* Values are on the percentage-point scale; single value is posterior median; 95% credible interval in brackets.
^† 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.

H_4b: Relationship with host government and funding sources

Hypothesis 4_b: Relationship with host government and funding sources

Donors will show increased willingness to donate to NGOs that are facing government crackdown and are funded primarily by numerous small private donors

Estimand

\[ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Funding} = \text{Few wealthy donors or Government} \mid \text{Relationship = Under crackdown or Criticized} \right) \bigr] - \\ &\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Funding} = \text{Many small donors} \mid \text{Relationship = Under crackdown or Criticized} \right) \bigr] \end{aligned} \]

Code

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

h4b_amces <- h4b_mms %>% 
  group_by(feat_govt) %>% 
  compare_levels(variable = avg, by = feat_funding_short, comparison = "control")

Code

p_h4b_mms <- h4b_mms %>% 
  ggplot(aes(x = avg, y = feat_funding_short, fill = feat_funding_short)) +
  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(11)) +
  scale_fill_manual(values = clrs$prism[c(3, 6, 5)], 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_h4b_amces <- h4b_amces %>% 
  ungroup() %>% 
  separate_wider_delim(
    feat_funding_short,
    delim = " - ", 
    names = c("feat_funding_short", "reference_level")
  ) %>% 
  add_row(avg = 0, feat_funding_short = "Many small donors", feat_govt = "Friendly relationship with government") %>%
  add_row(avg = 0, feat_funding_short = "Many small donors", feat_govt = "Criticized by government") %>%
  add_row(avg = 0, feat_funding_short = "Many small donors", feat_govt = "Under government crackdown") %>%
  mutate(feat_funding_short = factor(feat_funding_short, levels = levels(h4b_mms$feat_funding_short))) %>% 
  mutate(feat_govt = factor(feat_govt, levels = levels(h4b_mms$feat_govt))) %>% 
  ggplot(aes(x = avg, y = feat_funding_short, fill = feat_funding_short)) +
  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(11)) +
  scale_fill_manual(values = clrs$prism[c(3, 6, 5)], 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_h4b_mms | p_h4b_amces

Code

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

h4b_tbl_amces <- h4b_amces %>% 
  group_by(feat_govt, feat_funding_short) %>% 
  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_funding_short = str_replace(feat_funding_short, " - ", "−<br>")) %>% 
  mutate(across(starts_with("p_"), ~fmt_decimal(.))) %>% 
  arrange(desc(feat_govt)) %>% 
  select(contrast = feat_funding_short, diff_nice = nice, p_neq_0)

bind_cols(
  h4b_tbl_mm, 
  h4b_tbl_amces %>% 
    add_row(contrast = NA, .after = 2) %>% 
    add_row(contrast = NA, .after = 5) %>% 
    add_row(contrast = NA, .after = 8)
) %>% 
  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_funding_short, contrast)) %>% 
  cols_label(
    feat_funding_short = "Funding source", 
    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()

Funding source	Posterior EMM^*	Contrast	Posterior ∆^*	p_direction^†
Relationship with government: Under government crackdown
Government grants	0.200 [0.191, 0.209]	Government grants− Many small donors	−0.031 [−0.041, −0.022]	1.000
Handful of wealthy private donors	0.195 [0.186, 0.204]	Handful of wealthy private donors− Many small donors	−0.037 [−0.046, −0.028]	1.000
Many small donors	0.232 [0.222, 0.241]	—	—	—
Relationship with government: Criticized by government
Government grants	0.234 [0.225, 0.244]	Government grants− Many small donors	−0.035 [−0.045, −0.024]	1.000
Handful of wealthy private donors	0.228 [0.218, 0.238]	Handful of wealthy private donors− Many small donors	−0.041 [−0.052, −0.031]	1.000
Many small donors	0.269 [0.259, 0.280]	—	—	—
Relationship with government: Friendly relationship with government
Government grants	0.302 [0.291, 0.313]	Government grants− Many small donors	−0.040 [−0.052, −0.028]	1.000
Handful of wealthy private donors	0.295 [0.285, 0.306]	Handful of wealthy private donors− Many small donors	−0.047 [−0.059, −0.035]	1.000
Many small donors	0.342 [0.331, 0.354]	—	—	—
^* Values are on the percentage-point scale; single value is posterior median; 95% credible interval in brackets.
^† 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.

H_4c: Relationship with host government, funding sources, and issue area

Hypothesis 4_c: Relationship with host government, funding sources, and issue area

Donors will show increased willingness to donate to NGOs that are facing government crackdown and are funded primarily by numerous small private donors and work in less contentious areas (emergency response and refugee relief)

Estimand

\[ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Funding} = \text{Few wealthy donors or Government} \mid \text{(Relationship = Under crackdown or Criticized) and (Issue = less contentious)} \right) \bigr] - \\ &\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Funding} = \text{Many small donors} \mid \text{(Relationship = Under crackdown or Criticized) and (Issue = less contentious)} \right) \bigr] \end{aligned} \]

Code

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

h4c_amces <- h4c_mms %>% 
  group_by(feat_govt, feat_issue) %>% 
  compare_levels(variable = avg, by = feat_funding_short, comparison = "control")

Code

p_h4c_mms <- h4c_mms %>%
  ggplot(aes(x = avg, y = feat_funding_short, fill = feat_funding_short)) +
  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(11)) +
  scale_fill_manual(values = clrs$prism[c(3, 6, 5)], guide = "none") +
  facet_nested_wrap(
    vars(feat_govt, feat_issue),
    ncol = 4,
    strip = strip_nested(
      text_x = list(element_text(
        family = "Libre Franklin",
        face = "bold"
      ), NULL),
      background_x = list(element_rect(fill = "grey96"), NULL),
      by_layer_x = TRUE
    )
  ) +
  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_h4c_mms

Code


baselines <- expand_grid(
  avg = 0,
  feat_funding_short = "Many small donors",
  feat_govt = levels(h4c_mms$feat_govt),
  feat_issue = levels(h4c_mms$feat_issue)
)

p_h4c_amces <- h4c_amces %>% 
  ungroup() %>% 
  separate_wider_delim(
    feat_funding_short,
    delim = " - ", 
    names = c("feat_funding_short", "reference_level")
  ) %>% 
  bind_rows(baselines) %>% 
  mutate(feat_funding_short = factor(feat_funding_short, levels = levels(h4c_mms$feat_funding_short))) %>% 
  mutate(feat_govt = factor(feat_govt, levels = levels(h4c_mms$feat_govt))) %>% 
  ggplot(aes(x = avg, y = feat_funding_short, fill = feat_funding_short)) +
  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(11)) +
  scale_fill_manual(values = clrs$prism[c(3, 6, 5)], guide = "none") +
  facet_nested_wrap(
    vars(feat_govt, feat_issue),
    ncol = 4,
    strip = strip_nested(
      text_x = list(element_text(
        family = "Libre Franklin",
        face = "bold"
      ), NULL),
      background_x = list(element_rect(fill = "grey96"), NULL),
      by_layer_x = TRUE
    )
  ) +
  labs(
    x = "Percentage point change in probability of choice selection",
    y = NULL,
    fill = NULL,
    title = "Difference in estimated marginal means"
  )

p_h4c_amces

H4a: Funding sources

Estimand

H4b: Relationship with host government and funding sources

Estimand

H4c: Relationship with host government, funding sources, and issue area

Estimand

H_4a: Funding sources

H_4b: Relationship with host government and funding sources

H_4c: Relationship with host government, funding sources, and issue area