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", "xtable"
)

# 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 summary statistic for each variables, both continuous and categorical variables, and generates distribution for time duration variables.
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/Presentation.

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/Presentation.

Loading the Data

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

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

Sample definition

df_wide <- data |> filter(consent_coded_num == 1)
n_consent <- as.character(nrow(df_wide))

The dataset that contains all participants who passed high quality data checks in the cleaning script. The data currently has 46418 observations.
In this script, we will only restrict to participants who consented to start the chatbot. The number of observation in this sample is 18529. This is the main sample we will use for the analysis.
Throughout the analysis, we will restrict participants to subgroups based on certain conditions. For example, participants who received a treatment assignment, participants who selected a charity origin, and participants who selected a main charity cause etc.

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

Pie Chart

For US

In this section, we will create pie graphs for each main cause for participants who selected US as their country of choice.

df_US <- df_wide %>% filter(country_charity_coded=="US") %>% filter(main_cause_coded != "") %>% filter(charity_name_coded != "") %>%  count(main_cause_coded)

n_US <- as.character(sum(df_US$n))

 # First, save the output as a PNG file
png("Data/Presentation/us_causes.png", width = 800, height = 600)


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

labels <- paste(df_Global$main_cause_coded, "\n", "\n", df_Global$n, " (", proportions, "%)", sep="")
wrapped_labels <- sapply(labels, function(x) paste(strwrap(x, width = 20), collapse = "\n"))

# Create and plot the pie chart
pie(df_US$n, 
    labels = wrapped_labels, 
    main = "US Causes",
    init.angle = 90,
    radius = 0.7,
    label.dist = 3,# This helps in better placement of labels
    cex = 1.2,  # Increase this for bigger label text
    cex.main = 3)  # Increase this for a larger title font

# Close the device used for saving the output
dev.off()

pie(df_US$n, 
    labels = wrapped_labels, 
    main = "US Causes",
    init.angle = 90,
    radius = 0.7,
    label.dist = 3, # This helps in better placement of labels
    cex = 1.2,  # Increase this for bigger label text
    cex.main = 3)  # Increase this for a larger title font

For Global

In this section, we will create pie graphs for each main cause for participants who selected Global as their country of choice.

df_Global <- df_wide %>% filter(country_charity_coded=="Global") %>% filter(main_cause_coded != "") %>% filter(charity_name_coded != "") %>%  count(main_cause_coded)

n_Global <- as.character(sum(df_Global$n))

 # First, save the output as a PNG file
png("Data/Presentation/global_causes.png", width = 800, height = 600)

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

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

# Wrap text for labels if they are too long
wrapped_labels <- sapply(labels, function(x) paste(strwrap(x, width = 20), collapse = "\n"))

# Create and plot the pie chart
pie(df_Global$n, 
    labels = wrapped_labels, 
    main = "International Causes",
    init.angle = 90,  # This helps in better placement of labels
    cex = 1.9,  # Increase this for bigger label text
    cex.main = 3)  # Increase this for a larger title font

# Close the device used for saving the output
dev.off()

pie(df_Global$n, 
    labels = wrapped_labels, 
    main = "International Causes",
    init.angle = 90,  # This helps in better placement of labels
    cex = 1.9,  # Increase this for bigger label text
    cex.main = 3)  # Increase this for a larger title font

Table with top 10 subcauses and bottom 10 subcauses

Top 10

df_subcauses <- df_wide %>% filter(sub_cause_coded != "") %>% filter(charity_name_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)


latex_table <- xtable(df_subcauses_top, digits = 3, caption = "Top 10 Subcauses", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:38:59 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & sub\_cause\_coded & n & prop \\ 
##   \hline
## 1 & a roof over their head & 1834 & 0.099 \\ 
##   2 & hot food in their belly & 1740 & 0.094 \\ 
##   3 & employment training and opportunities & 1656 & 0.089 \\ 
##   4 & dogs \& cats humans' best friends & 1635 & 0.088 \\ 
##   5 & cancer: The Big C &  947 & 0.051 \\ 
##   6 & conserving natural spaces and habitats like old rainforests and national parks &  618 & 0.033 \\ 
##   7 & help all children learn to read &  606 & 0.033 \\ 
##   8 & people suffering from preventable diseases because of inadequate healthcare &  565 & 0.030 \\ 
##   9 & provide tutoring and support to underserved children &  389 & 0.021 \\ 
##   10 & refugees fleeing violence or other disasters &  367 & 0.020 \\ 
##    \hline
## \end{tabular}
## \caption{Top 10 Subcauses} 
## \label{tab:top_subcauses}
## \end{table}

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)

latex_table <- xtable(df_subcauses_bottom, digits = 3, caption = "Bottom 10 Subcauses", label = "tab:bottom_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:38:59 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & sub\_cause\_coded & n & prop \\ 
##   \hline
## 1 & eradicating polio &   12 & 0.001 \\ 
##   2 & preventing and curing blindness &   46 & 0.002 \\ 
##   3 & whales and ocean animals (Baby Beluga! Nemo!!) &   78 & 0.004 \\ 
##   4 & treating the big three: HIV, AIDS, Tuburculosis and Malaria &   95 & 0.005 \\ 
##   5 & people that are victims of human trafficking &  109 & 0.006 \\ 
##   6 & send a low income student to college &  131 & 0.007 \\ 
##   7 & support girls in STEM &  134 & 0.007 \\ 
##   8 & help teachers fund classroom projects &  151 & 0.008 \\ 
##   9 & groups targeted by their government &  154 & 0.008 \\ 
##   10 & protecting against preventable childhood diseases &  183 & 0.010 \\ 
##    \hline
## \end{tabular}
## \caption{Bottom 10 Subcauses} 
## \label{tab:bottom_subcauses}
## \end{table}

US Charity

Top 5

df_charity_match <- df_wide %>% filter(charity_name_coded != "") 


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

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) %>% head(5) %>% 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

df_charity_us_top <- 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) %>% head(5)


latex_table <- xtable(df_charity_us_top  , digits = 3, caption = "Top 5 US Charities", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:38:59 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & sub\_cause\_coded & n & prop \\ 
##   \hline
## 1 & a roof over their head & 1834 & 0.111 \\ 
##   2 & hot food in their belly & 1740 & 0.106 \\ 
##   3 & employment training and opportunities & 1656 & 0.100 \\ 
##   4 & dogs \& cats humans' best friends & 1635 & 0.099 \\ 
##   5 & cancer: The Big C &  947 & 0.057 \\ 
##    \hline
## \end{tabular}
## \caption{Top 5 US Charities} 
## \label{tab:top_subcauses}
## \end{table}

Bottom 5

df_charity_us %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_charity_match)) %>% arrange(n) %>% select(sub_cause_coded, n, prop) %>% head(5) %>% 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
whales and ocean animals (Baby Beluga! Nemo!!)	60	0.004
send a low income student to college	131	0.008
support girls in STEM	134	0.008
help teachers fund classroom projects	151	0.009
massive ocean clean up	186	0.011

df_charity_us_bottom <- df_charity_us %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_charity_match)) %>% arrange(n) %>% select(sub_cause_coded, n, prop) %>% head(5)


latex_table <- xtable(df_charity_us_bottom  , digits = 3, caption = "Bottom 5 US Charities", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:38:59 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & sub\_cause\_coded & n & prop \\ 
##   \hline
## 1 & whales and ocean animals (Baby Beluga! Nemo!!) &   60 & 0.004 \\ 
##   2 & send a low income student to college &  131 & 0.008 \\ 
##   3 & support girls in STEM &  134 & 0.008 \\ 
##   4 & help teachers fund classroom projects &  151 & 0.009 \\ 
##   5 & massive ocean clean up &  186 & 0.011 \\ 
##    \hline
## \end{tabular}
## \caption{Bottom 5 US Charities} 
## \label{tab:top_subcauses}
## \end{table}

Global Charity

Top5

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

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) %>% head(5) %>% 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

df_charity_global_top <- 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) %>% head(5)


