Skip to content
Snippets Groups Projects
Commit 568da154 authored by nc71qaxa's avatar nc71qaxa
Browse files

WONV adjustments

parent d86a4b35
No related branches found
No related tags found
No related merge requests found
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)
......@@ -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" =
![](Grafics/FlowChart_4_groups.png){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**?
![](Grafics/FlowChart_4_groups_A.png){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**?
![](Grafics/FlowChart_Optional_only.png){width="300"}
![](Grafics/FlowChart_4_groups_B.png){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?
![](Grafics/FlowChart_4_groups_B.png){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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment