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:
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)))
}
}
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.
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%")
}
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%
|
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%
|
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%
|
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%
|
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%
|
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%
|
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%
|
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%
|
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%
|
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"])
)
}
No Motive, Easy Ability
fork_analysis(v = "unvax", m = "no", a = "easy")

No Motive, Somewhat Difficult Ability
fork_analysis(v = "unvax", m = "no", a = "somewhat hard")

No Motive, Difficult Ability
fork_analysis(v = "unvax", m = "no", a = "really hard")

Maybe Motive, Easy Ability
fork_analysis(v = "unvax", m = "unsure", a = "easy")

Maybe Motive, Somewhat Difficult Ability
fork_analysis(v = "unvax", m = "unsure", a = "somewhat hard")

Maybe Motive, Difficult Ability
fork_analysis(v = "unvax", m = "unsure", a = "really hard")

Definitely Motive, Easy Ability
fork_analysis(v = "unvax", m = "yes", a = "easy")

Definitely Motive, Somewhat Difficult Ability
fork_analysis(v = "unvax", m = "yes", a = "somewhat hard")

Definitely Motive, Difficult Ability
fork_analysis(v = "unvax", m = "yes", a = "really hard")

Enjoyability and Comfortability
The following figure shows the percentage of completers that chose different levels (very/moderate/not) for the comfortability and enjoyability questions.
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())

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

Funnel Statistics for All Questions by Fork
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))
)

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

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

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

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

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

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

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

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

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

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

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