Set up

Loading R library

packages = c(
  "tidyverse", "data.table", "dtplyr", "rlang", "kableExtra", "haven", "ggcorrplot", "visdat", "VIM", "corrplot", "kableExtra", "fastDummies", "ggplot2", "cobalt", "ggthemes", "nnet", "fixest", "car"
)

# Load the packages, install if necessary
new_packages = packages[!(packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages, dependencies = TRUE)
lapply(packages, require, character.only = TRUE) |> invisible()

Goal

  • This document provides important analysis of the survey results (more detail to be added)

  • The current working directory is ~FB_Charitable_Giving/Code/SurveyDataAnalysis/

  • The data used in this script was processed by the main survey cleaning script.

  • The data we are using is located at ~FB_Charitable_Giving/Data/Processed.

  • The output tables, figures, and spreadsheet generated by this script can be found at ~FB_Charitable_Giving/Data/Processed.

Summary

Data

  • The data used in this script was processed by the main survey cleaning script.

  • The data we are using is located at ~FB_Charitable_Giving/Data/Processed.

  • The output tables, figures, and spreadsheet generated by this script can be found at ~FB_Charitable_Giving/Data/Processed.

Loading the Data

data <- readRDS("Data/Processed/charitable_clean_wide.rds")

a <- as.character(nrow(data))

Sample definition

Received Charity Match

  • The sample of received charity match contains participants who received a charity match
df_charity_match <- df_wide |> filter(charity_name_coded != "")

n_charity_match <- as.character(nrow(df_charity_match))
  • Currently, there are 16487 participants who received a charity match.

Received Treatment Assignment

  • The sample of received treatment assignment contains participants who received a treatment assignment
df_arm <- df_wide |> filter(is.na(arm_coded)==FALSE)

n_arm <- as.character(nrow(df_arm))
  • Currently, there are 10715 participants who received a treatment assignment.

Structure of Charity Matching Quiz

  • For each main cause, there are sub causes participants were asked to select, which are described as follows:

  • If country_choice_num is US:

    • The sub-causes for Transform education are:
      1. help all children learn to read
      2. send a low income student to college
      3. support girls in STEM
      4. help teachers fund classroom projects
      5. provide tutoring and support to underserved children
    • The sub-causes for Eradicate hunger and homelessness are:
      1. a roof over their head
      2. hot food in their belly
      3. employment training and opportunities
    • The sub-causes for Defend the oppressed and marginalized are:
      1. immigrants and refugees fleeing violence
      2. LGBTQ+ communities
      3. racial or ethnic minorities
      4. women
      5. people with disabilities
    • The sub-causes for Rescue the environment are:
      1. innovations that further clean energy technology
      2. massive ocean clean up
      3. conserving natural spaces and habitats like old rainforests and national parks
      4. new policies to regulate carbon emissions
    • The sub-causes for Heal the sick are:
      1. people suffering from preventable diseases because of inadequate healthcare
      2. rare diseases that need more research
      3. cancer: The Big C
      4. people with heart disease
    • The sub-causes for Protect the animals are:
      1. dogs & cats humans’ best friends
      2. all the WILD furry animals like lions, tigers and bears (oh and koalas)
      3. any species on the brink of extinction
      4. animals in factory farms
      5. whales and ocean animals (Baby Beluga! Nemo!!)

  • If country_choice_num is Global:

    • The sub-causes for Eradicate poverty worldwide are:
      1. the opportunity to go to school
      2. food in their belly
      3. the skills to grow food sustainably
      4. access to clean water
    • The sub-causes for Defend the oppressed and marginalized are:
      1. refugees fleeing violence or other disasters
      2. people that are victims of human trafficking
      3. women
      4. groups targeted by their government
    • The sub-causes for Rescue the environment are:
      1. innovations that further clean energy technology
      2. massive ocean clean up
      3. conserving natural spaces and habitats like old rainforests and national parks
      4. new policies to regulate carbon emissions
    • The sub-causes for Heal the sick are:
      1. protecting against preventable childhood diseases
      2. treating the big three: HIV, AIDS, Tuburculosis and Malaria
      3. eradicating polio
      4. preventing and curing blindness
    • The sub-causes for Protect the animals are:
      1. all the WILD furry animals like lions, tigers and bears (oh and koalas)
      2. any species on the brink of extinction
      3. whales and ocean animals (Baby Beluga! Nemo!!)

Data Dictionary

  • This is work in progress. More variables will be added as we are still working on the cleaning script.
library(Hmisc)
dictionary <- label(df_wide) %>% data.frame()
dictionary <- dictionary %>% 
  mutate(variable_names = rownames(dictionary)) %>%
  select(variable_names, '.')

rownames(dictionary) <- NULL
dictionary %>% arrange(dictionary[,1]) %>% kable(digits = 3, col.names = c("Variable Name", "Description")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Variable Name Description
analytic_id Unique identifier for each participant
arm_coded Treatment assignment of the participant
charitable_affirm_end Time stamp when participants finished answering the affirmation questions
charitable_affirm_start Time stamp when participants started answering the affirmation questions
charitable_intro_end Time stamp after participant saw the statement ‘Awesome! Let’s find your charity soulmate’
charitable_intro_start_time Time stamp when participant entered the chatbot
charitable_match_end Time stamp when participants finished providing their responses for the charity matching quiz
charitable_match_start Time stamp when participants began the charity matching quiz
charitable_reveal_end Time stamp at the end of charity reveal
charitable_reveal_start Time stamp when participants started seeing the charity reveal
charitable_treatment_end Time stamp at the end of the intervention
charitable_treatment_start_time Time stamp when participants got assigned a treatment group
charity_mismatch_type_1 1 if the expected charity name is not missing but the revealed charity name is missing
charity_mismatch_type_2 1 if the expected charity name does not match the revealed charity name
charity_name_coded Charity name revealed to the participant
consent_coded_num Binary flag for whether the participant gave consent to the study
country_charity_coded Country of charity (US or Global) selected by the participant
donate_later_coded Variable to indicate the donation intention of the participant to donate later
donate_today_coded Binary variable to indicate the donation intention of the participant to donate today
donor_type_coded Donor type assigned to the participant
duration_affirm Duration of the affirmation questions in minutes
duration_intro Duration of the introduction stage in minutes
duration_match Duration of the charity matching quiz in minutes
duration_reveal Duration of the charity reveal in minutes
duration_treatment Duration of the intervention in minutes
feedback_has_link Binary variable to indicate if the feedback contains a hyperlink
feedback_match_coded Feedback to charity match
greeting_coded Binary flag for whether the participant passed the greeting stage
has_logo_coded Binary flag for whether the charity has a logo
important_forward_looking_coded Score for the importance of forward-looking giving
important_responsive_coded Score for the importance of responsive giving
important_smart_coded Score for the importance of smart giving
main_cause_coded Main cause of charity selected by the participant
manipulation_order_coded Coded version of the manipulation order variable
manipulation_value_coded Coded version of the manipulation question value variable
not_affil_coded Binary flag for whether the participant passed the not affiliated stage
pre_consent_coded Binary flag for whether the participant passed the pre-consent stage
proper_order Flag for participants who have a time sequence that is in the correct order
repeat_quiz_coded Binary flag for whether the participant repeated the charity matching quiz
share_with_friend_coded Variable to indicate if the participant would like to share the link with friends
source_coded 1 if entered via JSON AD, 0 otherwise
stay_connected_coded Variable to indicate if the participant would like to stay connected with the chatbot
sub_cause_coded Sub cause selected by the participant
text_has_link Binary variable to indicate if the response contains a hyperlink
time_since_consent Time conseted since the experiment began in days
time_since_first_start Time started the chatbot since the experiment began in days
time_since_intervention Time started the intervention since the experiment began in days
time_since_match_start Time started the charity matching quiz since the experiment began in days
time_since_reveal Time started the charity reveal since the experiment began in days
treatment_completed Binary variable to indicate if participants have completed the treatment intervention
treatment_text Free text responses from participants in the opportunity and obligation arm

Funnel Table

start_chatbot <- data %>% nrow() 
consent <- df_wide %>% nrow()
complete_quiz <- df_charity_match %>% nrow()
complete_reveal <- df_charity_match %>% filter(!is.na(arm_coded)) %>% nrow()
answer_donate <- df_charity_match %>% filter(!is.na(donate_today_coded)) %>% nrow()
donate <- df_charity_match %>% filter(donate_today_coded == 1) %>% nrow()


table <- data.frame(
  Funnel_Stage = c("Start Chatbot", "Consent", "Complete Quiz", "Complete Reveal", "Answer Donate", "Donate"),
  Count = c(start_chatbot, consent, complete_quiz, complete_reveal, answer_donate, donate),
  Per_Start_Chatbot = c(start_chatbot/start_chatbot, consent/start_chatbot, complete_quiz/start_chatbot, complete_reveal/start_chatbot, answer_donate/start_chatbot, donate/start_chatbot),
  Per_Previous_Stage = c(NA, consent/start_chatbot, complete_quiz/consent, complete_reveal/complete_quiz, answer_donate/complete_reveal, donate/answer_donate))
  
table$Per_Start_Chatbot = round(table$Per_Start_Chatbot*100, 2)
table$Per_Previous_Stage = round(table$Per_Previous_Stage*100, 2)

table %>% kable(digits = 3, col.names = c("Funnel Stage", "Count", "Percentage of Start Chatbot", "Percentage of Previous Stage")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Funnel Stage Count Percentage of Start Chatbot Percentage of Previous Stage
Start Chatbot 46418 100.00 NA
Consent 18529 39.92 39.92
Complete Quiz 16487 35.52 88.98
Complete Reveal 10715 23.08 64.99
Answer Donate 7511 16.18 70.10
Donate 991 2.13 13.19

Covariate balance table

  • In this section, we will create the covariate balance table for the set of 16487 participants received a charity match.
df_arm <- df_charity_match %>%  filter(is.na(arm_coded)==FALSE)

df_control_opportunity <- df_arm %>% filter(arm_coded == "control" | arm_coded == "opportunity")
df_control_obligation <- df_arm %>% filter(arm_coded == "control" | arm_coded == "obligation")


df_control_opportunity$opportunity <- ifelse(df_control_opportunity$arm_coded == "opportunity", 1, 0)
df_control_obligation$obligation <- ifelse(df_control_obligation$arm_coded == "obligation", 1, 0)
# Compute SMD by stratum
love.plot(opportunity ~ source_coded + has_logo_coded + donor_type_coded + main_cause_coded ,
                 data=df_control_opportunity,
          groups = "arm_coded",
          binary = "std", # display standardized mean differences
          thresholds = c(m = .1), 
          colors =c(colorblind_pal()(8)[c(2)]))+ 
  scale_x_continuous(breaks = seq(-0.1, 0.1, .1)) +
  # specify theme aesthetics
  theme_minimal() + 
  # specify text size and face
  theme(strip.text = element_text(size = 12), 
      axis.text.x = element_text(size = 8, angle = 90, vjust = 0.5, hjust=1),
      axis.text.y = element_text(size = 5), 
      axis.title = element_text(size = 12, face = "bold"), 
      legend.position = "none", 
      plot.title = element_text(size = 16, face = "bold", hjust = 0.5)) +
  # specify labels
  labs(title = "Covariate Balance Opportunity vs Control", 
       x = 'Standardized Mean Difference', 
       y = "Covariate", 
       caption  = "For participants who received a charity match") 

# Compute SMD by stratum
love.plot(obligation ~ source_coded + has_logo_coded + donor_type_coded + main_cause_coded ,
                 data=df_control_obligation,
          groups = "arm_coded",
          binary = "std", # display standardized mean differences
          thresholds = c(m = .1), 
          colors =c(colorblind_pal()(8)[c(2)]))+ 
  scale_x_continuous(breaks = seq(-0.1, 0.1, .1)) +
  # specify theme aesthetics
  theme_minimal() + 
  # specify text size and face
  theme(strip.text = element_text(size = 12), 
      axis.text.x = element_text(size = 8, angle = 90, vjust = 0.5, hjust=1),
      axis.text.y = element_text(size = 5), 
      axis.title = element_text(size = 12, face = "bold"), 
      legend.position = "none", 
      plot.title = element_text(size = 16, face = "bold", hjust = 0.5)) +
  # specify labels
  labs(title = "Covariate Balance Obligation vs Control", 
       x = 'Standardized Mean Difference', 
       y = "Covariate", 
       caption  = "For participants who received a charity match")

Charity choices

  • This section provides a descriptive analysis of charity match results

Charity Origin

  • In this section, we will create a pie chart for charity’s origin among participants who received a charity match.
df_origin <- df_charity_match %>% filter(country_charity_coded != "") %>%  count(country_charity_coded)
pie(df_origin$n, 
    labels = wrapped_labels, 
    main = "Charity Origin",
    init.angle = 90,
    radius = 1,
    label.dist = 1.2, # This helps in better placement of labels
    cex = 1.5,  # Increase this for bigger label text
    cex.main = 2)  # Increase this for a larger title font

US Charity Main Cause

  • In this section, we will create a pie chart for each main cause for participants who selected US as their country of choice.
df_US <- df_charity_match %>% filter(country_charity_coded=="US") %>% filter(main_cause_coded != "") %>%  count(main_cause_coded)

n_US <- as.character(sum(df_US$n))
  • The sample used to create this pie chart is 13596 participants who received a charity and selected US as the main origin.
pie(df_US$n, 
    labels = wrapped_labels, 
    main = "US Causes",
    init.angle = 90,
    radius = 1,
    label.dist = 1.2, # This helps in better placement of labels
    cex = 0.6,  # Increase this for bigger label text
    cex.main = 2)  # Increase this for a larger title font

Global Charity Main Cause

  • In this section, we will create a pie chart for each main cause for participants who selected Global as their country of choice.
df_global <- df_charity_match %>% filter(country_charity_coded=="Global") %>% filter(main_cause_coded != "") %>%  count(main_cause_coded)

n_global <- as.character(sum(df_global$n))
  • The sample used to create this pie chart is 2891 participants who received a charity and selected Global as the main origin.
pie(df_global$n, 
    labels = wrapped_labels, 
    main = "Global Causes",
    init.angle = 90,
    radius = 1,
    label.dist = 1.2, # This helps in better placement of labels
    cex = 0.6,  # Increase this for bigger label text
    cex.main = 2)  # Increase this for a larger title font

Analysis of Subcause

All

Top 10

df_subcauses <- df_charity_match %>% filter(sub_cause_coded != "")

df_subcauses %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_wide)) %>% arrange(desc(n)) %>% select(sub_cause_coded, n, prop) %>% head(10) %>% kable(digits = 3, col.names = c("Subcause", "Count", "Proportion")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Subcause Count Proportion
a roof over their head 1834 0.099
hot food in their belly 1740 0.094
employment training and opportunities 1656 0.089
dogs & cats humans’ best friends 1635 0.088
cancer: The Big C 947 0.051
conserving natural spaces and habitats like old rainforests and national parks 618 0.033
help all children learn to read 606 0.033
people suffering from preventable diseases because of inadequate healthcare 565 0.030
provide tutoring and support to underserved children 389 0.021
refugees fleeing violence or other disasters 367 0.020 
df_subcauses_top <- df_subcauses %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_wide)) %>% arrange(desc(n)) %>% select(sub_cause_coded, n, prop) %>% head(10)

