# discrete colorblind palette
cb_colors <- brewer.pal(n = 8, name = "Dark2")
#show_col(cb_colors)
# custom ggplot2 theme
custom_theme <- theme_minimal() + 
      theme(strip.text = element_text(size = 16),
        axis.text=element_text(size=16),
        axis.title=element_text(size=16,face="bold"),
        panel.spacing = unit(1, "lines"), 
        legend.title = element_text(size=16,face="bold"), 
        legend.text = element_text(size=16), 
        plot.caption = element_text(size = 16),
        plot.title = element_text(size = 20, face = "bold"), 
        plot.title.position = "plot", 
        plot.subtitle = element_text(size = 16))

#source(here("analysis_scripts", "factor_cols.R"))

The purpose of the script is to run funnel statistics for the full pilot. For now, we set up the script using pilot version 8 data.

This script is step 3 of our pilot analysis process. So far we have:

  1. Cleaned the data and

  2. Generated summary statistics

1 Data Description

ad_themes <- c("Risky", "Inaccessible", "Unnecessary", "Fear")
ads <- read.csv(here("pilot8","data", "ads_data_v8.csv"))%>%
  mutate(theme = str_extract(pattern = paste(ad_themes, collapse = "|"), Ad.Set.Name))

full <- read.csv(here( "pilot8","data",  "full_df_clean.csv")) %>%
  filter(randomized == 1) %>%
  mutate(ad_country = str_extract(pattern = "SA|Ghana|Kenya|Nigeria", Ad.Set.Name), 
         ad_country = ifelse(ad_country == "SA", "South Africa", ad_country),
         South_Africa_ads = ifelse(ad_country == "South Africa", Ad.name, NA), 
         Nigeria_ads = ifelse(ad_country == "Nigeria", Ad.name, NA),
         Kenya_ads = ifelse(ad_country == "Kenya", Ad.name, NA), 
         Ghana_ads= ifelse(ad_country == "Ghana", Ad.name, NA))%>%
  mutate(Ad.name = factor(Ad.name, levels =sort(unique(ads$Ad.name))[sort(unique(ads$Ad.name)) != ""])) 


full_v7 <- read.csv(here("cleaned_data", "clean_full_v7.csv"))
ads_v7 <- read.csv(here("cleaned_data", "clean_ads_v7.csv"))

full_v56 <- read.csv(here("cleaned_data", "clean_full_v56.csv"))
ads_v56 <- read.csv(here("cleaned_data", "clean_ads_v56.csv"))


completers <- full %>%
  filter(full_complete == "complete")
noncompleters <- full%>%
  filter(full_complete != "complete")

dictionary <- read.csv(here("pilot8","data","data_dictionary_v2.csv"), na.strings = "") %>%
  remove_empty("rows")



  c(
      "Consent 1: Ask your opinion on vaccines",
      "Consent 2: Continue if you're over 18 and wish to start",
      "Vaccination status",
      "Motive to get vaccine",
      "Ability to get vaccine",
      "Get vaccine in future",
      "Preferred treatment",
      "Ethnicity",
      "Education",
      "Religion",
      "Religiosity","Location","Chat comfortability","Chat enjoyability")
##  [1] "Consent 1: Ask your opinion on vaccines"                
##  [2] "Consent 2: Continue if you're over 18 and wish to start"
##  [3] "Vaccination status"                                     
##  [4] "Motive to get vaccine"                                  
##  [5] "Ability to get vaccine"                                 
##  [6] "Get vaccine in future"                                  
##  [7] "Preferred treatment"                                    
##  [8] "Ethnicity"                                              
##  [9] "Education"                                              
## [10] "Religion"                                               
## [11] "Religiosity"                                            
## [12] "Location"                                               
## [13] "Chat comfortability"                                    
## [14] "Chat enjoyability"

The full dataset is only filtered to include observations in the month of August 2022 and removes empty rows, and has 8,742 observations. The completers data filters to observations where full_complete indicator is “complete”. There are 4,351 observations in this dataset. The noncompleters data filters to observations where full_complete indicator is “noncomplete”. There are 4,391 observations in this dataset. There is no filtering to the ads data.

The code follows much of the code in this script.

We use the following definitions in our funnel dropoff statistics:

  • Impressions (Total Count) = the total number of times our ad has been viewed
  • Clickthrough (%) = #clicks / #impressions
  • Messages Sent (%) = #conversations / #clicks
  • Consent Obtained (%) = #consents / #conversations
  • Core Survey Complete (%) = #forking section completed / #consents
  • Treatment Complete (%) = #treatment section completed / #forking section completed
  • Demo Questions Complete (%) = #demog section completed / #treatment section completed
  • Full Survey Complete (%) = #full chat completed / #demog section completed
form_percent <- function(dec){
  return(paste0(round(dec* 100, 1), "%"))
}

form_cost <- function(num){
  if (num == 0) {
    return(NA_character_)
  } else {
    return(paste0("$", round(cost / num, 3)))
  }
}

2 Funnel Dropoff Statistics, Full Data

In this section, we will show the funnel drop off statistics for the full dataset, and compare dropoff by variables. The first three columns of each table are the drop off statistics for the full data, and doesn’t change between tables. % Previous calculates the percent of users who answered the current question given that they answered the previous question. The % Total Obs columns calculates the percent of users who answer a question.

In the subsetted columns, the percent of total observations is calculated where the divisor is the number of users with that criteria - for example, for the “vax” subset, the divisor is total number of vaccinated users.

2.1 Funnel Dropoff Statistics Overall, with Previous Pilot Versions

full_impressions <- sum(ads$Impressions, na.rm = T)
full_clicks <-  sum(ads$Link.clicks, na.rm = T)
full_conversations <- sum(ads$Results, na.rm = T)

full_consents <- sum(full$consent == "yes", na.rm = T)
full_core_complete <- sum(!is.na(full$main_complete), na.rm = T)
full_treatment_complete <- sum(full$treatment_complete == "yes", na.rm = T)
full_demog_complete <- sum(!is.na(full$demog_complete), na.rm = T)
full_full_complete <- sum(full$full_complete == "complete", na.rm = T)

full_dropoff_current <- data.frame(
  metric = c("Impressions", "Link Clicks", "Messages Sent", 
             "Consent Obtained", "Core Survey Complete", "Treatment complete",
             "Demographic Questions Complete", "Full Survey Complete"), 
  
  total = scales::comma(c(full_impressions, full_clicks, full_conversations, full_consents, full_core_complete, full_treatment_complete, full_demog_complete, full_full_complete)),
  
  perc_of_prev = c("\\-", form_percent(full_clicks / full_impressions),
                   form_percent(full_conversations / full_clicks),
                   form_percent(full_consents / full_conversations),
                   form_percent(full_core_complete / full_consents),
                   form_percent(full_treatment_complete/full_core_complete),
                   form_percent(full_demog_complete / full_treatment_complete),
                   form_percent(full_full_complete / full_demog_complete)),
  
  perc_of_df = c("\\-", "\\-","\\-",
                   form_percent(full_consents / nrow(full)),
                   form_percent(full_core_complete / nrow(full)),
                   form_percent(full_treatment_complete/nrow(full)),
                   form_percent(full_demog_complete / nrow(full)), 
                 form_percent(full_full_complete/nrow(full))
                   )  
  
  
  )


# v7

full_impressions <- sum(ads_v7$Impressions, na.rm = T)
full_clicks <-  sum(ads_v7$Link.clicks, na.rm = T)
full_conversations <- sum(ads_v7$Results, na.rm = T)

full_consents <- sum(full_v7$consent == "yes", na.rm = T)
full_core_complete <- sum(!is.na(full_v7$main_complete), na.rm = T)
full_treatment_complete <- sum(full_v7$treatment_complete == "yes", na.rm = T)
full_demog_complete <- sum(!is.na(full_v7$demog_complete), na.rm = T)
full_full_complete <- sum(full_v7$full_complete == "yes", na.rm = T)

