Goal

The purpose of this script is to calculate and report the funnel statistics for the Facebook Charitable Giving cleaned data.

Loading the dataset

We load in the cleaned Facebook Charitable Giving data from the cleaning script.

setwd("/Users/ethanbernheim/Documents/GitHub/FB_Charitable_Giving/")
data <- readRDS("Data/Processed/charitable_clean_wide.rds")

Helper functions

Summary Table

This function creates a table displaying the frequencies of all values of a variable.

summary_table <- function(variable, title, var1, var2){
    bool_df <- as.data.frame(table(variable, useNA = 'ifany'))
    colnames(bool_df) <- c(var1, var2)
    kable(bool_df, caption = title, align = "c") |>
    kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) 
}

Setting up the data

We need to pre-process all relevant variables to be binary representations for the funnel analysis. For each variable, TRUE means the participant passed that stage of the quiz, and FALSE means they did not.

In order variables

We create two new variables, greeting_coded_funnel and pre_consent_coded_funnel, which are binary versions of greeting_coded and pre_consent_coded, respectively. Particpants passed each stage if the respective value is “Proceeded” and did not pass if the value is “Dropped off”.

data$greeting_coded_funnel <- data$greeting_coded == "Proceeded"
data$pre_consent_coded_funnel <- data$pre_consent_coded == "Proceeded"
summary_table(data$greeting_coded_funnel, "Greeting Funnel", "Greeting", "Count")
Greeting Funnel
Greeting Count
FALSE 4908
TRUE 41988
NA 36 
summary_table(data$pre_consent_coded_funnel, "Pre-consent Funnel", "Pre-consent", "Count")
Pre-consent Funnel
Pre-consent Count
FALSE 17801
TRUE 29095
NA 36

We create a new variable, consent_coded_funnel, which is a binary version of consent_coded. Participants only pass this stage if consent_coded_num is 1. This means the participants stated exactly “I consent, start now.”

data$consent_coded_funnel <- data$consent_coded_num == 1
summary_table(data$consent_coded_funnel, "Consent Funnel", "Consent", "Count")
Consent Funnel
Consent Count
FALSE 4026
TRUE 18688
NA 24218

The series of funnel variables below are set to TRUE if their respective cleaned variables have any value and FALSE if they are NA.

data$country_charity_coded_funnel <- !is.na(data$country_charity_coded)
data$main_cause_coded_funnel <- !is.na(data$main_cause_coded)
data$sub_cause_coded_funnel <- !is.na(data$sub_cause_coded)
data$charity_name_coded_funnel <- !is.na(data$charity_name_coded)
#data$treatment_FR_RF_coded_funnel <- !is.na(data$treatment_RF_coded) + !is.na(data$treatment_FR_coded)
data$manipulation_order_coded_funnel <- !is.na(data$manipulation_order_coded)
summary_table(data$country_charity_coded_funnel, "Country Charity Funnel", "Country Charity", "Count")
Country Charity Funnel
Country Charity Count
FALSE 29298
TRUE 17634 
summary_table(data$main_cause_coded_funnel, "Main Cause Funnel", "Main Cause", "Count")
Main Cause Funnel
Main Cause Count
FALSE 29806
TRUE 17126 
summary_table(data$sub_cause_coded_funnel, "Sub Cause Funnel", "Sub Cause", "Count")
Sub Cause Funnel
Sub Cause Count
FALSE 30272
TRUE 16660 
summary_table(data$charity_name_coded_funnel, "Charity Name Funnel", "Charity Name", "Count")
Charity Name Funnel
Charity Name Count
FALSE 30306
TRUE 16626 
#summary_table(data$treatment_FR_RF_coded_funnel, "Free Response Funnel", "Free Response", "Count")
summary_table(data$manipulation_order_coded_funnel, "Manipulation Order Funnel", "Manipulation Order", "Count")
Manipulation Order Funnel
Manipulation Order Count
FALSE 38628
TRUE 8304

The funnel variables below are set to TRUE if their respective cleaned variables have any value other than an empty string.

data$donor_type_coded_funnel <- !(data$donor_type_coded == "")
data$arm_coded_funnel <- !(data$arm_coded == "")
summary_table(data$donor_type_coded_funnel, "Donor Type Funnel", "Donor Type", "Count")
Donor Type Funnel
Donor Type Count
FALSE 30866
TRUE 16064
NA 2 
summary_table(data$arm_coded_funnel, "Treatment Arm Funnel", "Treatment Arm", "Count")
Treatment Arm Funnel
Treatment Arm Count
FALSE 36089
TRUE 10807
NA 36

Manipulation variables

We now create funnel variables for the manipulation variables. Since the manipulation questions are asked in one of two orders, we create two funnel variables for each manipulation value.

data$manipulation_value_coded_1_funnel <- !is.na(data$manipulation_value_coded) & data$manipulation_order_coded == 1
data$donate_today_coded_1_funnel <- !is.na(data$donate_today_coded) & data$manipulation_order_coded == 1
data$manipulation_value_coded_2_funnel <- !is.na(data$manipulation_value_coded) & data$manipulation_order_coded == 2
data$donate_today_coded_2_funnel <- !is.na(data$donate_today_coded) & data$manipulation_order_coded == 2
summary_table(data$manipulation_value_coded_1_funnel, "Manipulation Value 1 Funnel", "Manipulation Value 1", "Count")
Manipulation Value 1 Funnel
Manipulation Value 1 Count
FALSE 43133
TRUE 3799 
summary_table(data$manipulation_value_coded_2_funnel, "Manipulation Value 2 Funnel", "Manipulation Value 2", "Count")
Manipulation Value 2 Funnel
Manipulation Value 2 Count
FALSE 44271
TRUE 2661 
summary_table(data$donate_today_coded_1_funnel, "Donate Today 1 Funnel", "Donate Today 1", "Count")
Donate Today 1 Funnel
Donate Today 1 Count
FALSE 43295
TRUE 3635
NA 2 
summary_table(data$donate_today_coded_2_funnel, "Donate Today 2 Funnel", "Donate Today 2", "Count")
Donate Today 2 Funnel
Donate Today 2 Count
FALSE 42988
TRUE 3942
NA 2

Funnel statistic function

This function takes in a list of binary variables in order, representing stages of the quiz. The function calculates and returns the count of participants who passed each stage, the percentage of participants who passed each stage, and the percentage of participants who passed each stage relative to the previous stage.

count_non_na_list <- function(var_list){
  counts <- lapply(var_list, function(x) sum(x == TRUE, na.rm = TRUE))
  percent_total <- lapply(counts, function(x) x / nrow(data))
  percent_previous <- c(NA, lapply(2:length(counts), function(i) counts[[i]] / counts[[i - 1]]))
  funnel_df <- data.frame(stage = var_names)
  funnel_df$counts <- counts
  funnel_df$percent_total <- percent_total
  funnel_df$percent_previous <- percent_previous
  return(funnel_df)
}

Funnel statistics

In order, the stages of the funnel are

  • Greeting
  • Pre-consent
  • Consent
  • Country Charity
  • Main Cause
  • Sub Cause
  • Charity Name
  • Donor Type
  • Treatment Arm
  • Free Response
  • Manipulation Order

The funnel statistics are reported in the table below.

var_list <- list(data$greeting_coded_funnel, data$pre_consent_coded_funnel, data$consent_coded_funnel, data$country_charity_coded_funnel, data$main_cause_coded_funnel, 
data$sub_cause_coded_funnel, data$charity_name_coded_funnel, data$donor_type_coded_funnel, data$arm_coded_funnel, data$manipulation_order_coded_funnel)
var_names <- c("Greeting", "Pre-consent", "Consent", "Country Charity", "Main Cause", "Sub Cause", "Charity Name", "Donor Type", "Treatment Arm", "Manipulation Order")
funnel_df <- count_non_na_list(var_list)
kable(funnel_df, caption = "Basic Funnel Statistics", align = "c") |>
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Basic Funnel Statistics
stage counts percent_total percent_previous
Greeting 41988 0.8946561 NA
Pre-consent 29095 0.6199395 0.6929361
Consent 18688 0.3981931 0.6423097
Country Charity 17634 0.3757351 0.9436002
Main Cause 17126 0.3649109 0.971192
Sub Cause 16660 0.3549817 0.9727899
Charity Name 16626 0.3542572 0.9979592
Donor Type 16064 0.3422825 0.9661975
Treatment Arm 10807 0.2302693 0.6727465
Manipulation Order 8304 0.1769368 0.7683909

Manipulation Order Funnels

var_list <- list(data$manipulation_value_coded_1_funnel, data$donate_today_coded_1_funnel)
var_names <- c("Manipulation Value 1", "Donate Today 1")
funnel_df <- count_non_na_list(var_list)
kable(funnel_df, caption = "Manipulation Order 1 Funnel Statistics", align = "c") |>
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Manipulation Order 1 Funnel Statistics
stage counts percent_total percent_previous
Manipulation Value 1 3799 0.0809469 NA
Donate Today 1 3635 0.07745248 0.9568307 
var_list <- list(data$donate_today_coded_2_funnel, data$manipulation_value_coded_2_funnel)
var_names <- c("Donate Today 2", "Manipulation Value 2")
funnel_df <- count_non_na_list(var_list)
kable(funnel_df, caption = "Manipulation Order 2 Funnel Statistics", align = "c") |>
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Manipulation Order 2 Funnel Statistics
stage counts percent_total percent_previous
Donate Today 2 3942 0.08399386 NA
Manipulation Value 2 2661 0.05669905 0.6750381