Bottom 10

df_subcauses %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_wide)) %>% arrange(n) %>% select(sub_cause_coded, n, prop) %>% head(10) %>% kable(digits = 3, col.names = c("Subcause", "Count", "Proportion")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Subcause Count Proportion
eradicating polio 12 0.001
preventing and curing blindness 46 0.002
whales and ocean animals (Baby Beluga! Nemo!!) 78 0.004
treating the big three: HIV, AIDS, Tuburculosis and Malaria 95 0.005
people that are victims of human trafficking 109 0.006
send a low income student to college 131 0.007
support girls in STEM 134 0.007
help teachers fund classroom projects 151 0.008
groups targeted by their government 154 0.008
protecting against preventable childhood diseases 183 0.010 
df_subcauses_bottom <- df_subcauses %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_wide)) %>% arrange(n) %>% select(sub_cause_coded, n, prop) %>% head(10)

US Charity

df_charity_us <- df_charity_match %>% filter(country_charity_coded=="US")

n_us_charity <- as.character(nrow(df_charity_us))
  • The table below shows the main cause selection for the 13596 participants who selected US as their country of choice. The proportion has the denominator of n_charity_match participants who received a charity match.
df_charity_us %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_charity_match)) %>% arrange(desc(n)) %>% select(sub_cause_coded, n, prop) %>% kable(digits = 3, col.names = c("Charity Name", "Count", "Proportion")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Charity Name Count Proportion
a roof over their head 1834 0.111
hot food in their belly 1740 0.106
employment training and opportunities 1656 0.100
dogs & cats humans’ best friends 1635 0.099
cancer: The Big C 947 0.057
help all children learn to read 606 0.037
people suffering from preventable diseases because of inadequate healthcare 565 0.034
conserving natural spaces and habitats like old rainforests and national parks 428 0.026
provide tutoring and support to underserved children 389 0.024
people with disabilities 337 0.020
immigrants and refugees fleeing violence 330 0.020
rare diseases that need more research 323 0.020
racial or ethnic minorities 320 0.019
LGBTQ+ communities 288 0.017
women 262 0.016
innovations that further clean energy technology 242 0.015
people with heart disease 216 0.013
animals in factory farms 214 0.013
new policies to regulate carbon emissions 211 0.013
all the WILD furry animals like lions, tigers and bears (oh and koalas) 197 0.012
any species on the brink of extinction 194 0.012
massive ocean clean up 186 0.011
help teachers fund classroom projects 151 0.009
support girls in STEM 134 0.008
send a low income student to college 131 0.008
whales and ocean animals (Baby Beluga! Nemo!!) 60 0.004

Global Charity

df_charity_global <- df_charity_match %>% filter(country_charity_coded=="Global")

n_global_charity <- as.character(nrow(df_charity_global))
  • The table below shows main cause selection for the 2891 participants who selected Global as their country of choice. The proportion has the denominator of n_charity_match participants who received a charity match.
df_charity_global %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_charity_match)) %>% arrange(desc(n)) %>% select(sub_cause_coded, n, prop) %>% kable(digits = 3, col.names = c("Charity Name", "Count", "Proportion")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Charity Name Count Proportion
refugees fleeing violence or other disasters 367 0.022
the skills to grow food sustainably 291 0.018
food in their belly 238 0.014
the opportunity to go to school 237 0.014
access to clean water 219 0.013
conserving natural spaces and habitats like old rainforests and national parks 190 0.012
protecting against preventable childhood diseases 183 0.011
any species on the brink of extinction 169 0.010
groups targeted by their government 154 0.009
all the WILD furry animals like lions, tigers and bears (oh and koalas) 139 0.008
innovations that further clean energy technology 116 0.007
people that are victims of human trafficking 109 0.007
new policies to regulate carbon emissions 107 0.006
massive ocean clean up 102 0.006
women 99 0.006
treating the big three: HIV, AIDS, Tuburculosis and Malaria 95 0.006
preventing and curing blindness 46 0.003
whales and ocean animals (Baby Beluga! Nemo!!) 18 0.001
eradicating polio 12 0.001

Main Cause Analysis

US Origin

  • This table provides an analysis of the main cause selection for participants who selected US as their country of choice. The denominator for the proportions is the 16487 participants who received a charity match.
df_charity_us %>% group_by(main_cause_coded) %>% summarise(completed = n(), completed_completers = completed / nrow(df_charity_match), donate = sum(donate_today_coded == 1, na.rm=TRUE), proportion_donate = donate/nrow(df_charity_match)) %>% select(main_cause_coded, completed, completed_completers, proportion_donate) %>% kable(digits = 3, col.names = c("Main Cause", "Completed Charity Matching Quiz", "Completed Charity Matching Quiz / Total of Charity Matching Quiz Completers", "Donated Today / Total of Charity Matching Quiz Completers")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Main Cause Completed Charity Matching Quiz Completed Charity Matching Quiz / Total of Charity Matching Quiz Completers Donated Today / Total of Charity Matching Quiz Completers
Defend the oppressed and marginalized 1537 0.093 0.004
Eradicate hunger and homelessness 5230 0.317 0.018
Heal the sick 2051 0.124 0.005
Protect the animals 2300 0.140 0.010
Rescue the environment 1067 0.065 0.004
Transform education 1411 0.086 0.004

Global Origin

  • This table provides an analysis of the main cause selection for participants who selected Global as their country of choice. The denominator for the proportions is the 16487 participants who received a charity match.
df_charity_global %>% group_by(main_cause_coded) %>% summarise(completed = n(), completed_completers = completed / nrow(df_charity_match), donate = sum(donate_today_coded == 1, na.rm=TRUE), proportion_donate = donate/nrow(df_charity_match)) %>% select(main_cause_coded, completed, completed_completers, proportion_donate) %>% kable(digits = 3, col.names = c("Main Cause", "Completed Charity Matching Quiz", "Completed Charity Matching Quiz / Total of Charity Matching Quiz Completers", "Donated Today / Total of Charity Matching Quiz Completers")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Main Cause Completed Charity Matching Quiz Completed Charity Matching Quiz / Total of Charity Matching Quiz Completers Donated Today / Total of Charity Matching Quiz Completers
Defend the oppressed and marginalized 729 0.044 0.003
Eradicate poverty worldwide 985 0.060 0.005
Heal the sick 336 0.020 0.001
Protect the animals 326 0.020 0.001
Rescue the environment 515 0.031 0.002

Donor Type Analysis

  • This section provides an analysis of the donor type of participants.
df_donor_type <- df_charity_match %>% select(donor_type_coded) %>% filter(!is.na(donor_type_coded))

n_donor_type <- as.character(nrow(df_donor_type))
  • Currently, there are 15893 participants who were revealed a donor type.
df_donor_type %>% group_by(donor_type_coded) %>% summarise(n = n(), prop = n / nrow(df_donor_type)) %>% kable(digits = 3, col.names = c("Donor Type", "Count", "Proportion of Total Donor Type")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Donor Type Count Proportion of Total Donor Type
forward_looking 5119 0.322
responsive 4594 0.289
smart 6095 0.384
unsure 85 0.005 
df_donor_type_pie <- df_donor_type %>% count(donor_type_coded)

 #Calculate proportions
proportions <- round(df_donor_type_pie$n / sum(df_donor_type_pie$n) * 100, 1)  # percentages rounded to one decimal place

# Create labels that include count and proportion
labels <- paste(df_donor_type_pie$donor_type_coded, "\n", df_donor_type_pie$n, " (", proportions, "%)", sep="")


# Create the pie chart
pie(df_donor_type_pie$n, 
    labels = labels, 
    main = "Donor Type",
    cex = 1.5)

Looking at treatment assignment

  • In the experiment, after the charity match result is revealed, each participants were assigned to one of the following conditions: (1) control, (2) obligation, and (3) opportunity. We set the randomizer to assign 20 % of the participants to the control group, 40 % to the obligation group, and 40 % to the opportunity group.

  • Currently, there are 10715 participants who received a treatment assignment.

  • This table shows the distribution of participants across the treatment groups. We see that the actual proportion of participants of each group is very close to the target proportion.

df_arm %>% group_by(arm_coded) %>% summarise(n = n(), prop = n / nrow(df_arm)) %>% kable(digits = 3, col.names = c("Treatment Group", "Count", "Proportion of Total Treatment Group")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Treatment Group Count Proportion of Total Treatment Group
control 2161 0.202
obligation 4344 0.405
opportunity 4210 0.393

Analyzing donation intention, staying connected intention, and sharing with friends intention

  • This section provides an analysis of the donation intention, staying connected intention, and sharing with friends intention of participants who received a charity match, received treatment assignment, and answered the donation, staying connected, or sharing with friends questions.
count_answered_donate <- df_charity_match  %>% filter(!is.na(donate_today_coded)) %>% nrow()
count_stay_connected <- df_charity_match  %>% filter(!is.na(stay_connected_coded)) %>% nrow()
count_share_friend <- df_charity_match  %>% filter(!is.na(share_with_friend_coded)) %>% nrow()

mean_answered_donate <- sum(df_charity_match $donate_today_coded ==1, na.rm=TRUE)/count_answered_donate
mean_stay_connected <- sum(df_charity_match $stay_connected_coded =="Yes", na.rm=TRUE)/count_stay_connected
mean_share_friend <- sum(df_charity_match $share_with_friend_coded =="Yes", na.rm=TRUE)/count_share_friend

mean_answered_donate_q <- sum(df_charity_match $donate_today_coded ==1, na.rm=TRUE)/nrow(df_charity_match)
mean_stay_connected_q <- sum(df_charity_match $stay_connected_coded =="Yes", na.rm=TRUE)/nrow(df_charity_match)
mean_share_friend_q <- sum(df_charity_match $share_with_friend_coded =="Yes", na.rm=TRUE)/nrow(df_charity_match)

mean_answered_donate_arm <- sum(df_arm $donate_today_coded ==1, na.rm=TRUE)/nrow(df_arm)
mean_stay_connected_arm <- sum(df_arm $stay_connected_coded =="Yes", na.rm=TRUE)/nrow(df_arm)
mean_share_friend_arm <- sum(df_arm $share_with_friend_coded =="Yes", na.rm=TRUE)/nrow(df_arm)






table <- data.frame(
  variable = c("Donate \n Received Match", "Donate \n Received Arm", "Donate \n Ans Q", "Connected \n Received Match", "Connected \n Received Arm", "Connected \n Ans Q", "Share \n Received Match", "Share \n Received Arm", "Share \n Ans Q"), 
  N = c(nrow(df_charity_match),
        nrow(df_arm),
    count_answered_donate, 
        nrow(df_charity_match),
        nrow(df_arm),
        count_stay_connected, 
        nrow(df_charity_match),
        nrow(df_arm),
        count_share_friend 
        
  ), 
  mean = c(mean_answered_donate_q,
           mean_answered_donate_arm,
    mean_answered_donate, 
          mean_stay_connected_q,
           mean_stay_connected_arm,
           mean_stay_connected, 
          mean_share_friend_q,
          mean_share_friend_arm,
           mean_share_friend 
           
  ),
  se = c(sqrt(mean_answered_donate_q*(1-mean_answered_donate_q)/nrow(df_charity_match)),
         sqrt(mean_answered_donate_arm*(1-mean_answered_donate_arm)/nrow(df_arm)),
    sqrt(mean_answered_donate*(1-mean_answered_donate)/count_answered_donate), 
          sqrt(mean_stay_connected_q*(1-mean_stay_connected_q)/nrow(df_charity_match)),
         sqrt(mean_stay_connected_arm*(1-mean_stay_connected_arm)/nrow(df_arm)),
         sqrt(mean_stay_connected*(1-mean_stay_connected)/count_stay_connected), 
          sqrt(mean_share_friend_q*(1-mean_share_friend_q)/nrow(df_charity_match)),
          sqrt(mean_share_friend_arm*(1-mean_share_friend_arm)/nrow(df_arm)),
         sqrt(mean_share_friend*(1-mean_share_friend)/count_share_friend) 
         
  ))

table$variable <- factor(table$variable, levels = unique(table$variable))

table$se <- round(table$se, 3)
table$mean <- round(table$mean, 3)
ggplot(data = table, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
  geom_text(aes(label = paste("N =", N)), vjust = 0, size = 4, y= 0, color = "black") +
  geom_text(aes(label=formatC(mean,digits=3),y=mean+sign(mean)*se),vjust = -2.5,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=5) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 7), # Rotate x-axis labels
        axis.title.x = element_text(size = 5),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title ="", x = "", y = "Proportion") +
  scale_fill_manual(values = c("skyblue4", "skyblue3" , "skyblue2", "sienna4", "sienna3", "sienna2", "wheat4", "wheat3" , "wheat2")) +
  scale_y_continuous(limits = c(0, 0.45)) +
  theme(legend.position = "none")

## Save

ggsave("Data/Processed/charity_intention.png", width = 8, height = 6, dpi = 300)

Donation intention across treatment groups

df_donate <- df_charity_match %>% filter(!is.na(donate_today_coded))

n_donate_today <- as.character(nrow(df_donate))
  • In this section, we will analyze the donation intention across treatment groups. We use the sample of 10715 participants who received a treatment assignment and the sample of n_donate_today participants who answered the donate today question.
## Calculating N for each sample 

count_answered_donate_control <- df_donate  %>% 
  filter(arm_coded == "control") %>%
  nrow()

count_answered_donate_opportunity <- df_donate %>% 
  filter(arm_coded == "opportunity") %>% 
  nrow()

count_answered_donate_obligation <- df_donate %>% 
  filter(arm_coded == "obligation") %>% 
  nrow()

count_match_control <- sum(df_arm$arm_coded == "control", na.rm=TRUE)
count_match_opportunity <- sum(df_arm$arm_coded == "opportunity", na.rm=TRUE)
count_match_obligation <- sum(df_arm$arm_coded == "obligation", na.rm=TRUE)

mean_answered_donate_control <- sum(df_arm$donate_today_coded ==1 & df_arm$arm_coded == "control" , na.rm=TRUE)/count_answered_donate_control

mean_answered_donate_opportunity <- sum(df_arm$donate_today_coded ==1 & df_arm$arm_coded == "opportunity" , na.rm=TRUE)/count_answered_donate_opportunity

mean_answered_donate_obligation <- sum(df_arm$donate_today_coded ==1 & df_arm$arm_coded == "obligation" , na.rm=TRUE)/count_answered_donate_obligation

mean_donate_control_match <- sum(df_arm$donate_today_coded ==1 & df_arm$arm_coded == "control" , na.rm=TRUE)/count_match_control

mean_donate_opportunity_match <- sum(df_arm$donate_today_coded ==1 & df_arm$arm_coded == "opportunity" , na.rm=TRUE)/count_match_opportunity

mean_donate_obligation_match <- sum(df_arm$donate_today_coded ==1 & df_arm$arm_coded == "obligation" , na.rm=TRUE)/count_match_obligation

table_arm <- data.frame( 
  variable = c("Control\nReceived Arm", "Control\nAns Q",  "Opp\nReceived Arm", "Opp\nAns Q", "Obl \n Received Arm", "Obl \n Ans Q"),
  N = c(
        count_match_control,
        count_answered_donate_control,
        count_match_opportunity,
        count_answered_donate_opportunity,
        count_match_obligation,
        count_answered_donate_obligation
  ), 
  mean = c(mean_donate_control_match,
          mean_answered_donate_control,
           mean_donate_opportunity_match,
           mean_answered_donate_opportunity,
           mean_donate_obligation_match,
           mean_answered_donate_obligation
           
  ),
  se = c(sqrt(mean_donate_control_match*(1- mean_donate_control_match)/count_match_control),
    sqrt(mean_answered_donate_control*(1-mean_answered_donate_control)/count_answered_donate_control), 
          sqrt(mean_donate_opportunity_match*(1-mean_donate_opportunity_match)/count_match_opportunity),
         sqrt(mean_answered_donate_opportunity*(1-mean_answered_donate_opportunity)/count_answered_donate_opportunity), 
          sqrt(mean_donate_obligation_match*(1-mean_donate_obligation_match)/count_match_obligation),
         sqrt(mean_answered_donate_obligation*(1-mean_answered_donate_obligation)/count_answered_donate_obligation)
  ))


table_arm$variable <- factor(table_arm$variable, levels = unique(table_arm$variable))
table_arm$se <- round(table_arm$se, 3)
table_arm$mean <- round(table_arm$mean, 3)
ggplot(data = table_arm, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
   geom_text(aes(label = paste("N =", N)), vjust = 0, size = 5, y= 0, color = "black") +
  geom_text(aes(label=formatC(mean,digits=4),y=mean+sign(mean)*se),vjust = -2.5,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=mean+sign(mean)*se),vjust = -2,size=4) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 15), # Rotate x-axis labels
        axis.title.x = element_text(size = 5),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "", x = "", y = "Proportion of donating today") +
  scale_fill_manual(values = c("steelblue3", "steelblue4", "tan3", "tan4", "lightpink3", "lightpink4")) +
  scale_y_continuous(limits = c(0, 0.2)) +
  theme(legend.position = "none")

# save

ggsave("Data/Processed/charity_donation_arm.png", width = 8, height = 6, dpi = 300)

Testing the difference in donation between obligation and opportunity groups

In this section, we will test the difference in donation intention between the obligation and opportunity groups. We will use a two-sample t-test to test the difference in donation intention between the obligation and opportunity groups.

# Filter and aggregate the data
df_aggregate <- df_donate %>%
  filter(arm_coded %in% c("obligation", "opportunity")) %>%
  group_by(arm_coded) %>%
  summarise(successes = sum(donate_today_coded), trials = n())

# Run the proportion test
prop_test_donate <- prop.test(x = df_aggregate$successes, n = df_aggregate$trials)

prop_test_donate
## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  df_aggregate$successes out of df_aggregate$trials
## X-squared = 1.2611, df = 1, p-value = 0.2614
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.007932369  0.029951417
## sample estimates:
##    prop 1    prop 2 
## 0.1507047 0.1396952
  • We did not find a significant difference in donation intention between the obligation and opportunity groups.

Dropping from the chatbot

drop_off_donate_arm <- df_arm %>% filter(is.na(donate_today_coded))

n_drop_off <- as.character(nrow(drop_off_donate_arm))

In this section, we will analyze the proportion of participants who dropped off from the chatbot before answering the donate today question. Currently, we have 3205 participants who dropped off from the chatbot between after receiving a treatment assignment and before answering the donate today question.

drop_off_donate_arm %>% 
  group_by(arm_coded) %>% 
  summarise(n = n()) %>% 
  mutate(prop = n / sum(n)) %>%
  kable(digits = 3, col.names = c("Treatment Group", "Count", "Proportion of Total Drop Off")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")
Treatment Group Count Proportion of Total Drop Off
control 174 0.054
obligation 1577 0.492
opportunity 1454 0.454

We now test the difference in the proportion of participants who dropped off from the chatbot between the obligation and opportunity groups. We use a two-sample t-test to test the difference in the proportion of participants who dropped off from the chatbot between the obligation and opportunity groups.

# Filter and aggregate the data

df_aggregate_drop <- df_arm %>%
  filter(arm_coded %in% c("obligation", "opportunity")) %>%
  group_by(arm_coded) %>% 
  summarise(successes = sum(is.na(donate_today_coded)), trials = sum(is.na(donate_today_coded)) + sum(!is.na(donate_today_coded)))

# Run the proportion test

prop_test_drop <- prop.test(x = df_aggregate_drop$successes, n = df_aggregate_drop$trials)

prop_test_drop
## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  df_aggregate_drop$successes out of df_aggregate_drop$trials
## X-squared = 2.8382, df = 1, p-value = 0.09205
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.002840407  0.038162997
## sample estimates:
##    prop 1    prop 2 
## 0.3630295 0.3453682

We did not find a significant difference in the proportion of participants who dropped off from the chatbot between the obligation and opportunity groups.

Staying connected intention across treatment groups

count_stay_connected_control <- df_arm %>% filter(arm_coded == "control") %>% filter(!is.na(stay_connected_coded)) %>% nrow()
count_stay_connected_opportunity <- df_arm %>% filter(arm_coded == "opportunity") %>% filter(!is.na(stay_connected_coded)) %>% nrow()
count_stay_connected_obligation <- df_arm %>% filter(arm_coded == "obligation") %>% filter(!is.na(stay_connected_coded)) %>% nrow()

count_match_control <- sum(df_arm$arm_coded == "control", na.rm=TRUE)
count_match_opportunity <- sum(df_arm$arm_coded == "opportunity", na.rm=TRUE)
count_match_obligation <- sum(df_arm$arm_coded == "obligation", na.rm=TRUE)

mean_stay_connected_control <- sum(df_arm$stay_connected_coded =="Yes" & df_arm$arm_coded == "control", na.rm=TRUE)/count_stay_connected_control

mean_stay_connected_opportunity <- sum(df_arm$stay_connected_coded =="Yes" & df_arm$arm_coded == "opportunity", na.rm=TRUE)/count_stay_connected_opportunity

mean_stay_connected_obligation <- sum(df_arm$stay_connected_coded =="Yes" & df_arm$arm_coded == "obligation", na.rm=TRUE)/count_stay_connected_obligation

mean_stay_connected_control_match <- sum(df_arm$stay_connected_coded =="Yes" & df_arm$arm_coded == "control", na.rm=TRUE)/count_match_control

mean_stay_connected_opportunity_match <- sum(df_arm$stay_connected_coded =="Yes" & df_arm$arm_coded == "opportunity", na.rm=TRUE)/count_match_opportunity

mean_stay_connected_obligation_match <- sum(df_arm$stay_connected_coded =="Yes" & df_arm$arm_coded == "obligation", na.rm=TRUE)/count_match_obligation

table_arm_stay <- data.frame( 
  variable = c("Control\nReceived Arm", "Control\nAns Q",  "Opp\nReceived Arm", "Opp\nAns Q", "Obl \n Received Arm", "Obl \n Ans Q"),
  N = c(
        count_match_control,
        count_stay_connected_control,
        count_match_opportunity,
        count_stay_connected_opportunity,
        count_match_obligation,
        count_stay_connected_obligation
  ), 
  mean = c(mean_stay_connected_control_match,
          mean_stay_connected_control,
           mean_stay_connected_opportunity_match,
           mean_stay_connected_opportunity,
           mean_stay_connected_obligation_match,
           mean_stay_connected_obligation
           
  ),
  se = c(sqrt(mean_stay_connected_control_match*(1- mean_stay_connected_control_match)/count_match_control),
    sqrt(mean_stay_connected_control*(1-mean_stay_connected_control)/count_stay_connected_control), 
          sqrt(mean_stay_connected_opportunity_match*(1-mean_stay_connected_opportunity_match)/count_match_opportunity),
         sqrt(mean_stay_connected_opportunity*(1-mean_stay_connected_opportunity)/count_stay_connected_opportunity), 
          sqrt(mean_stay_connected_obligation_match*(1-mean_stay_connected_obligation_match)/count_match_obligation),
         sqrt(mean_stay_connected_obligation*(1-mean_stay_connected_obligation)/count_stay_connected_obligation)
  ))

table_arm_stay$variable <- factor(table_arm_stay$variable, levels = unique(table_arm_stay$variable))
table_arm_stay$se <- round(table_arm_stay$se, 3)
table_arm_stay$mean <- round(table_arm_stay$mean, 3)
ggplot(data = table_arm_stay, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
   geom_text(aes(label = paste("N =", N)), vjust = 0, size = 5, y= 0, color = "black") +
  geom_text(aes(label=formatC(mean,digits=4),y=mean+sign(mean)*se),vjust = -2.5,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=mean+sign(mean)*se),vjust = -2,size=4) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 15), # Rotate x-axis labels
        axis.title.x = element_text(size = 5),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "", x = "", y = "Proportion of staying connected") +
  scale_fill_manual(values = c("steelblue3", "steelblue4", "tan3", "tan4", "lightpink3", "lightpink4")) +
  scale_y_continuous(limits = c(0, 0.5)) +
  theme(legend.position = "none")

# Save 

ggsave("Data/Processed/charity_stay_connected_arm.png", width = 8, height = 6, dpi = 300)

Sharing with friends intention across treatment groups

count_share_friend_control <- df_arm %>% filter(arm_coded == "control") %>% filter(!is.na(share_with_friend_coded)) %>% nrow()
count_share_friend_opportunity <- df_arm %>% filter(arm_coded == "opportunity") %>% filter(!is.na(share_with_friend_coded)) %>% nrow()
count_share_friend_obligation <- df_arm %>% filter(arm_coded == "obligation") %>% filter(!is.na(share_with_friend_coded)) %>% nrow()

count_match_control <- sum(df_arm$arm_coded == "control", na.rm=TRUE)
count_match_opportunity <- sum(df_arm$arm_coded == "opportunity", na.rm=TRUE)
count_match_obligation <- sum(df_arm$arm_coded == "obligation", na.rm=TRUE)

mean_share_friend_control <- sum(df_arm$share_with_friend_coded =="Yes" & df_arm$arm_coded == "control", na.rm=TRUE)/count_share_friend_control

mean_share_friend_opportunity <- sum(df_arm$share_with_friend_coded =="Yes" & df_arm$arm_coded == "opportunity", na.rm=TRUE)/count_share_friend_opportunity

mean_share_friend_obligation <- sum(df_arm$share_with_friend_coded =="Yes" & df_arm$arm_coded == "obligation", na.rm=TRUE)/count_share_friend_obligation

mean_share_friend_control_match <- sum(df_arm$share_with_friend_coded =="Yes" & df_arm$arm_coded == "control", na.rm=TRUE)/count_match_control

mean_share_friend_opportunity_match <- sum(df_arm$share_with_friend_coded =="Yes" & df_arm$arm_coded == "opportunity", na.rm=TRUE)/count_match_opportunity

mean_share_friend_obligation_match <- sum(df_arm$share_with_friend_coded =="Yes" & df_arm$arm_coded == "obligation", na.rm=TRUE)/count_match_obligation

table_arm_share <- data.frame( 
  variable = c("Control\nReceived Arm", "Control\nAns Q",  "Opp\nReceived Arm", "Opp\nAns Q", "Obl \n Received Arm", "Obl \n Ans Q"),
  N = c(
        count_match_control,
        count_share_friend_control,
        count_match_opportunity,
        count_share_friend_opportunity,
        count_match_obligation,
        count_share_friend_obligation
  ), 
  mean = c(mean_share_friend_control_match,
          mean_share_friend_control,
           mean_share_friend_opportunity_match,
           mean_share_friend_opportunity,
           mean_share_friend_obligation_match,
           mean_share_friend_obligation
           
  ),
  se = c(sqrt(mean_share_friend_control_match*(1- mean_share_friend_control_match)/count_match_control),
    sqrt(mean_share_friend_control*(1-mean_share_friend_control)/count_share_friend_control), 
          sqrt(mean_share_friend_opportunity_match*(1-mean_share_friend_opportunity_match)/count_match_opportunity),
         sqrt(mean_share_friend_opportunity*(1-mean_share_friend_opportunity)/count_share_friend_opportunity), 
          sqrt(mean_share_friend_obligation_match*(1-mean_share_friend_obligation_match)/count_match_obligation),
         sqrt(mean_share_friend_obligation*(1-mean_share_friend_obligation)/count_share_friend_obligation)
  ))


table_arm_share$variable <- factor(table_arm_share$variable, levels = unique(table_arm_share$variable))

table_arm_share$se <- round(table_arm_share$se, 3)
table_arm_share$mean <- round(table_arm_share$mean, 3)
ggplot(data = table_arm_share, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
   geom_text(aes(label = paste("N =", N)), vjust = 0, size = 5, y= 0, color = "black") +
  geom_text(aes(label=formatC(mean,digits=4),y=mean+sign(mean)*se),vjust = -2.5,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=mean+sign(mean)*se),vjust = -2,size=4) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 15), # Rotate x-axis labels
        axis.title.x = element_text(size = 5),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "", x = "", y = "Proportion of sharing with friend") +
  scale_fill_manual(values = c("steelblue3", "steelblue4", "tan3", "tan4", "lightpink3", "lightpink4")) +
  scale_y_continuous(limits = c(0, 0.3)) +
  theme(legend.position = "none")

