diff --git a/Scripts/treatment.R b/Scripts/treatment.R
index 0d86be92cdb7c1df222622d0a26e89c452a9a842..0be11ce264ea3dc0cd4974f31f64808451739a1c 100644
--- a/Scripts/treatment.R
+++ b/Scripts/treatment.R
@@ -1,391 +1,391 @@
-library(viridis)
-
-data_grouped <- database %>%
- group_by(id) %>%
- summarise(across(c(Treatment, Treatment_new), list( gr= ~unique(.))))
-
-data_grouped <- data_grouped %>%
- mutate(Treatment_name = case_when(
- Treatment_new_gr == 1 ~ 'Video 1',
- Treatment_new_gr == 2 ~ 'No Video 1',
- Treatment_new_gr == 3 ~ 'No Info 2',
- Treatment_new_gr == 4 ~ 'No Video 2',
- Treatment_new_gr == 5 ~ 'Video 2',
- Treatment_new_gr == 6 ~ 'No Treatment 3',
- TRUE ~ NA_character_
- ))
-treatment_order<- c("Video 1", "No Video 1", "No Info 2","No Video 2", "Video 2" ,"No Treatment 3")
-
-data_grouped <- data_grouped %>% filter(!is.na(Treatment_gr))
-
-ggplot(data=data_grouped) +
- geom_bar(aes(x=factor(Treatment_name, levels=c("No Video 1", "Video 1", "No Info 2", "No Video 2", "Video 2",
- "No Treatment 3")),
- group=as.factor(Treatment_gr), fill=as.factor(Treatment_gr))) +
- xlab("Treatment Group") +
- ylab("Count") +
- scale_fill_viridis(option="D", discrete = T, labels=c("Always Info", "Optional Info", "Never Info")) +
- labs(fill="Treatment Group")
-
-ggsave("Figures/barplot_treatment.png", width=7, height=5, dpi="print")
-
-
-#### Inspect socio-demographic differences ####
-
-
-### Case A
-treatment_socio_A <- database_full %>%
- group_by(Treatment_A) %>%
- summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
- "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
- ~ round(mean(., na.rm = TRUE), 2))
-
-
-# Export table as tex file
-print(xtable(treatment_socio_A, type ="latex"),
- include.rownames = F, file ="Tables/socio_demos_A.tex")
-
-### Case B
-
-treatment_socio_B <- database_full %>% filter(Treatment_B == "Treated" | Treatment_A == "Not_Treated") %>%
- group_by(Treatment_B) %>%
- summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
- "Naturalness_SQ", "Employment_full", "Pensioner"),
- ~ round(mean(., na.rm = TRUE), 2))
-
-
-# Export table as tex file
-print(xtable(treatment_socio_B, type ="latex"),
- include.rownames = F, file ="Tables/socio_demos_B.tex")
-
-### Case C
-treatment_socio <- database_full %>% filter(!is.na(Treatment)) %>% group_by(Treatment_C) %>%
- summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
- "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
- ~ round(mean(., na.rm = TRUE), 2))
-
-treatment_socio_C <- database_full %>% filter(!is.na(Treatment_new)) %>% group_by(Treatment_C) %>%
- summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
- "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
- ~ round(mean(., na.rm = TRUE), 2))
-#
-# treatment_socio_C <- treatment_socio_C %>% mutate(Treatment_name = case_when(
-# Treatment_new == 1 ~ 'Video 1',
-# Treatment_new == 2 ~ 'No Video 1',
-# Treatment_new == 3 ~ 'No Info 2',
-# Treatment_new == 4 ~ 'No Video 2',
-# Treatment_new == 5 ~ 'Video 2',
-# Treatment_new == 6 ~ 'No Treatment 3',
-# TRUE ~ NA_character_
-# ))
-
-# Export table as tex file
-print(xtable(treatment_socio_C, type ="latex"),
- include.rownames = F, file ="Tables/socio_demos_C.tex")
-
-
-### Create boxplot for text treatment page #
-
-database_textpage <- database_full %>% filter(Treatment_new != 6)
-
-ggplot(data=database_textpage) +
- geom_boxplot(aes(y=groupTime1774, x= Treatment_new, group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
- coord_cartesian(ylim = c(0, 180)) +
- labs(fill="Treatment") +
- xlab("Treatment") +
- ylab("Time on Info Text Page")
-
-ggsave("Figures/treatment_time_bxplt.png", width=7, height = 5, dpi="print")
-
-
-
-table(database_full$Treatment_C)
-### Create boxplot for interview time per group #
-database_full <- database_full %>% mutate(groupTime1774 = case_when(is.na(groupTime1774) ~ 0, TRUE ~ groupTime1774),
- groupTime1784 = case_when(is.na(groupTime1784) ~ 0, TRUE ~ groupTime1784),
- groupTime1775 = case_when(is.na(groupTime1775) ~ 0, TRUE ~ groupTime1775),
- groupTime1785 = case_when(is.na(groupTime1785) ~ 0, TRUE ~ groupTime1785),
- groupTime1786 = case_when(is.na(groupTime1786) ~ 0, TRUE ~ groupTime1786)) %>%
- mutate(interviewtime_net = interviewtime - groupTime1774 - groupTime1784 - groupTime1775 - groupTime1785- groupTime1786 )
-# Calculate the cutoff values for the lowest and highest 1 percent
-lower_cutoff <- quantile(database_full$interviewtime_net, 0.01)
-upper_cutoff <- quantile(database_full$interviewtime_net, 0.95)
-
-# Filter the data to keep only values within the specified range
-database_full <- database_full %>%
- mutate(interviewtime_net_clean = ifelse(between(interviewtime_net, lower_cutoff, upper_cutoff), interviewtime_net, NA))
-
-# Assuming 'database' is your data frame
-video2_data <- subset(database_full, Treatment_C == "Video 2")
-
-# Summary statistics for interview time in 'Video 2' cases
-summary(video2_data$interviewtime_net_clean)
-# Assuming 'database' is your data frame
-sorted_database <- video2_data[order(video2_data$interviewtime_net_clean, decreasing = F), ]
-
-# Display the ten highest values of interview time
-top_10_highest <- tail(sorted_database$interviewtime_net_clean, 200)
-print(top_10_highest)
-
-
-bxplt_interview_time_A<-ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
- geom_boxplot(aes(y=interviewtime_net_clean, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
- coord_cartesian(ylim = c(500, 2900)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("Net Interview Time (s)")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
-bxplt_interview_time_B<-ggplot(data=database_full) +
- geom_boxplot(aes(y=interviewtime_net_clean, x= Treatment_B, group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
- coord_cartesian(ylim = c(500, 2900)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("Net Interview Time (s)")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
-bxplt_interview_time_C<-ggplot(data=database_full) +
- geom_boxplot(aes(y=interviewtime_net_clean, x= factor(Treatment_new, labels = treatment_order), group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
- coord_cartesian(ylim = c(500, 2900)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("Net Interview Time (s)")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
-ggsave("Figures/interview_time_bxplt.png", width=7, height = 5, dpi="print")
-
-
-# Boxplot Video Time
-
-video_resp <- database_full %>% filter(Treatment_new == 1 | Treatment_new == 5)
-
-ggplot(data=video_resp) +
- geom_boxplot(aes(y=groupTime1784, x= Treatment_name, group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
- coord_cartesian(ylim = c(100, 300)) +
- labs(fill="Treatment") +
- xlab("Treatment") +
- ylab("Time on Video Page")
-
-ggsave("Figures/video_time_bxplt.png", width=7, height = 5, dpi="print")
-
-
-#### Time per choice cards ####
-
-database_full <- database_full %>% rowwise() %>% mutate(CC_time = sum(c(c_across(groupTime1740:groupTime1767), groupTime1735,
- groupTime1736), na.rm=TRUE),
- CC_time_mean = CC_time/10)
-
-# Calculate the cutoff values for the lowest and highest 1 percent
-lower_cutoff <- quantile(database_full$CC_time_mean, 0.01)
-upper_cutoff <- quantile(database_full$CC_time_mean, 0.99)
-
-# Filter the data to keep only values within the specified range
-database_full <- database_full %>%
- mutate(CC_time_mean_clean = ifelse(between(CC_time_mean, lower_cutoff, upper_cutoff), CC_time_mean, NA))
-
-bxplt_cc_time_A<- ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
- geom_boxplot(aes(y=CC_time_mean_clean, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
- coord_cartesian(ylim = c(5, 40)) +
- labs(fill="Treatment") +
- xlab("Treatment") +
- ylab("Mean Time CC (s)")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
-bxplt_cc_time_B<- ggplot(data=database_full) +
- geom_boxplot(aes(y=CC_time_mean_clean, x= Treatment_B, group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
- coord_cartesian(ylim = c(5, 40)) +
- labs(fill="Treatment") +
- xlab("Treatment") +
- ylab("Mean Time CC (s)")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- bxplt_cc_time_C<- ggplot(data=database_full) +
- geom_boxplot(aes(y=CC_time_mean_clean, x= factor(Treatment_new, labels = treatment_order), group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
- coord_cartesian(ylim = c(5, 40)) +
- labs(fill="Treatment") +
- xlab("Treatment") +
- ylab("Mean Time CC (s)")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- ggsave("Figures/cc_time_bxplt.png", width=7, height = 5, dpi="print")
-
-#### Regression Treatment Time ####
-
-
-no_panel <- database_full %>% filter(!is.na(Treatment)) %>% group_by(id) %>%
- summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "groupTime1774", "Treatment_new",
- "WorkingTime", "interviewtime", "groupTime1733", "groupTime1784", "groupTime1775",
- "groupTime1785", "Number_Kids", "Kids_Dummy",
- "Screen", "Naturalness_SQ", "Employment_full", "Pensioner"),
- ~ round(mean(., na.rm = TRUE), 2))
-
-#### Number opt-out choices
-
- database_full <- database_full %>%
- group_by(id) %>%
- mutate(count_choosen_3 = sum(choice == 3, na.rm = TRUE)) %>%
- ungroup()
-
- bxplt_opt_A <-ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
- geom_boxplot(aes(y=count_choosen_3, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
- stat_summary(
- aes(x = Treatment_A, y = count_choosen_3, group = Treatment_A),
- fun = mean, geom = "point", shape = 18, size = 3,
- position = position_dodge(width = 0.75) )+
- coord_cartesian(ylim = c(0, 10)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("No. of Opt-Out Choices")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- bxplt_opt_B <-ggplot(data=database_full) +
- geom_boxplot(aes(y=count_choosen_3, x= Treatment_B, group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
- stat_summary(
- aes(x = Treatment_B, y = count_choosen_3, group = Treatment_B),
- fun = mean, geom = "point", shape = 18, size = 3,
- position = position_dodge(width = 0.75) )+
- coord_cartesian(ylim = c(0, 10)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("No. of Opt-Out Choices")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- bxplt_opt_C <-ggplot(data=database_full) +
- geom_boxplot(aes(y=count_choosen_3, x= factor(Treatment_new, labels = treatment_order) , group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
- stat_summary(
- aes(x = factor(Treatment_new, labels = treatment_order), y = count_choosen_3, group = Treatment_name),
- fun = mean, geom = "point", shape = 18, size = 3,
- position = position_dodge(width = 0.75) )+
- coord_cartesian(ylim = c(0, 10)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("No. of Opt-Out Choices")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- ggsave("Figures/number_opt_out_bxplt.png", width=7, height = 5, dpi="print")
-
-# Take a look at always opt out people
-always_opt_out <- database_full %>% filter(count_choosen_3 == 10)
-
-table(always_opt_out$Treatment)
-table(always_opt_out$Treatment_C)
-summary(always_opt_out$Z_Mean_NR)
-
-
-#### Quiz questions
-
- data <- database_full %>%
- group_by(id) %>%
- slice(1) %>%
- ungroup()
-
- ## Count correct answers after Treatment for Treatment Group (before CE)
- data <- data %>%
- mutate(correct_q1 = ifelse(TV01W3 == "A1", 1, 0)) %>%
- mutate(correct_q2 = ifelse(TV02W3 == "A2", 1, 0)) %>%
- mutate(correct_q3 = ifelse(TV03W3 == "AO01", 1, 0)) %>%
- mutate(correct_q4 = ifelse(TV04W3 == "AO01", 1, 0)) %>%
- mutate(correct_q5 = ifelse(TV05W3 == "AO02", 1, 0)) %>%
- mutate(correct_q6 = ifelse(TV06W3 == "AO02", 1, 0)) %>%
- mutate(correct_q7 = ifelse(TV07W3 == "AO01", 1, 0)) %>%
- mutate(number_correct = rowSums(select(., starts_with("correct_q")))) %>%
- mutate(number_correct = ifelse(TV01W3=="",NA , number_correct))
-
- table(data$number_correct, useNA = "always" )
- ## Count correct answers for all groups (after DCE)
- data <- data %>%
- mutate(b_correct_q1 = ifelse(TV11W3 == "A1", 1, 0)) %>%
- mutate(b_correct_q2 = ifelse(TV12W3 == "A2", 1, 0)) %>%
- mutate(b_correct_q3 = ifelse(TV15W3 == "AO01", 1, 0)) %>%
- mutate(b_correct_q4 = ifelse(TV16W3 == "AO01", 1, 0)) %>%
- mutate(b_correct_q5 = ifelse(TV17W3 == "AO02", 1, 0)) %>%
- mutate(b_correct_q6 = ifelse(TV18W3 == "AO02", 1, 0)) %>%
- mutate(b_correct_q7 = ifelse(TV19W3 == "AO01", 1, 0)) %>%
- mutate(b_number_correct = rowSums(select(., starts_with("b_correct_q"))))%>%
- mutate(number_correct = ifelse(is.na(number_correct), b_number_correct, number_correct)) %>%
- mutate(percentage_correct = (number_correct/7)*100)
-
- bxplt_quiz_A <- ggplot(data=data[!is.na(data$Treatment_A), ]) +
- geom_boxplot(aes(y=percentage_correct, x= Treatment_A , group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
- stat_summary(
- aes(x = Treatment_A, y = percentage_correct, group = Treatment_A),
- fun = mean, geom = "point", shape = 18, size = 3,
- position = position_dodge(width = 0.75) )+
- coord_cartesian(ylim = c(20, 100)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("%. of Correct Statements")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- bxplt_quiz_B <- ggplot(data=data) +
- geom_boxplot(aes(y=percentage_correct, x= Treatment_B , group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
- stat_summary(
- aes(x = Treatment_B, y = percentage_correct, group = Treatment_B),
- fun = mean, geom = "point", shape = 18, size = 3,
- position = position_dodge(width = 0.75) )+
- coord_cartesian(ylim = c(20, 100)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("%. of Correct Statements")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- bxplt_quiz_C <- ggplot(data=data) +
- geom_boxplot(aes(y=percentage_correct, x= factor(Treatment_new, labels = treatment_order) , group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
- stat_summary(
- aes(x = factor(Treatment_new, labels = treatment_order), y = percentage_correct, group = Treatment_name),
- fun = mean, geom = "point", shape = 18, size = 3,
- position = position_dodge(width = 0.75) )+
- coord_cartesian(ylim = c(20, 100)) +
- labs(fill="Treatment") +
- xlab("") +
- ylab("%. of Correct Statements")+
- scale_x_discrete( guide = guide_axis(angle = 45))+
- theme_minimal() + # Adjust the theme as needed
- theme(legend.position = "none")
-
- ggsave("Figures/correct_statements_bxplt.png", width=7, height = 5, dpi="print")
- quiz_data<-data
-# Maybe need to add other groups, ask Fabian
-no_panel <- no_panel %>% mutate(groupTime1774 = case_when(is.na(groupTime1774) ~ 0, TRUE ~ groupTime1774),
- groupTime1784 = case_when(is.na(groupTime1784) ~ 0, TRUE ~ groupTime1784),
- groupTime1775 = case_when(is.na(groupTime1775) ~ 0, TRUE ~ groupTime1775),
- groupTime1785 = case_when(is.na(groupTime1785) ~ 0, TRUE ~ groupTime1785)) %>%
- mutate(interviewtime_net = interviewtime - groupTime1774 - groupTime1784 - groupTime1775 - groupTime1785)
-
-no_panel_filt <- no_panel %>% filter(Treatment_new != 3 & Treatment_new != 6) %>%
- mutate(Dummy_Group_2 = case_when(Treatment_new > 2 ~ 1, TRUE ~0))
-
-treatment_model <- lm(data=no_panel_filt, log(groupTime1774) ~ Age + Gender_female +
- Kids_Dummy + Uni_degree + log(interviewtime_net) + log(Screen) + Dummy_Group_2 +
- Employment_full + Pensioner)
-
-summary(treatment_model)
-
-
-interviewtime_model <- lm(data=no_panel, log(interviewtime_net) ~ Age + Gender_female +
- log(Rent_SQ) + Kids_Dummy + Uni_degree + Employment_full +
- Pensioner + log(Screen))
-
-summary(interviewtime_model)
+library(viridis)
+
+data_grouped <- database %>%
+ group_by(id) %>%
+ summarise(across(c(Treatment, Treatment_new), list( gr= ~unique(.))))
+
+data_grouped <- data_grouped %>%
+ mutate(Treatment_name = case_when(
+ Treatment_new_gr == 1 ~ 'Video 1',
+ Treatment_new_gr == 2 ~ 'No Video 1',
+ Treatment_new_gr == 3 ~ 'No Info 2',
+ Treatment_new_gr == 4 ~ 'No Video 2',
+ Treatment_new_gr == 5 ~ 'Video 2',
+ Treatment_new_gr == 6 ~ 'No Treatment 3',
+ TRUE ~ NA_character_
+ ))
+treatment_order<- c("Video 1", "No Video 1", "No Info 2","No Video 2", "Video 2" ,"No Treatment 3")
+
+data_grouped <- data_grouped %>% filter(!is.na(Treatment_gr))
+
+ggplot(data=data_grouped) +
+ geom_bar(aes(x=factor(Treatment_name, levels=c("No Video 1", "Video 1", "No Info 2", "No Video 2", "Video 2",
+ "No Treatment 3")),
+ group=as.factor(Treatment_gr), fill=as.factor(Treatment_gr))) +
+ xlab("Treatment Group") +
+ ylab("Count") +
+ scale_fill_viridis(option="D", discrete = T, labels=c("Always Info", "Optional Info", "Never Info")) +
+ labs(fill="Treatment Group")
+
+ggsave("Figures/barplot_treatment.png", width=7, height=5, dpi="print")
+
+
+#### Inspect socio-demographic differences ####
+
+
+### Case A
+treatment_socio_A <- database_full %>%
+ group_by(Treatment_A) %>%
+ summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
+ "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
+ ~ round(mean(., na.rm = TRUE), 2))
+
+
+# Export table as tex file
+print(xtable(treatment_socio_A, type ="latex"),
+ include.rownames = F, file ="Tables/socio_demos_A.tex")
+
+### Case B
+
+treatment_socio_B <- database_full %>% filter(Treatment_B == "Treated" | Treatment_A == "Not_Treated") %>%
+ group_by(Treatment_B) %>%
+ summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
+ "Naturalness_SQ", "Employment_full", "Pensioner"),
+ ~ round(mean(., na.rm = TRUE), 2))
+
+
+# Export table as tex file
+print(xtable(treatment_socio_B, type ="latex"),
+ include.rownames = F, file ="Tables/socio_demos_B.tex")
+
+### Case C
+treatment_socio <- database_full %>% filter(!is.na(Treatment)) %>% group_by(Treatment_C) %>%
+ summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
+ "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
+ ~ round(mean(., na.rm = TRUE), 2))
+
+treatment_socio_C <- database_full %>% filter(!is.na(Treatment_new)) %>% group_by(Treatment_C) %>%
+ summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
+ "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
+ ~ round(mean(., na.rm = TRUE), 2))
+#
+# treatment_socio_C <- treatment_socio_C %>% mutate(Treatment_name = case_when(
+# Treatment_new == 1 ~ 'Video 1',
+# Treatment_new == 2 ~ 'No Video 1',
+# Treatment_new == 3 ~ 'No Info 2',
+# Treatment_new == 4 ~ 'No Video 2',
+# Treatment_new == 5 ~ 'Video 2',
+# Treatment_new == 6 ~ 'No Treatment 3',
+# TRUE ~ NA_character_
+# ))
+
+# Export table as tex file
+print(xtable(treatment_socio_C, type ="latex"),
+ include.rownames = F, file ="Tables/socio_demos_C.tex")
+
+
+### Create boxplot for text treatment page #
+
+database_textpage <- database_full %>% filter(Treatment_new != 6)
+
+ggplot(data=database_textpage) +
+ geom_boxplot(aes(y=groupTime1774, x= Treatment_new, group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
+ coord_cartesian(ylim = c(0, 180)) +
+ labs(fill="Treatment") +
+ xlab("Treatment") +
+ ylab("Time on Info Text Page")
+
+ggsave("Figures/treatment_time_bxplt.png", width=7, height = 5, dpi="print")
+
+
+
+table(database_full$Treatment_C)
+### Create boxplot for interview time per group #, remove quiz group 1776
+database_full <- database_full %>% mutate(groupTime1774 = case_when(is.na(groupTime1774) ~ 0, TRUE ~ groupTime1774),
+ groupTime1784 = case_when(is.na(groupTime1784) ~ 0, TRUE ~ groupTime1784),
+ groupTime1775 = case_when(is.na(groupTime1775) ~ 0, TRUE ~ groupTime1775),
+ groupTime1785 = case_when(is.na(groupTime1785) ~ 0, TRUE ~ groupTime1785),
+ groupTime1786 = case_when(is.na(groupTime1786) ~ 0, TRUE ~ groupTime1786)) %>%
+ mutate(interviewtime_net = interviewtime - groupTime1774 - groupTime1784 - groupTime1775 - groupTime1785- groupTime1786 - groupTime1776)
+# Calculate the cutoff values for the lowest and highest 1 percent
+lower_cutoff <- quantile(database_full$interviewtime_net, 0.01)
+upper_cutoff <- quantile(database_full$interviewtime_net, 0.95)
+
+# Filter the data to keep only values within the specified range
+database_full <- database_full %>%
+ mutate(interviewtime_net_clean = ifelse(between(interviewtime_net, lower_cutoff, upper_cutoff), interviewtime_net, NA))
+
+# Assuming 'database' is your data frame
+video2_data <- subset(database_full, Treatment_C == "Video 2")
+
+# Summary statistics for interview time in 'Video 2' cases
+summary(video2_data$interviewtime_net_clean)
+# Assuming 'database' is your data frame
+sorted_database <- video2_data[order(video2_data$interviewtime_net_clean, decreasing = F), ]
+
+# Display the ten highest values of interview time
+top_10_highest <- tail(sorted_database$interviewtime_net_clean, 200)
+print(top_10_highest)
+
+
+bxplt_interview_time_A<-ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
+ geom_boxplot(aes(y=interviewtime_net_clean, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
+ coord_cartesian(ylim = c(500, 2900)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("Net Interview Time (s)")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+bxplt_interview_time_B<-ggplot(data=database_full) +
+ geom_boxplot(aes(y=interviewtime_net_clean, x= Treatment_B, group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
+ coord_cartesian(ylim = c(500, 2900)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("Net Interview Time (s)")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+bxplt_interview_time_C<-ggplot(data=database_full) +
+ geom_boxplot(aes(y=interviewtime_net_clean, x= factor(Treatment_new, labels = treatment_order), group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
+ coord_cartesian(ylim = c(500, 2900)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("Net Interview Time (s)")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ggsave("Figures/interview_time_bxplt.png", width=7, height = 5, dpi="print")
+
+
+# Boxplot Video Time
+
+video_resp <- database_full %>% filter(Treatment_new == 1 | Treatment_new == 5)
+
+ggplot(data=video_resp) +
+ geom_boxplot(aes(y=groupTime1784, x= Treatment_name, group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
+ coord_cartesian(ylim = c(100, 300)) +
+ labs(fill="Treatment") +
+ xlab("Treatment") +
+ ylab("Time on Video Page")
+
+ggsave("Figures/video_time_bxplt.png", width=7, height = 5, dpi="print")
+
+
+#### Time per choice cards ####
+
+database_full <- database_full %>% rowwise() %>% mutate(CC_time = sum(c(c_across(groupTime1740:groupTime1767), groupTime1735,
+ groupTime1736), na.rm=TRUE),
+ CC_time_mean = CC_time/10)
+
+# Calculate the cutoff values for the lowest and highest 1 percent
+lower_cutoff <- quantile(database_full$CC_time_mean, 0.01)
+upper_cutoff <- quantile(database_full$CC_time_mean, 0.99)
+
+# Filter the data to keep only values within the specified range
+database_full <- database_full %>%
+ mutate(CC_time_mean_clean = ifelse(between(CC_time_mean, lower_cutoff, upper_cutoff), CC_time_mean, NA))
+
+bxplt_cc_time_A<- ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
+ geom_boxplot(aes(y=CC_time_mean_clean, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
+ coord_cartesian(ylim = c(5, 40)) +
+ labs(fill="Treatment") +
+ xlab("Treatment") +
+ ylab("Mean Time CC (s)")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+bxplt_cc_time_B<- ggplot(data=database_full) +
+ geom_boxplot(aes(y=CC_time_mean_clean, x= Treatment_B, group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
+ coord_cartesian(ylim = c(5, 40)) +
+ labs(fill="Treatment") +
+ xlab("Treatment") +
+ ylab("Mean Time CC (s)")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ bxplt_cc_time_C<- ggplot(data=database_full) +
+ geom_boxplot(aes(y=CC_time_mean_clean, x= factor(Treatment_new, labels = treatment_order), group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
+ coord_cartesian(ylim = c(5, 40)) +
+ labs(fill="Treatment") +
+ xlab("Treatment") +
+ ylab("Mean Time CC (s)")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ ggsave("Figures/cc_time_bxplt.png", width=7, height = 5, dpi="print")
+
+#### Regression Treatment Time ####
+
+
+no_panel <- database_full %>% filter(!is.na(Treatment)) %>% group_by(id) %>%
+ summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "groupTime1774", "Treatment_new",
+ "WorkingTime", "interviewtime", "groupTime1733", "groupTime1784", "groupTime1775",
+ "groupTime1785", "Number_Kids", "Kids_Dummy",
+ "Screen", "Naturalness_SQ", "Employment_full", "Pensioner"),
+ ~ round(mean(., na.rm = TRUE), 2))
+
+#### Number opt-out choices
+
+ database_full <- database_full %>%
+ group_by(id) %>%
+ mutate(count_choosen_3 = sum(choice == 3, na.rm = TRUE)) %>%
+ ungroup()
+
+ bxplt_opt_A <-ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
+ geom_boxplot(aes(y=count_choosen_3, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
+ stat_summary(
+ aes(x = Treatment_A, y = count_choosen_3, group = Treatment_A),
+ fun = mean, geom = "point", shape = 18, size = 3,
+ position = position_dodge(width = 0.75) )+
+ coord_cartesian(ylim = c(0, 10)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("No. of Opt-Out Choices")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ bxplt_opt_B <-ggplot(data=database_full) +
+ geom_boxplot(aes(y=count_choosen_3, x= Treatment_B, group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
+ stat_summary(
+ aes(x = Treatment_B, y = count_choosen_3, group = Treatment_B),
+ fun = mean, geom = "point", shape = 18, size = 3,
+ position = position_dodge(width = 0.75) )+
+ coord_cartesian(ylim = c(0, 10)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("No. of Opt-Out Choices")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ bxplt_opt_C <-ggplot(data=database_full) +
+ geom_boxplot(aes(y=count_choosen_3, x= factor(Treatment_new, labels = treatment_order) , group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
+ stat_summary(
+ aes(x = factor(Treatment_new, labels = treatment_order), y = count_choosen_3, group = Treatment_name),
+ fun = mean, geom = "point", shape = 18, size = 3,
+ position = position_dodge(width = 0.75) )+
+ coord_cartesian(ylim = c(0, 10)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("No. of Opt-Out Choices")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ ggsave("Figures/number_opt_out_bxplt.png", width=7, height = 5, dpi="print")
+
+# Take a look at always opt out people
+always_opt_out <- database_full %>% filter(count_choosen_3 == 10)
+
+table(always_opt_out$Treatment)
+table(always_opt_out$Treatment_C)
+summary(always_opt_out$Z_Mean_NR)
+
+
+#### Quiz questions
+
+ data <- database_full %>%
+ group_by(id) %>%
+ slice(1) %>%
+ ungroup()
+
+ ## Count correct answers after Treatment for Treatment Group (before CE)
+ data <- data %>%
+ mutate(correct_q1 = ifelse(TV01W3 == "A1", 1, 0)) %>%
+ mutate(correct_q2 = ifelse(TV02W3 == "A2", 1, 0)) %>%
+ mutate(correct_q3 = ifelse(TV03W3 == "AO01", 1, 0)) %>%
+ mutate(correct_q4 = ifelse(TV04W3 == "AO01", 1, 0)) %>%
+ mutate(correct_q5 = ifelse(TV05W3 == "AO02", 1, 0)) %>%
+ mutate(correct_q6 = ifelse(TV06W3 == "AO02", 1, 0)) %>%
+ mutate(correct_q7 = ifelse(TV07W3 == "AO01", 1, 0)) %>%
+ mutate(number_correct = rowSums(select(., starts_with("correct_q")))) %>%
+ mutate(number_correct = ifelse(TV01W3=="",NA , number_correct))
+
+ table(data$number_correct, useNA = "always" )
+ ## Count correct answers for all groups (after DCE)
+ data <- data %>%
+ mutate(b_correct_q1 = ifelse(TV11W3 == "A1", 1, 0)) %>%
+ mutate(b_correct_q2 = ifelse(TV12W3 == "A2", 1, 0)) %>%
+ mutate(b_correct_q3 = ifelse(TV15W3 == "AO01", 1, 0)) %>%
+ mutate(b_correct_q4 = ifelse(TV16W3 == "AO01", 1, 0)) %>%
+ mutate(b_correct_q5 = ifelse(TV17W3 == "AO02", 1, 0)) %>%
+ mutate(b_correct_q6 = ifelse(TV18W3 == "AO02", 1, 0)) %>%
+ mutate(b_correct_q7 = ifelse(TV19W3 == "AO01", 1, 0)) %>%
+ mutate(b_number_correct = rowSums(select(., starts_with("b_correct_q"))))%>%
+ mutate(number_correct = ifelse(is.na(number_correct), b_number_correct, number_correct)) %>%
+ mutate(percentage_correct = (number_correct/7)*100)
+
+ bxplt_quiz_A <- ggplot(data=data[!is.na(data$Treatment_A), ]) +
+ geom_boxplot(aes(y=percentage_correct, x= Treatment_A , group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
+ stat_summary(
+ aes(x = Treatment_A, y = percentage_correct, group = Treatment_A),
+ fun = mean, geom = "point", shape = 18, size = 3,
+ position = position_dodge(width = 0.75) )+
+ coord_cartesian(ylim = c(20, 100)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("%. of Correct Statements")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ bxplt_quiz_B <- ggplot(data=data) +
+ geom_boxplot(aes(y=percentage_correct, x= Treatment_B , group=Treatment_B, fill=Treatment_B), outlier.shape = NA) +
+ stat_summary(
+ aes(x = Treatment_B, y = percentage_correct, group = Treatment_B),
+ fun = mean, geom = "point", shape = 18, size = 3,
+ position = position_dodge(width = 0.75) )+
+ coord_cartesian(ylim = c(20, 100)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("%. of Correct Statements")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ bxplt_quiz_C <- ggplot(data=data) +
+ geom_boxplot(aes(y=percentage_correct, x= factor(Treatment_new, labels = treatment_order) , group=Treatment_name, fill=Treatment_name), outlier.shape = NA) +
+ stat_summary(
+ aes(x = factor(Treatment_new, labels = treatment_order), y = percentage_correct, group = Treatment_name),
+ fun = mean, geom = "point", shape = 18, size = 3,
+ position = position_dodge(width = 0.75) )+
+ coord_cartesian(ylim = c(20, 100)) +
+ labs(fill="Treatment") +
+ xlab("") +
+ ylab("%. of Correct Statements")+
+ scale_x_discrete( guide = guide_axis(angle = 45))+
+ theme_minimal() + # Adjust the theme as needed
+ theme(legend.position = "none")
+
+ ggsave("Figures/correct_statements_bxplt.png", width=7, height = 5, dpi="print")
+ quiz_data<-data
+# Maybe need to add other groups, ask Fabian
+no_panel <- no_panel %>% mutate(groupTime1774 = case_when(is.na(groupTime1774) ~ 0, TRUE ~ groupTime1774),
+ groupTime1784 = case_when(is.na(groupTime1784) ~ 0, TRUE ~ groupTime1784),
+ groupTime1775 = case_when(is.na(groupTime1775) ~ 0, TRUE ~ groupTime1775),
+ groupTime1785 = case_when(is.na(groupTime1785) ~ 0, TRUE ~ groupTime1785)) %>%
+ mutate(interviewtime_net = interviewtime - groupTime1774 - groupTime1784 - groupTime1775 - groupTime1785)
+
+no_panel_filt <- no_panel %>% filter(Treatment_new != 3 & Treatment_new != 6) %>%
+ mutate(Dummy_Group_2 = case_when(Treatment_new > 2 ~ 1, TRUE ~0))
+
+treatment_model <- lm(data=no_panel_filt, log(groupTime1774) ~ Age + Gender_female +
+ Kids_Dummy + Uni_degree + log(interviewtime_net) + log(Screen) + Dummy_Group_2 +
+ Employment_full + Pensioner)
+
+summary(treatment_model)
+
+
+interviewtime_model <- lm(data=no_panel, log(interviewtime_net) ~ Age + Gender_female +
+ log(Rent_SQ) + Kids_Dummy + Uni_degree + Employment_full +
+ Pensioner + log(Screen))
+
+summary(interviewtime_model)
diff --git a/project_start.qmd b/project_start.qmd
index 4d61464034a7b385bd0d8f2ffbd6ae6d8ec65bac..67d1c46fb8ca2949420f08b785222c8a3b1002dd 100644
--- a/project_start.qmd
+++ b/project_start.qmd
@@ -47,7 +47,7 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
- **Stated preference** methods are frequently applied in **environmental valuation** to estimate economic values of policies, goods, and services that cannot be valued otherwise.
- Stated preference methods face **validity challenges**.
- Valid value estimation requires **sufficient information** provision about the good being valued.
-- Still unclear **what formats of information** and **how much information** are optimal for valid preference elicitation.
+- Still unclear **what formats of information provision** and **how much information** are optimal for valid preference elicitation.
:::
## Motivation (2)
@@ -57,6 +57,8 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
- Too **little information** may lead respondents to **not** being able to make an **informed choice**.
- Valid preference elicitation depends not only on the provision of information, but also on the **appropriate processing and recall** of the information by the respondent.
- **Optional information** allows the respondents to gather required information if needed and might increase efficiency of information provision
+
+- Providing optional information should enhance optimal information seeking leading to less heterogeneity in good-specific knowledge between the respondents
:::
## Literature
@@ -64,7 +66,7 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
::: incremental
- There is **little research** on the effects of **optional information provision** on choice behavior and information recall.
- In their study, @tienhaara2022information surveyed preferences for agricultural genetic resources, allowing respondents the option to access detailed information on the valued goods prior to preference elicitation.
-- Similarly, @hu2009consumers offered respondents the opportunity to access voluntary information about genetic modified food before participating in a choice experiment.
+- Similarly, @hu2009consumers offered respondents the opportunity to access optional information about genetic modified food before participating in a choice experiment.
- Both studies conclude that, on average, respondents who voluntary retrieve information have **larger willingness to pay** for the good to be valued.
- Their study design, however, does not allow comparing the optional information retrieval to a version where the additional information was shown obligatory.
:::
@@ -81,8 +83,16 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
::: incremental
1. Do obligatory and optional information provision affect **survey engagement**, **information recall**, **consequentiality**, and **stated preferences**?
+
+- OLS and MXL with interactions
+
2. Do **socio-demographic** or **attitudinal** variables influence the decision to **access optional information**?
+
+- Logit regression
+
3. Do **survey engagement**, **information recall**, **consequentiality**, and **stated preferences** differ between respondents who **voluntary access information** and those who do not?
+
+- OLS and MXL with interactions
:::
# Survey & Data
@@ -151,58 +161,56 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
{width="300"}
-## Methods (1) {auto-animate="true"}
+<!-- ## Methods (1) {auto-animate="true"} -->
-- OLS regression (survey engagement, information recall, consequentiality):
+<!-- - OLS regression (survey engagement, information recall, consequentiality): -->
-```{=tex}
-\begin{equation}
- Y = \beta_0 + \beta_{Treat} \cdot v_{Treat} + \beta_{Control} \cdot v_{Control} + \epsilon
- \label{ols}
-\end{equation}
-```
-- Mixed logit model with interactions in WTP space:
+<!-- ```{=tex} -->
+<!-- \begin{equation} -->
+<!-- Y = \beta_0 + \beta_{Treat} \cdot v_{Treat} + \beta_{Control} \cdot v_{Control} + \epsilon -->
+<!-- \label{ols} -->
+<!-- \end{equation} -->
+<!-- ``` -->
+<!-- - Mixed logit model with interactions in WTP space: -->
-```{=tex}
-\begin{equation}
- U_i = -(\beta_{C_i} + \beta_{TreatC_i} \cdot v_{Treat}) \cdot (\beta_{X_i} \cdot v_{X_i} + \beta_{TreatX_i} \cdot v_{X_i} \cdot v_{Treat} - C_i) + \epsilon_i
- \label{mxl_base}
-\end{equation}
-```
-## Methods (2) {auto-animate="true"}
-- Mixed logit model with interactions in WTP space:
+<!-- ## Methods (2) {auto-animate="true"} -->
-```{=tex}
-\begin{equation}
- U_i = -(\beta_{C_i} + \beta_{TreatC_i} \cdot v_{Treat}) \cdot (\beta_{X_i} \cdot v_{X_i} + \beta_{TreatX_i} \cdot v_{X_i} \cdot v_{Treat} - C_i) + \epsilon_i
-\end{equation}
-```
-with
+<!-- - Mixed logit model with interactions in WTP space: -->
-```{=tex}
-\begin{equation}
- v_{X_i} = \{ASC_{sq_i}, Nat_i, WD_i\}
-\end{equation}
-```
-and
+<!-- ```{=tex} -->
+<!-- \begin{equation} -->
+<!-- U_i = -(\beta_{C_i} + \beta_{TreatC_i} \cdot v_{Treat}) \cdot (\beta_{X_i} \cdot v_{X_i} + \beta_{TreatX_i} \cdot v_{X_i} \cdot v_{Treat} - C_i) + \epsilon_i -->
+<!-- \end{equation} -->
+<!-- ``` -->
+<!-- with -->
+
+<!-- ```{=tex} -->
+<!-- \begin{equation} -->
+<!-- v_{X_i} = \{ASC_{sq_i}, Nat_i, WD_i\} -->
+<!-- \end{equation} -->
+<!-- ``` -->
+<!-- and -->
+
+<!-- ```{=tex} -->
+<!-- \begin{equation} -->
+<!-- v_{Treat_A} = \{Treated, Optional Treatment\} -->
+<!-- \end{equation} -->
+<!-- ``` -->
+<!-- ```{=tex} -->
+<!-- \begin{equation} -->
+<!-- v_{Treat_B} = \{Treated, Vol. Treated, No Info\} -->
+<!-- \end{equation} -->
+<!-- ``` -->
-```{=tex}
-\begin{equation}
- v_{Treat_A} = \{Treated, Optional Treatment\}
-\end{equation}
-```
-```{=tex}
-\begin{equation}
- v_{Treat_B} = \{Treated, Vol. Treated, No Info\}
-\end{equation}
-```
# Case A: Obligatory vs. Optional Information
## Case A
+1. Do obligatory and optional information provision affect **survey engagement**, **information recall**, **consequentiality**, and **stated preferences**?
+
{width="300"}
<!-- ::: {style="font-size: 45%;"} -->
@@ -227,17 +235,52 @@ and
## OLS: Engagement
+::: panel-tabset
+
+### OLS Specification
+
```{=tex}
\begin{equation}
- Y = \beta_0 + \beta_{Treat} \cdot v_{Treat} + \beta_{Control} \cdot v_{Control} + \epsilon
+ Y = \beta_0 + \beta_{Treat} \cdot v_{Treat} + \beta_{SocDem} \cdot v_{SocDem} + \epsilon
\label{olss}
\end{equation}
```
+with
+
+```{=tex}
+\begin{equation}
+ Y = \left\{
+ \begin{aligned}
+ &\text{Net Interview Time, Mean Choice Card Time} \\
+ &\text{Percentage of correct quiz statements, Consequentiality Score}
+ \end{aligned}
+ \right\}
+\end{equation}
+```
+
+
+```{=tex}
+\begin{equation}
+ v_{Treat} = \{\text{Treated, Optional Treatment}\}
+\end{equation}
+```
+
+```{=tex}
+\begin{equation}
+ v_{SocDem} = \{\text{Age, Gender, Income, Education, NR-Index}\}
+\end{equation}
+```
+
+
+### Results
+
```{r}
ggpubr::ggarrange(plot_interview_A, plot_cc_A)
```
+:::
+
## OLS: Information Recall & Consequentiality
```{r}
@@ -246,7 +289,38 @@ ggpubr::ggarrange(plot_mani_A, plot_cons_A)
## MXL: Effects on Stated Preferences
-::: {style="font-size: 80%;"}
+::: panel-tabset
+
+### MXL Specification
+
+```{=tex}
+\begin{equation}
+ U_i = -(\beta_{C_i} + \beta_{TreatC_i} \cdot v_{Treat}) \cdot (\beta_{X_i} \cdot v_{X_i} + \beta_{TreatX_i} \cdot v_{X_i} \cdot v_{Treat} - C_i) + \epsilon_i
+ \label{mxl_base}
+\end{equation}
+```
+with
+
+```{=tex}
+\begin{equation}
+ v_{X_i} = \{ASC_{sq_i}, Nat_i, WD_i\}
+\end{equation}
+```
+
+```{=tex}
+\begin{equation}
+ v_{Treat} = \{\text{Treated, Optional Treatment}\}
+\end{equation}
+```
+```{=tex}
+\begin{equation}
+ C_i = \{Rent_i\}
+\end{equation}
+```
+
+### Results
+
+::: {style="font-size: 68%;"}
```{r, results='asis'}
htmlreg(c(case_A_cols[1], remGOF(case_A_cols[2:4])),
custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
@@ -259,17 +333,24 @@ htmlreg(c(case_A_cols[1], remGOF(case_A_cols[2:4])),
```
:::
+
+:::
+
# Case B: Voluntary Information Access
-## Case B
+## Voluntary Information Access
+
+2. Do **socio-demographic** or **attitudinal** variables influence the decision to **access optional information**?
+
+{width="300"}
+
-{width="300"}
## Logit Regression: Who chooses Optional Information?
```{=tex}
\begin{equation}
- Y = \beta_0 + \beta_{Control} \cdot v_{Control} + \epsilon
+ Y = \beta_0 + \beta_{SocDem} \cdot v_{SocDem} + \epsilon
\label{simple_logit}
\end{equation}
```
@@ -289,6 +370,13 @@ htmlreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="t
```
:::
+
+## Case B
+
+3. Do **survey engagement**, **information recall**, **consequentiality**, and **stated preferences** differ between respondents who **voluntary access information** and those who do not?
+
+{width="300"}
+
## OLS Engagement: Interview & Choice Card Time
```{r}
@@ -340,13 +428,11 @@ htmlreg(c(case_B_cols_NR[1], remGOF(case_B_cols_NR[2:6])),
1. Do obligatory and optional information provision affect survey engagement, information recall, consequentiality, and stated preferences?
::: incremental
-- Obligatory and voluntary treatments do not increase survey engagement measured via time spend on the survey
-
-- Small negative effect for obligatory treatment on survey engagement
+- Obligatory and optional treatments do not increase survey engagement measured via time spend on the survey
- Both treatments increase information recall, stronger effect for obligatory treatment
-- No effect on consequentiality
+- No effects on consequentiality
- Strong effects on stated preferences for both treatments, more pronounced effect for the obligatory treatment
:::
@@ -368,27 +454,21 @@ htmlreg(c(case_B_cols_NR[1], remGOF(case_B_cols_NR[2:6])),
3. Do survey engagement, information recall, consequentiality, and stated preferences differ between respondents who voluntary access information and those who do not?
::: incremental
-- Respondents that voluntary access information do engage more in the survey & have a higher consequentiality score
+- Respondents that voluntary access information do not engage more in the survey, but perform best in the quiz
-- Voluntary information access is negatively correlated with number of status quo choices
+- Respondents that decide to not access additional information engage less in the survey, have a lower consequentiality score and do not perform different in the quiz than the non-treated respondents
-- Higher willingness to pay values in groups that voluntary access information
+- Highest willingness to pay values in the group that voluntary accesses information
:::
## Conclusion
::: incremental
-- Obligatory and voluntary information treatments increase information recall and willingness to pay for naturalness of and proximity to urban green spaces
-
-- Exogenous treatments do not affect consequentiality
-
-- Voluntary information access is correlated with increased consequentiality, higher survey engagement and higher willingness to pay
-
-- Obligatory information treatment is more effective than optional on the cost of slightly reduced survey engagement
+- Providing optional information does not lead to optional information seeking
-- Voluntarily accessed treatment shows strongest effects, but is highly endogenous
+- Optional information is mostly accessed by people that are interested in the good to be valued
-- Providing optional information seem to rather increase inequality in good-specific knowledge than decreasing it
+- We recommend to use obligatory information provision rather than optional one
:::
## References