latex_table <- xtable(df_charity_global_top  , digits = 3, caption = "Top 5 Global Charities", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:00 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & sub\_cause\_coded & n & prop \\ 
##   \hline
## 1 & refugees fleeing violence or other disasters &  367 & 0.022 \\ 
##   2 & the skills to grow food sustainably &  291 & 0.018 \\ 
##   3 & food in their belly &  238 & 0.014 \\ 
##   4 & the opportunity to go to school &  237 & 0.014 \\ 
##   5 & access to clean water &  219 & 0.013 \\ 
##    \hline
## \end{tabular}
## \caption{Top 5 Global Charities} 
## \label{tab:top_subcauses}
## \end{table}

Bottom 5

df_charity_global %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_charity_match)) %>% arrange(n) %>% select(sub_cause_coded, n, prop) %>% head(5) %>% 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
eradicating polio	12	0.001
whales and ocean animals (Baby Beluga! Nemo!!)	18	0.001
preventing and curing blindness	46	0.003
treating the big three: HIV, AIDS, Tuburculosis and Malaria	95	0.006
women	99	0.006

df_charity_global_bottom <- df_charity_global %>% group_by(sub_cause_coded) %>% summarise(n = n(), prop = n()/nrow(df_charity_match)) %>% arrange(n) %>% select(sub_cause_coded, n, prop) %>% head(5)


latex_table <- xtable(df_charity_global_bottom  , digits = 3, caption = "Bottom 5 Global Charities", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:00 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & sub\_cause\_coded & n & prop \\ 
##   \hline
## 1 & eradicating polio &   12 & 0.001 \\ 
##   2 & whales and ocean animals (Baby Beluga! Nemo!!) &   18 & 0.001 \\ 
##   3 & preventing and curing blindness &   46 & 0.003 \\ 
##   4 & treating the big three: HIV, AIDS, Tuburculosis and Malaria &   95 & 0.006 \\ 
##   5 & women &   99 & 0.006 \\ 
##    \hline
## \end{tabular}
## \caption{Bottom 5 Global Charities} 
## \label{tab:top_subcauses}
## \end{table}

TABLE

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 Quiz", "completed_match", "Proportion Donate")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")

Main Cause	Completed Quiz	completed_match	Proportion Donate
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

df_us_main_cause <- 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)

latex_table <- xtable(df_us_main_cause  , digits = 3, caption = "US Main Causes", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:00 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrrr}
##   \hline
##  & main\_cause\_coded & completed & completed\_completers & proportion\_donate \\ 
##   \hline
## 1 & Defend the oppressed and marginalized & 1537 & 0.093 & 0.004 \\ 
##   2 & Eradicate hunger and homelessness & 5230 & 0.317 & 0.018 \\ 
##   3 & Heal the sick & 2051 & 0.124 & 0.005 \\ 
##   4 & Protect the animals & 2300 & 0.140 & 0.010 \\ 
##   5 & Rescue the environment & 1067 & 0.065 & 0.004 \\ 
##   6 & Transform education & 1411 & 0.086 & 0.004 \\ 
##    \hline
## \end{tabular}
## \caption{US Main Causes} 
## \label{tab:top_subcauses}
## \end{table}

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 Quiz", "completed_match", "Proportion Donate")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")

Main Cause	Completed Quiz	completed_match	Proportion Donate
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

df_global_main_cause <- 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)
latex_table <- xtable(df_global_main_cause  , digits = 3, caption = "Global Main Causes", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:00 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrrr}
##   \hline
##  & main\_cause\_coded & completed & completed\_completers & proportion\_donate \\ 
##   \hline
## 1 & Defend the oppressed and marginalized &  729 & 0.044 & 0.003 \\ 
##   2 & Eradicate poverty worldwide &  985 & 0.060 & 0.005 \\ 
##   3 & Heal the sick &  336 & 0.020 & 0.001 \\ 
##   4 & Protect the animals &  326 & 0.020 & 0.001 \\ 
##   5 & Rescue the environment &  515 & 0.031 & 0.002 \\ 
##    \hline
## \end{tabular}
## \caption{Global Main Causes} 
## \label{tab:top_subcauses}
## \end{table}