# Save

ggsave("Data/Processed/charity_share_friend_arm.png", width = 8, height = 6, dpi = 300)

Analysis of Manipulation Order and Average Importance Score

df_both <- df_wide %>% filter(!is.na(donate_today_coded)) %>% filter(!is.na(manipulation_value_coded)) %>% select(donate_today_coded, manipulation_value_coded, manipulation_order_coded)

count_donate_order1 <- df_both %>% filter(donate_today_coded==1) %>% filter(manipulation_order_coded == 1) %>% nrow()
count_donate_order2 <- df_both %>% filter(donate_today_coded==1) %>% filter(manipulation_order_coded == 2) %>% nrow()
count_not_donate_order1 <- df_both %>% filter(donate_today_coded==0) %>% filter(manipulation_order_coded == 1) %>% nrow()
count_not_donate_order2 <- df_both %>% filter(donate_today_coded==0) %>% filter(manipulation_order_coded == 2) %>% nrow()

df_both$manipulation_value_coded <- as.numeric(df_both$manipulation_value_coded)


mean_donate_order1 <- mean(df_both$manipulation_value_coded[df_both$donate_today_coded==1 & df_both$manipulation_order_coded == 1], na.rm=TRUE)

mean_donate_order2 <- mean(df_both$manipulation_value_coded[df_both$donate_today_coded==1 & df_both$manipulation_order_coded == 2], na.rm=TRUE)