full_dropoff_v7 <- data.frame(
  metric = c("Impressions", "Link Clicks", "Messages Sent", 
             "Consent Obtained", "Core Survey Complete", "Treatment complete",
             "Demographic Questions Complete", "Full Survey Complete"), 
  
  total_v7 = scales::comma(c(full_impressions, full_clicks, full_conversations, full_consents, full_core_complete, full_treatment_complete, full_demog_complete, full_full_complete)),
  
  perc_of_prev_v7 = c("\\-", form_percent(full_clicks / full_impressions),
                   form_percent(full_conversations / full_clicks),
                   form_percent(full_consents / full_conversations),
                   form_percent(full_core_complete / full_consents),
                   form_percent(full_treatment_complete/full_core_complete),
                   form_percent(full_demog_complete / full_treatment_complete),
                   form_percent(full_full_complete / full_demog_complete)),
  
  perc_of_df_v7 = c("\\-", "\\-","\\-",
                   form_percent(full_consents / nrow(full)),
                   form_percent(full_core_complete / nrow(full)),
                   form_percent(full_treatment_complete/nrow(full)),
                   form_percent(full_demog_complete / nrow(full)), 
                 form_percent(full_full_complete/nrow(full))
                   )  
  
  
  )



# v56

full_impressions <- sum(ads_v56$Impressions, na.rm = T)
full_clicks <-  sum(ads_v56$Link.clicks, na.rm = T)
full_conversations <- sum(ads_v56$Results, na.rm = T)

full_consents <- sum(full_v56$consent == "yes", na.rm = T)
full_core_complete <- sum(!is.na(full_v56$main_complete), na.rm = T)
full_treatment_complete <- sum(full_v56$treatment_complete == "yes", na.rm = T)
full_demog_complete <- sum(!is.na(full_v56$demog_complete), na.rm = T)
full_full_complete <- sum(full_v56$full_complete == "yes", na.rm = T)

full_dropoff_v56 <- data.frame(
  metric = c("Impressions", "Link Clicks", "Messages Sent", 
             "Consent Obtained", "Core Survey Complete", "Treatment complete",
             "Demographic Questions Complete", "Full Survey Complete"), 
  
  total_v56 = scales::comma(c(full_impressions, full_clicks, full_conversations, full_consents, full_core_complete, full_treatment_complete, full_demog_complete, full_full_complete)),
  
  perc_of_prev_v56 = c("\\-", form_percent(full_clicks / full_impressions),
                   form_percent(full_conversations / full_clicks),
                   form_percent(full_consents / full_conversations),
                   form_percent(full_core_complete / full_consents),
                   form_percent(full_treatment_complete/full_core_complete),
                   form_percent(full_demog_complete / full_treatment_complete),
                   form_percent(full_full_complete / full_demog_complete)),
  
  perc_of_df_v56 = c("\\-", "\\-","\\-",
                   form_percent(full_consents / nrow(full)),
                   form_percent(full_core_complete / nrow(full)),
                   form_percent(full_treatment_complete/nrow(full)),
                   form_percent(full_demog_complete / nrow(full)), 
                 form_percent(full_full_complete/nrow(full))
                   )  
  
  
  )


full_dropoff_current %>%
  merge(full_dropoff_v7, by = "metric") %>%
  merge(full_dropoff_v56, by = "metric") %>%
  mutate(metric = factor(metric, levels = c("Impressions",
                                            "Link Clicks",
                                            "Messages Sent", 
                                            "Consent Obtained", 
                                            "Core Survey Complete", 
                                            "Treatment complete", 
                                            "Demographic Questions Complete", 
                                            "Full Survey Complete"))) %>%
  arrange(metric) %>%
 kable( caption = "", digits = 3, 
        col.names = c("Metric", rep(c("Total", "% Previous", "% Total Obs"), 3)))%>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  add_header_above(c(" " = 1, "Current Pilot" = 3, "Pilot V7" = 3, "Pilot V5/V6" = 3 )) %>%
  scroll_box(height = "100%")
Current Pilot
Pilot V7
Pilot V5/V6
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - 1,502,722 - - 807,893 - -
Link Clicks 40,462 1.6% - 12,181 0.8% - 11,344 1.4% -
Messages Sent 9,137 22.6% - 5,137 42.2% - 6,089 53.7% -
Consent Obtained 5,331 58.3% 61% 3,305 64.3% 37.8% 4,618 75.8% 52.8%
Core Survey Complete 4,864 91.2% 55.6% 2,791 84.4% 31.9% 4,046 87.6% 46.3%
Treatment complete 4,725 97.1% 54% 2,606 93.4% 29.8% 3,821 94.4% 43.7%
Demographic Questions Complete 4,351 92.1% 49.8% 2,488 95.5% 28.5% 3,671 96.1% 42%
Full Survey Complete 4,351 100% 49.8% 2,434 97.8% 27.8% 3,597 98% 41.1%
full_funnel <- function(variable){
  
  
  if(is.factor(full[[variable]])){
    var_list <- levels(full[[variable]])
  } else{
    var_list <- full %>%
      select(variable) %>%
      drop_na() %>% 
      pull() %>%
      unique()
  
  }



  tbl <- data.frame(metric = c("Consent Obtained", "Core Survey Complete", "Treatment complete",
             "Demographic Questions Complete", "Full Survey Complete"))

  for(i in var_list){
    
    df <- full[full[[variable]] == i & !is.na(full[[variable]]), ]
    
    consents <- sum(df[, "consent"] == "yes", na.rm = T)
    core_complete <- sum(!is.na(df[, "main_complete"]), na.rm = T) 
    treatment_complete <- sum(df[, "treatment_complete"] == "yes", na.rm = T)
    demog_complete <- sum(!is.na(df[, "demog_complete"]), na.rm = T)
    full_complete <- sum(df[, "full_complete"] == "complete", na.rm = T)
  
    drop_off <- data.frame(
      metric = c("Consent Obtained", "Core Survey Complete", "Treatment complete",
                 "Demographic Questions Complete", "Full Survey Complete"), 
    
    total = scales::comma(c( consents, core_complete, treatment_complete, demog_complete, full_complete)),
    
    perc_of_prev = c("\\-",
                     form_percent(core_complete / consents),
                     form_percent(treatment_complete/core_complete),
                     form_percent(demog_complete / treatment_complete),
                     form_percent(full_complete / demog_complete)),
    
    perc_of_df = c(
      form_percent(consents / nrow(df)),
      form_percent(core_complete / nrow(df)),
      form_percent(treatment_complete/nrow(df)),
      form_percent(demog_complete / nrow(df)), 
      form_percent(full_complete/nrow(df)))
    
  )
    
    
   colnames(drop_off)[colnames(drop_off) != "metric"] <- paste(colnames(drop_off)[colnames(drop_off) != "metric"], i, sep = "_")
    
    
   tbl <-  merge(tbl, drop_off, by = "metric")
    
  }
  
  
  headers <- c()
  for(i in 1:length(var_list)){
     headers <- append(headers, setNames(3, str_to_title(var_list[i])))
  }
  
  final_tbl <- merge(full_dropoff_current, tbl,by = "metric", all = T) %>%
    mutate(metric = factor(metric, levels =  c("Impressions", "Link Clicks", "Messages Sent", 
               "Consent Obtained", "Core Survey Complete", "Treatment complete",
               "Demographic Questions Complete", "Full Survey Complete"))) %>% 
    arrange(metric) %>%
    replace(is.na(.), "\\-")
  
  kable(final_tbl, caption = "", digits = 3, 
        col.names = c("Metric", rep(c("Total", "% Previous", "% Total Obs"), length(var_list)+1)))%>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  add_header_above(c(" " = 4, headers)) %>%
  scroll_box(height = "100%")

}

2.2 Vax Status

full_funnel("vax_status")
Unvax
Vax
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - -
Messages Sent 9,137 22.6% - - - - - - -
Consent Obtained 5,331 58.3% 61% 1,581 - 99.8% 3,445 - 99.6%
Core Survey Complete 4,864 91.2% 55.6% 1,504 95.1% 94.9% 3,356 97.4% 97.1%
Treatment complete 4,725 97.1% 54% 1,474 98% 93.1% 3,249 96.8% 94%
Demographic Questions Complete 4,351 92.1% 49.8% 1,354 91.9% 85.5% 2,995 92.2% 86.6%
Full Survey Complete 4,351 100% 49.8% 1,354 100% 85.5% 2,995 100% 86.6%