df_charity_us %>% 
  group_by(main_cause_coded, sub_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(sub_cause_coded, completed, completed_completers, proportion_donate) %>% 
  kable(digits = 3, col.names = c("Maincause", "Subcause", "Completed Quiz", "Completed/total", "Proportion Donate")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")

Maincause	Subcause	Completed Quiz	Completed/total	Proportion Donate
Defend the oppressed and marginalized	LGBTQ+ communities	288	0.017	0.001
Defend the oppressed and marginalized	immigrants and refugees fleeing violence	330	0.020	0.001
Defend the oppressed and marginalized	people with disabilities	337	0.020	0.001
Defend the oppressed and marginalized	racial or ethnic minorities	320	0.019	0.001
Defend the oppressed and marginalized	women	262	0.016	0.001
Eradicate hunger and homelessness	a roof over their head	1834	0.111	0.008
Eradicate hunger and homelessness	employment training and opportunities	1656	0.100	0.003
Eradicate hunger and homelessness	hot food in their belly	1740	0.106	0.006
Heal the sick	cancer: The Big C	947	0.057	0.002
Heal the sick	people suffering from preventable diseases because of inadequate healthcare	565	0.034	0.002
Heal the sick	people with heart disease	216	0.013	0.001
Heal the sick	rare diseases that need more research	323	0.020	0.001
Protect the animals	all the WILD furry animals like lions, tigers and bears (oh and koalas)	197	0.012	0.001
Protect the animals	animals in factory farms	214	0.013	0.001
Protect the animals	any species on the brink of extinction	194	0.012	0.001
Protect the animals	dogs & cats humans’ best friends	1635	0.099	0.007
Protect the animals	whales and ocean animals (Baby Beluga! Nemo!!)	60	0.004	0.000
Rescue the environment	conserving natural spaces and habitats like old rainforests and national parks	428	0.026	0.002
Rescue the environment	innovations that further clean energy technology	242	0.015	0.001
Rescue the environment	massive ocean clean up	186	0.011	0.001
Rescue the environment	new policies to regulate carbon emissions	211	0.013	0.001
Transform education	help all children learn to read	606	0.037	0.003
Transform education	help teachers fund classroom projects	151	0.009	0.000
Transform education	provide tutoring and support to underserved children	389	0.024	0.001
Transform education	send a low income student to college	131	0.008	0.000
Transform education	support girls in STEM	134	0.008	0.000

df_us_sub_cause <- df_charity_us  %>% group_by(main_cause_coded, sub_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(sub_cause_coded, completed, completed_completers, proportion_donate)

latex_table <- xtable(df_us_sub_cause  , digits = 3, caption = "US Main Causes", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:00 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rllrrr}
##   \hline
##  & main\_cause\_coded & sub\_cause\_coded & completed & completed\_completers & proportion\_donate \\ 
##   \hline
## 1 & Defend the oppressed and marginalized & LGBTQ+ communities &  288 & 0.017 & 0.001 \\ 
##   2 & Defend the oppressed and marginalized & immigrants and refugees fleeing violence &  330 & 0.020 & 0.001 \\ 
##   3 & Defend the oppressed and marginalized & people with disabilities &  337 & 0.020 & 0.001 \\ 
##   4 & Defend the oppressed and marginalized & racial or ethnic minorities &  320 & 0.019 & 0.001 \\ 
##   5 & Defend the oppressed and marginalized & women &  262 & 0.016 & 0.001 \\ 
##   6 & Eradicate hunger and homelessness & a roof over their head & 1834 & 0.111 & 0.008 \\ 
##   7 & Eradicate hunger and homelessness & employment training and opportunities & 1656 & 0.100 & 0.003 \\ 
##   8 & Eradicate hunger and homelessness & hot food in their belly & 1740 & 0.106 & 0.006 \\ 
##   9 & Heal the sick & cancer: The Big C &  947 & 0.057 & 0.002 \\ 
##   10 & Heal the sick & people suffering from preventable diseases because of inadequate healthcare &  565 & 0.034 & 0.002 \\ 
##   11 & Heal the sick & people with heart disease &  216 & 0.013 & 0.001 \\ 
##   12 & Heal the sick & rare diseases that need more research &  323 & 0.020 & 0.001 \\ 
##   13 & Protect the animals & all the WILD furry animals like lions, tigers and bears (oh and koalas) &  197 & 0.012 & 0.001 \\ 
##   14 & Protect the animals & animals in factory farms &  214 & 0.013 & 0.001 \\ 
##   15 & Protect the animals & any species on the brink of extinction &  194 & 0.012 & 0.001 \\ 
##   16 & Protect the animals & dogs \& cats humans' best friends & 1635 & 0.099 & 0.007 \\ 
##   17 & Protect the animals & whales and ocean animals (Baby Beluga! Nemo!!) &   60 & 0.004 & 0.000 \\ 
##   18 & Rescue the environment & conserving natural spaces and habitats like old rainforests and national parks &  428 & 0.026 & 0.002 \\ 
##   19 & Rescue the environment & innovations that further clean energy technology &  242 & 0.015 & 0.001 \\ 
##   20 & Rescue the environment & massive ocean clean up &  186 & 0.011 & 0.001 \\ 
##   21 & Rescue the environment & new policies to regulate carbon emissions &  211 & 0.013 & 0.001 \\ 
##   22 & Transform education & help all children learn to read &  606 & 0.037 & 0.003 \\ 
##   23 & Transform education & help teachers fund classroom projects &  151 & 0.009 & 0.000 \\ 
##   24 & Transform education & provide tutoring and support to underserved children &  389 & 0.024 & 0.001 \\ 
##   25 & Transform education & send a low income student to college &  131 & 0.008 & 0.000 \\ 
##   26 & Transform education & support girls in STEM &  134 & 0.008 & 0.000 \\ 
##    \hline
## \end{tabular}
## \caption{US Main Causes} 
## \label{tab:top_subcauses}
## \end{table}

df_charity_global %>% 
  group_by(main_cause_coded, sub_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(sub_cause_coded, completed, completed_completers, proportion_donate) %>% 
  kable(digits = 3, col.names = c("Maincause", "Subcause", "Completed Quiz", "Completed/total", "Proportion Donate")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")

Maincause	Subcause	Completed Quiz	Completed/total	Proportion Donate
Defend the oppressed and marginalized	groups targeted by their government	154	0.009	0.001
Defend the oppressed and marginalized	people that are victims of human trafficking	109	0.007	0.000
Defend the oppressed and marginalized	refugees fleeing violence or other disasters	367	0.022	0.002
Defend the oppressed and marginalized	women	99	0.006	0.000
Eradicate poverty worldwide	access to clean water	219	0.013	0.002
Eradicate poverty worldwide	food in their belly	238	0.014	0.001
Eradicate poverty worldwide	the opportunity to go to school	237	0.014	0.002
Eradicate poverty worldwide	the skills to grow food sustainably	291	0.018	0.001
Heal the sick	eradicating polio	12	0.001	0.000
Heal the sick	preventing and curing blindness	46	0.003	0.000
Heal the sick	protecting against preventable childhood diseases	183	0.011	0.001
Heal the sick	treating the big three: HIV, AIDS, Tuburculosis and Malaria	95	0.006	0.000
Protect the animals	all the WILD furry animals like lions, tigers and bears (oh and koalas)	139	0.008	0.000
Protect the animals	any species on the brink of extinction	169	0.010	0.001
Protect the animals	whales and ocean animals (Baby Beluga! Nemo!!)	18	0.001	0.000
Rescue the environment	conserving natural spaces and habitats like old rainforests and national parks	190	0.012	0.001
Rescue the environment	innovations that further clean energy technology	116	0.007	0.000
Rescue the environment	massive ocean clean up	102	0.006	0.000
Rescue the environment	new policies to regulate carbon emissions	107	0.006	0.000

df_global_sub_cause <- df_charity_global  %>% group_by(main_cause_coded, sub_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(sub_cause_coded, completed, completed_completers, proportion_donate)

latex_table <- xtable(df_global_sub_cause  , digits = 3, caption = "Global Main Causes", label = "tab:top_subcauses")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:01 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rllrrr}
##   \hline
##  & main\_cause\_coded & sub\_cause\_coded & completed & completed\_completers & proportion\_donate \\ 
##   \hline
## 1 & Defend the oppressed and marginalized & groups targeted by their government &  154 & 0.009 & 0.001 \\ 
##   2 & Defend the oppressed and marginalized & people that are victims of human trafficking &  109 & 0.007 & 0.000 \\ 
##   3 & Defend the oppressed and marginalized & refugees fleeing violence or other disasters &  367 & 0.022 & 0.002 \\ 
##   4 & Defend the oppressed and marginalized & women &   99 & 0.006 & 0.000 \\ 
##   5 & Eradicate poverty worldwide & access to clean water &  219 & 0.013 & 0.002 \\ 
##   6 & Eradicate poverty worldwide & food in their belly &  238 & 0.014 & 0.001 \\ 
##   7 & Eradicate poverty worldwide & the opportunity to go to school &  237 & 0.014 & 0.002 \\ 
##   8 & Eradicate poverty worldwide & the skills to grow food sustainably &  291 & 0.018 & 0.001 \\ 
##   9 & Heal the sick & eradicating polio &   12 & 0.001 & 0.000 \\ 
##   10 & Heal the sick & preventing and curing blindness &   46 & 0.003 & 0.000 \\ 
##   11 & Heal the sick & protecting against preventable childhood diseases &  183 & 0.011 & 0.001 \\ 
##   12 & Heal the sick & treating the big three: HIV, AIDS, Tuburculosis and Malaria &   95 & 0.006 & 0.000 \\ 
##   13 & Protect the animals & all the WILD furry animals like lions, tigers and bears (oh and koalas) &  139 & 0.008 & 0.000 \\ 
##   14 & Protect the animals & any species on the brink of extinction &  169 & 0.010 & 0.001 \\ 
##   15 & Protect the animals & whales and ocean animals (Baby Beluga! Nemo!!) &   18 & 0.001 & 0.000 \\ 
##   16 & Rescue the environment & conserving natural spaces and habitats like old rainforests and national parks &  190 & 0.012 & 0.001 \\ 
##   17 & Rescue the environment & innovations that further clean energy technology &  116 & 0.007 & 0.000 \\ 
##   18 & Rescue the environment & massive ocean clean up &  102 & 0.006 & 0.000 \\ 
##   19 & Rescue the environment & new policies to regulate carbon emissions &  107 & 0.006 & 0.000 \\ 
##    \hline
## \end{tabular}
## \caption{Global Main Causes} 
## \label{tab:top_subcauses}
## \end{table}

Pie chart for donor type

df_donor_type <- df_charity_match %>% select(donor_type_coded) %>% filter(!is.na(donor_type_coded))

df_donor_type %>% group_by(donor_type_coded) %>% summarise(n = n()) %>% kable(digits = 3, col.names = c("Donor Type", "Count")) |>
      kable_styling(bootstrap_options = c("striped", "hover")) |>
      kableExtra::scroll_box( height = "500px")

Donor Type	Count
forward_looking	5119
responsive	4594
smart	6095
unsure	85

df_donor_type <- df_charity_match %>% select(donor_type_coded) %>% filter(!is.na(donor_type_coded)) %>% count(donor_type_coded)

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

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


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

png("Data/Presentation/donor_type.png", width = 900, height = 700)
pie(df_donor_type$n, 
    labels = labels, 
    main = "",
    cex = 1.5)
dev.off()

## png 
##   2

Donate later choices

df_donate_later <- df_charity_match %>% filter(donate_today_coded == 0) %>% select(donate_later_coded) %>% count(donate_later_coded)

 #Calculate proportions

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

# Create labels that include count and proportion

labels <- paste(df_donate_later$donate_later_coded, "\n", df_donate_later$n, " (", proportions, "%)", sep="")

# Create the pie chart

pie(df_donate_later$n, 
    labels = labels, 
    main = "",
    cex = 1.5)

png("Data/Presentation/donate_later.png", width = 900, height = 700)

pie(df_donate_later$n, 
    labels = labels, 
    main = "",
    cex = 1.5)
dev.off()

## png 
##   2

Creating bar charts

count_answered_donate <- df_wide %>% filter(!is.na(donate_today_coded)) %>% nrow()
count_stay_connected <- df_wide %>% filter(!is.na(stay_connected_coded)) %>% nrow()
count_share_friend <- df_wide %>% filter(!is.na(share_with_friend_coded)) %>% nrow()

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

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

table <- data.frame(
  variable = c("Donate \n Received Match", "Donate \n Ans Q", "Connected \n Received Match", "Connected \n Ans Q", "Share \n Received Match", "Share \n Ans Q"), 
  N = c(nrow(df_charity_match), 
    count_answered_donate, 
        nrow(df_charity_match),
        count_stay_connected, 
         nrow(df_charity_match),
        count_share_friend 
        
  ), 
  mean = c(mean_answered_donate_q,
    mean_answered_donate, 
          mean_stay_connected_q,
           mean_stay_connected, 
          mean_share_friend_q,
           mean_share_friend 
           
  ),
  se = c(sqrt(mean_answered_donate_q*(1-mean_answered_donate_q)/nrow(df_charity_match)),
    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*(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*(1-mean_share_friend)/count_share_friend) 
         
  ))

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

table$se <- round(table$se, 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 = 5, 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 = 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_fill_manual(values = c("skyblue4", "skyblue", "sienna4", "sienna2", "wheat3", "wheat2")) +
  scale_y_continuous(limits = c(0, 0.45)) +
  theme(legend.position = "none")

## Save

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

Creating data frame for donation intention across treatment groups

## Calculating N for each sample 

count_answered_donate_control <- df_charity_match  %>% 
  filter(arm_coded == "control" & !is.na(donate_today_coded)) %>%
  nrow()

count_answered_donate_opportunity <- df_charity_match %>% 
  filter(arm_coded == "opportunity" & !is.na(donate_today_coded)) %>% 
  nrow()

count_answered_donate_obligation <- df_charity_match %>% 
  filter(arm_coded == "obligation" & !is.na(donate_today_coded)) %>% 
  nrow()

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

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

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

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

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

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

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

table_arm <- data.frame( 
  variable = c("Control\nReceived Match", "Control\nAns Q",  "Opp\nReceived Match", "Opp\nAns Q", "Obl \n Received Match", "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/Presentation/charity_donation_arm.png", width = 8, height = 6, dpi = 300)

Just show 3 bars for completers

table_arm_b <- data.frame( 
  variable = c("Control\nReceived Match", "Opp\nReceived Match",  "Obl \n Received Match"),
  N = c(
        count_match_control,
        
        count_match_opportunity,
        
        count_match_obligation
  ), 
  mean = c(mean_donate_control_match,
          
           mean_donate_opportunity_match,
           
           mean_donate_obligation_match
           
  ),
  se = c(sqrt(mean_donate_control_match*(1- mean_donate_control_match)/count_match_control),
     
          sqrt(mean_donate_opportunity_match*(1-mean_donate_opportunity_match)/count_match_opportunity),
         
          sqrt(mean_donate_obligation_match*(1-mean_donate_obligation_match)/count_match_obligation)
         
  ))


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

table_arm_b$mean <- round(table_arm_b$mean, 3)

ggplot(data = table_arm_b, 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",  "tan3",  "lightpink3")) +
  scale_y_continuous(limits = c(0, 0.2)) +
  theme(legend.position = "none")

# save

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

Creating data frame for staying connected across treatment groups

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

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

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

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

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

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

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

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

table_arm_stay <- data.frame( 
  variable = c("Control\nReceived Match", "Control\nAns Q",  "Opp\nReceived Match", "Opp\nAns Q", "Obl \n Received Match", "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)

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

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/Presentation/charity_stay_connected_arm.png", width = 8, height = 6, dpi = 300)

Creating 3 bar charts

table_arm_stay_b <- data.frame( 
  variable = c("Control\nReceived Match", "Opp\nReceived Match",  "Obl \n Received Match"),
  N = c(
        count_match_control,
        
        count_match_opportunity,
        
        count_match_obligation
  ), 
  mean = c(mean_stay_connected_control_match,
          
           mean_stay_connected_opportunity_match,
           
           mean_stay_connected_obligation_match
           
  ),
  se = c(sqrt(mean_stay_connected_control_match*(1- mean_stay_connected_control_match)/count_match_control),
     
          sqrt(mean_stay_connected_opportunity_match*(1-mean_stay_connected_opportunity_match)/count_match_opportunity),
         
          sqrt(mean_stay_connected_obligation_match*(1-mean_stay_connected_obligation_match)/count_match_obligation)
         
  ))

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

ggplot(data = table_arm_stay_b, 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",  "tan3",  "lightpink3")) +
  scale_y_continuous(limits = c(0, 0.45)) +
  theme(legend.position = "none")

# save

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

Creating data frame for sharing with friend across treatment groups

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

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

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

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

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

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

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

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

table_arm_share <- data.frame( 
  variable = c("Control\nReceived Match", "Control\nAns Q",  "Opp\nReceived Match", "Opp\nAns Q", "Obl \n Received Match", "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/Presentation/charity_share_friend_arm.png", width = 8, height = 6, dpi = 300)

Creating data frame for average manipulation value for each manipulation order

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/Presentation/importance.png", width = 8, height = 6, dpi = 300)

Creating a bar chart, each question for each donor type.

df_donor_type <- df_charity_match %>% 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_charity_match)
prop_forward_looking_2 <- sum(df_donor_type$important_forward_looking_coded == 2, na.rm=TRUE) / nrow(df_charity_match)
prop_forward_looking_3 <- sum(df_donor_type$important_forward_looking_coded == 3, na.rm=TRUE) / nrow(df_charity_match)
prop_smart_1 <- sum(df_donor_type$important_smart_coded == 1, na.rm=TRUE) / nrow(df_charity_match)
prop_smart_2 <- sum(df_donor_type$important_smart_coded == 2, na.rm=TRUE) / nrow(df_charity_match)
prop_smart_3 <- sum(df_donor_type$important_smart_coded == 3, na.rm=TRUE) / nrow(df_charity_match)
prop_responsive_1 <- sum(df_donor_type$important_responsive_coded == 1, na.rm=TRUE) / nrow(df_charity_match)
prop_responsive_2 <- sum(df_donor_type$important_responsive_coded == 2, na.rm=TRUE) / nrow(df_charity_match)
prop_responsive_3 <- sum(df_donor_type$important_responsive_coded == 3, na.rm=TRUE) / nrow(df_charity_match)

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/Presentation/charity_donor_type_question.png", width = 8, height = 6, dpi = 300)

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)

# generate LaTex 

latex_table <- xtable(table, caption = "Funnel", label = "tab:Funnel")
print(latex_table)

## % latex table generated in R 4.3.3 by xtable 1.8-4 package
## % Mon Apr 22 17:39:15 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrrr}
##   \hline
##  & Funnel\_Stage & Count & Per\_Start\_Chatbot & Per\_Previous\_Stage \\ 
##   \hline
## 1 & Start Chatbot & 46418 & 100.00 &  \\ 
##   2 & Consent & 18529 & 39.92 & 39.92 \\ 
##   3 & Complete Quiz & 16487 & 35.52 & 88.98 \\ 
##   4 & Complete Reveal & 10715 & 23.08 & 64.99 \\ 
##   5 & Answer Donate & 7511 & 16.18 & 70.10 \\ 
##   6 & Donate & 991 & 2.13 & 13.19 \\ 
##    \hline
## \end{tabular}
## \caption{Funnel} 
## \label{tab:Funnel}
## \end{table}

FB-Charitable Givings Presentation for CN Board Meeting

Kiet Le and Szymon Sacher

2024-04-22

Set up

Loading R library

Goal

Summary

Data

Loading the Data

Sample definition

Structure of Charity Matching Quiz

Data Dictionary

Pie Chart

For US

For Global

Table with top 10 subcauses and bottom 10 subcauses

Top 10

Bottom 10

US Charity

Top 5

Bottom 5

Global Charity

Top5

Bottom 5

TABLE

Pie chart for donor type

Donate later choices

Creating bar charts

Creating data frame for donation intention across treatment groups

Just show 3 bars for completers

Creating data frame for staying connected across treatment groups

Creating 3 bar charts

Creating data frame for average manipulation value for each manipulation order

Creating a bar chart, each question for each donor type.

Label

Funnel Table