mean_not_donate_order1 <- mean(df_both$manipulation_value_coded[df_both$donate_today_coded==0 & df_both$manipulation_order_coded == 1], na.rm=TRUE)

mean_not_donate_order2 <- mean(df_both$manipulation_value_coded[df_both$donate_today_coded==0 & df_both$manipulation_order_coded == 2], na.rm=TRUE)

se_donate_order1 <- sd(df_both$manipulation_value_coded[df_both$donate_today_coded==1 & df_both$manipulation_order_coded == 1], na.rm=TRUE)/sqrt(count_donate_order1)

se_donate_order2 <- sd(df_both$manipulation_value_coded[df_both$donate_today_coded==1 & df_both$manipulation_order_coded == 2], na.rm=TRUE)/sqrt(count_donate_order2)

se_not_donate_order1 <- sd(df_both$manipulation_value_coded[df_both$donate_today_coded==0 & df_both$manipulation_order_coded == 1], na.rm=TRUE)/sqrt(count_not_donate_order1)

se_not_donate_order2 <- sd(df_both$manipulation_value_coded[df_both$donate_today_coded==0 & df_both$manipulation_order_coded == 2], na.rm=TRUE)/sqrt(count_not_donate_order2)

table_manipulation <- data.frame(
  variable = c("Donate \n Order 1", "Donate \n Order 2", "Not Donate \n Order 1", "Not Donate \n Order 2"), 
  N = c(count_donate_order1, 
        count_donate_order2, 
        count_not_donate_order1, 
        count_not_donate_order2
  ), 
  mean = c(mean_donate_order1, 
           mean_donate_order2, 
           mean_not_donate_order1, 
           mean_not_donate_order2
  ),
  se = c(se_donate_order1, 
         se_donate_order2, 
         se_not_donate_order1, 
         se_not_donate_order2
  ))