2.3 Motivation

full_funnel("motive_main")
Misunderstood
Risky
Benefit
Beliefs
Text Answer
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 303.0 - 99.7% 871 - 99.7% 838 - 99.8% 230.0 - 99.6% 521.0 - 92%
Core Survey Complete 4,864 91.2% 55.6% 295.0 97.4% 97% 847 97.2% 96.9% 798 95.2% 95% 222.0 96.5% 96.1% 478.0 91.7% 84.5%
Treatment complete 4,725 97.1% 54% 290.0 98.3% 95.4% 825 97.4% 94.4% 780 97.7% 92.9% 219.0 98.6% 94.8% 469.0 98.1% 82.9%
Demographic Questions Complete 4,351 92.1% 49.8% 271.0 93.4% 89.1% 773 93.7% 88.4% 718 92.1% 85.5% 202.0 92.2% 87.4% 444.0 94.7% 78.4%
Full Survey Complete 4,351 100% 49.8% 271.0 100% 89.1% 773 100% 88.4% 718 100% 85.5% 202.0 100% 87.4% 444.0 100% 78.4%

2.4 Impediment Theme

full_funnel("theme")
Risky
Unnecessary
Fear
Inaccessible
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 1,423 - 61.7% 1,006 - 66.3% 1,167 - 59.1% 1,193 - 62.3%
Core Survey Complete 4,864 91.2% 55.6% 1,287 90.4% 55.8% 920 91.5% 60.6% 1,051 90.1% 53.3% 1,081 90.6% 56.4%
Treatment complete 4,725 97.1% 54% 1,248 97% 54.1% 898 97.6% 59.2% 1,010 96.1% 51.2% 1,049 97% 54.8%
Demographic Questions Complete 4,351 92.1% 49.8% 1,144 91.7% 49.6% 837 93.2% 55.2% 913 90.4% 46.3% 949 90.5% 49.6%
Full Survey Complete 4,351 100% 49.8% 1,144 100% 49.6% 837 100% 55.2% 913 100% 46.3% 949 100% 49.6%

2.5 Ad Images by Country

full_funnel("ad_country")
Nigeria
Kenya
South Africa
Ghana
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 1,307 - 59.1% 2,312 - 69.9% 751 - 53.2% 419 - 53.4%
Core Survey Complete 4,864 91.2% 55.6% 1,173 89.7% 53% 2,184 94.5% 66.1% 631 84% 44.7% 351 83.8% 44.8%
Treatment complete 4,725 97.1% 54% 1,137 96.9% 51.4% 2,126 97.3% 64.3% 604 95.7% 42.8% 338 96.3% 43.1%
Demographic Questions Complete 4,351 92.1% 49.8% 1,016 89.4% 45.9% 1,994 93.8% 60.3% 545 90.2% 38.6% 288 85.2% 36.7%
Full Survey Complete 4,351 100% 49.8% 1,016 100% 45.9% 1,994 100% 60.3% 545 100% 38.6% 288 100% 36.7%

2.5.1 Ghana

full_funnel("Ghana_ads")
Ghana - Unnecessary - Image3 - New
Ghana - Inaccessible - Image7 - New
Ghana - Fear - Image2 - New
Ghana - Risk - Image1
Ghana - Fear - Image8 - New
Ghana - Risk - Image2
Ghana - Risk - Image6 - New
Ghana - Inaccessible - Image8 - New
Ghana - Inaccessible - Image1
Ghana - Unnecessary - Image1 - New
Ghana - Inaccessible - Image2
Ghana - Risk - Image4 - New
Ghana - Inaccessible - Image3
Ghana - Unnecessary - Image3
Ghana - Fear - Image1 - New
Ghana - Risk - Image3
Ghana - Unnecessary - Image1
Ghana - Unnecessary - Image2
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 35.0 - 70% 14.0 - 56% 57.0 - 55.9% 21.0 - 47.7% 61.0 - 58.1% 13.0 - 48.1% 50.0 - 43.9% 29.0 - 53.7% 25.0 - 62.5% 2 - 33.3% 10.0 - 62.5% 6 - 46.2% 22.0 - 59.5% 20.0 - 69% 9.0 - 52.9% 18.0 - 48.6% 18.0 - 40.9% 9.0 - 37.5%
Core Survey Complete 4,864 91.2% 55.6% 31.0 88.6% 62% 12.0 85.7% 48% 47.0 82.5% 46.1% 15.0 71.4% 34.1% 56.0 91.8% 53.3% 13.0 100% 48.1% 44.0 88% 38.6% 25.0 86.2% 46.3% 20.0 80% 50% 2 100% 33.3% 8.0 80% 50% 6 100% 46.2% 17.0 77.3% 45.9% 15.0 75% 51.7% 7.0 77.8% 41.2% 13.0 72.2% 35.1% 14.0 77.8% 31.8% 6.0 66.7% 25%
Treatment complete 4,725 97.1% 54% 31.0 100% 62% 11.0 91.7% 44% 47.0 100% 46.1% 15.0 100% 34.1% 54.0 96.4% 51.4% 13.0 100% 48.1% 43.0 97.7% 37.7% 23.0 92% 42.6% 19.0 95% 47.5% 2 100% 33.3% 8.0 100% 50% 6 100% 46.2% 16.0 94.1% 43.2% 12.0 80% 41.4% 7.0 100% 41.2% 13.0 100% 35.1% 12.0 85.7% 27.3% 6.0 100% 25%
Demographic Questions Complete 4,351 92.1% 49.8% 28.0 90.3% 56% 9.0 81.8% 36% 43.0 91.5% 42.2% 14.0 93.3% 31.8% 43.0 79.6% 41% 11.0 84.6% 40.7% 36.0 83.7% 31.6% 18.0 78.3% 33.3% 16.0 84.2% 40% 2 100% 33.3% 8.0 100% 50% 6 100% 46.2% 13.0 81.2% 35.1% 10.0 83.3% 34.5% 7.0 100% 41.2% 10.0 76.9% 27% 10.0 83.3% 22.7% 4.0 66.7% 16.7%
Full Survey Complete 4,351 100% 49.8% 28.0 100% 56% 9.0 100% 36% 43.0 100% 42.2% 14.0 100% 31.8% 43.0 100% 41% 11.0 100% 40.7% 36.0 100% 31.6% 18.0 100% 33.3% 16.0 100% 40% 2 100% 33.3% 8.0 100% 50% 6 100% 46.2% 13.0 100% 35.1% 10.0 100% 34.5% 7.0 100% 41.2% 10.0 100% 27% 10.0 100% 22.7% 4.0 100% 16.7%

2.5.2 Kenya

