From b94aa5688122fb2af9e72d97c0bb82fdcb3bfdc3 Mon Sep 17 00:00:00 2001
From: Cavallaro <nino.cavallaro@idiv.de>
Date: Wed, 6 Mar 2024 13:53:24 +0100
Subject: [PATCH] Table MXL models
---
Scripts/create_tables.R | 68 ++++++++++++++++++++++++------
Scripts/ols/ols_consequentiality.R | 6 +--
Scripts/ols/ols_opt_out.R | 6 +--
Scripts/ols/ols_quiz.R | 6 +--
Scripts/ols/ols_time_spent.R | 14 +++---
5 files changed, 69 insertions(+), 31 deletions(-)
diff --git a/Scripts/create_tables.R b/Scripts/create_tables.R
index 89d8527..6f97b00 100644
--- a/Scripts/create_tables.R
+++ b/Scripts/create_tables.R
@@ -1,52 +1,92 @@
+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" = "Higher Education")
+ "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 C", "with Controls"),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1),
+ 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.",
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 C", "with Controls"),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses. Dependent variable: 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 C", "with Controls"),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses. Dependent variable: 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 C", "with Controls"),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses. Dependent variable: 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 C", "with Controls"),
- custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "%stars. Standard errors in parentheses. Dependent variable: Number of opt-out choices.",
file="Tables/ols/optout.tex")
+#### Logit #####
+
+texreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.header = list("Voluntary Information Access" = 1),
+ custom.coef.map = list_ols, custom.note = "%stars. Standard errors in parentheses.",
+ 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. Standard errors in parentheses.",
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ file="Tables/mxl/case_A_rent_INT.tex")
+
+### Baseline case C
+case_C <- quicktexregapollo(mxl_wtp_case_c_rentINT)
+
+
# 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")
+# 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/ols/ols_consequentiality.R b/Scripts/ols/ols_consequentiality.R
index 6effd89..3e00225 100644
--- a/Scripts/ols/ols_consequentiality.R
+++ b/Scripts/ols/ols_consequentiality.R
@@ -10,19 +10,19 @@ 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 + as.factor(Education),data)
+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 + as.factor(Education),data)
+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 + as.factor(Education),data)
+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_opt_out.R b/Scripts/ols/ols_opt_out.R
index b441c11..e63bb76 100644
--- a/Scripts/ols/ols_opt_out.R
+++ b/Scripts/ols/ols_opt_out.R
@@ -9,16 +9,16 @@ 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+as.factor(Education),data)
+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+as.factor(Education),data)
+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+as.factor(Education),data)
+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
diff --git a/Scripts/ols/ols_quiz.R b/Scripts/ols/ols_quiz.R
index 2d04edf..a4af052 100644
--- a/Scripts/ols/ols_quiz.R
+++ b/Scripts/ols/ols_quiz.R
@@ -6,17 +6,17 @@ 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 + as.factor(Education),quiz_data)
+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 + as.factor(Education),quiz_data)
+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 + as.factor(Education),quiz_data)
+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)
diff --git a/Scripts/ols/ols_time_spent.R b/Scripts/ols/ols_time_spent.R
index 11cfa56..ab1090d 100644
--- a/Scripts/ols/ols_time_spent.R
+++ b/Scripts/ols/ols_time_spent.R
@@ -12,33 +12,31 @@ 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 + as.factor(Education),data)
+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 +as.factor(Education),data)
+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 + as.factor(Education),data)
+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)
-dir.create("Tables/ols/")
-texreg(ols_time_spent_control_C, "Tables/ols/time_spent_control_c.tex")
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 +as.factor(Education),data)
+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 + as.factor(Education),data)
+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 +as.factor(Education),data)
+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(
--
GitLab