table_manipulation$variable <- factor(table_manipulation$variable, levels = unique(table_manipulation$variable))
table_manipulation$se <- round(table_manipulation$se, 3)


ggplot(data = table_manipulation, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
   geom_text(aes(label = paste("N =", N)), vjust = 0, size = 5, y= 0, color = "black") +
  geom_text(aes(label=formatC(mean,digits=4),y=mean+sign(mean)*se),vjust = -2.5,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=5) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 15), # Rotate x-axis labels
        axis.title.x = element_text(size = 15),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "", x = "", y = "Average Importance Score") +
  scale_fill_manual(values = c("skyblue4", "skyblue", "sienna4", "sienna2")) +
  scale_y_continuous(limits = c(0, 5.5)) +
  theme(legend.position = "none")

# save

ggsave("Data/Processed/importance.png", width = 8, height = 6, dpi = 300)

In this section, we will conduct a t-test of the difference in average importance score between the participants who donated among those who had manipulation order 1 and among those who had manipulation order 2. We will also test the difference in average importance score between the participants who did not donate among those who had manipulation order 1 and among those who had manipulation order 2.

Not Donate Today

# Filter and aggregate the data

diff_mean_not_donate <- mean_not_donate_order1 - mean_not_donate_order2
se_mean_not_donate <- sqrt(se_not_donate_order1^2 + se_not_donate_order2^2)