full_funnel("Kenya_ads")
Kenya - Unnecessary - Image3 - New
Kenya - Inaccessible - Image9 - New
Kenya - Fear - Image8 - New
Kenya - Risk - Image2
Kenya - Unnecessary - Image1
Kenya - Risk - Image6 - New
Kenya - Inaccessible - Image1
Kenya - Risk - Image1
Kenya - Risk - Image5 - New
Kenya - Risk - Image4 - New
Kenya - Fear - Image1 - New
Kenya - Risk - Image3
Kenya - Unnecessary - Image3
Kenya - Unnecessary - Image2
Kenya - Inaccessible - Image8 - New
Kenya - Inaccessible - Image2
Kenya - Inaccessible - Image7 - New
Kenya - Unnecessary - Image1 - New
Kenya - Inaccessible - Image3
Kenya - Fear - Image2 - New
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 285.0 - 73.1% 120.0 - 63.8% 327 - 63.4% 59.0 - 75.6% 125.0 - 78.1% 246.0 - 57.5% 212.0 - 86.9% 160.0 - 80.4% 81.0 - 73.6% 22.0 - 59.5% 165.0 - 76% 147.0 - 86% 69.0 - 80.2% 29.0 - 82.9% 110.0 - 52.4% 15.0 - 62.5% 53.0 - 56.4% 27.0 - 69.2% 41.0 - 78.8% 19.0 - 67.9%
Core Survey Complete 4,864 91.2% 55.6% 279.0 97.9% 71.5% 108.0 90% 57.4% 308 94.2% 59.7% 54.0 91.5% 69.2% 120.0 96% 75% 217.0 88.2% 50.7% 200.0 94.3% 82% 153.0 95.6% 76.9% 81.0 100% 73.6% 22.0 100% 59.5% 155.0 93.9% 71.4% 140.0 95.2% 81.9% 65.0 94.2% 75.6% 25.0 86.2% 71.4% 108.0 98.2% 51.4% 12.0 80% 50% 52.0 98.1% 55.3% 26.0 96.3% 66.7% 40.0 97.6% 76.9% 19.0 100% 67.9%
Treatment complete 4,725 97.1% 54% 277.0 99.3% 71% 106.0 98.1% 56.4% 298 96.8% 57.8% 53.0 98.1% 67.9% 116.0 96.7% 72.5% 208.0 95.9% 48.6% 195.0 97.5% 79.9% 151.0 98.7% 75.9% 80.0 98.8% 72.7% 22.0 100% 59.5% 150.0 96.8% 69.1% 137.0 97.9% 80.1% 61.0 93.8% 70.9% 25.0 100% 71.4% 104.0 96.3% 49.5% 10.0 83.3% 41.7% 51.0 98.1% 54.3% 25.0 96.2% 64.1% 39.0 97.5% 75% 18.0 94.7% 64.3%
Demographic Questions Complete 4,351 92.1% 49.8% 265.0 95.7% 67.9% 100.0 94.3% 53.2% 276 92.6% 53.5% 52.0 98.1% 66.7% 111.0 95.7% 69.4% 188.0 90.4% 43.9% 182.0 93.3% 74.6% 141.0 93.4% 70.9% 78.0 97.5% 70.9% 20.0 90.9% 54.1% 140.0 93.3% 64.5% 131.0 95.6% 76.6% 57.0 93.4% 66.3% 22.0 88% 62.9% 101.0 97.1% 48.1% 7.0 70% 29.2% 49.0 96.1% 52.1% 23.0 92% 59% 34.0 87.2% 65.4% 17.0 94.4% 60.7%
Full Survey Complete 4,351 100% 49.8% 265.0 100% 67.9% 100.0 100% 53.2% 276 100% 53.5% 52.0 100% 66.7% 111.0 100% 69.4% 188.0 100% 43.9% 182.0 100% 74.6% 141.0 100% 70.9% 78.0 100% 70.9% 20.0 100% 54.1% 140.0 100% 64.5% 131.0 100% 76.6% 57.0 100% 66.3% 22.0 100% 62.9% 101.0 100% 48.1% 7.0 100% 29.2% 49.0 100% 52.1% 23.0 100% 59% 34.0 100% 65.4% 17.0 100% 60.7%

2.5.3 Nigeria

full_funnel("Nigeria_ads")
Nigeria - Risk - Image6 - New
Nigeria - Fear - Image8 - New
Nigeria - Risk - Image5 - New
Nigeria - Fear - Image1 - New
Nigeria - Unnecessary - Image3 - New
Nigeria - Unnecessary - Image3
Nigeria - Inaccessible - Image9 - New
Nigeria - Inaccessible - Image2
Nigeria - Inaccessible - Image8 - New
Nigeria - Risk - Image2
Nigeria - Risk - Image3
Nigeria - Risk - Image1
Nigeria - Unnecessary - Image1
Nigeria - Unnecessary - Image1 - New
Nigeria - Inaccessible - Image1
Nigeria - Inaccessible - Image3
Nigeria - Risk - Image4 - New
Nigeria - Inaccessible - Image7 - New
Nigeria - Unnecessary - Image2
Nigeria - Fear - Image2 - New
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 117.0 - 51.3% 162.0 - 51.8% 37.0 - 66.1% 121.0 - 59.6% 117.0 - 66.9% 42.0 - 59.2% 131.0 - 57.2% 44.0 - 65.7% 36.0 - 64.3% 37.0 - 78.7% 43.0 - 55.8% 118.0 - 61.5% 70.0 - 66.7% 9.0 - 47.4% 106.0 - 60.6% 46.0 - 66.7% 16 - 69.6% 14.0 - 46.7% 23.0 - 56.1% 18.0 - 50%
Core Survey Complete 4,864 91.2% 55.6% 105.0 89.7% 46.1% 147.0 90.7% 47% 38.0 102.7% 67.9% 103.0 85.1% 50.7% 113.0 96.6% 64.6% 34.0 81% 47.9% 124.0 94.7% 54.1% 40.0 90.9% 59.7% 32.0 88.9% 57.1% 35.0 94.6% 74.5% 38.0 88.4% 49.4% 105.0 89% 54.7% 58.0 82.9% 55.2% 8.0 88.9% 42.1% 92.0 86.8% 52.6% 40.0 87% 58% 16 100% 69.6% 12.0 85.7% 40% 17.0 73.9% 41.5% 16.0 88.9% 44.4%
Treatment complete 4,725 97.1% 54% 100.0 95.2% 43.9% 142.0 96.6% 45.4% 38.0 100% 67.9% 101.0 98.1% 49.8% 112.0 99.1% 64% 33.0 97.1% 46.5% 123.0 99.2% 53.7% 39.0 97.5% 58.2% 32.0 100% 57.1% 33.0 94.3% 70.2% 36.0 94.7% 46.8% 102.0 97.1% 53.1% 56.0 96.6% 53.3% 8.0 100% 42.1% 85.0 92.4% 48.6% 40.0 100% 58% 16 100% 69.6% 12.0 100% 40% 16.0 94.1% 39% 13.0 81.2% 36.1%
Demographic Questions Complete 4,351 92.1% 49.8% 96.0 96% 42.1% 128.0 90.1% 40.9% 38.0 100% 67.9% 88.0 87.1% 43.3% 110.0 98.2% 62.9% 26.0 78.8% 36.6% 112.0 91.1% 48.9% 33.0 84.6% 49.3% 25.0 78.1% 44.6% 30.0 90.9% 63.8% 28.0 77.8% 36.4% 83.0 81.4% 43.2% 48.0 85.7% 45.7% 8.0 100% 42.1% 73.0 85.9% 41.7% 38.0 95% 55.1% 16 100% 69.6% 11.0 91.7% 36.7% 14.0 87.5% 34.1% 11.0 84.6% 30.6%
Full Survey Complete 4,351 100% 49.8% 96.0 100% 42.1% 128.0 100% 40.9% 38.0 100% 67.9% 88.0 100% 43.3% 110.0 100% 62.9% 26.0 100% 36.6% 112.0 100% 48.9% 33.0 100% 49.3% 25.0 100% 44.6% 30.0 100% 63.8% 28.0 100% 36.4% 83.0 100% 43.2% 48.0 100% 45.7% 8.0 100% 42.1% 73.0 100% 41.7% 38.0 100% 55.1% 16 100% 69.6% 11.0 100% 36.7% 14.0 100% 34.1% 11.0 100% 30.6%

2.5.4 South Africa

