From cc01d3afeb1a236d2f0bc8d0ff43aec364f4741b Mon Sep 17 00:00:00 2001
From: Nino Cavallaro <nino.cavallaro@idiv.de>
Date: Sun, 17 Mar 2024 12:44:50 +0100
Subject: [PATCH] presentation discussion
---
.gitignore | 34 +-
Scripts/MAKE_FILE.R | 196 ++++-----
Scripts/compare_split_samples.R | 406 +++++++++---------
Scripts/create_tables.R | 332 +++++++-------
Scripts/data_prep.R | 252 +++++------
Scripts/interaction_plots_presi.R | 116 ++---
.../mxl/mxl_wtp_space_NR_caseC_RentINT_X.R | 388 ++++++++---------
Scripts/nat_interaction_plot.R | 52 +--
Scripts/ols/ols_consequentiality.R | 56 +--
Scripts/ols/ols_nr.R | 46 +-
Scripts/ols/ols_opt_out.R | 160 +++----
Scripts/ols/ols_quiz.R | 128 +++---
Scripts/ols/ols_time_spent.R | 144 +++----
project_start.qmd | 308 +++++++------
14 files changed, 1341 insertions(+), 1277 deletions(-)
diff --git a/.gitignore b/.gitignore
index c591ceb..e983046 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,18 +1,18 @@
-.Rproj.user
-.Rhistory
-*.RData
-.Ruserdata
-*.rds
-*.xlsx
-*.png
-Thumbs.db
-/Estimation_results/
-*.pptx
-/Data
-/Tables
-*.pdf
-
-# Presentation quarto output
-project_start.html
-/project_start_cache
+.Rproj.user
+.Rhistory
+*.RData
+.Ruserdata
+*.rds
+*.xlsx
+*.png
+Thumbs.db
+/Estimation_results/
+*.pptx
+/Data
+/Tables
+*.pdf
+
+# Presentation quarto output
+project_start.html
+/project_start_cache
/project_start_files
\ No newline at end of file
diff --git a/Scripts/MAKE_FILE.R b/Scripts/MAKE_FILE.R
index 84e3ec0..08efb1f 100644
--- a/Scripts/MAKE_FILE.R
+++ b/Scripts/MAKE_FILE.R
@@ -1,99 +1,99 @@
-rm(list=ls())
-library(tidyverse)
-library(tidylog)
-library(apollo)
-library(reshape2)
-library(xtable)
-library(stargazer)
-library(texreg)
-#test
-# Set values for estimation in Apollo
-n_draws <- 2000
-n_cores <- min(parallel::detectCores()-1, 25)
-
-# Load data
-load("Data/database_full.RData")
-load("Data/database.RData")
-
-# Data preparation
-source("Scripts/data_prep.R")
-source("Scripts/treatment.R")
-
-####### Estimate models ######
-
-### Logit
-source("Scripts/logit/chr_vol_treat.R")
-source("Scripts/logit/protesters.R")
-
-### OLS
-source("Scripts/ols/ols_time_spent.R")
-source("Scripts/ols/ols_quiz.R")
-source("Scripts/ols/ols_opt_out.R")
-source("Scripts/ols/ols_nr.R")
-source("Scripts/ols/ols_consequentiality.R")
-
-##### Conditional Logits #####
-#source("Scripts/clogit.R")
-#source("Scripts/clogit_wtp.R")
-
-##### Mixed Logit Models ######
-
-#source("Scripts/mxl/mxl_wtp_space.R")
-#source("Scripts/mxl/mxl_wtp_space_4d.R")
-#source("Scripts/mxl/mxl_wtp_space_interact_all.R")
-#source("Scripts/mxl/mxl_socio_int.R")
-#source("Scripts/mxl/mxl_treatment_time.R")
-#source("Scripts/mxl/mxl_treatment_time_interaction.R")
-#source("Scripts/mxl/mxl_treatment_time_Dummies.R")
-#source("Scripts/mxl/mxl_wtp_space_interact_everything.R")
-#source("Scripts/mxl/mxl_wtp_space_4d_interact_everything.R")
-#############################
-
-##### Load models ############
-
-mxl_wtp <- apollo_loadModel("Estimation_results/mxl/MXL_wtp")
-mxl_wtp_4d <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_4d")
-mxl_wtp_all_int <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_interact_all")
-mxl_wtp_socio <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_socio_int")
-mxl_wtp_tt <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_treatment_time")
-mxl_wtp_tt_interaction <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_treatment_time_interaction")
-mxl_wtp_time_groups <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_time_groups")
-mxl_wtp_everything <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_interact_everything")
-mxl_wtp_case_a <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case A")
-mxl_wtp_case_a_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR A")
-mxl_wtp_case_b <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case B")
-mxl_wtp_case_b_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR B")
-mxl_wtp_case_c <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_Case_C")
-mxl_wtp_case_c_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_NR_Case_C")
-
-# rent interactions models
-mxl_wtp_case_a_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case A Rent Int")
-mxl_wtp_case_b_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case B Rent Int")
-mxl_wtp_case_c_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_Case_C Rent INT")
-
-# rent interactions models NR
-mxl_wtp_NR_case_a_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR A Rent INT")
-mxl_wtp_NR_case_c_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_NR_Case_C RENT INT X")
-
-# Alternative case
-case_d <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case D Rent Int")
-
-##############################
-
-# Model analysis
-source("Scripts/visualize_models.R")
-
-source("Scripts/compare_split_samples.R")
-
-source("Scripts/create_tables.R")
-
-source("Scripts/interaction_plots_presi.R")
-
-
-### Old models ###
-
-
-# # without protesters
-# mxl_wtp_case_a_prot <- apollo_loadModel("Estimation_results/mxl/without_protesters/MXL_wtp Case A prot")
-# mxl_wtp_case_b_prot <- apollo_loadModel("Estimation_results/mxl/without_protesters/MXL_wtp Case B prot")
+rm(list=ls())
+library(tidyverse)
+library(tidylog)
+library(apollo)
+library(reshape2)
+library(xtable)
+library(stargazer)
+library(texreg)
+#test
+# Set values for estimation in Apollo
+n_draws <- 2000
+n_cores <- min(parallel::detectCores()-1, 25)
+
+# Load data
+load("Data/database_full.RData")
+load("Data/database.RData")
+
+# Data preparation
+source("Scripts/data_prep.R")
+source("Scripts/treatment.R")
+
+####### Estimate models ######
+
+### Logit
+source("Scripts/logit/chr_vol_treat.R")
+source("Scripts/logit/protesters.R")
+
+### OLS
+source("Scripts/ols/ols_time_spent.R")
+source("Scripts/ols/ols_quiz.R")
+source("Scripts/ols/ols_opt_out.R")
+source("Scripts/ols/ols_nr.R")
+source("Scripts/ols/ols_consequentiality.R")
+
+##### Conditional Logits #####
+#source("Scripts/clogit.R")
+#source("Scripts/clogit_wtp.R")
+
+##### Mixed Logit Models ######
+
+#source("Scripts/mxl/mxl_wtp_space.R")
+#source("Scripts/mxl/mxl_wtp_space_4d.R")
+#source("Scripts/mxl/mxl_wtp_space_interact_all.R")
+#source("Scripts/mxl/mxl_socio_int.R")
+#source("Scripts/mxl/mxl_treatment_time.R")
+#source("Scripts/mxl/mxl_treatment_time_interaction.R")
+#source("Scripts/mxl/mxl_treatment_time_Dummies.R")
+#source("Scripts/mxl/mxl_wtp_space_interact_everything.R")
+#source("Scripts/mxl/mxl_wtp_space_4d_interact_everything.R")
+#############################
+
+##### Load models ############
+
+mxl_wtp <- apollo_loadModel("Estimation_results/mxl/MXL_wtp")
+mxl_wtp_4d <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_4d")
+mxl_wtp_all_int <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_interact_all")
+mxl_wtp_socio <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_socio_int")
+mxl_wtp_tt <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_treatment_time")
+mxl_wtp_tt_interaction <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_treatment_time_interaction")
+mxl_wtp_time_groups <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_time_groups")
+mxl_wtp_everything <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_interact_everything")
+mxl_wtp_case_a <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case A")
+mxl_wtp_case_a_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR A")
+mxl_wtp_case_b <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case B")
+mxl_wtp_case_b_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR B")
+mxl_wtp_case_c <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_Case_C")
+mxl_wtp_case_c_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_NR_Case_C")
+
+# rent interactions models
+mxl_wtp_case_a_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case A Rent Int")
+mxl_wtp_case_b_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case B Rent Int")
+mxl_wtp_case_c_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_Case_C Rent INT")
+
+# rent interactions models NR
+mxl_wtp_NR_case_a_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR A Rent INT")
+mxl_wtp_NR_case_c_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_NR_Case_C RENT INT X")
+
+# Alternative case
+case_d <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case D Rent Int")
+
+##############################
+
+# Model analysis
+source("Scripts/visualize_models.R")
+
+source("Scripts/compare_split_samples.R")
+
+source("Scripts/create_tables.R")
+
+source("Scripts/interaction_plots_presi.R")
+
+
+### Old models ###
+
+
+# # without protesters
+# mxl_wtp_case_a_prot <- apollo_loadModel("Estimation_results/mxl/without_protesters/MXL_wtp Case A prot")
+# mxl_wtp_case_b_prot <- apollo_loadModel("Estimation_results/mxl/without_protesters/MXL_wtp Case B prot")
# mxl_wtp_case_c_prot <- apollo_loadModel("Estimation_results/mxl/without_protesters/MXL_wtp_Case_C prot")
\ No newline at end of file
diff --git a/Scripts/compare_split_samples.R b/Scripts/compare_split_samples.R
index 9fbb606..ab93b95 100644
--- a/Scripts/compare_split_samples.R
+++ b/Scripts/compare_split_samples.R
@@ -1,203 +1,203 @@
-#### Load WTP models for different treatments #####
-
-# Case A
-
-mxl_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Treated A")
-mxl_vol_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Vol_Treated A")
-mxl_not_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Not_Treated A")
-
-
-mxl_info_compare <- as.data.frame(mxl_tr$estimate)
-mxl_info_compare[2] <- as.data.frame(mxl_vol_tr$estimate)
-mxl_info_compare[3] <- as.data.frame(mxl_not_tr$estimate)
-
-alpha = 0.1
-mxl_info_compare$margin_of_error1 <- qnorm(1-alpha)*mxl_tr$robse
-mxl_info_compare$margin_of_error2 <- qnorm(1-alpha)*mxl_vol_tr$robse
-mxl_info_compare$margin_of_error3 <- qnorm(1-alpha)*mxl_not_tr$robse
-
-mxl_info_compare <- rownames_to_column(mxl_info_compare, "Coefficent")
-colnames(mxl_info_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
- "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
-
-
-mxl_melt_info <- melt(mxl_info_compare[1:4], id = "Coefficent")
-mxl_melt_info$ME <- mxl_info_compare$Margin_of_error_TR
-mxl_melt_info$ME[9:16] <- mxl_info_compare$Margin_of_error_VOL_TR
-mxl_melt_info$ME[17:24] <- mxl_info_compare$Margin_of_error_NOT_TR
-
-
-# Figure paper compare info treatments #
-ggplot(data=mxl_melt_info, aes(x=Coefficent, y=abs(value), fill=variable)) +
- geom_bar(stat="identity", position='dodge', width = 0.9) +
- geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
- ylab("Absolute Value") +
- xlab("Coefficient") +
- scale_x_discrete(guide = guide_axis(angle = 45)) +
- scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
- theme(legend.position = c(0.85, 0.8))
-
-ggsave("Figures/compare_split_samplesA.png", dpi = "print", width = 7, height = 5)
-
-# Case A log rent
-
-mxl_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Treated A log")
-mxl_vol_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Vol_Treated A log")
-mxl_not_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Not_Treated A log")
-
-
-mxl_info_compare <- as.data.frame(mxl_tr$estimate)
-mxl_info_compare[2] <- as.data.frame(mxl_vol_tr$estimate)
-mxl_info_compare[3] <- as.data.frame(mxl_not_tr$estimate)
-
-alpha = 0.05
-mxl_info_compare$margin_of_error1 <- qnorm(1-alpha)*mxl_tr$robse
-mxl_info_compare$margin_of_error2 <- qnorm(1-alpha)*mxl_vol_tr$robse
-mxl_info_compare$margin_of_error3 <- qnorm(1-alpha)*mxl_not_tr$robse
-
-mxl_info_compare <- rownames_to_column(mxl_info_compare, "Coefficent")
-colnames(mxl_info_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
- "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
-
-
-mxl_melt_info_log <- melt(mxl_info_compare[1:4], id = "Coefficent")
-mxl_melt_info_log$ME <- mxl_info_compare$Margin_of_error_TR
-mxl_melt_info_log$ME[8:14] <- mxl_info_compare$Margin_of_error_VOL_TR
-mxl_melt_info_log$ME[15:21] <- mxl_info_compare$Margin_of_error_NOT_TR
-
-mxl_melt_info_log <- mxl_melt_info_log %>% mutate(ME = case_when(abs(value) < 1 ~ ME*100, TRUE~ME),
- value = case_when(abs(value) < 1 ~ value*100, TRUE~value))
-
-# Figure paper compare info treatments #
-ggplot(data=mxl_melt_info_log, aes(x=Coefficent, y=abs(value), fill=variable)) +
- geom_bar(stat="identity", position='dodge', width = 0.9) +
- geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
- ylab("Absolute Value") +
- xlab("Coefficient") +
- scale_x_discrete(guide = guide_axis(angle = 45)) +
- scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
- theme(legend.position = c(0.85, 0.8))
-
-
-
-### Compare clogit models prefspace
-
-clogit_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A TR")
-clogit_vol_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A VOL TR")
-clogit_not_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A NOT TR")
-
-
-clogit_compare <- as.data.frame(clogit_tr$estimate)
-clogit_compare[2] <- as.data.frame(clogit_vol_tr$estimate)
-clogit_compare[3] <- as.data.frame(clogit_not_tr$estimate)
-
-alpha = 0.1
-clogit_compare$margin_of_error1 <- qnorm(1-alpha)*clogit_tr$robse
-clogit_compare$margin_of_error2 <- qnorm(1-alpha)*clogit_vol_tr$robse
-clogit_compare$margin_of_error3 <- qnorm(1-alpha)*clogit_not_tr$robse
-
-clogit_compare <- rownames_to_column(clogit_compare, "Coefficent")
-colnames(clogit_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
- "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
-
-
-clogit_melt <- melt(clogit_compare[1:4], id = "Coefficent")
-clogit_melt$ME <-clogit_compare$Margin_of_error_TR
-clogit_melt$ME[5:8] <- clogit_compare$Margin_of_error_VOL_TR
-clogit_melt$ME[9:12] <- clogit_compare$Margin_of_error_NOT_TR
-
-# Scale up rent and wd coefficients for visibility
-clogit_melt <- clogit_melt %>% mutate(ME = case_when(value <= 0.1 ~ ME*10, TRUE ~ ME),
- value = case_when(value <= 0.1 ~ value*10, TRUE ~ value))
-
-# Figure clogit prefspace
-ggplot(data=clogit_melt, aes(x=Coefficent, y=abs(value), fill=variable)) +
- geom_bar(stat="identity", position='dodge', width = 0.9) +
- geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
- ylab("Absolute Value") +
- xlab("Coefficient") +
- scale_x_discrete(guide = guide_axis(angle = 45)) +
- scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
- theme(legend.position = c(0.85, 0.8))
-
-
-## Clogit WTP space
-
-clogit_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A TR wtp")
-clogit_vol_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A VOL TR wtp")
-clogit_not_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A NOT TR wtp")
-
-
-clogit_compare <- as.data.frame(clogit_tr$estimate)
-clogit_compare[2] <- as.data.frame(clogit_vol_tr$estimate)
-clogit_compare[3] <- as.data.frame(clogit_not_tr$estimate)
-
-alpha = 0.1
-clogit_compare$margin_of_error1 <- qnorm(1-alpha)*clogit_tr$robse
-clogit_compare$margin_of_error2 <- qnorm(1-alpha)*clogit_vol_tr$robse
-clogit_compare$margin_of_error3 <- qnorm(1-alpha)*clogit_not_tr$robse
-
-clogit_compare <- rownames_to_column(clogit_compare, "Coefficent")
-colnames(clogit_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
- "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
-
-
-clogit_melt <- melt(clogit_compare[1:4], id = "Coefficent")
-clogit_melt$ME <-clogit_compare$Margin_of_error_TR
-clogit_melt$ME[5:8] <- clogit_compare$Margin_of_error_VOL_TR
-clogit_melt$ME[9:12] <- clogit_compare$Margin_of_error_NOT_TR
-
-# Scale up rent and wd coefficients for visibility
-clogit_melt <- clogit_melt %>% mutate(ME = case_when(abs(value) <= 0.5 ~ ME*1000, abs(value) <= 2 ~ ME*10, TRUE ~ ME),
- value = case_when(abs(value) <= 0.5 ~ abs(value)*1000, value <= 2 ~ value*10, TRUE ~ value))
-
-# Figure clogit prefspace
-ggplot(data=clogit_melt, aes(x=Coefficent, y=abs(value), fill=variable)) +
- geom_bar(stat="identity", position='dodge', width = 0.9) +
- geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
- ylab("Absolute Value") +
- xlab("Coefficient") +
- scale_x_discrete(guide = guide_axis(angle = 45)) +
- scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
- theme(legend.position = c(0.85, 0.8))
-
-
-## Clogit WTP space log rent
-
-clogit_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A TR wtp log")
-clogit_vol_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A VOL TR wtp log")
-clogit_not_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A NOT TR wtp log")
-
-
-clogit_compare <- as.data.frame(clogit_tr$estimate)
-clogit_compare[2] <- as.data.frame(clogit_vol_tr$estimate)
-clogit_compare[3] <- as.data.frame(clogit_not_tr$estimate)
-
-alpha = 0.1
-clogit_compare$margin_of_error1 <- qnorm(1-alpha)*clogit_tr$robse
-clogit_compare$margin_of_error2 <- qnorm(1-alpha)*clogit_vol_tr$robse
-clogit_compare$margin_of_error3 <- qnorm(1-alpha)*clogit_not_tr$robse
-
-clogit_compare <- rownames_to_column(clogit_compare, "Coefficent")
-colnames(clogit_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
- "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
-
-
-clogit_melt <- melt(clogit_compare[1:4], id = "Coefficent")
-clogit_melt$ME <-clogit_compare$Margin_of_error_TR
-clogit_melt$ME[5:8] <- clogit_compare$Margin_of_error_VOL_TR
-clogit_melt$ME[9:12] <- clogit_compare$Margin_of_error_NOT_TR
-
-# Scale up rent and wd coefficients for visibility
-clogit_melt <- clogit_melt %>% mutate(ME = case_when(Coefficent != "mu_rent" ~ ME*1000, TRUE ~ ME),
- value = case_when(Coefficent != "mu_rent" ~ value*1000, TRUE ~ value))
-
-# Figure clogit prefspace
-ggplot(data=clogit_melt, aes(x=Coefficent, y=abs(value), fill=variable)) +
- geom_bar(stat="identity", position='dodge', width = 0.9) +
- geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
- ylab("Absolute Value") +
- xlab("Coefficient") +
- scale_x_discrete(guide = guide_axis(angle = 45)) +
- scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
- theme(legend.position = c(0.85, 0.8))
+#### Load WTP models for different treatments #####
+
+# Case A
+
+mxl_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Treated A")
+mxl_vol_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Vol_Treated A")
+mxl_not_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Not_Treated A")
+
+
+mxl_info_compare <- as.data.frame(mxl_tr$estimate)
+mxl_info_compare[2] <- as.data.frame(mxl_vol_tr$estimate)
+mxl_info_compare[3] <- as.data.frame(mxl_not_tr$estimate)
+
+alpha = 0.1
+mxl_info_compare$margin_of_error1 <- qnorm(1-alpha)*mxl_tr$robse
+mxl_info_compare$margin_of_error2 <- qnorm(1-alpha)*mxl_vol_tr$robse
+mxl_info_compare$margin_of_error3 <- qnorm(1-alpha)*mxl_not_tr$robse
+
+mxl_info_compare <- rownames_to_column(mxl_info_compare, "Coefficent")
+colnames(mxl_info_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
+ "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
+
+
+mxl_melt_info <- melt(mxl_info_compare[1:4], id = "Coefficent")
+mxl_melt_info$ME <- mxl_info_compare$Margin_of_error_TR
+mxl_melt_info$ME[9:16] <- mxl_info_compare$Margin_of_error_VOL_TR
+mxl_melt_info$ME[17:24] <- mxl_info_compare$Margin_of_error_NOT_TR
+
+
+# Figure paper compare info treatments #
+ggplot(data=mxl_melt_info, aes(x=Coefficent, y=abs(value), fill=variable)) +
+ geom_bar(stat="identity", position='dodge', width = 0.9) +
+ geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
+ ylab("Absolute Value") +
+ xlab("Coefficient") +
+ scale_x_discrete(guide = guide_axis(angle = 45)) +
+ scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
+ theme(legend.position = c(0.85, 0.8))
+
+ggsave("Figures/compare_split_samplesA.png", dpi = "print", width = 7, height = 5)
+
+# Case A log rent
+
+mxl_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Treated A log")
+mxl_vol_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Vol_Treated A log")
+mxl_not_tr <- apollo_loadModel("Estimation_results/mxl/Split_samples/MXL_wtp Not_Treated A log")
+
+
+mxl_info_compare <- as.data.frame(mxl_tr$estimate)
+mxl_info_compare[2] <- as.data.frame(mxl_vol_tr$estimate)
+mxl_info_compare[3] <- as.data.frame(mxl_not_tr$estimate)
+
+alpha = 0.05
+mxl_info_compare$margin_of_error1 <- qnorm(1-alpha)*mxl_tr$robse
+mxl_info_compare$margin_of_error2 <- qnorm(1-alpha)*mxl_vol_tr$robse
+mxl_info_compare$margin_of_error3 <- qnorm(1-alpha)*mxl_not_tr$robse
+
+mxl_info_compare <- rownames_to_column(mxl_info_compare, "Coefficent")
+colnames(mxl_info_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
+ "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
+
+
+mxl_melt_info_log <- melt(mxl_info_compare[1:4], id = "Coefficent")
+mxl_melt_info_log$ME <- mxl_info_compare$Margin_of_error_TR
+mxl_melt_info_log$ME[8:14] <- mxl_info_compare$Margin_of_error_VOL_TR
+mxl_melt_info_log$ME[15:21] <- mxl_info_compare$Margin_of_error_NOT_TR
+
+mxl_melt_info_log <- mxl_melt_info_log %>% mutate(ME = case_when(abs(value) < 1 ~ ME*100, TRUE~ME),
+ value = case_when(abs(value) < 1 ~ value*100, TRUE~value))
+
+# Figure paper compare info treatments #
+ggplot(data=mxl_melt_info_log, aes(x=Coefficent, y=abs(value), fill=variable)) +
+ geom_bar(stat="identity", position='dodge', width = 0.9) +
+ geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
+ ylab("Absolute Value") +
+ xlab("Coefficient") +
+ scale_x_discrete(guide = guide_axis(angle = 45)) +
+ scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
+ theme(legend.position = c(0.85, 0.8))
+
+
+
+### Compare clogit models prefspace
+
+clogit_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A TR")
+clogit_vol_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A VOL TR")
+clogit_not_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A NOT TR")
+
+
+clogit_compare <- as.data.frame(clogit_tr$estimate)
+clogit_compare[2] <- as.data.frame(clogit_vol_tr$estimate)
+clogit_compare[3] <- as.data.frame(clogit_not_tr$estimate)
+
+alpha = 0.1
+clogit_compare$margin_of_error1 <- qnorm(1-alpha)*clogit_tr$robse
+clogit_compare$margin_of_error2 <- qnorm(1-alpha)*clogit_vol_tr$robse
+clogit_compare$margin_of_error3 <- qnorm(1-alpha)*clogit_not_tr$robse
+
+clogit_compare <- rownames_to_column(clogit_compare, "Coefficent")
+colnames(clogit_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
+ "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
+
+
+clogit_melt <- melt(clogit_compare[1:4], id = "Coefficent")
+clogit_melt$ME <-clogit_compare$Margin_of_error_TR
+clogit_melt$ME[5:8] <- clogit_compare$Margin_of_error_VOL_TR
+clogit_melt$ME[9:12] <- clogit_compare$Margin_of_error_NOT_TR
+
+# Scale up rent and wd coefficients for visibility
+clogit_melt <- clogit_melt %>% mutate(ME = case_when(value <= 0.1 ~ ME*10, TRUE ~ ME),
+ value = case_when(value <= 0.1 ~ value*10, TRUE ~ value))
+
+# Figure clogit prefspace
+ggplot(data=clogit_melt, aes(x=Coefficent, y=abs(value), fill=variable)) +
+ geom_bar(stat="identity", position='dodge', width = 0.9) +
+ geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
+ ylab("Absolute Value") +
+ xlab("Coefficient") +
+ scale_x_discrete(guide = guide_axis(angle = 45)) +
+ scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
+ theme(legend.position = c(0.85, 0.8))
+
+
+## Clogit WTP space
+
+clogit_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A TR wtp")
+clogit_vol_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A VOL TR wtp")
+clogit_not_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A NOT TR wtp")
+
+
+clogit_compare <- as.data.frame(clogit_tr$estimate)
+clogit_compare[2] <- as.data.frame(clogit_vol_tr$estimate)
+clogit_compare[3] <- as.data.frame(clogit_not_tr$estimate)
+
+alpha = 0.1
+clogit_compare$margin_of_error1 <- qnorm(1-alpha)*clogit_tr$robse
+clogit_compare$margin_of_error2 <- qnorm(1-alpha)*clogit_vol_tr$robse
+clogit_compare$margin_of_error3 <- qnorm(1-alpha)*clogit_not_tr$robse
+
+clogit_compare <- rownames_to_column(clogit_compare, "Coefficent")
+colnames(clogit_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
+ "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
+
+
+clogit_melt <- melt(clogit_compare[1:4], id = "Coefficent")
+clogit_melt$ME <-clogit_compare$Margin_of_error_TR
+clogit_melt$ME[5:8] <- clogit_compare$Margin_of_error_VOL_TR
+clogit_melt$ME[9:12] <- clogit_compare$Margin_of_error_NOT_TR
+
+# Scale up rent and wd coefficients for visibility
+clogit_melt <- clogit_melt %>% mutate(ME = case_when(abs(value) <= 0.5 ~ ME*1000, abs(value) <= 2 ~ ME*10, TRUE ~ ME),
+ value = case_when(abs(value) <= 0.5 ~ abs(value)*1000, value <= 2 ~ value*10, TRUE ~ value))
+
+# Figure clogit prefspace
+ggplot(data=clogit_melt, aes(x=Coefficent, y=abs(value), fill=variable)) +
+ geom_bar(stat="identity", position='dodge', width = 0.9) +
+ geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
+ ylab("Absolute Value") +
+ xlab("Coefficient") +
+ scale_x_discrete(guide = guide_axis(angle = 45)) +
+ scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
+ theme(legend.position = c(0.85, 0.8))
+
+
+## Clogit WTP space log rent
+
+clogit_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A TR wtp log")
+clogit_vol_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A VOL TR wtp log")
+clogit_not_tr <- apollo_loadModel("Estimation_results/clogit/Clogit case A NOT TR wtp log")
+
+
+clogit_compare <- as.data.frame(clogit_tr$estimate)
+clogit_compare[2] <- as.data.frame(clogit_vol_tr$estimate)
+clogit_compare[3] <- as.data.frame(clogit_not_tr$estimate)
+
+alpha = 0.1
+clogit_compare$margin_of_error1 <- qnorm(1-alpha)*clogit_tr$robse
+clogit_compare$margin_of_error2 <- qnorm(1-alpha)*clogit_vol_tr$robse
+clogit_compare$margin_of_error3 <- qnorm(1-alpha)*clogit_not_tr$robse
+
+clogit_compare <- rownames_to_column(clogit_compare, "Coefficent")
+colnames(clogit_compare) <- c("Coefficent", "Estimate_TR", "Estimate_VOL_TR", "Estimate_NOT_TR", "Margin_of_error_TR",
+ "Margin_of_error_VOL_TR", "Margin_of_error_NOT_TR")
+
+
+clogit_melt <- melt(clogit_compare[1:4], id = "Coefficent")
+clogit_melt$ME <-clogit_compare$Margin_of_error_TR
+clogit_melt$ME[5:8] <- clogit_compare$Margin_of_error_VOL_TR
+clogit_melt$ME[9:12] <- clogit_compare$Margin_of_error_NOT_TR
+
+# Scale up rent and wd coefficients for visibility
+clogit_melt <- clogit_melt %>% mutate(ME = case_when(Coefficent != "mu_rent" ~ ME*1000, TRUE ~ ME),
+ value = case_when(Coefficent != "mu_rent" ~ value*1000, TRUE ~ value))
+
+# Figure clogit prefspace
+ggplot(data=clogit_melt, aes(x=Coefficent, y=abs(value), fill=variable)) +
+ geom_bar(stat="identity", position='dodge', width = 0.9) +
+ geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
+ ylab("Absolute Value") +
+ xlab("Coefficient") +
+ scale_x_discrete(guide = guide_axis(angle = 45)) +
+ scale_fill_brewer(palette = "Set2", labels = c("Treated", "Voluntary Treatment", "Not Treated"), name="Treatment") +
+ theme(legend.position = c(0.85, 0.8))
diff --git a/Scripts/create_tables.R b/Scripts/create_tables.R
index 5eab954..9513164 100644
--- a/Scripts/create_tables.R
+++ b/Scripts/create_tables.R
@@ -1,166 +1,166 @@
-library(choiceTools)
-
-dir.create("Tables/mxl")
-dir.create("Tables/logit")
-dir.create("Tables/ols/")
-
-
-list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
- "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
- "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
- "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
- "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree")
-
-# Manipulation check
-texreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_percentage_correct_C, ols_percentage_correct_control_C),
- custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
- custom.header = list("Dependent Variable: Percentage of correct quiz statements" = 1:4),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:mani",
- caption = "Results of OLS on percentage of correct quiz statements.",
- file="Tables/ols/manipulation.tex")
-
-
-# Net interview time
-texreg(l=list(ols_time_spent_A, ols_time_spent_control_A, ols_time_spent_C, ols_time_spent_control_C),
- custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
- custom.header = list("Dependent variable: Net interview time" = 1:4),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:net_int",
- caption = "Results of OLS on net interview time.",
- file="Tables/ols/interviewtime.tex")
-
-
-# CC Time
-texreg(l=list(ols_time_cc_A, ols_time_cc_control_A, ols_time_cc_C, ols_time_cc_control_C),
- custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
- custom.header = list("Dependent variable: Mean choice card time" = 1:4),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:cctime",
- caption = "Results of OLS on mean choice card time.",
- file="Tables/ols/cctime.tex")
-
-# Consequentiality
-texreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_model_control_C),
- custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
- custom.header = list("Dependent variable: Consequentiality score" = 1:4),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:conseq",
- caption = "Results of OLS on consequentiality score.",
- file="Tables/ols/consequentiality.tex")
-
-# Opt Out
-texreg(l=list(ols_opt_out_A, ols_opt_out_control_A, ols_opt_out_C, ols_opt_out_control_C),
- custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
- custom.header = list("Dependent variable: Number of opt-out choices" = 1:4),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:optout",
- caption = "Results of OLS on number of opt-out choices.",
- file="Tables/ols/optout.tex")
-
-# NR
-texreg(l=list(nr_model_treat_A),
- custom.model.names = c("OLS regression"),
- custom.header = list("Dependent variable: NR-Index" = 1),
- custom.coef.map = list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
- "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
- "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
- "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
- "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree", "Kids_Dummy" = "Children",
- "Naturalness_SQ" = "Naturalness SQ", "WalkingDistance_SQ" = "Walking Distance SQ"),
- stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:nr_ols",
- caption = "Results of OLS on the NR-index.",
- file="Tables/ols/nr_ols.tex")
-
-#### Logit #####
-
-texreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.model.names = c("Logit regression"),
- custom.header = list("Dependent variable: Voluntary Information Access" = 1),
- custom.coef.map = list_ols, custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:logit_vt",
- caption = "Results of logit regression on the access of optional information.",
- file="Tables/logit/chose_treatment.tex")
-
-
-##### MXL #######
-
-### Baseline case A
-case_A <- quicktexregapollo(mxl_wtp_case_a_rentINT)
-
-coef_names <- case_A@coef.names
-coef_names <- sub("^(mu_)(.*)(_T|_VT)$", "\\2\\3", coef_names)
-coef_names[4] <- "mu_ASC_sq"
-case_A@coef.names <- coef_names
-
-case_A_cols <- map(c("^mu_", "^sig_", "_T$", "_VT$"), subcoef, case_A)
-
-texreg(c(case_A_cols[1], remGOF(case_A_cols[2:4])),
- custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
- "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
- "wd" = "Walking Distance", "asc" = "ASC SQ"),
- custom.model.names = c("Mean", "SD", "Treated", "Voluntary Treated"), custom.note = "%stars. Robust standard errors in parentheses.",
- stars = c(0.01, 0.05, 0.1), float.pos="tb",
- label = "tab:mxl_A",
- caption = "Results of mixed logit model with treatment interactions for Case A.",
- file="Tables/mxl/case_A_rent_INT.tex")
-
-### Baseline case C
-case_C <- quicktexregapollo(mxl_wtp_case_c_rentINT)
-
-coef_names <- case_C@coef.names
-coef_names <- sub("^(mu_)(.*)(1|2|info)$", "\\2\\3", coef_names)
-coef_names[4] <- "mu_ASC_sq"
-case_C@coef.names <- coef_names
-
-
-case_C_cols <- map(c("^mu_", "^sig_", "_vid1$", "_vid2$", "_nv1$", "_nv2$", "_no_info$"), subcoef, case_C)
-
-texreg(c(case_C_cols[1], remGOF(case_C_cols[2:7])),
- custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
- "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
- "wd" = "Walking Distance", "asc" = "ASC SQ",
- "ASC_sq_info" = "ASC SQ", "rent_info" = "Rent", "nat_info" = "Naturalness", "walking_info" = "Walking Distance"),
- custom.model.names = c("Mean", "SD", "Video 1", "Video 2", "Text 1", "Text 2", "No Info"), custom.note = "%stars. Robust standard errors in parentheses.",
- stars = c(0.01, 0.05, 0.1), float.pos="tb",
- label = "tab:mxl_C",
- caption = "Results of mixed logit model with treatment interactions for Case B.",
- file="Tables/mxl/case_C_rent_INT.tex")
-
-### Rent NR model case C
-case_C_NR <- quicktexregapollo(mxl_wtp_NR_case_c_rentINT)
-
-coef_names <- case_C_NR@coef.names
-coef_names <- sub("^(mu_)(.*)(1|2|info|NR)$", "\\2\\3", coef_names)
-coef_names[4] <- "mu_ASC_sq"
-case_C_NR@coef.names <- coef_names
-
-
-case_C_cols_NR <- map(c("^mu_", "^sig_", "_vid1$", "_vid2$", "_nv1$", "_nv2$", "_no_info$", "_NR$"), subcoef, case_C_NR)
-
-texreg(c(case_C_cols_NR[1], remGOF(case_C_cols_NR[2:8])),
- custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
- "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
- "wd" = "Walking Distance", "asc" = "ASC SQ",
- "ASC_sq_info" = "ASC SQ", "rent_info" = "Rent", "nat_info" = "Naturalness", "walking_info" = "Walking Distance"),
- custom.model.names = c("Mean", "SD", "Video 1", "Video 2", "Text 1", "Text 2", "No Info", "NR"), custom.note = "%stars. Robust standard errors in parentheses.",
- stars = c(0.01, 0.05, 0.1), float.pos="tb",
- label = "tab:mxl_NR",
- caption = "Results of mixed logit model with treatment and NR-index interactions for Case B.",
- file="Tables/mxl/case_C_rent_INT_NR.tex")
-# Main model
-# texreg(l=list(mxl_wtp_case_a_rentINT),
-# custom.coef.map = list("mu_natural" = "Naturalness", "mu_walking" = "Walking Distance", "mu_rent" = "Rent",
-# "ASC_sq" = "ASC SQ", "sig_natural" = "Naturalness SD", "sig_walking" = "Walking Distance SD",
-# "sig_rent" = "Rent SD", "sig_ASC_sq" = "ASC SD",
-# "mu_nat_T" = "Naturalness X Treated", "mu_wd_T" = "Walking Distance X Treated", "mu_rent_T" = "Rent X Treated",
-# "mu_asc_T" = "ASC X Treated", "mu_nat_VT" = "Naturalness X Vol. Treated", "mu_wd_VT" = "Walking Distance X Vol. Treated",
-# "mu_rent_VT" = "Rent X Vol. Treated", "mu_asc_VT" = "ASC X Vol. Treated"),
-# stars = c(0.01, 0.05, 0.1), override.se = mxl_wtp_case_a_rentINT$robse, file="Tables/mxl/case_A_rent_INT.tex")
+library(choiceTools)
+
+dir.create("Tables/mxl")
+dir.create("Tables/logit")
+dir.create("Tables/ols/")
+
+
+list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
+ "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
+ "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
+ "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
+ "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree")
+
+# Manipulation check
+texreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_percentage_correct_C, ols_percentage_correct_control_C),
+ custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
+ custom.header = list("Dependent Variable: Percentage of correct quiz statements" = 1:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:mani",
+ caption = "Results of OLS on percentage of correct quiz statements.",
+ file="Tables/ols/manipulation.tex")
+
+
+# Net interview time
+texreg(l=list(ols_time_spent_A, ols_time_spent_control_A, ols_time_spent_C, ols_time_spent_control_C),
+ custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
+ custom.header = list("Dependent variable: Net interview time" = 1:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:net_int",
+ caption = "Results of OLS on net interview time.",
+ file="Tables/ols/interviewtime.tex")
+
+
+# CC Time
+texreg(l=list(ols_time_cc_A, ols_time_cc_control_A, ols_time_cc_C, ols_time_cc_control_C),
+ custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
+ custom.header = list("Dependent variable: Mean choice card time" = 1:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:cctime",
+ caption = "Results of OLS on mean choice card time.",
+ file="Tables/ols/cctime.tex")
+
+# Consequentiality
+texreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_model_control_C),
+ custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
+ custom.header = list("Dependent variable: Consequentiality score" = 1:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:conseq",
+ caption = "Results of OLS on consequentiality score.",
+ file="Tables/ols/consequentiality.tex")
+
+# Opt Out
+texreg(l=list(ols_opt_out_A, ols_opt_out_control_A, ols_opt_out_C, ols_opt_out_control_C),
+ custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
+ custom.header = list("Dependent variable: Number of opt-out choices" = 1:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:optout",
+ caption = "Results of OLS on number of opt-out choices.",
+ file="Tables/ols/optout.tex")
+
+# NR
+texreg(l=list(nr_model_treat_A),
+ custom.model.names = c("OLS regression"),
+ custom.header = list("Dependent variable: NR-Index" = 1),
+ custom.coef.map = list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
+ "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
+ "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
+ "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
+ "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree", "Kids_Dummy" = "Children",
+ "Naturalness_SQ" = "Naturalness SQ", "WalkingDistance_SQ" = "Walking Distance SQ"),
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:nr_ols",
+ caption = "Results of OLS on the NR-index.",
+ file="Tables/ols/nr_ols.tex")
+
+#### Logit #####
+
+texreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.model.names = c("Logit regression"),
+ custom.header = list("Dependent variable: Voluntary Information Access" = 1),
+ custom.coef.map = list_ols, custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:logit_vt",
+ caption = "Results of logit regression on the access of optional information.",
+ file="Tables/logit/chose_treatment.tex")
+
+
+##### MXL #######
+
+### Baseline case A
+case_A <- quicktexregapollo(mxl_wtp_case_a_rentINT)
+
+coef_names <- case_A@coef.names
+coef_names <- sub("^(mu_)(.*)(_T|_VT)$", "\\2\\3", coef_names)
+coef_names[4] <- "mu_ASC_sq"
+case_A@coef.names <- coef_names
+
+case_A_cols <- map(c("^mu_", "^sig_", "_T$", "_VT$"), subcoef, case_A)
+
+texreg(c(case_A_cols[1], remGOF(case_A_cols[2:4])),
+ custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
+ "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
+ "wd" = "Walking Distance", "asc" = "ASC SQ"),
+ custom.model.names = c("Mean", "SD", "Treated", "Voluntary Treated"), custom.note = "%stars. Robust standard errors in parentheses.",
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ label = "tab:mxl_A",
+ caption = "Results of mixed logit model with treatment interactions for Case A.",
+ file="Tables/mxl/case_A_rent_INT.tex")
+
+### Baseline case C
+case_C <- quicktexregapollo(mxl_wtp_case_c_rentINT)
+
+coef_names <- case_C@coef.names
+coef_names <- sub("^(mu_)(.*)(1|2|info)$", "\\2\\3", coef_names)
+coef_names[4] <- "mu_ASC_sq"
+case_C@coef.names <- coef_names
+
+
+case_C_cols <- map(c("^mu_", "^sig_", "_vid1$", "_vid2$", "_nv1$", "_nv2$", "_no_info$"), subcoef, case_C)
+
+texreg(c(case_C_cols[1], remGOF(case_C_cols[2:7])),
+ custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
+ "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
+ "wd" = "Walking Distance", "asc" = "ASC SQ",
+ "ASC_sq_info" = "ASC SQ", "rent_info" = "Rent", "nat_info" = "Naturalness", "walking_info" = "Walking Distance"),
+ custom.model.names = c("Mean", "SD", "Video 1", "Video 2", "Text 1", "Text 2", "No Info"), custom.note = "%stars. Robust standard errors in parentheses.",
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ label = "tab:mxl_C",
+ caption = "Results of mixed logit model with treatment interactions for Case B.",
+ file="Tables/mxl/case_C_rent_INT.tex")
+
+### Rent NR model case C
+case_C_NR <- quicktexregapollo(mxl_wtp_NR_case_c_rentINT)
+
+coef_names <- case_C_NR@coef.names
+coef_names <- sub("^(mu_)(.*)(1|2|info|NR)$", "\\2\\3", coef_names)
+coef_names[4] <- "mu_ASC_sq"
+case_C_NR@coef.names <- coef_names
+
+
+case_C_cols_NR <- map(c("^mu_", "^sig_", "_vid1$", "_vid2$", "_nv1$", "_nv2$", "_no_info$", "_NR$"), subcoef, case_C_NR)
+
+texreg(c(case_C_cols_NR[1], remGOF(case_C_cols_NR[2:8])),
+ custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
+ "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
+ "wd" = "Walking Distance", "asc" = "ASC SQ",
+ "ASC_sq_info" = "ASC SQ", "rent_info" = "Rent", "nat_info" = "Naturalness", "walking_info" = "Walking Distance"),
+ custom.model.names = c("Mean", "SD", "Video 1", "Video 2", "Text 1", "Text 2", "No Info", "NR"), custom.note = "%stars. Robust standard errors in parentheses.",
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ label = "tab:mxl_NR",
+ caption = "Results of mixed logit model with treatment and NR-index interactions for Case B.",
+ file="Tables/mxl/case_C_rent_INT_NR.tex")
+# Main model
+# texreg(l=list(mxl_wtp_case_a_rentINT),
+# custom.coef.map = list("mu_natural" = "Naturalness", "mu_walking" = "Walking Distance", "mu_rent" = "Rent",
+# "ASC_sq" = "ASC SQ", "sig_natural" = "Naturalness SD", "sig_walking" = "Walking Distance SD",
+# "sig_rent" = "Rent SD", "sig_ASC_sq" = "ASC SD",
+# "mu_nat_T" = "Naturalness X Treated", "mu_wd_T" = "Walking Distance X Treated", "mu_rent_T" = "Rent X Treated",
+# "mu_asc_T" = "ASC X Treated", "mu_nat_VT" = "Naturalness X Vol. Treated", "mu_wd_VT" = "Walking Distance X Vol. Treated",
+# "mu_rent_VT" = "Rent X Vol. Treated", "mu_asc_VT" = "ASC X Vol. Treated"),
+# stars = c(0.01, 0.05, 0.1), override.se = mxl_wtp_case_a_rentINT$robse, file="Tables/mxl/case_A_rent_INT.tex")
diff --git a/Scripts/data_prep.R b/Scripts/data_prep.R
index 6261dca..567faf4 100644
--- a/Scripts/data_prep.R
+++ b/Scripts/data_prep.R
@@ -1,126 +1,126 @@
-# Prepare variables that we want to use
-
-database_full <- database_full %>% rename(Gender = "Q03W123", Education = "Q06W123", HHSize = "Q41W123",
- WorkingTime = "Q44W123", Birthyear = "Q01W123", Rent_net = "Q07W123",
- Number_Kids = "Q42W123", Employment_type = "Q43W123", Conseq_UGS = "Q28W3",
- Conseq_Money = "Q29W3")
-
-
-database_full <- database_full %>% mutate(Gender = dplyr::recode(Gender, "A1" = 1, "A2" = 2, "A3"=3),
- Education = dplyr::recode(Education, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4, "A5" = 5),
- Employment_type = dplyr::recode(Employment_type, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4,
- "A5" = 5, "A6" = 6),
- Conseq_UGS = dplyr::recode(Conseq_UGS, "A1" = 5, "A2" = 4, "A3"=3, "A4" = 2, "A5" = 1, "A6" = NA_real_),
- Conseq_Money = dplyr::recode(Conseq_Money, "A1" = 5, "A2" = 4, "A3"=3, "A4" = 2, "A5" = 1, "A6" = NA_real_))
-
-database_full <- database_full %>% mutate(Gender_female = case_when(Gender == 2 ~1, TRUE~0),
- Age = 2023-Birthyear,
- Uni_degree = case_when(Education == 5 ~1, TRUE~0),
- Kids_Dummy = case_when(Number_Kids > 0 ~ 1, TRUE ~0),
- Employment_full = case_when(Employment_type == 1 ~ 1, TRUE~0),
- Pensioner = case_when(Employment_type == 6 ~ 1, TRUE~0),
- Age_mean = Age - mean(Age))
-
-# Data cleaning
-
-
-
-database_full <- database_full %>% filter(Rent_SQ <= 10000 & Rent_SQ >=50) %>%
- filter(WalkingDistance_SQ > 0 & WalkingDistance_SQ <= 300) %>%
- filter(Gender!=3)
-
-database <- database %>% filter(Rent_SQ <= 10000 & Rent_SQ >=50) %>%
- filter(WalkingDistance_SQ > 0 & WalkingDistance_SQ <= 300)
-
-
-summary(database_full$interviewtime)
-
-database_full <- database_full %>% filter(interviewtime >= 300) # make change time to 10 seconds?
-
-
-database_full <- database_full %>%
- filter(!is.na(Treatment_new)) %>%
- mutate(Treatment_A = case_when(
- Treatment == 1 ~ "Treated",
- Treatment == 2 ~ "Vol_Treated",
- Treatment == 3 ~ "Not_Treated",
- TRUE ~ NA_character_
- )) %>%
- mutate(Treatment_B = case_when(
- Treatment_new == 1 | Treatment_new == 2 | Treatment_new == 4 | Treatment_new == 5 ~ "Treated",
- Treatment_new == 3 | Treatment_new == 6 ~ "Not_Treated"
- )) %>%
- mutate(Treatment_C = 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_
- ))
-
-id_list <- unique(database_full$id)
-
-# Do we sill want to use this? or only database full?
-database <- database %>% filter(id %in% id_list) %>% filter(!is.na(Treatment_new))
-# Building NR Index
-
-for (i in 1:21) {
- variable_name <- paste0("Q38S", sprintf("%02d", i), "W3") # Generate variable name
- cat("Table for", variable_name, ":\n")
- print(table(database_full[[variable_name]]))
- cat("\n")
- database_full[[variable_name]] <- as.numeric(factor(database_full[[variable_name]], levels = c("A1", "A2", "A3", "A4", "A5")))
- cat("Table for", variable_name, ":\n")
- print(table(database_full[[variable_name]]))
- cat("\n")
-}
-
-variables_to_reverse <- c("Q38S02W3", "Q38S03W3", "Q38S10W3", "Q38S11W3", "Q38S13W3", "Q38S14W3", "Q38S15W3", "Q38S18W3")
-for (variable_name in variables_to_reverse) {
- cat("Table for", variable_name, ":\n")
-
- # Convert the variable to a factor with numerical levels and reverse the scores
- database_full[[variable_name]] <- 6 - as.numeric(database_full[[variable_name]])
-
- # Print the table
- print(table(database_full[[variable_name]]))
- cat("\n")
-}
-q38_variables <- grep("^Q38", names(database_full), value = TRUE)
-database_full$Total_NR <- rowSums(database_full[q38_variables])
-hist(database_full$Total_NR)
-database_full <- database_full %>%
- mutate(Mean_NR=Total_NR/21)
-mean_nr<-mean(database_full$Mean_NR, na.rm = TRUE)
-sd_nr<-sd(database_full$Mean_NR, na.rm = TRUE)
-database_full <- database_full %>%
- mutate(Z_Mean_NR=(Mean_NR-mean_nr)/sd_nr)
-database$Z_Mean_NR<- database_full$Z_Mean_NR
-summary(database$Z_Mean_NR)
-
-#Self-Reference Index
-
-for (i in 8:10) {
- variable_name <- paste0("TV", sprintf("%02d", i), "W3") # Generate variable name
- cat("Table for", variable_name, ":\n")
- print(table(database_full[[variable_name]]))
- cat("\n")
- database_full[[variable_name]] <- as.numeric(factor(database_full[[variable_name]], levels = c("A1", "A2", "A3", "A4", "A5")))
- cat("Table for", variable_name, ":\n")
- print(table(database_full[[variable_name]]))
- cat("\n")
-}
-
-
-database_full$Total_SR <- database_full$TV08W3+database_full$TV09W3+database_full$TV10W3
-hist(database_full$Total_SR)
-database_full <- database_full %>%
- mutate(Mean_SR=Total_SR/3)
-mean_sr<-mean(database_full$Mean_SR, na.rm = TRUE)
-sd_sr<-sd(database_full$Mean_SR, na.rm = TRUE)
-database_full <- database_full %>%
- mutate(Z_Mean_SR=(Mean_SR-mean_sr)/sd_sr)
-database$Z_Mean_SR<- database_full$Z_Mean_SR
-summary(database$Z_Mean_SR)
+# Prepare variables that we want to use
+
+database_full <- database_full %>% rename(Gender = "Q03W123", Education = "Q06W123", HHSize = "Q41W123",
+ WorkingTime = "Q44W123", Birthyear = "Q01W123", Rent_net = "Q07W123",
+ Number_Kids = "Q42W123", Employment_type = "Q43W123", Conseq_UGS = "Q28W3",
+ Conseq_Money = "Q29W3")
+
+
+database_full <- database_full %>% mutate(Gender = dplyr::recode(Gender, "A1" = 1, "A2" = 2, "A3"=3),
+ Education = dplyr::recode(Education, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4, "A5" = 5),
+ Employment_type = dplyr::recode(Employment_type, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4,
+ "A5" = 5, "A6" = 6),
+ Conseq_UGS = dplyr::recode(Conseq_UGS, "A1" = 5, "A2" = 4, "A3"=3, "A4" = 2, "A5" = 1, "A6" = NA_real_),
+ Conseq_Money = dplyr::recode(Conseq_Money, "A1" = 5, "A2" = 4, "A3"=3, "A4" = 2, "A5" = 1, "A6" = NA_real_))
+
+database_full <- database_full %>% mutate(Gender_female = case_when(Gender == 2 ~1, TRUE~0),
+ Age = 2023-Birthyear,
+ Uni_degree = case_when(Education == 5 ~1, TRUE~0),
+ Kids_Dummy = case_when(Number_Kids > 0 ~ 1, TRUE ~0),
+ Employment_full = case_when(Employment_type == 1 ~ 1, TRUE~0),
+ Pensioner = case_when(Employment_type == 6 ~ 1, TRUE~0),
+ Age_mean = Age - mean(Age))
+
+# Data cleaning
+
+
+
+database_full <- database_full %>% filter(Rent_SQ <= 10000 & Rent_SQ >=50) %>%
+ filter(WalkingDistance_SQ > 0 & WalkingDistance_SQ <= 300) %>%
+ filter(Gender!=3)
+
+database <- database %>% filter(Rent_SQ <= 10000 & Rent_SQ >=50) %>%
+ filter(WalkingDistance_SQ > 0 & WalkingDistance_SQ <= 300)
+
+
+summary(database_full$interviewtime)
+
+database_full <- database_full %>% filter(interviewtime >= 300) # make change time to 10 seconds?
+
+
+database_full <- database_full %>%
+ filter(!is.na(Treatment_new)) %>%
+ mutate(Treatment_A = case_when(
+ Treatment == 1 ~ "Treated",
+ Treatment == 2 ~ "Vol_Treated",
+ Treatment == 3 ~ "Not_Treated",
+ TRUE ~ NA_character_
+ )) %>%
+ mutate(Treatment_B = case_when(
+ Treatment_new == 1 | Treatment_new == 2 | Treatment_new == 4 | Treatment_new == 5 ~ "Treated",
+ Treatment_new == 3 | Treatment_new == 6 ~ "Not_Treated"
+ )) %>%
+ mutate(Treatment_C = 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_
+ ))
+
+id_list <- unique(database_full$id)
+
+# Do we sill want to use this? or only database full?
+database <- database %>% filter(id %in% id_list) %>% filter(!is.na(Treatment_new))
+# Building NR Index
+
+for (i in 1:21) {
+ variable_name <- paste0("Q38S", sprintf("%02d", i), "W3") # Generate variable name
+ cat("Table for", variable_name, ":\n")
+ print(table(database_full[[variable_name]]))
+ cat("\n")
+ database_full[[variable_name]] <- as.numeric(factor(database_full[[variable_name]], levels = c("A1", "A2", "A3", "A4", "A5")))
+ cat("Table for", variable_name, ":\n")
+ print(table(database_full[[variable_name]]))
+ cat("\n")
+}
+
+variables_to_reverse <- c("Q38S02W3", "Q38S03W3", "Q38S10W3", "Q38S11W3", "Q38S13W3", "Q38S14W3", "Q38S15W3", "Q38S18W3")
+for (variable_name in variables_to_reverse) {
+ cat("Table for", variable_name, ":\n")
+
+ # Convert the variable to a factor with numerical levels and reverse the scores
+ database_full[[variable_name]] <- 6 - as.numeric(database_full[[variable_name]])
+
+ # Print the table
+ print(table(database_full[[variable_name]]))
+ cat("\n")
+}
+q38_variables <- grep("^Q38", names(database_full), value = TRUE)
+database_full$Total_NR <- rowSums(database_full[q38_variables])
+hist(database_full$Total_NR)
+database_full <- database_full %>%
+ mutate(Mean_NR=Total_NR/21)
+mean_nr<-mean(database_full$Mean_NR, na.rm = TRUE)
+sd_nr<-sd(database_full$Mean_NR, na.rm = TRUE)
+database_full <- database_full %>%
+ mutate(Z_Mean_NR=(Mean_NR-mean_nr)/sd_nr)
+database$Z_Mean_NR<- database_full$Z_Mean_NR
+summary(database$Z_Mean_NR)
+
+#Self-Reference Index
+
+for (i in 8:10) {
+ variable_name <- paste0("TV", sprintf("%02d", i), "W3") # Generate variable name
+ cat("Table for", variable_name, ":\n")
+ print(table(database_full[[variable_name]]))
+ cat("\n")
+ database_full[[variable_name]] <- as.numeric(factor(database_full[[variable_name]], levels = c("A1", "A2", "A3", "A4", "A5")))
+ cat("Table for", variable_name, ":\n")
+ print(table(database_full[[variable_name]]))
+ cat("\n")
+}
+
+
+database_full$Total_SR <- database_full$TV08W3+database_full$TV09W3+database_full$TV10W3
+hist(database_full$Total_SR)
+database_full <- database_full %>%
+ mutate(Mean_SR=Total_SR/3)
+mean_sr<-mean(database_full$Mean_SR, na.rm = TRUE)
+sd_sr<-sd(database_full$Mean_SR, na.rm = TRUE)
+database_full <- database_full %>%
+ mutate(Z_Mean_SR=(Mean_SR-mean_sr)/sd_sr)
+database$Z_Mean_SR<- database_full$Z_Mean_SR
+summary(database$Z_Mean_SR)
diff --git a/Scripts/interaction_plots_presi.R b/Scripts/interaction_plots_presi.R
index 4fde3d4..0ab7a74 100644
--- a/Scripts/interaction_plots_presi.R
+++ b/Scripts/interaction_plots_presi.R
@@ -1,58 +1,58 @@
-# Create Interaction Term Plot for Presentation
-
-
-####
-create_interaction_term_plot <- function(ols_summary, treatment_labels, ord, unit, down, up) {
- alpha <- 0.1
- z_value <- qnorm(1 - alpha / 2)
-
- plot_data <- summary(ols_summary)
- plot_data <- as.data.frame(plot_data$coefficients)
- plot_data$ME <- z_value * plot_data$`Std. Error`
- plot_data <- rownames_to_column(plot_data, "Coefficient")
-
- plot_data <- plot_data %>% filter(str_detect(Coefficient, "Treatment"))
-
- plot_data$Coefficient <- treatment_labels
-
- plot <- ggplot(data = plot_data) +
- geom_bar(aes(x = factor(Coefficient, levels=c(ord)), y = Estimate, fill = Coefficient), stat = "identity", position = 'dodge', width = 0.5, alpha = 0.7) +
- geom_errorbar(aes(x = Coefficient, ymin = Estimate - ME, ymax = Estimate + ME), width = 0.3, position = position_dodge(0.8)) +
- scale_x_discrete(guide = guide_axis(angle = 0)) +
- guides(fill = "none") +
- coord_cartesian(ylim=c(down, up)) +
- xlab("Treatment Group") +
- ylab(paste0(unit))
-
- return(plot)
-}
-
-
-case_A_labels <- c("Treated", "Voluntary Treated")
-case_C_labels <- c("No Info 2", "Text 1", "Text 2", "Video 1", "Video 2")
-case_C_labels_re <- c("Text 1", "Text 2", "Video 1", "Video 2", "No Info 2")
-
-plot_interview_A <- create_interaction_term_plot(ols_time_spent_control_A, case_A_labels, case_A_labels,
- "Interview Time in Seconds", -250, 380)
-plot_interview_C <- create_interaction_term_plot(ols_time_spent_control_C, case_C_labels, case_C_labels_re,
- "Interview Time in Seconds", -250, 380)
-
-plot_cc_A <- create_interaction_term_plot(ols_time_cc_control_A, case_A_labels, case_A_labels,
- "Mean Choice Card Time in Seconds", -5, 5)
-plot_cc_C <- create_interaction_term_plot(ols_time_cc_control_C, case_C_labels, case_C_labels_re,
- "Mean Choice Card Time in Seconds", -5, 5)
-
-plot_mani_A <- create_interaction_term_plot(ols_percentage_correct_control_A, case_A_labels, case_A_labels,
- "Percentage of Correct Quiz Statements", -5, 15)
-plot_mani_C <- create_interaction_term_plot(ols_percentage_correct_control_C, case_C_labels, case_C_labels_re,
- "Percentage of Correct Quiz Statements", -5, 15)
-
-plot_cons_A <- create_interaction_term_plot(conseq_model_control_A, case_A_labels, case_A_labels,
- "Consequentiality Score", -0.5, 0.8)
-plot_cons_C <- create_interaction_term_plot(conseq_model_control_C, case_C_labels, case_C_labels_re,
- "Consequentiality Score", -0.5, 0.8)
-
-plot_opt_A <- create_interaction_term_plot(ols_opt_out_control_A, case_A_labels, case_A_labels,
- "Number of Opt-out Choices", -1.5, 1)
-plot_opt_C <- create_interaction_term_plot(ols_opt_out_control_C, case_C_labels, case_C_labels_re,
- "Number of Opt-out Choices", -1.5, 1)
+# Create Interaction Term Plot for Presentation
+
+
+####
+create_interaction_term_plot <- function(ols_summary, treatment_labels, ord, unit, down, up) {
+ alpha <- 0.1
+ z_value <- qnorm(1 - alpha / 2)
+
+ plot_data <- summary(ols_summary)
+ plot_data <- as.data.frame(plot_data$coefficients)
+ plot_data$ME <- z_value * plot_data$`Std. Error`
+ plot_data <- rownames_to_column(plot_data, "Coefficient")
+
+ plot_data <- plot_data %>% filter(str_detect(Coefficient, "Treatment"))
+
+ plot_data$Coefficient <- treatment_labels
+
+ plot <- ggplot(data = plot_data) +
+ geom_bar(aes(x = factor(Coefficient, levels=c(ord)), y = Estimate, fill = Coefficient), stat = "identity", position = 'dodge', width = 0.5, alpha = 0.7) +
+ geom_errorbar(aes(x = Coefficient, ymin = Estimate - ME, ymax = Estimate + ME), width = 0.3, position = position_dodge(0.8)) +
+ scale_x_discrete(guide = guide_axis(angle = 0)) +
+ guides(fill = "none") +
+ coord_cartesian(ylim=c(down, up)) +
+ xlab("Treatment Group") +
+ ylab(paste0(unit))
+
+ return(plot)
+}
+
+
+case_A_labels <- c("Treated", "Voluntary Treated")
+case_C_labels <- c("No Info 2", "Text 1", "Text 2", "Video 1", "Video 2")
+case_C_labels_re <- c("Text 1", "Text 2", "Video 1", "Video 2", "No Info 2")
+
+plot_interview_A <- create_interaction_term_plot(ols_time_spent_control_A, case_A_labels, case_A_labels,
+ "Interview Time in Seconds", -250, 380)
+plot_interview_C <- create_interaction_term_plot(ols_time_spent_control_C, case_C_labels, case_C_labels_re,
+ "Interview Time in Seconds", -250, 380)
+
+plot_cc_A <- create_interaction_term_plot(ols_time_cc_control_A, case_A_labels, case_A_labels,
+ "Mean Choice Card Time in Seconds", -5, 5)
+plot_cc_C <- create_interaction_term_plot(ols_time_cc_control_C, case_C_labels, case_C_labels_re,
+ "Mean Choice Card Time in Seconds", -5, 5)
+
+plot_mani_A <- create_interaction_term_plot(ols_percentage_correct_control_A, case_A_labels, case_A_labels,
+ "Percentage of Correct Quiz Statements", -5, 15)
+plot_mani_C <- create_interaction_term_plot(ols_percentage_correct_control_C, case_C_labels, case_C_labels_re,
+ "Percentage of Correct Quiz Statements", -5, 15)
+
+plot_cons_A <- create_interaction_term_plot(conseq_model_control_A, case_A_labels, case_A_labels,
+ "Consequentiality Score", -0.5, 0.8)
+plot_cons_C <- create_interaction_term_plot(conseq_model_control_C, case_C_labels, case_C_labels_re,
+ "Consequentiality Score", -0.5, 0.8)
+
+plot_opt_A <- create_interaction_term_plot(ols_opt_out_control_A, case_A_labels, case_A_labels,
+ "Number of Opt-out Choices", -1.5, 1)
+plot_opt_C <- create_interaction_term_plot(ols_opt_out_control_C, case_C_labels, case_C_labels_re,
+ "Number of Opt-out Choices", -1.5, 1)
diff --git a/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R b/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R
index f659244..f210486 100644
--- a/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R
+++ b/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R
@@ -1,194 +1,194 @@
-#### Apollo standard script #####
-
-library(apollo) # Load apollo package
-
-
-
-# Test treatment effect
-
-database <- database_full %>%
- filter(!is.na(Treatment_new)) %>%
- mutate(Dummy_Video_1 = case_when(Treatment_new == 1 ~ 1, TRUE ~ 0),
- Dummy_Video_2 = case_when(Treatment_new == 5 ~ 1, TRUE ~ 0),
- Dummy_no_info = case_when(Treatment_new == 3 ~ 1, TRUE~0),
- Dummy_Info_nv1 = case_when(Treatment_new == 2 ~1, TRUE~0),
- Dummy_Info_nv2 = case_when(Treatment_new == 4 ~1 , TRUE~0))
-
-#initialize model
-
-apollo_initialise()
-
-
-### Set core controls
-apollo_control = list(
- modelName = "MXL_wtp_NR_Case_C Rent INT X",
- modelDescr = "MXL wtp space NR Case C Rent INT X",
- indivID ="id",
- mixing = TRUE,
- HB= FALSE,
- nCores = n_cores,
- outputDirectory = "Estimation_results/mxl"
-)
-
-##### Define model parameters depending on your attributes and model specification! ####
-# set values to 0 for conditional logit model
-
-apollo_beta=c(mu_natural = 15,
- mu_walking = -1,
- mu_rent = -2,
- ASC_sq = 0,
- mu_rent_NR = 0,
- mu_nat_NR = 0,
- mu_wd_NR = 0,
- mu_asc_NR = 0,
- mu_ASC_sq_vid1 = 0,
- mu_ASC_sq_vid2 = 0,
- mu_ASC_sq_no_info = 0,
- mu_ASC_sq_info_nv1 = 0,
- mu_ASC_sq_info_nv2 = 0,
- mu_rent_vid1 = 0,
- mu_rent_vid2 = 0,
- mu_rent_no_info = 0,
- mu_rent_info_nv1 = 0,
- mu_rent_info_nv2 = 0,
- mu_nat_vid1 =0,
- mu_nat_vid2 = 0,
- mu_nat_no_info = 0,
- mu_nat_info_nv1 = 0,
- mu_nat_info_nv2 = 0,
- mu_walking_vid1 =0,
- mu_walking_vid2 = 0,
- mu_walking_no_info = 0,
- mu_walking_info_nv1 = 0,
- mu_walking_info_nv2 = 0,
- sig_natural = 15,
- sig_walking = 2,
- sig_rent = 2,
- sig_ASC_sq = 2)
-
-### specify parameters that should be kept fixed, here = none
-apollo_fixed = c()
-
-### Set parameters for generating draws, use 2000 sobol draws
-apollo_draws = list(
- interDrawsType = "sobol",
- interNDraws = n_draws,
- interUnifDraws = c(),
- interNormDraws = c("draws_natural", "draws_walking", "draws_rent", "draws_asc"),
- intraDrawsType = "halton",
- intraNDraws = 0,
- intraUnifDraws = c(),
- intraNormDraws = c()
-)
-
-### Create random parameters, define distribution of the parameters
-apollo_randCoeff = function(apollo_beta, apollo_inputs){
- randcoeff = list()
-
- randcoeff[["b_mu_natural"]] = mu_natural + sig_natural * draws_natural
- randcoeff[["b_mu_walking"]] = mu_walking + sig_walking * draws_walking
- randcoeff[["b_mu_rent"]] = -exp(mu_rent + sig_rent * draws_rent)
- randcoeff[["b_ASC_sq"]] = ASC_sq + sig_ASC_sq * draws_asc
-
- return(randcoeff)
-}
-
-
-### validate
-apollo_inputs = apollo_validateInputs()
-apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
-
- ### Function initialisation: do not change the following three commands
- ### Attach inputs and detach after function exit
- apollo_attach(apollo_beta, apollo_inputs)
- on.exit(apollo_detach(apollo_beta, apollo_inputs))
-
- ### Create list of probabilities P
- P = list()
-
- #### List of utilities (later integrated in mnl_settings below) ####
- # Define utility functions here:
-
- V = list()
- V[['alt1']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info +
- mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR) *
- (b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 +
- mu_nat_NR * Naturalness_1 * Z_Mean_NR + mu_wd_NR * WalkingDistance_1 * Z_Mean_NR +
- mu_nat_vid1 * Naturalness_1 *Dummy_Video_1 + mu_nat_no_info * Naturalness_1 * Dummy_no_info
- + mu_nat_info_nv1 * Naturalness_1 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_1 * Dummy_Video_2
- + mu_nat_info_nv2 * Naturalness_1 *Dummy_Info_nv2 +
- mu_walking_vid1 * WalkingDistance_1 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_1 * Dummy_no_info
- + mu_walking_info_nv1 * WalkingDistance_1 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_1 * Dummy_Video_2
- + mu_walking_info_nv2 * WalkingDistance_1 *Dummy_Info_nv2- Rent_1)
-
- V[['alt2']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info +
- mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR)*
- (b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 +
- mu_nat_NR * Naturalness_2 * Z_Mean_NR + mu_wd_NR * WalkingDistance_2 * Z_Mean_NR +
- mu_nat_vid1 * Naturalness_2 *Dummy_Video_1 + mu_nat_no_info * Naturalness_2 * Dummy_no_info
- + mu_nat_info_nv1 * Naturalness_2 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_2 * Dummy_Video_2
- + mu_nat_info_nv2 * Naturalness_2 *Dummy_Info_nv2+
- mu_walking_vid1 * WalkingDistance_2 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_2 * Dummy_no_info
- + mu_walking_info_nv1 * WalkingDistance_2 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_2 * Dummy_Video_2
- + mu_walking_info_nv2 * WalkingDistance_2 *Dummy_Info_nv2 - Rent_2)
-
- V[['alt3']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info +
- mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR) *
- (b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 +
- mu_asc_NR * Z_Mean_NR + mu_nat_NR * Naturalness_3 * Z_Mean_NR +
- mu_wd_NR * WalkingDistance_3 * Z_Mean_NR +
- mu_nat_vid1 * Naturalness_3 *Dummy_Video_1 + mu_nat_no_info * Naturalness_3 * Dummy_no_info
- + mu_nat_info_nv1 * Naturalness_3 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_3 * Dummy_Video_2
- + mu_nat_info_nv2 * Naturalness_3 *Dummy_Info_nv2+
- mu_walking_vid1 * WalkingDistance_3 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_3 * Dummy_no_info
- + mu_walking_info_nv1 * WalkingDistance_3 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_3 * Dummy_Video_2
- + mu_walking_info_nv2 * WalkingDistance_3 *Dummy_Info_nv2
- + mu_ASC_sq_vid1 * Dummy_Video_1 + mu_ASC_sq_vid2 * Dummy_Video_2
- + mu_ASC_sq_no_info * Dummy_no_info + mu_ASC_sq_info_nv1 * Dummy_Info_nv1
- + mu_ASC_sq_info_nv2 * Dummy_Info_nv2 - Rent_3)
-
-
- ### Define settings for MNL model component
- mnl_settings = list(
- alternatives = c(alt1=1, alt2=2, alt3=3),
- avail = 1, # all alternatives are available in every choice
- choiceVar = choice,
- V = V#, # tell function to use list vector defined above
-
- )
-
- ### Compute probabilities using MNL model
- P[['model']] = apollo_mnl(mnl_settings, functionality)
-
- ### Take product across observation for same individual
- P = apollo_panelProd(P, apollo_inputs, functionality)
-
- ### Average across inter-individual draws - nur bei Mixed Logit!
- P = apollo_avgInterDraws(P, apollo_inputs, functionality)
-
- ### Prepare and return outputs of function
- P = apollo_prepareProb(P, apollo_inputs, functionality)
- return(P)
-}
-
-
-
-# ################################################################# #
-#### MODEL ESTIMATION ##
-# ################################################################# #
-# estimate model with bfgs algorithm
-
-mxl_wtp_NR_case_c_rentINTX = apollo_estimate(apollo_beta, apollo_fixed,
- apollo_probabilities, apollo_inputs,
- estimate_settings=list(maxIterations=400,
- estimationRoutine="bfgs",
- hessianRoutine="analytic"))
-
-
-
-# ################################################################# #
-#### MODEL OUTPUTS ##
-# ################################################################# #
-apollo_saveOutput(mxl_wtp_NR_case_c_rentINTX)
-
-
+#### Apollo standard script #####
+
+library(apollo) # Load apollo package
+
+
+
+# Test treatment effect
+
+database <- database_full %>%
+ filter(!is.na(Treatment_new)) %>%
+ mutate(Dummy_Video_1 = case_when(Treatment_new == 1 ~ 1, TRUE ~ 0),
+ Dummy_Video_2 = case_when(Treatment_new == 5 ~ 1, TRUE ~ 0),
+ Dummy_no_info = case_when(Treatment_new == 3 ~ 1, TRUE~0),
+ Dummy_Info_nv1 = case_when(Treatment_new == 2 ~1, TRUE~0),
+ Dummy_Info_nv2 = case_when(Treatment_new == 4 ~1 , TRUE~0))
+
+#initialize model
+
+apollo_initialise()
+
+
+### Set core controls
+apollo_control = list(
+ modelName = "MXL_wtp_NR_Case_C Rent INT X",
+ modelDescr = "MXL wtp space NR Case C Rent INT X",
+ indivID ="id",
+ mixing = TRUE,
+ HB= FALSE,
+ nCores = n_cores,
+ outputDirectory = "Estimation_results/mxl"
+)
+
+##### Define model parameters depending on your attributes and model specification! ####
+# set values to 0 for conditional logit model
+
+apollo_beta=c(mu_natural = 15,
+ mu_walking = -1,
+ mu_rent = -2,
+ ASC_sq = 0,
+ mu_rent_NR = 0,
+ mu_nat_NR = 0,
+ mu_wd_NR = 0,
+ mu_asc_NR = 0,
+ mu_ASC_sq_vid1 = 0,
+ mu_ASC_sq_vid2 = 0,
+ mu_ASC_sq_no_info = 0,
+ mu_ASC_sq_info_nv1 = 0,
+ mu_ASC_sq_info_nv2 = 0,
+ mu_rent_vid1 = 0,
+ mu_rent_vid2 = 0,
+ mu_rent_no_info = 0,
+ mu_rent_info_nv1 = 0,
+ mu_rent_info_nv2 = 0,
+ mu_nat_vid1 =0,
+ mu_nat_vid2 = 0,
+ mu_nat_no_info = 0,
+ mu_nat_info_nv1 = 0,
+ mu_nat_info_nv2 = 0,
+ mu_walking_vid1 =0,
+ mu_walking_vid2 = 0,
+ mu_walking_no_info = 0,
+ mu_walking_info_nv1 = 0,
+ mu_walking_info_nv2 = 0,
+ sig_natural = 15,
+ sig_walking = 2,
+ sig_rent = 2,
+ sig_ASC_sq = 2)
+
+### specify parameters that should be kept fixed, here = none
+apollo_fixed = c()
+
+### Set parameters for generating draws, use 2000 sobol draws
+apollo_draws = list(
+ interDrawsType = "sobol",
+ interNDraws = n_draws,
+ interUnifDraws = c(),
+ interNormDraws = c("draws_natural", "draws_walking", "draws_rent", "draws_asc"),
+ intraDrawsType = "halton",
+ intraNDraws = 0,
+ intraUnifDraws = c(),
+ intraNormDraws = c()
+)
+
+### Create random parameters, define distribution of the parameters
+apollo_randCoeff = function(apollo_beta, apollo_inputs){
+ randcoeff = list()
+
+ randcoeff[["b_mu_natural"]] = mu_natural + sig_natural * draws_natural
+ randcoeff[["b_mu_walking"]] = mu_walking + sig_walking * draws_walking
+ randcoeff[["b_mu_rent"]] = -exp(mu_rent + sig_rent * draws_rent)
+ randcoeff[["b_ASC_sq"]] = ASC_sq + sig_ASC_sq * draws_asc
+
+ return(randcoeff)
+}
+
+
+### validate
+apollo_inputs = apollo_validateInputs()
+apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
+
+ ### Function initialisation: do not change the following three commands
+ ### Attach inputs and detach after function exit
+ apollo_attach(apollo_beta, apollo_inputs)
+ on.exit(apollo_detach(apollo_beta, apollo_inputs))
+
+ ### Create list of probabilities P
+ P = list()
+
+ #### List of utilities (later integrated in mnl_settings below) ####
+ # Define utility functions here:
+
+ V = list()
+ V[['alt1']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info +
+ mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR) *
+ (b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 +
+ mu_nat_NR * Naturalness_1 * Z_Mean_NR + mu_wd_NR * WalkingDistance_1 * Z_Mean_NR +
+ mu_nat_vid1 * Naturalness_1 *Dummy_Video_1 + mu_nat_no_info * Naturalness_1 * Dummy_no_info
+ + mu_nat_info_nv1 * Naturalness_1 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_1 * Dummy_Video_2
+ + mu_nat_info_nv2 * Naturalness_1 *Dummy_Info_nv2 +
+ mu_walking_vid1 * WalkingDistance_1 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_1 * Dummy_no_info
+ + mu_walking_info_nv1 * WalkingDistance_1 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_1 * Dummy_Video_2
+ + mu_walking_info_nv2 * WalkingDistance_1 *Dummy_Info_nv2- Rent_1)
+
+ V[['alt2']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info +
+ mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR)*
+ (b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 +
+ mu_nat_NR * Naturalness_2 * Z_Mean_NR + mu_wd_NR * WalkingDistance_2 * Z_Mean_NR +
+ mu_nat_vid1 * Naturalness_2 *Dummy_Video_1 + mu_nat_no_info * Naturalness_2 * Dummy_no_info
+ + mu_nat_info_nv1 * Naturalness_2 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_2 * Dummy_Video_2
+ + mu_nat_info_nv2 * Naturalness_2 *Dummy_Info_nv2+
+ mu_walking_vid1 * WalkingDistance_2 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_2 * Dummy_no_info
+ + mu_walking_info_nv1 * WalkingDistance_2 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_2 * Dummy_Video_2
+ + mu_walking_info_nv2 * WalkingDistance_2 *Dummy_Info_nv2 - Rent_2)
+
+ V[['alt3']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info +
+ mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR) *
+ (b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 +
+ mu_asc_NR * Z_Mean_NR + mu_nat_NR * Naturalness_3 * Z_Mean_NR +
+ mu_wd_NR * WalkingDistance_3 * Z_Mean_NR +
+ mu_nat_vid1 * Naturalness_3 *Dummy_Video_1 + mu_nat_no_info * Naturalness_3 * Dummy_no_info
+ + mu_nat_info_nv1 * Naturalness_3 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_3 * Dummy_Video_2
+ + mu_nat_info_nv2 * Naturalness_3 *Dummy_Info_nv2+
+ mu_walking_vid1 * WalkingDistance_3 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_3 * Dummy_no_info
+ + mu_walking_info_nv1 * WalkingDistance_3 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_3 * Dummy_Video_2
+ + mu_walking_info_nv2 * WalkingDistance_3 *Dummy_Info_nv2
+ + mu_ASC_sq_vid1 * Dummy_Video_1 + mu_ASC_sq_vid2 * Dummy_Video_2
+ + mu_ASC_sq_no_info * Dummy_no_info + mu_ASC_sq_info_nv1 * Dummy_Info_nv1
+ + mu_ASC_sq_info_nv2 * Dummy_Info_nv2 - Rent_3)
+
+
+ ### Define settings for MNL model component
+ mnl_settings = list(
+ alternatives = c(alt1=1, alt2=2, alt3=3),
+ avail = 1, # all alternatives are available in every choice
+ choiceVar = choice,
+ V = V#, # tell function to use list vector defined above
+
+ )
+
+ ### Compute probabilities using MNL model
+ P[['model']] = apollo_mnl(mnl_settings, functionality)
+
+ ### Take product across observation for same individual
+ P = apollo_panelProd(P, apollo_inputs, functionality)
+
+ ### Average across inter-individual draws - nur bei Mixed Logit!
+ P = apollo_avgInterDraws(P, apollo_inputs, functionality)
+
+ ### Prepare and return outputs of function
+ P = apollo_prepareProb(P, apollo_inputs, functionality)
+ return(P)
+}
+
+
+
+# ################################################################# #
+#### MODEL ESTIMATION ##
+# ################################################################# #
+# estimate model with bfgs algorithm
+
+mxl_wtp_NR_case_c_rentINTX = apollo_estimate(apollo_beta, apollo_fixed,
+ apollo_probabilities, apollo_inputs,
+ estimate_settings=list(maxIterations=400,
+ estimationRoutine="bfgs",
+ hessianRoutine="analytic"))
+
+
+
+# ################################################################# #
+#### MODEL OUTPUTS ##
+# ################################################################# #
+apollo_saveOutput(mxl_wtp_NR_case_c_rentINTX)
+
+
diff --git a/Scripts/nat_interaction_plot.R b/Scripts/nat_interaction_plot.R
index b29594a..706e331 100644
--- a/Scripts/nat_interaction_plot.R
+++ b/Scripts/nat_interaction_plot.R
@@ -1,26 +1,26 @@
-df_NR_C <- as.data.frame(mxl_wtp_NR_case_c_rentINT$estimate)
-alpha = 0.1
-z_value <- qnorm(1-alpha)
-df_NR_C$margin_of_error1 <- z_value*mxl_wtp_NR_case_c_rentINT$robse
-
-df_NR_C <- rownames_to_column(df_NR_C, "Coefficent")
-
-colnames(df_NR_C) <- c("Coefficent", "Estimate", "Margin_of_error")
-
-df_NR_C_melt <- melt(df_NR_C[1:2], id = "Coefficent")
-
-df_NR_C_melt$ME <- df_NR_C$Margin_of_error
-
-df_NR_C_melt <- df_NR_C_melt %>%
- filter(str_starts(Coefficent, "mu_nat_"))
-
-df_NR_C_melt$Coefficent <- c("NR", "Video 1", "Video 2", "No Info 2", "Text 1", "Text 2")
-
-ggplot(data=df_NR_C_melt,
- aes(x=factor(Coefficent, levels = c("NR", "No Info 2", "Text 1", "Text 2", "Video 1", "Video 2")),
- y=value, fill=variable)) +
- geom_bar(aes(fill=Coefficent), stat="identity", position='dodge', width = 0.9, alpha=0.7) +
- geom_errorbar(aes(x=Coefficent, ymin=value-ME, ymax=value+ME), width=0.3, position=position_dodge(0.8)) +
- ylab("Interaction Effect WTP Naturalness") +
- xlab("Interaction") +
- scale_x_discrete(guide = guide_axis(angle = 45))
+df_NR_C <- as.data.frame(mxl_wtp_NR_case_c_rentINT$estimate)
+alpha = 0.1
+z_value <- qnorm(1-alpha)
+df_NR_C$margin_of_error1 <- z_value*mxl_wtp_NR_case_c_rentINT$robse
+
+df_NR_C <- rownames_to_column(df_NR_C, "Coefficent")
+
+colnames(df_NR_C) <- c("Coefficent", "Estimate", "Margin_of_error")
+
+df_NR_C_melt <- melt(df_NR_C[1:2], id = "Coefficent")
+
+df_NR_C_melt$ME <- df_NR_C$Margin_of_error
+
+df_NR_C_melt <- df_NR_C_melt %>%
+ filter(str_starts(Coefficent, "mu_nat_"))
+
+df_NR_C_melt$Coefficent <- c("NR", "Video 1", "Video 2", "No Info 2", "Text 1", "Text 2")
+
+ggplot(data=df_NR_C_melt,
+ aes(x=factor(Coefficent, levels = c("NR", "No Info 2", "Text 1", "Text 2", "Video 1", "Video 2")),
+ y=value, fill=variable)) +
+ geom_bar(aes(fill=Coefficent), stat="identity", position='dodge', width = 0.9, alpha=0.7) +
+ geom_errorbar(aes(x=Coefficent, ymin=value-ME, ymax=value+ME), width=0.3, position=position_dodge(0.8)) +
+ ylab("Interaction Effect WTP Naturalness") +
+ xlab("Interaction") +
+ scale_x_discrete(guide = guide_axis(angle = 45))
diff --git a/Scripts/ols/ols_consequentiality.R b/Scripts/ols/ols_consequentiality.R
index 3e00225..446c328 100644
--- a/Scripts/ols/ols_consequentiality.R
+++ b/Scripts/ols/ols_consequentiality.R
@@ -1,28 +1,28 @@
-# Q28W3
-
-# Q29W3
-
-# A1 I belive, A5 I don't belive; A6 i don't know
-
-data <- data %>% mutate(Conseq_score = Conseq_UGS + Conseq_Money)
-
-
-conseq_model_A <- lm(Conseq_score ~ as.factor(Treatment_A), data)
-summary(conseq_model_A)
-
-conseq_model_control_A <- lm(Conseq_score ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
-summary(conseq_model_control_A )
-
-
-conseq_model_B <- lm(Conseq_score ~ as.factor(Treatment_B), data)
-summary(conseq_model_B)
-
-conseq_model_control_B <- lm(Conseq_score ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
-summary(conseq_model_control_B)
-
-
-conseq_model_C <- lm(Conseq_score ~ as.factor(Treatment_C), data)
-summary(conseq_model_C)
-
-conseq_model_control_C <- lm(Conseq_score ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
-summary(conseq_model_control_C)
+# Q28W3
+
+# Q29W3
+
+# A1 I belive, A5 I don't belive; A6 i don't know
+
+data <- data %>% mutate(Conseq_score = Conseq_UGS + Conseq_Money)
+
+
+conseq_model_A <- lm(Conseq_score ~ as.factor(Treatment_A), data)
+summary(conseq_model_A)
+
+conseq_model_control_A <- lm(Conseq_score ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(conseq_model_control_A )
+
+
+conseq_model_B <- lm(Conseq_score ~ as.factor(Treatment_B), data)
+summary(conseq_model_B)
+
+conseq_model_control_B <- lm(Conseq_score ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(conseq_model_control_B)
+
+
+conseq_model_C <- lm(Conseq_score ~ as.factor(Treatment_C), data)
+summary(conseq_model_C)
+
+conseq_model_control_C <- lm(Conseq_score ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(conseq_model_control_C)
diff --git a/Scripts/ols/ols_nr.R b/Scripts/ols/ols_nr.R
index 2ad2e09..274e610 100644
--- a/Scripts/ols/ols_nr.R
+++ b/Scripts/ols/ols_nr.R
@@ -1,23 +1,23 @@
-# Analyze NR Score
-
-data$Treatment_C <- as.factor(data$Treatment_C)
-
-data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
-
-nr_model <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ Rent_SQ +
- Naturalness_SQ + WalkingDistance_SQ , data)
-
-summary(nr_model)
-
-nr_model_treat <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome +
- as.factor(Treatment_C) + Naturalness_SQ, data)
-
-summary(nr_model_treat)
-
-
-nr_model_treat_A <- lm(Z_Mean_NR ~ as.factor(Treatment_A) + QFIncome + as.factor(Gender)+Age_mean+Uni_degree + Kids_Dummy +
- Naturalness_SQ + WalkingDistance_SQ, data)
-
-summary(nr_model_treat_A)
-
-vif(nr_model_treat)
+# Analyze NR Score
+
+data$Treatment_C <- as.factor(data$Treatment_C)
+
+data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
+
+nr_model <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ Rent_SQ +
+ Naturalness_SQ + WalkingDistance_SQ , data)
+
+summary(nr_model)
+
+nr_model_treat <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome +
+ as.factor(Treatment_C) + Naturalness_SQ, data)
+
+summary(nr_model_treat)
+
+
+nr_model_treat_A <- lm(Z_Mean_NR ~ as.factor(Treatment_A) + QFIncome + as.factor(Gender)+Age_mean+Uni_degree + Kids_Dummy +
+ Naturalness_SQ + WalkingDistance_SQ, data)
+
+summary(nr_model_treat_A)
+
+vif(nr_model_treat)
diff --git a/Scripts/ols/ols_opt_out.R b/Scripts/ols/ols_opt_out.R
index e63bb76..9c2357f 100644
--- a/Scripts/ols/ols_opt_out.R
+++ b/Scripts/ols/ols_opt_out.R
@@ -1,80 +1,80 @@
-data <- database_full %>%
- group_by(id) %>%
- slice(1) %>%
- ungroup()
-
-data$Treatment_C <- as.factor(data$Treatment_C)
-
-data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
-
-ols_opt_out_A<- lm( count_choosen_3 ~ as.factor(Treatment_A) ,data)
-summary(ols_opt_out_A)
-ols_opt_out_control_A<- lm( count_choosen_3 ~ as.factor(Treatment_A) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
-summary(ols_opt_out_control_A)
-
-ols_opt_out_B<- lm( count_choosen_3 ~ as.factor(Treatment_B) ,data)
-summary(ols_opt_out_B)
-ols_opt_out_control_B<- lm( count_choosen_3 ~ as.factor(Treatment_B) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
-summary(ols_opt_out_control_B)
-ols_opt_out_C<- lm( count_choosen_3 ~ as.factor(Treatment_C) ,data)
-summary(ols_opt_out_C)
-ols_opt_out_control_C<- lm( count_choosen_3 ~ as.factor(Treatment_C) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
-summary(ols_opt_out_control_C)
-
-# Obtain predicted values
-predictions <- predict(ols_opt_out_control_C, data, se.fit = TRUE)
-
-# Create a data frame with predictions and standard errors
-predictions_df <- data.frame(
- Treatment_C = data$Treatment_C,
- Predicted_Value = predictions$fit,
- Standard_Error = predictions$se.fit
-)
-
-# Calculate means and standard errors
-means <- aggregate(Predicted_Value ~ Treatment_C, predictions_df, mean)
-means$Standard_Error <- aggregate(Standard_Error ~ Treatment_C, predictions_df, mean)$Standard_Error
-
-# Plot mean and standard errors
-library(ggplot2)
-
-ggplot(means, aes(x = as.factor(Treatment_C), y = Predicted_Value, fill = as.factor(Treatment_C))) +
- geom_bar(stat = "identity", position = "dodge") +
- geom_errorbar(aes(ymin = Predicted_Value - 1.64*Standard_Error, ymax = Predicted_Value + 1.64*Standard_Error),
- position = position_dodge(width = 0.9), width = 0.25) +
- labs(fill = "Treatment") +
- xlab("Treatment") +
- ylab("Mean Predicted Value") +
- theme_minimal()
-#
-# # Create an HTML results table with customized names and stars
-# results_table_1 <- stargazer(
-# ols_opt_out_1, ols_opt_out_control_1,
-# align = TRUE,
-# type = "html",
-# dep.var.labels = "No. Opt-out choices",
-# covariate.labels = c("Video 1", "Video 2", "No Info choosen", "Text 1", "Text 2",
-# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
-# "Hochschulabschluss") ,
-# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
-# star.char = c("*", "**", "***") # Custom significance stars
-# )
-#
-# # Save the HTML table to a file
-# writeLines(results_table_1, "Estimation_results/ols/opt_out_1.html")
-#
-# # Create an HTML results table with customized names and stars
-# results_table_2 <- stargazer(
-# ols_opt_out_2, ols_opt_out_control_2,
-# align = TRUE,
-# type = "html",
-# dep.var.labels = "No. Opt-out choices",
-# covariate.labels = c("Video", "No Info choosen", "Text",
-# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
-# "Hochschulabschluss") ,
-# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
-# star.char = c("*", "**", "***") # Custom significance stars
-# )
-#
-# # Save the HTML table to a file
-# writeLines(results_table_2, "Estimation_results/ols/opt_out_2.html")
+data <- database_full %>%
+ group_by(id) %>%
+ slice(1) %>%
+ ungroup()
+
+data$Treatment_C <- as.factor(data$Treatment_C)
+
+data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
+
+ols_opt_out_A<- lm( count_choosen_3 ~ as.factor(Treatment_A) ,data)
+summary(ols_opt_out_A)
+ols_opt_out_control_A<- lm( count_choosen_3 ~ as.factor(Treatment_A) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
+summary(ols_opt_out_control_A)
+
+ols_opt_out_B<- lm( count_choosen_3 ~ as.factor(Treatment_B) ,data)
+summary(ols_opt_out_B)
+ols_opt_out_control_B<- lm( count_choosen_3 ~ as.factor(Treatment_B) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
+summary(ols_opt_out_control_B)
+ols_opt_out_C<- lm( count_choosen_3 ~ as.factor(Treatment_C) ,data)
+summary(ols_opt_out_C)
+ols_opt_out_control_C<- lm( count_choosen_3 ~ as.factor(Treatment_C) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
+summary(ols_opt_out_control_C)
+
+# Obtain predicted values
+predictions <- predict(ols_opt_out_control_C, data, se.fit = TRUE)
+
+# Create a data frame with predictions and standard errors
+predictions_df <- data.frame(
+ Treatment_C = data$Treatment_C,
+ Predicted_Value = predictions$fit,
+ Standard_Error = predictions$se.fit
+)
+
+# Calculate means and standard errors
+means <- aggregate(Predicted_Value ~ Treatment_C, predictions_df, mean)
+means$Standard_Error <- aggregate(Standard_Error ~ Treatment_C, predictions_df, mean)$Standard_Error
+
+# Plot mean and standard errors
+library(ggplot2)
+
+ggplot(means, aes(x = as.factor(Treatment_C), y = Predicted_Value, fill = as.factor(Treatment_C))) +
+ geom_bar(stat = "identity", position = "dodge") +
+ geom_errorbar(aes(ymin = Predicted_Value - 1.64*Standard_Error, ymax = Predicted_Value + 1.64*Standard_Error),
+ position = position_dodge(width = 0.9), width = 0.25) +
+ labs(fill = "Treatment") +
+ xlab("Treatment") +
+ ylab("Mean Predicted Value") +
+ theme_minimal()
+#
+# # Create an HTML results table with customized names and stars
+# results_table_1 <- stargazer(
+# ols_opt_out_1, ols_opt_out_control_1,
+# align = TRUE,
+# type = "html",
+# dep.var.labels = "No. Opt-out choices",
+# covariate.labels = c("Video 1", "Video 2", "No Info choosen", "Text 1", "Text 2",
+# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
+# "Hochschulabschluss") ,
+# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
+# star.char = c("*", "**", "***") # Custom significance stars
+# )
+#
+# # Save the HTML table to a file
+# writeLines(results_table_1, "Estimation_results/ols/opt_out_1.html")
+#
+# # Create an HTML results table with customized names and stars
+# results_table_2 <- stargazer(
+# ols_opt_out_2, ols_opt_out_control_2,
+# align = TRUE,
+# type = "html",
+# dep.var.labels = "No. Opt-out choices",
+# covariate.labels = c("Video", "No Info choosen", "Text",
+# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
+# "Hochschulabschluss") ,
+# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
+# star.char = c("*", "**", "***") # Custom significance stars
+# )
+#
+# # Save the HTML table to a file
+# writeLines(results_table_2, "Estimation_results/ols/opt_out_2.html")
diff --git a/Scripts/ols/ols_quiz.R b/Scripts/ols/ols_quiz.R
index a4af052..d80f763 100644
--- a/Scripts/ols/ols_quiz.R
+++ b/Scripts/ols/ols_quiz.R
@@ -1,64 +1,64 @@
-
-quiz_data$Treatment_C <- as.factor(quiz_data$Treatment_C)
-
-quiz_data$Treatment_C <- relevel(quiz_data$Treatment_C, ref = "No Treatment 3")
-
-
-ols_percentage_correct_A<- lm( percentage_correct ~ as.factor(Treatment_A) ,quiz_data)
-summary(ols_percentage_correct_A)
-ols_percentage_correct_control_A<- lm( percentage_correct ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
-summary(ols_percentage_correct_control_A)
-
-ols_percentage_correct_B<- lm( percentage_correct ~ as.factor(Treatment_B) ,quiz_data)
-summary(ols_percentage_correct_B)
-ols_percentage_correct_control_B<- lm( percentage_correct ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
-summary(ols_percentage_correct_control_B)
-
-ols_percentage_correct_C<- lm( percentage_correct ~ as.factor(Treatment_C) ,quiz_data)
-summary(ols_percentage_correct_C)
-ols_percentage_correct_control_C<- lm( percentage_correct ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
-summary(ols_percentage_correct_control_C)
-
-vif(ols_percentage_correct_control_C)
-
-#
-# # Create an HTML results table with customized names and stars
-# results_table_3 <- stargazer(
-# ols_quiz_1a, ols_quiz_control_1a, ols_quiz_1b, ols_quiz_control_1b,
-# align = TRUE,
-# type = "html",
-# dep.var.labels = "No. correct quiz questions",
-# covariate.labels = c("Video 1", "Video 2", "No Info choosen", "Text 1", "Text 2",
-# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
-# "Hochschulabschluss") ,
-# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
-# star.char = c("*", "**", "***") # Custom significance stars
-# )
-#
-# # Save the HTML table to a file
-# writeLines(results_table_3, "Estimation_results/ols/quiz_1.html")
-#
-# # Create an HTML results table with customized names and stars
-# results_table_4 <- stargazer(
-# ols_quiz_2a, ols_quiz_control_2a, ols_quiz_2b, ols_quiz_control_2b,
-# align = TRUE,
-# type = "html",
-# dep.var.labels = "No. correct quiz questions",
-# covariate.labels = c("Video", "No Info choosen", "Text",
-# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
-# "Hochschulabschluss") ,
-# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
-# star.char = c("*", "**", "***") # Custom significance stars
-# )
-#
-# # Save the HTML table to a file
-# writeLines(results_table_4, "Estimation_results/ols/quiz_2.html")
-#
-#
-# # Poisson regression
-# poisson_quiz_2b <- glm(
-# number_correct ~ Dummy_Video + Dummy_no_info + Dummy_nv,
-# quiz_data = quiz_data,
-# family = poisson
-# )
-# summary(poisson_quiz_2b)
+
+quiz_data$Treatment_C <- as.factor(quiz_data$Treatment_C)
+
+quiz_data$Treatment_C <- relevel(quiz_data$Treatment_C, ref = "No Treatment 3")
+
+
+ols_percentage_correct_A<- lm( percentage_correct ~ as.factor(Treatment_A) ,quiz_data)
+summary(ols_percentage_correct_A)
+ols_percentage_correct_control_A<- lm( percentage_correct ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
+summary(ols_percentage_correct_control_A)
+
+ols_percentage_correct_B<- lm( percentage_correct ~ as.factor(Treatment_B) ,quiz_data)
+summary(ols_percentage_correct_B)
+ols_percentage_correct_control_B<- lm( percentage_correct ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
+summary(ols_percentage_correct_control_B)
+
+ols_percentage_correct_C<- lm( percentage_correct ~ as.factor(Treatment_C) ,quiz_data)
+summary(ols_percentage_correct_C)
+ols_percentage_correct_control_C<- lm( percentage_correct ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
+summary(ols_percentage_correct_control_C)
+
+vif(ols_percentage_correct_control_C)
+
+#
+# # Create an HTML results table with customized names and stars
+# results_table_3 <- stargazer(
+# ols_quiz_1a, ols_quiz_control_1a, ols_quiz_1b, ols_quiz_control_1b,
+# align = TRUE,
+# type = "html",
+# dep.var.labels = "No. correct quiz questions",
+# covariate.labels = c("Video 1", "Video 2", "No Info choosen", "Text 1", "Text 2",
+# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
+# "Hochschulabschluss") ,
+# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
+# star.char = c("*", "**", "***") # Custom significance stars
+# )
+#
+# # Save the HTML table to a file
+# writeLines(results_table_3, "Estimation_results/ols/quiz_1.html")
+#
+# # Create an HTML results table with customized names and stars
+# results_table_4 <- stargazer(
+# ols_quiz_2a, ols_quiz_control_2a, ols_quiz_2b, ols_quiz_control_2b,
+# align = TRUE,
+# type = "html",
+# dep.var.labels = "No. correct quiz questions",
+# covariate.labels = c("Video", "No Info choosen", "Text",
+# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
+# "Hochschulabschluss") ,
+# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
+# star.char = c("*", "**", "***") # Custom significance stars
+# )
+#
+# # Save the HTML table to a file
+# writeLines(results_table_4, "Estimation_results/ols/quiz_2.html")
+#
+#
+# # Poisson regression
+# poisson_quiz_2b <- glm(
+# number_correct ~ Dummy_Video + Dummy_no_info + Dummy_nv,
+# quiz_data = quiz_data,
+# family = poisson
+# )
+# summary(poisson_quiz_2b)
diff --git a/Scripts/ols/ols_time_spent.R b/Scripts/ols/ols_time_spent.R
index ab1090d..a9afc04 100644
--- a/Scripts/ols/ols_time_spent.R
+++ b/Scripts/ols/ols_time_spent.R
@@ -1,72 +1,72 @@
-library(car)
-
-data <- database_full %>%
- group_by(id) %>%
- slice(1) %>%
- ungroup()
-
-
-data$Treatment_C <- as.factor(data$Treatment_C)
-
-data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
-
-ols_time_spent_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) ,data)
-summary(ols_time_spent_A)
-ols_time_spent_control_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
-summary(ols_time_spent_control_A)
-
-ols_time_spent_B<- lm( interviewtime_net_clean ~ as.factor(Treatment_B) ,data)
-summary(ols_time_spent_B)
-ols_time_spent_control_B<- lm( interviewtime_net_clean ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
-summary(ols_time_spent_control_B)
-ols_time_spent_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) ,data)
-summary(ols_time_spent_C)
-ols_time_spent_control_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
-summary(ols_time_spent_control_C)
-
-
-ols_time_cc_A<- lm( CC_time_mean_clean ~ as.factor(Treatment_A) ,data)
-summary(ols_time_cc_A)
-ols_time_cc_control_A<- lm( CC_time_mean_clean ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
-summary(ols_time_cc_control_A)
-
-ols_time_cc_B<- lm( CC_time_mean_clean ~ as.factor(Treatment_B) ,data)
-summary(ols_time_cc_B)
-ols_time_cc_control_B<- lm( CC_time_mean_clean ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome + Uni_degree,data)
-summary(ols_time_cc_control_B)
-ols_time_cc_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) ,data)
-summary(ols_time_cc_C)
-ols_time_cc_control_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
-summary(ols_time_cc_control_C)
-# # Create an HTML results table with customized names and stars
-# results_table_5 <- stargazer(
-# ols_tme_spent_1, ols_tme_spent_control_1,
-# align = TRUE,
-# type = "html",
-# dep.var.labels = "Interview Time (without Treatments)",
-# covariate.labels = c("Treated_A", "Treated_B","No Info choosen", "Video 1", "Video 2", "Text 1", "Text 2",
-# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
-# "Hochschulabschluss") ,
-# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
-# star.char = c("*", "**", "***") # Custom significance stars
-# )
-#
-# # Save the HTML table to a file
-# writeLines(results_table_5, "Estimation_results/ols/time_spent_1.html")
-#
-# # Create an HTML results table with customized names and stars
-# results_table_6 <- stargazer(
-# ols_tme_spent_2, ols_tme_spent_control_2,
-# align = TRUE,
-# type = "html",
-# dep.var.labels = "Interview Time (without Treatments)",
-# covariate.labels = c("Video", "No Info choosen", "Text",
-# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
-# "Hochschulabschluss") ,
-# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
-# star.char = c("*", "**", "***") # Custom significance stars
-# )
-#
-# # Save the HTML table to a file
-# writeLines(results_table_6, "Estimation_results/ols/time_spent_2.html")
-
+library(car)
+
+data <- database_full %>%
+ group_by(id) %>%
+ slice(1) %>%
+ ungroup()
+
+
+data$Treatment_C <- as.factor(data$Treatment_C)
+
+data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
+
+ols_time_spent_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) ,data)
+summary(ols_time_spent_A)
+ols_time_spent_control_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(ols_time_spent_control_A)
+
+ols_time_spent_B<- lm( interviewtime_net_clean ~ as.factor(Treatment_B) ,data)
+summary(ols_time_spent_B)
+ols_time_spent_control_B<- lm( interviewtime_net_clean ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
+summary(ols_time_spent_control_B)
+ols_time_spent_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) ,data)
+summary(ols_time_spent_C)
+ols_time_spent_control_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(ols_time_spent_control_C)
+
+
+ols_time_cc_A<- lm( CC_time_mean_clean ~ as.factor(Treatment_A) ,data)
+summary(ols_time_cc_A)
+ols_time_cc_control_A<- lm( CC_time_mean_clean ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
+summary(ols_time_cc_control_A)
+
+ols_time_cc_B<- lm( CC_time_mean_clean ~ as.factor(Treatment_B) ,data)
+summary(ols_time_cc_B)
+ols_time_cc_control_B<- lm( CC_time_mean_clean ~ as.factor(Treatment_B) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome + Uni_degree,data)
+summary(ols_time_cc_control_B)
+ols_time_cc_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) ,data)
+summary(ols_time_cc_C)
+ols_time_cc_control_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
+summary(ols_time_cc_control_C)
+# # Create an HTML results table with customized names and stars
+# results_table_5 <- stargazer(
+# ols_tme_spent_1, ols_tme_spent_control_1,
+# align = TRUE,
+# type = "html",
+# dep.var.labels = "Interview Time (without Treatments)",
+# covariate.labels = c("Treated_A", "Treated_B","No Info choosen", "Video 1", "Video 2", "Text 1", "Text 2",
+# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
+# "Hochschulabschluss") ,
+# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
+# star.char = c("*", "**", "***") # Custom significance stars
+# )
+#
+# # Save the HTML table to a file
+# writeLines(results_table_5, "Estimation_results/ols/time_spent_1.html")
+#
+# # Create an HTML results table with customized names and stars
+# results_table_6 <- stargazer(
+# ols_tme_spent_2, ols_tme_spent_control_2,
+# align = TRUE,
+# type = "html",
+# dep.var.labels = "Interview Time (without Treatments)",
+# covariate.labels = c("Video", "No Info choosen", "Text",
+# "Female", "Divers", "Age", "mittlere Reife", "Abitur", "Berufsausbildung",
+# "Hochschulabschluss") ,
+# star.cutoffs = c(0.1, 0.05, 0.01), # Custom significance levels
+# star.char = c("*", "**", "***") # Custom significance stars
+# )
+#
+# # Save the HTML table to a file
+# writeLines(results_table_6, "Estimation_results/ols/time_spent_2.html")
+
diff --git a/project_start.qmd b/project_start.qmd
index 7b38247..7b97fa8 100644
--- a/project_start.qmd
+++ b/project_start.qmd
@@ -34,101 +34,103 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
```
## Motivation (1)
-::: {.incremental}
-- **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.
+
+::: incremental
+- **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.
:::
## Motivation (2)
-::: {.incremental}
-- Too **much information** may increase survey **complexity**, leading to respondents being overburdened with it and producing less consistent choices.
-- 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.
-- **Voluntary information** allows the respondents to gather required information if needed.
+
+::: incremental
+- Too **much information** may increase survey **complexity**, leading to respondents being overburdened with it and producing less consistent choices.
+- 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.
+- **Voluntary information** allows the respondents to gather required information if needed.
:::
## Literature
-::: {.incremental}
-- There is **little research** on the effects of **voluntary information provision** on choice behavior and information recall.
-- In their study, **Tienhaara et al. (2022)** surveyed preferences for agricultural genetic resources, allowing respondents the option to access detailed information on the valued goods prior to preference elicitation.
-- Similarly, **Hu et al. (2009)** offered respondents the opportunity to access voluntary information about genetic modified food before participating in a choice experiment.
-- Both studies conclude that, on average, respondents who retrieve voluntary information
-have **larger willingness to pay** for the good to be valued.
-- Their study design, however, does not allow comparing the voluntary information retrieval to a version where the additional information was shown obligatory.
+
+::: incremental
+- There is **little research** on the effects of **voluntary information provision** on choice behavior and information recall.
+- In their study, **Tienhaara et al. (2022)** surveyed preferences for agricultural genetic resources, allowing respondents the option to access detailed information on the valued goods prior to preference elicitation.
+- Similarly, **Hu et al. (2009)** offered respondents the opportunity to access voluntary information about genetic modified food before participating in a choice experiment.
+- Both studies conclude that, on average, respondents who retrieve voluntary information have **larger willingness to pay** for the good to be valued.
+- Their study design, however, does not allow comparing the voluntary information retrieval to a version where the additional information was shown obligatory.
:::
+
## Research Contribution
-::: {.incremental}
-- Our study explores the impact of additional obligatory and voluntary information on stated preferences using an exogenous split sample approach with three treatments.
-- We investigate the effects of information treatments on survey engagement, information recall, consequentiality, and stated preferences, similar to Welling et al. (2023), expanding our understanding of treatment effects.
-- We test who choose additional information and to what extent they have different preferences than respondents who do not choose aditional information.
+::: incremental
+- Our study explores the impact of additional obligatory and voluntary information on stated preferences using an exogenous split sample approach with three treatments.
+- We investigate the effects of information treatments on survey engagement, information recall, consequentiality, and stated preferences, similar to Welling et al. (2023), expanding our understanding of treatment effects.
+- We test who choose additional information and to what extent they have different preferences than respondents who do not choose aditional information.
:::
+
## Research Questions
-::: {.incremental}
-1. How do obligatory and voluntary information treatments affect **survey engagement**, **information recall**, **consequentiality**, and **stated preferences**?
-2. Do **socio-demographic** variables or natural **connectedness** influence the decision to **access voluntary information**?
-3. Do **survey engagement**, **information recall**, **consequentiality**, and **stated preferences** differ between respondents who **access voluntary information** and those who do not?
+
+::: incremental
+1. How do obligatory and voluntary information treatments affect **survey engagement**, **information recall**, **consequentiality**, and **stated preferences**?
+2. Do **socio-demographic** variables or natural **connectedness** influence the decision to **access voluntary information**?
+3. Do **survey engagement**, **information recall**, **consequentiality**, and **stated preferences** differ between respondents who **access voluntary information** and those who do not?
:::
+
## Discrete Choice Experiment
-::: {.incremental}
-- To investigate the research questions, we use data from a **discrete choice experiment (DCE)** on naturalness of urban green spaces.
-- The survey is an exact **replication** of the choice experiment of **Bronnmann et al., (2023)** and differs only in the information provided to the respondents.
-- In the DCE, respondents were asked to imagine possible **changes** to their **most frequently used UGS**.
-- This **restructuring** involved adjustments to the UGS’s **naturalness** and changes to the **walking distance**.
-- The associated **costs** of this restructuring were intended to be integrated into monthly **rental payments**.
-- Participants in the DCE were presented **ten** randomly assigned **choice cards** with a choice between **two alternative programs** for the renovation of the UGS and the **current status quo**.
+
+::: incremental
+- To investigate the research questions, we use data from a **discrete choice experiment (DCE)** on naturalness of urban green spaces.
+- The survey is an exact **replication** of the choice experiment of **Bronnmann et al., (2023)** and differs only in the information provided to the respondents.
+- In the DCE, respondents were asked to imagine possible **changes** to their **most frequently used UGS**.
+- This **restructuring** involved adjustments to the UGS's **naturalness** and changes to the **walking distance**.
+- The associated **costs** of this restructuring were intended to be integrated into monthly **rental payments**.
+- Participants in the DCE were presented **ten** randomly assigned **choice cards** with a choice between **two alternative programs** for the renovation of the UGS and the **current status quo**.
:::
+
## Choice Card
{width="300"}
-
-
## Treatment (Information provision)
-- Short info text about the effect of **natural urban green spaces** on urban **heat islands**.
-- **Optional video** with the almost the same information.
+
+- Short info text about the effect of **natural urban green spaces** on urban **heat islands**.
+- **Optional video** with the almost the same information.
{width="200"}
## Treatment (Quiz)
-::: {.incremental}
-**Seven quiz questions** with strict reference to the previously provided information.
+::: incremental
+**Seven quiz questions** with strict reference to the previously provided information.
Example Questions:
-1. Which of the following statements are correct?
-
-- The temperature difference between the city and the surrounding area can be up to 10
-degrees Celsius. (true/false)
-
+1. Which of the following statements are correct?
+- The temperature difference between the city and the surrounding area can be up to 10 degrees Celsius. (true/false)
-2. According to the information provided, which of the following properties influences
-the temperature in the city?
+2. According to the information provided, which of the following properties influences the temperature in the city?
-- The proximity of green spaces to nature (yes/no)
-- Light pollution in the city (yes/no)
+- The proximity of green spaces to nature (yes/no)
+- Light pollution in the city (yes/no)
:::
## Treatment (Self reference)
-::: {.incremental}
+
+::: incremental
To what extent do you agree or disagree with the following statements?
-1. I am limited by high temperatures in the city during the summer. (Strongly agree - Strongly disagree)
+1. I am limited by high temperatures in the city during the summer. (Strongly agree - Strongly disagree)
-2. The city should do more to avoid heat islands. (Strongly agree - Strongly disagree)
+2. The city should do more to avoid heat islands. (Strongly agree - Strongly disagree)
:::
-
-## Experimental Setting
+## Experimental Setting
{width="300"}
-
-## Case A
+## Case A
{width="300"}
@@ -137,18 +139,20 @@ To what extent do you agree or disagree with the following statements?
{width="300"}
## Data
-::: {.incremental}
-- **Socio-demographics**: Age, Gender, Income, Education.
-- Natural Relatedness Index: Measure derived from 21 items on **connectedness to nature**.
-- Quiz: Evaluation of the quiz we gave to everyone after the DCE.**->Information recall**
-- Timings: We saved the net interview time and the mean Choice Card time.-> **Survey engagement**
-- **Consequentiality**:
+
+::: incremental
+- **Socio-demographics**: Age, Gender, Income, Education.
+- Natural Relatedness Index: Measure derived from 21 items on **connectedness to nature**.
+- Quiz: Evaluation of the quiz we gave to everyone after the DCE.**-\>Information recall**
+- Timings: We saved the net interview time and the mean Choice Card time.-\> **Survey engagement**
+- **Consequentiality**:
-- To what extent do you believe that the decisions you make will have an impact on how the green spaces in your neighbourhood are designed in the future?
-- To what extent do you believe that the decisions you make will affect whether you have to pay a contribution for urban greening in the future?
-:::
-## Methods
+:::
+
+## Methods (1) {auto-animate="true"}
- Logit regression (voluntary information access):
@@ -158,9 +162,7 @@ To what extent do you agree or disagree with the following statements?
\label{simple_logit}
\end{equation}
```
-
-
-- OLS regression (survey engagement):
+- OLS regression (survey engagement & information recall):
```{=tex}
\begin{equation}
@@ -168,7 +170,6 @@ To what extent do you agree or disagree with the following statements?
\label{ols}
\end{equation}
```
-
- Mixed logit model with interactions in WTP space:
```{=tex}
@@ -177,48 +178,38 @@ To what extent do you agree or disagree with the following statements?
\label{mxl_base}
\end{equation}
```
-## Socio Demografics {.smaller}
+## Methods (2) {auto-animate="true"}
-::: {style="font-size: 50%;"}
-::: panel-tabset
-### Case A
+- Mixed logit model with interactions in WTP space:
-```{r}
-kableExtra::kable(treatment_socio_A)
+```{=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}
```
-### Case B
+with
-```{r}
-kableExtra::kable(treatment_socio_C)
+```{=tex}
+\begin{equation}
+ v_{X_i} = \{ASC_{sq_i}, Nat_i, WD_i\}
+\end{equation}
```
-:::
-:::
+and
+```{=tex}
+\begin{equation}
+ v_{Treat_A} = \{Treated, Volutary Treated\}
+\end{equation}
+```
-## NR
+```{=tex}
+\begin{equation}
+ v_{Treat_B} = \{Text 1, Text 2, Video 1, Video 2, No Info 2\}
+\end{equation}
+```
-**Hypotheses:** Individuals with greater Nature Relatedness (NR) are more inclined to autonomously seek information about environmental subjects, such as the impact of urban green spaces on urban heat islands. Consequently, any observed increase in the willingness to pay among the treated group may be attributed to the individuals' higher NR rather than the treatment itself.
-## NR OLS
-
-::: {style="font-size: 65%;"}
-```{r, results='asis'}
-htmlreg(l=list(nr_model_treat_A), single.row = TRUE,
- custom.model.names = c("OLS regression"),
- custom.header = list("Dependent variable: NR-Index" = 1),
- custom.coef.map = list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
- "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
- "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
- "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
- "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree", "Kids_Dummy" = "Children",
- "Naturalness_SQ" = "Naturalness SQ", "WalkingDistance_SQ" = "Walking Distance SQ"),
- stars = c(0.01, 0.05, 0.1), float.pos="tb",
- custom.note = "%stars. Standard errors in parentheses.",
- label = "tab:nr_ols",
- caption = "Results of OLS on the NR-index.")
-```
-:::
## Logit Regression: Who choses treatment?
@@ -237,13 +228,11 @@ htmlreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="t
```
:::
-
-
## OLS Engagement: Interview time
::: panel-tabset
-
### Table
+
::: {style="font-size: 55%;"}
```{r, results='asis'}
htmlreg(l=list(ols_time_spent_A, ols_time_spent_control_A, ols_time_spent_C, ols_time_spent_control_C),
@@ -257,22 +246,23 @@ htmlreg(l=list(ols_time_spent_A, ols_time_spent_control_A, ols_time_spent_C, o
:::
### Plot
+
```{r}
ggpubr::ggarrange(plot_interview_A, plot_interview_C)
```
-
:::
-
## OLS Engagement: Choice Card Time
::: panel-tabset
### Plot
+
```{r}
ggpubr::ggarrange(plot_cc_A, plot_cc_C)
```
### Table
+
::: {style="font-size: 55%;"}
```{r, results='asis'}
htmlreg(l=list(ols_time_cc_A, ols_time_cc_control_A, ols_time_cc_C, ols_time_cc_control_C),
@@ -284,21 +274,19 @@ htmlreg(l=list(ols_time_cc_A, ols_time_cc_control_A, ols_time_cc_C, ols_time_c
caption = "Results of OLS on mean choice card time.")
```
:::
-
:::
-
-
## OLS: Manipulation check
::: panel-tabset
-
### Plot
+
```{r}
ggpubr::ggarrange(plot_mani_A, plot_mani_C)
```
### Table
+
::: {style="font-size: 55%;"}
```{r, results='asis'}
htmlreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_percentage_correct_C, ols_percentage_correct_control_C),
@@ -310,7 +298,6 @@ htmlreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_
caption = "Results of OLS on percentage of correct quiz statements.")
```
:::
-
:::
<!-- ## Self Reference -->
@@ -328,13 +315,14 @@ htmlreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_
## OLS: Consequentiality
::: panel-tabset
-
### Plot
+
```{r}
ggpubr::ggarrange(plot_cons_A, plot_cons_C)
```
### Table
+
::: {style="font-size: 55%;"}
```{r, results='asis'}
htmlreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_model_control_C),
@@ -346,21 +334,19 @@ htmlreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_mo
caption = "Results of OLS on consequentiality score.")
```
:::
-
:::
-
## OLS: Opt-out
::: panel-tabset
-
### Plot
+
```{r}
ggpubr::ggarrange(plot_opt_A, plot_opt_C)
```
-
### Table
+
::: {style="font-size: 60%;"}
```{r, results='asis'}
htmlreg(l=list(ols_opt_out_A, ols_opt_out_control_A, ols_opt_out_C, ols_opt_out_control_C),
@@ -372,7 +358,6 @@ htmlreg(l=list(ols_opt_out_A, ols_opt_out_control_A, ols_opt_out_C, ols_opt_out_
caption = "Results of OLS on number of opt-out choices.")
```
:::
-
:::
## MXL: Split Samples
@@ -421,13 +406,9 @@ htmlreg(c(case_C_cols[1], remGOF(case_C_cols[2:7])),
:::
:::
-
-
## MXL: WTP space with NR index
-
::: {style="font-size: 60%;"}
-
```{r, results='asis'}
htmlreg(c(case_C_cols_NR[1], remGOF(case_C_cols_NR[2:8])),
custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
@@ -439,20 +420,63 @@ htmlreg(c(case_C_cols_NR[1], remGOF(case_C_cols_NR[2:8])),
label = "tab:mxl_NR",
caption = "Results of mixed logit model with treatment and NR-index interactions for Case B.")
```
-
:::
<!-- ## Case D -->
<!-- ```{r} -->
+
<!-- summary(case_d) -->
+
<!-- ``` -->
-## Takeaways
+## Discussion (1)
+
+1. How do obligatory and voluntary information treatments 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
+
+- Both treatments increase information recall, stronger effect for obligatory treatment
+
+- No effect on consequentiality
+
+- Strong effects on stated preferences for both treatments, more pronounced effect for the obligatory treatment
+
+:::
+
+## Discussion (2)
+
+2. Do socio-demographic variables or natural connectedness influence the decision to access voluntary information?
+
+::: incremental
+
+- Respondents that voluntary access information are younger, richer and have a higher natural relatedness index
+
+- No effects of gender and education
+
+- Respondents' preferences for the good to be valued influence the likelihood of accessing additional information
+
+:::
+
+## Discussion (3)
+
+3. Do survey engagement, information recall, consequentiality, and stated preferences differ between respondents who access voluntary information and those who do not?
+
+::: incremental
+
+- Respondents that voluntary access information do engage differently in the survey
+
+:::
+
+## Conclusion
## Appendix
-Information provision (Video)
-Link to the video: https://idiv.limequery.com/upload/surveys/682191/files/urban-heat-island-effekt.mp4
+
+Information provision (Video) Link to the video: https://idiv.limequery.com/upload/surveys/682191/files/urban-heat-island-effekt.mp4
## Summary Statistics A
@@ -461,6 +485,46 @@ Link to the video: https://idiv.limequery.com/upload/surveys/682191/files/urban-
## Summary Statistics B
{width="300"}
+
+
+## Socio Demografics {.smaller}
+
+::: {style="font-size: 50%;"}
+::: panel-tabset
+### Case A
+
+```{r}
+kableExtra::kable(treatment_socio_A)
+```
+
+### Case B
+
+```{r}
+kableExtra::kable(treatment_socio_C)
+```
+:::
+:::
+
+## NR OLS
+
+::: {style="font-size: 65%;"}
+```{r, results='asis'}
+htmlreg(l=list(nr_model_treat_A), single.row = TRUE,
+ custom.model.names = c("OLS regression"),
+ custom.header = list("Dependent variable: NR-Index" = 1),
+ custom.coef.map = list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
+ "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
+ "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
+ "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
+ "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree", "Kids_Dummy" = "Children",
+ "Naturalness_SQ" = "Naturalness SQ", "WalkingDistance_SQ" = "Walking Distance SQ"),
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses.",
+ label = "tab:nr_ols",
+ caption = "Results of OLS on the NR-index.")
+```
+:::
+
<!-- ## MXL: WTP space -->
<!-- ::: panel-tabset -->
--
GitLab