t_test_not_donate <- diff_mean_not_donate / se_mean_not_donate

p_value_not_donate <- 2 * pt(-abs(t_test_not_donate), df = count_not_donate_order1 + count_not_donate_order2 - 2)

diff_not_donate <- as.character(round(diff_mean_not_donate, 3))
se_not_donate <- as.character(round(se_mean_not_donate, 3))
t_test_not_donate <- as.character(round(t_test_not_donate, 3))
p_value_not_donate <- as.character(round(p_value_not_donate, 3))

The difference in the avereage importance score of participants who did not donate today between those who had manipulation order 1 and those who had manipulation order 2 is 0.054 (SE = 0.02, t = 2.688, p = 0.007).

Difference in Differences

# Filter and aggregate the data

diff_mean_donate_not_donate <- mean_donate_order1 - mean_not_donate_order1 - (mean_donate_order2 - mean_not_donate_order2)

se_mean_donate_not_donate <- sqrt(se_donate_order1^2 + se_not_donate_order1^2 + se_donate_order2^2 + se_not_donate_order2^2)

t_test_donate_not_donate <- diff_mean_donate_not_donate / se_mean_donate_not_donate

p_value_donate_not_donate <- 2 * pt(-abs(t_test_donate_not_donate), df = count_donate_order1 + count_donate_order2 + count_not_donate_order1 + count_not_donate_order2 - 4)

diff_donate_not_donate <- as.character(round(diff_mean_donate_not_donate, 3))
se_donate_not_donate <- as.character(round(se_mean_donate_not_donate, 3))

t_test_donate_not_donate <- as.character(round(t_test_donate_not_donate, 3))
p_value_donate_not_donate <- as.character(round(p_value_donate_not_donate, 3))

The difference in the avereage importance score of participants who donated today and those who did not donate today between those who had manipulation order 1 and those who had manipulation order 2 is 0.024 (SE = 0.053, t = 0.455, p = 0.649).

Table for average score between manipulation order and donation intention.

This section provides a table that shows the average importance score between the manipulation order and donation intention, the standard errors, and the differences with standard errors.

table_score <- data.frame(
  variable = c("Donate Today", "Not Donate Today", "Difference in Difference" 
               ),
  Order_1 = c(mean_donate_order1, mean_not_donate_order1, NA),
  Order_2 = c(mean_donate_order2, mean_not_donate_order2, NA ),
  diff = c(diff_mean_donate, diff_mean_not_donate, diff_mean_donate_not_donate),
  p_value = c(p_value_donate, p_value_not_donate, p_value_donate_not_donate)
)

table_score %>% kable(digits = 3, col.names = c("Variable", "Order 1", "Order 2", "Mean Difference", "p-value")) |>
  kable_styling(bootstrap_options = c("striped", "hover")) |>
  kableExtra::scroll_box( height = "500px")
Variable Order 1 Order 2 Mean Difference p-value
Donate Today 4.784 4.706 0.078 0.109
Not Donate Today 4.716 4.662 0.054 0.007
Difference in Difference NA NA 0.024 0.649

Table for the differences

This section provides a table that show the difference between the donation intention and manipulation order.

table_diff <- data.frame(
  variable = c("Donate Today Order 1 - Order 2", "Not Donate Today Order 1 - Order 2", "Difference in Difference"), 
  diff = c(diff_donate, diff_not_donate, diff_donate_not_donate),
  se = c(se_donate, se_not_donate, se_donate_not_donate),
  t_test = c(t_test_donate, t_test_not_donate, t_test_donate_not_donate),
  p_value = c(p_value_donate, p_value_not_donate, p_value_donate_not_donate)
)

table_diff %>% kable(digits = 3, col.names = c("Variable", "Mean Difference", "SE", "t-test", "p-value")) |>
  kable_styling(bootstrap_options = c("striped", "hover")) |>
  kableExtra::scroll_box( height = "500px")
Variable Mean Difference SE t-test p-value
Donate Today Order 1 - Order 2 0.078 0.049 1.602 0.109
Not Donate Today Order 1 - Order 2 0.054 0.02 2.688 0.007
Difference in Difference 0.024 0.053 0.455 0.649

Analyis of Manipulation Order and Donation Intention

df_both <- df_wide %>% filter(!is.na(donate_today_coded)) %>% filter(!is.na(manipulation_value_coded)) %>% select(donate_today_coded, manipulation_value_coded, manipulation_order_coded)

count_donate_order1 <- df_both %>% filter(donate_today_coded==1) %>% filter(manipulation_order_coded == 1) %>% nrow()
count_donate_order2 <- df_both %>% filter(donate_today_coded==1) %>% filter(manipulation_order_coded == 2) %>% nrow()
count_not_donate_order1 <- df_both %>% filter(donate_today_coded==0) %>% filter(manipulation_order_coded == 1) %>% nrow()
count_not_donate_order2 <- df_both %>% filter(donate_today_coded==0) %>% filter(manipulation_order_coded == 2) %>% nrow()


