H₁: Branding

Code

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

# Targets stuff
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₁: Branding

Hypothesis 1: Branding

Donors will be more likely to donate to Oxfam and Red Cross compared to Amnesty International and Greenpeace.

Mechanism: awareness of need and contentiousness of issue area

Estimand

\[ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Organization} = \text{Oxfam or Red Cross} \right) \bigr] - \\ &\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Organization} = \text{Amnesty International or Greenpeace} \right) \bigr] \end{aligned} \]

Code

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

h1_amces <- h1_mms %>% 
  group_by(feat_org) %>% 
  compare_levels(variable = avg, by = feat_org, comparison = "control")

Code

p_h1_mms <- h1_mms %>% 
  ggplot(aes(x = avg, y = feat_org, fill = feat_org)) +
  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(1, 3, 5, 7)], guide = "none") +
  labs(
    x = "Overall average predicted probability",
    y = NULL,
    fill = NULL,
    title = "Estimated marginal means"
  )

p_h1_amces <- h1_amces %>% 
  ungroup() %>% 
    separate_wider_delim(
    feat_org,
    delim = " - ", 
    names = c("feat_org", "reference_level")
  ) %>% 
  add_row(avg = 0, feat_org = unique(.$reference_level)) %>% 
  ggplot(aes(x = avg, y = feat_org, fill = feat_org)) +
  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(1, 3, 5, 7)], guide = "none") +
  labs(
    x = "Percentage point change in probability of choice selection",
    y = NULL,
    fill = NULL,
    title = "Average marginal component effects (AMCEs)"
  )

p_h1_mms | p_h1_amces

Code

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

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

bind_cols(
  h1_tbl_mm, 
  add_row(h1_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_org, contrast)) %>% 
  cols_label(
    feat_org = "Organization", 
    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()

Organization	Posterior EMM^*	Contrast	Posterior AMCE^*	p_direction^†
Red Cross	0.349 [0.339, 0.359]	Red Cross− Amnesty International	0.123 [0.110, 0.135]	1.000
Oxfam	0.206 [0.198, 0.215]	Oxfam− Amnesty International	−0.020 [−0.031, −0.008]	1.000
Greenpeace	0.240 [0.231, 0.249]	Greenpeace− Amnesty International	0.014 [0.002, 0.026]	0.988
Amnesty International	0.226 [0.217, 0.235]	(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.

--- title: "H~1~: Branding" format: html: code-fold: true --- ```{r setup, include=FALSE} knitr::opts_chunk$set( fig.align = "center", fig.retina = 3, fig.width = 6, fig.height = (6 * 0.618), out.width = "80%", collapse = TRUE, dev = "ragg_png" ) options( digits = 3, width = 120, dplyr.summarise.inform = FALSE, knitr.kable.NA = "" ) ``` ```{r libraries-data, warning=FALSE, message=FALSE} library(tidyverse) library(targets) library(tidybayes) library(patchwork) library(scales) library(glue) library(gt) library(gtExtras) # Targets stuff 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~1~: Branding ::: {.callout-tip icon=false} ## {{< iconify fa6-solid flask-vial >}} Hypothesis 1: Branding **Donors will be more likely to donate to Oxfam and Red Cross compared to Amnesty International and Greenpeace.** *Mechanism: awareness of need and contentiousness of issue area* ::: ## Estimand $$ \begin{aligned} \theta =&\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Organization} = \text{Oxfam or Red Cross} \right) \bigr] - \\ &\ \textbf{E}\bigl[ Y_i \mid \operatorname{do}\left( \text{Organization} = \text{Amnesty International or Greenpeace} \right) \bigr] \end{aligned} $$ ```{r h1-calc-estimands} h1_mms <- preds_all %>% group_by(feat_org, .draw) %>% summarize(avg = mean(.epred)) h1_amces <- h1_mms %>% group_by(feat_org) %>% compare_levels(variable = avg, by = feat_org, comparison = "control") ``` ```{r plot-h1-mm-amce, fig.width=10, fig.height=4, out.width="100%"} #| column: body-outset-right p_h1_mms <- h1_mms %>% ggplot(aes(x = avg, y = feat_org, fill = feat_org)) + 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(1, 3, 5, 7)], guide = "none") + labs( x = "Overall average predicted probability", y = NULL, fill = NULL, title = "Estimated marginal means" ) p_h1_amces <- h1_amces %>% ungroup() %>% separate_wider_delim( feat_org, delim = " - ", names = c("feat_org", "reference_level") ) %>% add_row(avg = 0, feat_org = unique(.$reference_level)) %>% ggplot(aes(x = avg, y = feat_org, fill = feat_org)) + 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(1, 3, 5, 7)], guide = "none") + labs( x = "Percentage point change in probability of choice selection", y = NULL, fill = NULL, title = "Average marginal component effects (AMCEs)" ) p_h1_mms | p_h1_amces ``` ```{r table-h1-mm-amce} #| column: body-outset-right h1_tbl_mm <- h1_mms %>% group_by(feat_org) %>% median_qi() %>% mutate(nice = glue("{fmt_decimal(avg)}<br>{build_ci(.lower, .upper)}")) %>% arrange(desc(feat_org)) %>% select(feat_org, nice) h1_tbl_amces <- h1_amces %>% group_by(feat_org) %>% 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_org = str_replace(feat_org, " - ", "−<br>")) %>% mutate(across(starts_with("p_"), ~fmt_decimal(.))) %>% arrange(desc(feat_org)) %>% select(contrast = feat_org, amce_nice = nice, p_neq_0) bind_cols( h1_tbl_mm, add_row(h1_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_org, contrast)) %>% cols_label( feat_org = "Organization", 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() ```

H1: Branding

Estimand

H₁: Branding