full_funnel("South_Africa_ads")
Sa - Fear - Image2 - Lookalike - New
Sa - Risk - Image6 - New
Sa - Fear - Image2 - New
Sa - Risk - Image6 - Lookalike - New
Sa - Inaccessible - Image1
Sa - Inaccessible - Image8 - Lookalike - New
Sa - Unnecessary - Image3 - New
Sa - Inaccessible - Image3
Sa - Fear - Image8 - Lookalike - New
Sa - Unnecessary - Image2
Sa - Risk - Image5 - Lookalike - New
Sa - Fear - Image1 - Lookalike - New
Sa - Inaccessible - Image9 - New
Sa - Inaccessible - Image8 - New
Sa - Risk - Image4 - Lookalike - New
Sa - Fear - Image1 - New
Sa - Risk - Image4 - New
Sa - Inaccessible - Image9 - Lookalike - New
Sa - Inaccessible - Image7 - New
Sa - Fear - Image8 - New
Sa - Inaccessible - Image7 - Lookalike - New
Sa - Risk - Image1
Sa - Risk - Image1 - Lookalike
Sa - Unnecessary - Image1 - New
Sa - Inaccessible - Image1 - Lookalike
Sa - Risk - Image2
Sa - Unnecessary - Image1 - Lookalike
Sa - Unnecessary - Image1
Sa - Unnecessary - Image3
Sa - Risk - Image3
Sa - Unnecessary - Image3 - Lookalike
Sa - Inaccessible - Image3 - Lookalike
Sa - Risk - Image8 - Lookalike
Sa - Inaccessible - Image2 - Lookalike
Sa - Inaccessible - Image2
Sa - Unnecessary - Image2 - Lookalike
Sa - Risk - Image2 - Lookalike
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 57.0 - 45.6% 56.0 - 49.6% 72.0 - 52.2% 58.0 - 51.3% 13.0 - 61.9% 33.0 - 62.3% 62.0 - 48.8% 23.0 - 56.1% 12.0 - 57.1% 12.0 - 50% 25.0 - 53.2% 12.0 - 36.4% 13.0 - 41.9% 22.0 - 50% 8.0 - 61.5% 52.0 - 65.8% 1 - 25% 14.0 - 46.7% 5 - 50% 23.0 - 57.5% 12.0 - 57.1% 33.0 - 64.7% 12.0 - 66.7% 8.0 - 47.1% 23.0 - 62.2% 19.0 - 61.3% 11.0 - 52.4% 19.0 - 57.6% 7.0 - 58.3% 17.0 - 56.7% 3.0 - 100% 4.0 - 40% 1 - 33.3% 2.0 - 40% 1.0 - 50% 4 - 66.7% 2 - 50%
Core Survey Complete 4,864 91.2% 55.6% 51.0 89.5% 40.8% 50.0 89.3% 44.2% 56.0 77.8% 40.6% 46.0 79.3% 40.7% 11.0 84.6% 52.4% 30.0 90.9% 56.6% 54.0 87.1% 42.5% 18.0 78.3% 43.9% 8.0 66.7% 38.1% 10.0 83.3% 41.7% 23.0 92% 48.9% 12.0 100% 36.4% 11.0 84.6% 35.5% 20.0 90.9% 45.5% 7.0 87.5% 53.8% 45.0 86.5% 57% 1 100% 25% 12.0 85.7% 40% 5 100% 50% 21.0 91.3% 52.5% 8.0 66.7% 38.1% 25.0 75.8% 49% 10.0 83.3% 55.6% 8.0 100% 47.1% 18.0 78.3% 48.6% 15.0 78.9% 48.4% 9.0 81.8% 42.9% 17.0 89.5% 51.5% 4.0 57.1% 33.3% 12.0 70.6% 40% 1.0 33.3% 33.3% 3.0 75% 30% 1 100% 33.3% 2.0 100% 40% 1.0 100% 50% 4 100% 66.7% 2 100% 50%
Treatment complete 4,725 97.1% 54% 46.0 90.2% 36.8% 48.0 96% 42.5% 53.0 94.6% 38.4% 45.0 97.8% 39.8% 11.0 100% 52.4% 30.0 100% 56.6% 53.0 98.1% 41.7% 18.0 100% 43.9% 7.0 87.5% 33.3% 10.0 100% 41.7% 22.0 95.7% 46.8% 12.0 100% 36.4% 11.0 100% 35.5% 20.0 100% 45.5% 6.0 85.7% 46.2% 43.0 95.6% 54.4% 1 100% 25% 11.0 91.7% 36.7% 5 100% 50% 19.0 90.5% 47.5% 8.0 100% 38.1% 24.0 96% 47.1% 9.0 90% 50% 8.0 100% 47.1% 17.0 94.4% 45.9% 13.0 86.7% 41.9% 9.0 100% 42.9% 17.0 100% 51.5% 4.0 100% 33.3% 11.0 91.7% 36.7% 1.0 100% 33.3% 2.0 66.7% 20% 1 100% 33.3% 2.0 100% 40% 1.0 100% 50% 4 100% 66.7% 2 100% 50%
Demographic Questions Complete 4,351 92.1% 49.8% 39.0 84.8% 31.2% 41.0 85.4% 36.3% 51.0 96.2% 37% 43.0 95.6% 38.1% 11.0 100% 52.4% 28.0 93.3% 52.8% 50.0 94.3% 39.4% 14.0 77.8% 34.1% 7.0 100% 33.3% 10.0 100% 41.7% 19.0 86.4% 40.4% 10.0 83.3% 30.3% 10.0 90.9% 32.3% 16.0 80% 36.4% 6.0 100% 46.2% 36.0 83.7% 45.6% 1 100% 25% 10.0 90.9% 33.3% 5 100% 50% 17.0 89.5% 42.5% 7.0 87.5% 33.3% 24.0 100% 47.1% 8.0 88.9% 44.4% 7.0 87.5% 41.2% 16.0 94.1% 43.2% 12.0 92.3% 38.7% 9.0 100% 42.9% 15.0 88.2% 45.5% 3.0 75% 25% 9.0 81.8% 30% 1.0 100% 33.3% 2.0 100% 20% 1 100% 33.3% 1.0 50% 20% 0.0 0% 0% 4 100% 66.7% 2 100% 50%
Full Survey Complete 4,351 100% 49.8% 39.0 100% 31.2% 41.0 100% 36.3% 51.0 100% 37% 43.0 100% 38.1% 11.0 100% 52.4% 28.0 100% 52.8% 50.0 100% 39.4% 14.0 100% 34.1% 7.0 100% 33.3% 10.0 100% 41.7% 19.0 100% 40.4% 10.0 100% 30.3% 10.0 100% 32.3% 16.0 100% 36.4% 6.0 100% 46.2% 36.0 100% 45.6% 1 100% 25% 10.0 100% 33.3% 5 100% 50% 17.0 100% 42.5% 7.0 100% 33.3% 24.0 100% 47.1% 8.0 100% 44.4% 7.0 100% 41.2% 16.0 100% 43.2% 12.0 100% 38.7% 9.0 100% 42.9% 15.0 100% 45.5% 3.0 100% 25% 9.0 100% 30% 1.0 100% 33.3% 2.0 100% 20% 1 100% 33.3% 1.0 100% 20% 0.0 NaN% 0% 4 100% 66.7% 2 100% 50%

3 Time Variation

Next, we look at funnel statistics by time variation. We look at a few different categories:

Category Description
Time Two 12-hour periords, for 8pm to 8am and 8am to 8pm
Day 7 days of the week
Day-Time 14 combinations of time and day

3.1 Day-Time Group

full_funnel("day_time_group")
Mon 8 Pm To 8 Am
Wed 8 Pm To 8 Am
Tue 8 Am To 8 Pm
Thu 8 Am To 8 Pm
Tue 8 Pm To 8 Am
Wed 8 Am To 8 Pm
Thu 8 Pm To 8 Am
Fri 8 Am To 8 Pm
Sun 8 Am To 8 Pm
Mon 8 Am To 8 Pm
Sun 8 Pm To 8 Am
Sat 8 Am To 8 Pm
Sat 8 Pm To 8 Am
Fri 8 Pm To 8 Am
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 8.0 - 61.5% 764 - 68.4% 2,093 - 51% 834 - 73.3% 34.0 - 44.2% 606 - 74.9% 790 - 69.6% 30.0 - 48.4% 30.0 - 47.6% 13 - 43.3% 8 - 42.1% 51.0 - 77.3% 28.0 - 77.8% 42.0 - 56%
Core Survey Complete 4,864 91.2% 55.6% 6.0 75% 46.2% 695 91% 62.2% 1,898 90.7% 46.3% 781 93.6% 68.6% 33.0 97.1% 42.9% 560 92.4% 69.2% 701 88.7% 61.8% 25.0 83.3% 40.3% 28.0 93.3% 44.4% 13 100% 43.3% 8 100% 42.1% 48.0 94.1% 72.7% 28.0 100% 77.8% 40.0 95.2% 53.3%
Treatment complete 4,725 97.1% 54% 6.0 100% 46.2% 676 97.3% 60.5% 1,833 96.6% 44.7% 765 98% 67.2% 33.0 100% 42.9% 546 97.5% 67.5% 678 96.7% 59.7% 24.0 96% 38.7% 28.0 100% 44.4% 13 100% 43.3% 8 100% 42.1% 48.0 100% 72.7% 28.0 100% 77.8% 39.0 97.5% 52%
Demographic Questions Complete 4,351 92.1% 49.8% 6.0 100% 46.2% 626 92.6% 56% 1,683 91.8% 41% 712 93.1% 62.6% 32.0 97% 41.6% 508 93% 62.8% 602 88.8% 53% 23.0 95.8% 37.1% 28.0 100% 44.4% 13 100% 43.3% 8 100% 42.1% 48.0 100% 72.7% 27.0 96.4% 75% 35.0 89.7% 46.7%
Full Survey Complete 4,351 100% 49.8% 6.0 100% 46.2% 626 100% 56% 1,683 100% 41% 712 100% 62.6% 32.0 100% 41.6% 508 100% 62.8% 602 100% 53% 23.0 100% 37.1% 28.0 100% 44.4% 13 100% 43.3% 8 100% 42.1% 48.0 100% 72.7% 27.0 100% 75% 35.0 100% 46.7%