mean_donate_order_1 <- count_donate_order1 / sum(df_both$manipulation_order_coded == 1, na.rm=TRUE)

mean_donate_order_2 <- count_donate_order2 / sum(df_both$manipulation_order_coded == 2, na.rm=TRUE)

mean_not_donate_order_1 <- count_not_donate_order1 / sum(df_both$manipulation_order_coded == 1, na.rm=TRUE)

mean_not_donate_order_2 <- count_not_donate_order2 / sum(df_both$manipulation_order_coded == 2, na.rm=TRUE)


se_donate_order_1 <- sqrt(mean_donate_order_1*(1- mean_donate_order_1)/sum(df_both$manipulation_order_coded == 1, na.rm=TRUE))
                          
se_donate_order_2 <- sqrt(mean_donate_order_2*(1- mean_donate_order_2)/sum(df_both$manipulation_order_coded == 2, na.rm=TRUE))
                          
se_not_donate_order_1 <- sqrt(mean_not_donate_order_1*(1- mean_not_donate_order_1)/sum(df_both$manipulation_order_coded == 1, na.rm=TRUE))
                              
se_not_donate_order_2 <- sqrt(mean_not_donate_order_2*(1- mean_not_donate_order_2)/sum(df_both$manipulation_order_coded == 2, na.rm=TRUE))
                                                                                                                                                      
table_manipulation <- data.frame(
  variable = c("Donate \n Order 1", "Donate \n Order 2", "Not Donate \n Order 1", "Not Donate \n Order 2"), 
  N = c(count_donate_order1, 
        count_donate_order2, 
        count_not_donate_order1, 
        count_not_donate_order2
  ), 
  mean = c(mean_donate_order_1, 
           mean_donate_order_2, 
           mean_not_donate_order_1, 
           mean_not_donate_order_2
  ),
  se = c(se_donate_order_1, 
         se_donate_order_2, 
         se_not_donate_order_1, 
         se_not_donate_order_2
  ))

table_manipulation$variable <- factor(table_manipulation$variable, levels = unique(table_manipulation$variable))
table_manipulation$se <- round(table_manipulation$se, 3)

ggplot(data = table_manipulation, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
   geom_text(aes(label = paste("N =", N)), vjust = 0, size = 5, y= 0, color = "black") +
  geom_text(aes(label=formatC(mean,digits=4),y=mean+sign(mean)*se),vjust = -2.5,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=mean+sign(mean)*se),vjust = -1,size=5) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 12), # Rotate x-axis labels
        axis.title.x = element_text(size = 15),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "", x = "", y = "Proportion") +
  scale_fill_manual(values = c("skyblue4", "skyblue", "sienna4", "sienna2")) +
  scale_y_continuous(limits = c(0, 1)) +
  theme(legend.position = "none")

# save

ggsave("Data/Processed/manipulation_order_donate.png", width = 8, height = 6, dpi = 300)

Looking at the difference in the donation intention between the two manipulation orders

  • In this section, we will compare the donation intention between the two manipulation orders. We will use a two-sample t-test to compare the difference in proportion of the two groups.
diff_in_mean_1 <- mean_donate_order_1 - mean_donate_order_2

diff <- as.character(diff_in_mean_1)


se_diff_1 <- sqrt((mean_donate_order_1)*(1-mean_donate_order_1)/sum(df_both$manipulation_order_coded == 1, na.rm=TRUE) + (mean_donate_order_2)*(1-mean_donate_order_2)/sum(df_both$manipulation_order_coded == 2, na.rm=TRUE))

se_diff <- as.character(se_diff_1)


t_stat_1 <- diff_in_mean_1/se_diff_1

t_stat <- as.character(round(t_stat_1,3))

p_value_1 <- 2*pt(-abs(t_stat_1), df = sum(df_both$manipulation_order_coded == 1, na.rm=TRUE) + sum(df_both$manipulation_order_coded == 2, na.rm=TRUE) - 2)

p_value <- as.character(round(p_value_1))


table_diff <- data.frame(
  variable = c("Donate Today"), 
  mean = c(diff_in_mean_1),
  se = c(se_diff_1),
  t_stat = c(t_stat_1),
  p_value = c(p_value_1)
)

table_diff$variable <- factor(table_diff$variable, levels = unique(table_diff$variable))

table_diff$mean <- round(table_diff$mean, 3)
table_diff$se <- round(table_diff$se, 3)
table_diff$t_stat <- round(table_diff$t_stat, 3)
table_diff$p_value <- round(table_diff$p_value, 3)
ggplot(data = table_diff, aes(x = variable, y = mean)) +
  geom_errorbar(aes(ymin = mean - 1.96*se, ymax = mean + 1.96*se), width = 0.5) +
  geom_text(aes(label=formatC(mean,digits=4),y=-0.025),vjust = -2,size=5)+
  geom_text(aes(label=paste("(",formatC(se,digits=3),")",sep=""),y=-0.025),vjust = -1,size=5) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 12), # Rotate x-axis labels
        axis.title.x = element_text(size = 15),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "95% Confidence Interval", x = "", y = "Manipulation 1 - Manipulation 2") +
  scale_y_continuous(limits = c(-0.1, 0.1)) +
  theme(legend.position = "none")

ggsave("Data/Processed/manipulation_order_donate_diff.png", width = 8, height = 6, dpi = 300)
  • Conducting a t-test of the proportion of donating between the two manipulation orders, we find that the difference in the proportion of donating between the two manipulation orders is statistically significant, where participants who received the manipulation in the first order were less likely to donate than those who received the manipulation in the second order (t = -4.872, p = 0).

Donor Type

  • In this section we used the sample of 10715 participants who received a treatment assignment, and look at the proportion of participants who rated the importance of being smart, responsive, and forward-looking as 1, 2, or 3.
df_donor_type <- df_arm %>% select(important_smart_coded, important_responsive_coded, important_forward_looking_coded) 

# create a data frame 

prop_forward_looking_1 <- sum(df_donor_type$important_forward_looking_coded == 1, na.rm=TRUE) / nrow(df_arm)
prop_forward_looking_2 <- sum(df_donor_type$important_forward_looking_coded == 2, na.rm=TRUE) / nrow(df_arm)
prop_forward_looking_3 <- sum(df_donor_type$important_forward_looking_coded == 3, na.rm=TRUE) / nrow(df_arm)
prop_smart_1 <- sum(df_donor_type$important_smart_coded == 1, na.rm=TRUE) / nrow(df_arm)
prop_smart_2 <- sum(df_donor_type$important_smart_coded == 2, na.rm=TRUE) / nrow(df_arm)
prop_smart_3 <- sum(df_donor_type$important_smart_coded == 3, na.rm=TRUE) / nrow(df_arm)
prop_responsive_1 <- sum(df_donor_type$important_responsive_coded == 1, na.rm=TRUE) / nrow(df_arm)
prop_responsive_2 <- sum(df_donor_type$important_responsive_coded == 2, na.rm=TRUE) / nrow(df_arm)
prop_responsive_3 <- sum(df_donor_type$important_responsive_coded == 3, na.rm=TRUE) / nrow(df_arm)

table_type <- data.frame(
  variable = c("Smart \n 1", "Smart \n 2", "Smart \n 3", "Resp \n 1", "Resp \n 2", "Resp \n 3", "Fwd Look \n 1", "Fwd Look \n 2", "Fwd Look \n 3"), 
  mean = c(
    prop_smart_1,
    prop_smart_2,
    prop_smart_3,
    prop_responsive_1,
    prop_responsive_2,
    prop_responsive_3,
     prop_forward_looking_1,
    prop_forward_looking_2,
    prop_forward_looking_3
  ), 
  N = c(
    sum(df_donor_type$important_smart_coded == 1, na.rm=TRUE),
    sum(df_donor_type$important_smart_coded == 2, na.rm=TRUE),
    sum(df_donor_type$important_smart_coded == 3, na.rm=TRUE),
    sum(df_donor_type$important_responsive_coded == 1, na.rm=TRUE),
    sum(df_donor_type$important_responsive_coded == 2, na.rm=TRUE),
    sum(df_donor_type$important_responsive_coded == 3, na.rm=TRUE),
    sum(df_donor_type$important_forward_looking_coded == 1, na.rm=TRUE),
    sum(df_donor_type$important_forward_looking_coded == 2, na.rm=TRUE),
    sum(df_donor_type$important_forward_looking_coded == 3, na.rm=TRUE)
  )
)
table_type$variable <- factor(table_type$variable, levels = unique(table_type$variable))
table_type$mean <- round(table_type$mean, 3)

Label

Note that blue is for smart, brown is for responsive, and green is for forward looking.