3.2 Day

full_funnel("wday")
Mon
Wed
Tue
Thu
Fri
Sun
Sat
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - - - - - - - - - - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - - - - - - - - - - - - - - - - -
Messages Sent 9,137 22.6% - - - - - - - - - - - - - - - - - - - - - -
Consent Obtained 5,331 58.3% 61% 21.0 - 48.8% 1,370 - 71.1% 2,127 - 50.9% 1,624 - 71.4% 72.0 - 52.6% 38.0 - 46.3% 79.0 - 77.5%
Core Survey Complete 4,864 91.2% 55.6% 19.0 90.5% 44.2% 1,255 91.6% 65.2% 1,931 90.8% 46.2% 1,482 91.3% 65.2% 65.0 90.3% 47.4% 36.0 94.7% 43.9% 76.0 96.2% 74.5%
Treatment complete 4,725 97.1% 54% 19.0 100% 44.2% 1,222 97.4% 63.4% 1,866 96.6% 44.7% 1,443 97.4% 63.5% 63.0 96.9% 46% 36.0 100% 43.9% 76.0 100% 74.5%
Demographic Questions Complete 4,351 92.1% 49.8% 19.0 100% 44.2% 1,134 92.8% 58.9% 1,715 91.9% 41% 1,314 91.1% 57.8% 58.0 92.1% 42.3% 36.0 100% 43.9% 75.0 98.7% 73.5%
Full Survey Complete 4,351 100% 49.8% 19.0 100% 44.2% 1,134 100% 58.9% 1,715 100% 41% 1,314 100% 57.8% 58.0 100% 42.3% 36.0 100% 43.9% 75.0 100% 73.5%

3.3 Time

full_funnel("time_group")
8 Pm To 8 Am
8 Am To 8 Pm
Metric Total % Previous % Total Obs Total % Previous % Total Obs Total % Previous % Total Obs
Impressions 2,461,406 - - - - - - - -
Link Clicks 40,462 1.6% - - - - - - -
Messages Sent 9,137 22.6% - - - - - - -
Consent Obtained 5,331 58.3% 61% 1,674 - 67.7% 3,657 - 58.3%
Core Survey Complete 4,864 91.2% 55.6% 1,511 90.3% 61.1% 3,353 91.7% 53.5%
Treatment complete 4,725 97.1% 54% 1,468 97.2% 59.4% 3,257 97.1% 51.9%
Demographic Questions Complete 4,351 92.1% 49.8% 1,336 91% 54% 3,015 92.6% 48.1%
Full Survey Complete 4,351 100% 49.8% 1,336 100% 54% 3,015 100% 48.1%

4 Noncompleters

Next, we look more closely at non-completers.

We assign individuals to forks. To do this, each user must have non missing values for vaccination status, motivation, and ability. There are 551 out of 4,391 (13%) noncompleters for which this is the case.

First, let’s look at the noncompleters with missing values in either vaccination status, motivation, or ability (3,840 out of 4,391 (87%)).

fork_tbl <- noncompleters %>% 
  filter(is.na(vax_status) | is.na(motive) | is.na(ability)) %>%
    select(continue_1,consent,vax_status,motive,ability,vax_future,best_treatment,ethnicity,education,religion,religiosity,location,comfortable,enjoyable) %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate") %>%
    arrange(-completion_rate) %>% 
    transmute(
      completion_rate,
      question = case_when(
        question == "continue_1" ~ "Consent 1: Ask your opinion on vaccines",
        question == "consent" ~ "Consent 2: Continue if you're over 18 and wish to start",
        question == "vax_status" ~ "Vaccination status",
        question == "motive" ~ "Motive to get vaccine",
        question == "ability" ~ "Ability to get vaccine",
        question == "vax_future" ~ "Get vaccine in future",
        question == "best_treatment" ~ "Preferred treatment",
        question == "ethnicity" ~ "Ethnicity",
        question == "education" ~ "Education",
        question == "religion" ~ "Religion",
        question == "religiosity" ~ "Religiosity",
        question == "location" ~ "Location",
        question == "comfortable" ~ "Chat comfortability",
        question == "enjoyable" ~ "Chat enjoyability",
        TRUE ~ NA_character_
      )
    ) %>%
    mutate(question = factor(question, levels =  c(
      "Consent 1: Ask your opinion on vaccines",
      "Consent 2: Continue if you're over 18 and wish to start",
      "Vaccination status",
      "Motive to get vaccine",
      "Ability to get vaccine",
      "Get vaccine in future",
      "Preferred treatment",
      "Ethnicity",
      "Education",
      "Religion",
      "Religiosity","Location","Chat comfortability","Chat enjoyability")) %>% fct_rev()) 
  
  ggplot(fork_tbl, aes(x= question, y = completion_rate, group = 1)) +
    geom_point(size = 3) +
    geom_line() +
    scale_y_continuous(limits = c(0, 1), labels = scales::percent_format(accuracy = 1)) +
    coord_flip() +
    custom_theme +
    labs(
      x = "",
      y = "Completion rate (%)",
      caption = paste("Number of Observations:", scales::comma(nrow(noncompleters[is.na(noncompleters$vax_status) |is.na(noncompleters$motive) |  is.na(noncompleters$ability), ])))
    )

noncompleters_summary <- noncompleters %>%
  filter(!is.na(vax_status), !is.na(motive), !is.na(ability)) %>%
  group_by(vax_status, motive, ability) %>%
  count() %>%
  group_by(vax_status) %>%
  mutate(per_in_vax_status = form_percent(n/sum(n))) %>%
  ungroup() %>%
  mutate(per_overall = form_percent(n/sum(n))) 

kable(noncompleters_summary, caption = "Noncompleters by Fork", digits = 3, 
      col.names = c("Vaccination Status", 
                    "Motive", "Ability", "Number of Observations", 
                    "Percent within Vaccination Status", 
                    "Percent Overall"))%>%
kable_styling(bootstrap_options = c("striped", "hover"))
Noncompleters by Fork
Vaccination Status Motive Ability Number of Observations Percent within Vaccination Status Percent Overall
unvax no easy 16 8.8% 2.9%
unvax no really hard 16 8.8% 2.9%
unvax no somewhat hard 18 9.9% 3.3%
unvax no text answer 1 0.5% 0.2%
unvax unsure easy 30 16.5% 5.4%
unvax unsure really hard 14 7.7% 2.5%
unvax unsure somewhat hard 20 11% 3.6%
unvax unsure text answer 3 1.6% 0.5%
unvax yes easy 30 16.5% 5.4%
unvax yes really hard 8 4.4% 1.5%
unvax yes somewhat hard 25 13.7% 4.5%
unvax yes text answer 1 0.5% 0.2%
vax no easy 6 1.6% 1.1%
vax no really hard 10 2.7% 1.8%
vax no somewhat hard 8 2.2% 1.5%
vax no text answer 1 0.3% 0.2%
vax unsure easy 33 8.9% 6%
vax unsure really hard 4 1.1% 0.7%
vax unsure somewhat hard 16 4.3% 2.9%
vax unsure text answer 10 2.7% 1.8%
vax yes easy 198 53.7% 35.9%
vax yes really hard 15 4.1% 2.7%
vax yes somewhat hard 67 18.2% 12.2%
vax yes text answer 1 0.3% 0.2%

4.1 Dropoff for Unvaccinated Noncompleters by Fork

Next, we look at drop off for unvaccinated noncompleters by our 12 forks. We look at specific questions rather than groups of questions.

fork_analysis <- function(v, m, a){
  fork_tbl <- noncompleters %>% 
    filter(vax_status == v &  motive == m & ability == a) %>%
    select(continue_1,consent,vax_status,motive,ability,post_want_vax,best_treatment,ethnicity,education,religion,religiosity,location,comfortable,enjoyable) %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate") %>%
    arrange(-completion_rate) %>% 
    transmute(
      completion_rate,
      question = case_when(
        question == "continue_1" ~ "Consent 1: Ask your opinion on vaccines",
        question == "consent" ~ "Consent 2: Continue if you're over 18 and wish to start",
        question == "vax_status" ~ "Vaccination status",
        question == "motive" ~ "Motive to get vaccine",
        question == "ability" ~ "Ability to get vaccine",
          question == "best_treatment" ~ "Preferred treatment",
        question == "post_want_vax" ~ "Get vaccine in future",
          question == "comfortable" ~ "Chat comfortability",
        question == "enjoyable" ~ "Chat enjoyability",
        question == "ethnicity" ~ "Ethnicity",
        question == "education" ~ "Education",
        question == "religion" ~ "Religion",
        question == "religiosity" ~ "Religiosity",
        question == "location" ~ "Location",
        TRUE ~ NA_character_
      )
    ) %>%
    mutate(question = factor(question, levels =  c(
      "Consent 1: Ask your opinion on vaccines",
      "Consent 2: Continue if you're over 18 and wish to start",
      "Vaccination status",
      "Motive to get vaccine",
      "Ability to get vaccine",
      "Preferred treatment",
      "Get vaccine in future",
      "Chat comfortability",
      "Chat enjoyability",
      "Ethnicity",
      "Education",
      "Religion",
      "Religiosity","Location")) %>% fct_rev()) 
  
  ggplot(fork_tbl, aes(x= question, y = completion_rate, group = 1)) +
    geom_point(size = 3) +
    geom_line() +
    scale_y_continuous(limits = c(0, 1), labels = scales::percent_format(accuracy = 1)) +
    coord_flip() +
    custom_theme +
    labs(
      x = "",
      y = "Completion rate (%)",
      caption = paste("Number of Observations:", noncompleters_summary[noncompleters_summary$vax_status == v & noncompleters_summary$motive == m & noncompleters_summary$ability == a, "n"])
    )
}

4.1.1 No Motive, Easy Ability

fork_analysis(v = "unvax", m = "no", a = "easy")

4.1.2 No Motive, Somewhat Difficult Ability

fork_analysis(v = "unvax", m = "no", a = "somewhat hard")

4.1.3 No Motive, Difficult Ability

fork_analysis(v = "unvax", m = "no", a = "really hard")

4.1.4 Maybe Motive, Easy Ability

fork_analysis(v = "unvax", m = "unsure", a = "easy")

4.1.5 Maybe Motive, Somewhat Difficult Ability

fork_analysis(v = "unvax", m = "unsure", a = "somewhat hard")

4.1.6 Maybe Motive, Difficult Ability

fork_analysis(v = "unvax", m = "unsure", a = "really hard")

4.1.7 Definitely Motive, Easy Ability

fork_analysis(v = "unvax", m = "yes", a = "easy")

4.1.8 Definitely Motive, Somewhat Difficult Ability

fork_analysis(v = "unvax", m = "yes", a = "somewhat hard")

4.1.9 Definitely Motive, Difficult Ability

fork_analysis(v = "unvax", m = "yes", a = "really hard")

5 Enjoyability and Comfortability

The following figure shows the percentage of completers that chose different levels (very/moderate/not) for the comfortability and enjoyability questions.

5.1 Completers

comfortable <- completers %>%
  select(comfortable) %>%
  mutate(
    comfortable = str_to_sentence(comfortable) %>% str_squish()) %>%
    filter(comfortable %in% c("Very comfortable", "Somewhat comfortable", "Not comfortable")) %>%
    mutate(comfortable = factor(comfortable, levels = c("Very comfortable", "Somewhat comfortable", "Not comfortable"))) %>%
    group_by(comfortable) %>%
  count() %>%
  ungroup() %>%
  mutate(percent = paste(round(n/sum(n) * 100, 0), "%", sep = ""), 
         percent = ifelse(n/sum(n) * 100 < 6, "", percent),
         p = rev(cumsum(rev(n/sum(n)))), 
         variable= "comfortable")%>% 
  rename(label = comfortable)%>%
  mutate(short_label = case_when(label == "Very comfortable" ~ "very", 
                                 label == "Somewhat comfortable" ~"moderately", 
                                 label == "Not comfortable" ~ "not"))

enjoyable <- completers %>%
  select(enjoyable) %>%
  mutate(
  enjoyable= str_to_sentence(enjoyable) %>% str_squish()) %>%
   filter(enjoyable %in% c("Very enjoyable", "Kind of enjoyable", "Not enjoyable"))  %>%
   mutate(enjoyable = factor(enjoyable, levels = c("Very enjoyable", "Kind of enjoyable", "Not enjoyable"))) %>%
    group_by(enjoyable) %>%
  count() %>%
  ungroup() %>%
  mutate(percent = paste(round(n/sum(n) * 100, 0), "%", sep = ""), 
         percent = ifelse(n/sum(n) * 100 < 6, "", percent),
         p = rev(cumsum(rev(n/sum(n)))), 
         variable = "enjoyable")%>% 
  rename(label = enjoyable) %>%
  mutate(short_label = case_when(label == "Very enjoyable" ~ "very", 
                                 label == "Kind of enjoyable" ~"moderately", 
                                 label == "Not enjoyable" ~ "not"))


comfort_enjoy <- rbind(comfortable, enjoyable)  %>%
   mutate(short_label = factor(short_label, levels = c("very", "moderately", "not")))

  
comfort_enjoy %>%
   mutate(variable_num = as.numeric(as.factor(variable))) %>%
  ggplot(aes(x = variable_num, y = n, fill = short_label)) +
  geom_bar(position = "fill", stat = "identity", 
           color = "white", width = .5) + 
  custom_theme + 
  scale_fill_manual(values = cb_colors, labels = str_to_title)+
  geom_text(aes(label = percent), 
            color = "white", 
            position = position_fill(vjust = 0.5), 
            size = 16/.pt, fontface = "bold") + 
  scale_x_continuous(limits = c(NA, 2.7), 
                     breaks = c(1, 2), 
                     labels = c("Comfortability", "Enjoyability")) +
  scale_y_continuous(breaks = c(0, 1), 
                     labels = c("0%", "100%"))+ 
  labs(x = "", y = "",
       title = "Percent of Respondents by Comfortability\nand Enjoyability for Completers",
            caption = paste("Nonmissing Comfortability Observations:", scales::comma(sum(comfortable$n)), "\n", "Nonmissing Enjoyability Observations:", scales::comma(sum(enjoyable$n)))) +
  geom_text_repel(data = . %>% filter(variable == "enjoyable"), 
                  aes(x= variable_num, y = p- 0.01, 
                      label = str_to_title(short_label), 
                      color = short_label), 
                  nudge_x = 0.4, direction = "y", 
                  hjust = "left", size = 16/.pt) +
    scale_color_manual(values = cb_colors) +
    theme(legend.position = "none",
          panel.grid.major.x = element_blank(),
          panel.grid.minor = element_blank()) 

5.2 Noncompleters