ggplot(data = table_type, aes(x = variable, y = mean, fill = variable)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label=formatC(mean,digits=4),y=mean),vjust = -2.5,size=5)+
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, size = 15), # Rotate x-axis labels
        axis.title.x = element_text(size = 5),
        axis.text.y =element_text(angle = 0, hjust = 0.5, size = 12),
        axis.title.y = element_text(size = 15)) +
  labs(title = "", x = "", y = "Proportion") +
  scale_x_discrete(labels = c("1", "2", "3", "1", "2", "3", "1", "2", "3")) +
  scale_fill_manual(values = c("skyblue4", "skyblue3", "skyblue2", "sienna4", "sienna3", "sienna1", "green4", "green3", "green1" )) +
  scale_y_continuous(limits = c(0, 0.9)) +
  theme(legend.position = "none")

ggsave("Data/Processed/charity_donor_type_question.png", width = 8, height = 6, dpi = 300)

Intention to donate

  • We consider two samples: (1) Answered Q: the users who answered the relevant question in the survey and (2) Started Treatment: the users who started the treatment. In the latter case, we define “Intend to Donate (All Sample)” to be equal to “FALSE” for the users who dropped out of the treatment before answering the relevant question (and similarly for “Wanted to Stay Connected (All Sample)”). We think of as worst case scenario for the treatments.

  • The table below shows the intention to donate of the set of participants who answered whether they were going to donate today.

df_wide <- df_wide %>% mutate(
  intend_to_donate = case_when(
    is.na(donate_today_coded) ~ NA,
    donate_today_coded == 1 ~ TRUE,
    donate_today_coded == 0 ~ FALSE
),
  intend_to_donate_all_sample = case_when(
    donate_today_coded == 1 ~ TRUE,
    donate_today_coded != 1 | is.na(donate_today_coded)  ~ FALSE
  )
)

df_wide <- df_wide %>% mutate(
  signed_up_follow_up = case_when(
    is.na(stay_connected_coded) ~ NA,
    stay_connected_coded == "Yes" ~ TRUE,
    stay_connected_coded == "No" ~ FALSE
  ),
  signed_up_follow_up_all_sample = case_when(
    stay_connected_coded == "Yes" ~ TRUE,
    stay_connected_coded != "Yes" | is.na(stay_connected_coded)  ~ FALSE
  )
)



intent_by_charity = feols(intend_to_donate ~ -1 + charity_name_coded, data = df_wide, vcov = "hetero") |>
    coeftable() |> 
    as.data.frame()


intent_by_charity = intent_by_charity |>
    mutate(
       charity_name_coded = str_replace(rownames(intent_by_charity), "charity_name_coded", ""),
        p_donate = paste0(round(Estimate, 2), " (", round(`Std. Error`, 4), ")")
    )

# NULL rownames 

rownames(intent_by_charity) <- NULL


intent_by_charity %>% select(charity_name_coded, p_donate) %>% kable(digits = 3, col.names = c("Charity Name", "P(Donate) and SE")) |>
    kable_styling(bootstrap_options = c("striped", "hover")) |>
    kableExtra::scroll_box( height = "500px")
Charity Name P(Donate) and SE
American Heart Association 0.12 (0.0314)
American Society for the Prevention of Cruelty to Animals 0.16 (0.0137)
Amnesty International 0.13 (0.0379)
BRAC 0.15 (0.0301)
Clean Air Task Force 0.14 (0.0275)
Concern Worldwide 0.14 (0.0519)
Dana-Farber Cancer Institute 0.09 (0.0151)
DonorsChoose 0.14 (0.0461)
Evidence Action Inc.  0.15 (0.0383)
Feeding America 0.12 (0.0113)
Freedom Network 0.17 (0.055)
Girls Inc.  0.07 (0.0398)
Global Fund for Women 0.19 (0.0595)
HealthWell Foundation 0.11 (0.0195)
HIAS 0.14 (0.0206)
Housing Matters 0.14 (0.0112)
Mercy For Animals 0.14 (0.0336)
National Women’s Law Center 0.11 (0.0278)
Natural Resources Defense Council 0.17 (0.03)
Rainforest Trust 0.17 (0.0221)
Reading is Fundamental 0.18 (0.0241)
Rocketship Education 0.07 (0.0192)
Room to Read 0.22 (0.0388)
Sightsavers Inc.  0.14 (0.0733)
Southern Poverty Law Center 0.1 (0.0243)
Special Olympics 0.08 (0.0214)
Surfrider Foundation 0.12 (0.0287)
The Leukemia & Lymphoma Society 0.07 (0.0218)
The Ocean Foundation 0.31 (0.0787)
The Rotary Foundation 0.14 (0.1326)
The Trevor Project 0.2 (0.0379)
Thurgood Marshall College Fund 0.1 (0.0454)
WaterAid 0.2 (0.0359)
Wild Earth Allies 0.09 (0.023)
Wildlife SOS 0.14 (0.0268)
World Food Program 0.16 (0.0358)
Year Up 0.08 (0.0108)

Treatment effect analysis

Intention to donate

mod1 = feols(intend_to_donate ~ i(arm_coded, ref = "control"), data = df_wide, vcov = "hetero") 
mod2 = feols(intend_to_donate ~ i(arm_coded, ref = "control") | factor(charity_name_coded) , data = df_wide, vcov = "hetero")

mod1_itt = feols(intend_to_donate_all_sample ~ i(arm_coded, ref = "control"),
    data = df_wide |> filter(!is.na(charitable_treatment_start_time)), vcov = "hetero") 
mod2_itt = feols(intend_to_donate_all_sample ~ i(arm_coded, ref = "control") | factor(charity_name_coded),
    data =  df_wide |> filter(!is.na(charitable_treatment_start_time)), vcov = "hetero")


mod3 = feols(signed_up_follow_up ~ i(arm_coded, ref = "control"), data = df_wide, vcov = "hetero")
mod4 = feols(signed_up_follow_up ~ i(arm_coded, ref = "control") | factor(charity_name_coded) , data = df_wide, vcov = "hetero")

mod3_itt = feols(signed_up_follow_up_all_sample ~ i(arm_coded, ref = "control"),
    data = df_wide |> filter(!is.na(charitable_treatment_start_time)), vcov = "hetero")

mod4_itt = feols(signed_up_follow_up_all_sample ~ i(arm_coded, ref = "control") | factor(charity_name_coded),
    data = df_wide |> filter(!is.na(charitable_treatment_start_time)), vcov = "hetero")
etable_html <- as.data.frame(a)
etable_html %>% kable(etable_html, format = "html") %>%
   kable_styling(bootstrap_options = c("striped", "hover")) |>
    kableExtra::scroll_box( height = "500px")
model 1 model 2 model 3 model 4
Dependent Var.: Intent to Donate (All Sample) Intent to Donate (All Sample) Intent to Donate Intent to Donate
Constant 0.0875*** (0.0061) 0.0951*** (0.0066)
Obligation 0.0085 (0.0075) 0.0093 (0.0075) 0.0556*** (0.0095) 0.0567*** (0.0094)
Opportunity 0.0040 (0.0075) 0.0056 (0.0075) 0.0446*** (0.0093) 0.0463*** (0.0093)
Fixed-Effects: —————————– —————————– —————— ——————
Charity Match No Yes No Yes
_______________ _____________________________ _____________________________ __________________ __________________
S.E. type Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedas.-rob. Heteroskedas.-rob.
Sample Started Treatment Started Treatment Answered Q Answered Q
Observations 10,715 10,715 7,510 7,510
R2 0.00013 0.00860 0.00446 0.01668
Within R2 – 0.00014 – 0.00472
P-val Opp=Obl 0.4708 0.5562 0.2456 0.2728 
etable_html <- as.data.frame(b)
etable_html %>% kable(etable_html, format = "html") %>%
   kable_styling(bootstrap_options = c("striped", "hover")) |>
    kableExtra::scroll_box( height = "500px")
model 1 model 2 model 3 model 4
Dependent Var.: Wanted to Stay Connected (All Sample) Wanted to Stay Connected (All Sample) Wanted to Stay Connected Wanted to Stay Connected
Constant 0.2425*** (0.0092) 0.3420*** (0.0121)
Obligation -0.0558*** (0.0109) -0.0549*** (0.0109) 0.0333* (0.0160) 0.0334* (0.0160)
Opportunity -0.0394*** (0.0111) -0.0370*** (0.0111) 0.0584*** (0.0161) 0.0603*** (0.0161)
Fixed-Effects: —————————— —————————— ———————— ————————
Charity Match No Yes No Yes
_______________ ______________________________ ______________________________ ________________________ ________________________
S.E. type Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robu. Heteroskedasticity-robu.
Sample Started Treatment Started Treatment Answered Q Answered Q
Observations 10,715 10,715 5,828 5,828
R2 0.00258 0.01120 0.00223 0.01337
Within R2 – 0.00251 – 0.00239
P-val Opp=Obl 0.0557 0.0369 0.0904 0.0701