comfortable <- noncompleters %>%
  select(comfortable) %>%
  mutate(
    comfortable = str_to_sentence(comfortable) %>% str_squish()) %>%
    filter(comfortable %in% c("Very comfortable", "Somewhat comfortable", "Not comfortable")) %>%
    mutate(comfortable = factor(comfortable, levels = c("Very comfortable", "Somewhat comfortable", "Not comfortable"))) %>%
    group_by(comfortable) %>%
  count() %>%
  ungroup() %>%
  mutate(percent = paste(round(n/sum(n) * 100, 0), "%", sep = ""), 
         percent = ifelse(n/sum(n) * 100 < 6, "", percent),
         p = rev(cumsum(rev(n/sum(n)))), 
         variable= "comfortable")%>% 
  rename(label = comfortable)%>%
  mutate(short_label = case_when(label == "Very comfortable" ~ "very", 
                                 label == "Somewhat comfortable" ~"moderately", 
                                 label == "Not comfortable" ~ "not"))

enjoyable <- noncompleters %>%
  select(enjoyable) %>%
  mutate(
  enjoyable= str_to_sentence(enjoyable) %>% str_squish()) %>%
   filter(enjoyable %in% c("Very enjoyable", "Kind of enjoyable", "Not enjoyable"))  %>%
   mutate(enjoyable = factor(enjoyable, levels = c("Very enjoyable", "Kind of enjoyable", "Not enjoyable"))) %>%
    group_by(enjoyable) %>%
  count() %>%
  ungroup() %>%
  mutate(percent = paste(round(n/sum(n) * 100, 0), "%", sep = ""), 
         percent = ifelse(n/sum(n) * 100 < 6, "", percent),
         p = rev(cumsum(rev(n/sum(n)))), 
         variable = "enjoyable")%>% 
  rename(label = enjoyable) %>%
  mutate(short_label = case_when(label == "Very enjoyable" ~ "very", 
                                 label == "Kind of enjoyable" ~"moderately", 
                                 label == "Not enjoyable" ~ "not"))


comfort_enjoy <- rbind(comfortable, enjoyable)  %>%
   mutate(short_label = factor(short_label, levels = c("very", "moderately", "not")))

  
comfort_enjoy %>%
   mutate(variable_num = as.numeric(as.factor(variable))) %>%
  ggplot(aes(x = variable_num, y = n, fill = short_label)) +
  geom_bar(position = "fill", stat = "identity", 
           color = "white", width = .5) + 
  custom_theme + 
  scale_fill_manual(values = cb_colors, labels = str_to_title)+
  geom_text(aes(label = percent), 
            color = "white", 
            position = position_fill(vjust = 0.5), 
            size = 16/.pt, fontface = "bold") + 
  scale_x_continuous(limits = c(NA, 2.7), 
                     breaks = c(1, 2), 
                     labels = c("Comfortability", "Enjoyability")) +
  scale_y_continuous(breaks = c(0, 1), 
                     labels = c("0%", "100%"))+ 
  labs(x = "", y = "",
       title = "Percent of Respondents by Comfortability\nand Enjoyability for Non-completers",
       
       caption = paste("Nonmissing Comfortability Observations:", scales::comma(sum(comfortable$n)), "\n", "Nonmissing Enjoyability Observations:", scales::comma(sum(enjoyable$n)))) +
  geom_text_repel(data = . %>% filter(variable == "enjoyable"), 
                  aes(x= variable_num, y = p- 0.01, 
                      label = str_to_title(short_label), 
                      color = short_label), 
                  nudge_x = 0.4, direction = "y", 
                  hjust = "left", size = 16/.pt) +
    scale_color_manual(values = cb_colors) +
    theme(legend.position = "none",
          panel.grid.major.x = element_blank(),
          panel.grid.minor = element_blank()) 

6 Funnel Statistics for All Questions by Fork

6.1 Unvax, Yes Motive, Easy Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "unvax") & fork_motive %in% c("all", "probably") & fork_ability %in% c("all", "easy") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number" & variable_name != "greating_answer") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "unvax" & motive == "yes" & ability == "easy") %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.2 Unvax, Yes Motive, Hard Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "unvax") & fork_motive %in% c("all", "probably") & fork_ability %in% c("all", "hard") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence)%>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "unvax" & motive == "yes" & ability  %in% c("somewhat hard", "really hard")) %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.3 Unvax, Unsure Motive, Easy Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "unvax") & fork_motive %in% c("all", "unsure") & fork_ability %in% c("all", "easy") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "unvax" & motive == "unsure" & ability == "easy") %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.4 Unvax, Unsure Motive, Hard Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "unvax") & fork_motive %in% c("all", "unsure") & fork_ability %in% c("all", "hard") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "unvax" & motive == "unsure" & ability  %in% c("somewhat hard", "really hard")) %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.5 Unvax, No Motive, Easy Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "unvax") & fork_motive %in% c("all", "no") & fork_ability %in% c("all", "easy") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "unvax" & motive == "no" & ability == "easy") %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.6 Unvax, No Motive, Hard Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "unvax") & fork_motive %in% c("all", "no") & fork_ability %in% c("all", "hard") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "unvax" & motive == "no" & ability  %in% c("somewhat hard", "really hard")) %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.7 Vax, Yes Motive, Easy Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "vax") & fork_motive %in% c("all", "probably") & fork_ability %in% c("all", "easy") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number" & variable_name != "greating_answer") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence)%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "vax" & motive == "yes" & ability == "easy") %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.8 Vax, Yes Motive, Hard Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "vax") & fork_motive %in% c("all", "probably") & fork_ability %in% c("all", "hard") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence)%>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "vax" & motive == "yes" & ability  %in% c("somewhat hard", "really hard")) %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.9 Vax, Unsure Motive, Easy Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "vax") & fork_motive %in% c("all", "unsure") & fork_ability %in% c("all", "easy") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "vax" & motive == "unsure" & ability == "easy") %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.10 Vax, Unsure Motive, Hard Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "vax") & fork_motive %in% c("all", "unsure") & fork_ability %in% c("all", "hard") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "vax" & motive == "unsure" & ability  %in% c("somewhat hard", "really hard")) %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )

6.11 Vax, No Motive, Easy Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "vax") & fork_motive %in% c("all", "no") & fork_ability %in% c("all", "easy") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "vax" & motive == "no" & ability == "easy") %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl)))

6.12 Vax, No Motive, Hard Ability

# get variable order
var_order <- dictionary %>%
  filter(fork_unvax %in% c("all", "vax") & fork_motive %in% c("all", "no") & fork_ability %in% c("all", "hard") & is.na(flow) & variable_name != "gender" & variable_name != "phone_number") %>%
  select(!flow) %>%
  mutate(sequence = 1: nrow(.)) %>% select(variable_name, variable_label, sequence) %>%
  filter(!(variable_name %in% c("availability_main", "time_main", "money_main", "ability_sub_other", "ability_mis_explain",
                                "belief_main", "benefit_main", "risk_main", "motive_sub_explain", "motive_mis_explain", "greating_answer", "motive_other", "treat_no_explain")))%>%
  mutate(variable_name = ifelse(variable_name == "covid_vax_future", "post_want_vax", variable_name))


tbl <- full %>%
  filter(vax_status == "vax" & motive == "no" & ability  %in% c("somewhat hard", "really hard")) %>%
  select(all_of(var_order$variable_name))
  
# sum of completes
data.frame(complete = colSums(!is.na(tbl))) %>%
  # percent of total
  mutate(perc_of_total = form_percent(complete/nrow(tbl)),
         # percent of last question
         perc_of_prev = form_percent(complete/lag(complete)))
tbl2 <- tbl %>%
    summarize_all(~ mean(!is.na(.))) %>% 
    pivot_longer(cols = everything(), names_to = "question", values_to = "completion_rate")  %>%
  mutate(question = str_to_title(str_replace_all(pattern = "_", replacement = " ", string = question)),
    question = factor(question, levels = rev(question)))
  
ggplot(tbl2, aes(x= question, y = completion_rate, group = 1)) +
  geom_point(size = 3) +
  geom_line() +
  scale_y_continuous(limits = c(0.5, 1), labels = scales::percent_format(accuracy = 1)) +
  coord_flip() +
  custom_theme +
  labs(
    x = "",
    y = "Completion rate (%)",
    caption = paste("Number of Observations:", nrow(tbl))
  )