diff --git a/Scripts/MAKE_FILE.R b/Scripts/MAKE_FILE.R
index 52a9683a56b8406d656317e196c73298b02bf208..6cf22a98924880512a37cb00a8384c6968b005b1 100644
--- a/Scripts/MAKE_FILE.R
+++ b/Scripts/MAKE_FILE.R
@@ -7,24 +7,25 @@ library(xtable)
library(stargazer)
library(texreg)
-
-# Set values
+# Set values for estimation in Apollo
n_draws <- 2000
-n_cores <- 1
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 ######
-### OLS
+### 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")
@@ -35,7 +36,6 @@ source("Scripts/ols/ols_consequentiality.R")
#source("Scripts/clogit.R")
#source("Scripts/clogit_wtp.R")
-
##### Mixed Logit Models ######
#source("Scripts/mxl/mxl_wtp_space.R")
@@ -47,10 +47,8 @@ source("Scripts/ols/ols_consequentiality.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")
@@ -68,31 +66,32 @@ 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")
-# 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")
-
# 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")
+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")
\ No newline at end of file
+source("Scripts/create_tables.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/create_tables.R b/Scripts/create_tables.R
index d7d998d0b53d838d0de45be6a22a360e07a37f8c..efb47a9d922170d970fec51c5c2f804d16fd777a 100644
--- a/Scripts/create_tables.R
+++ b/Scripts/create_tables.R
@@ -125,6 +125,26 @@ texreg(c(case_C_cols[1], remGOF(case_C_cols[2:7])),
label = "tab:mxl_C",
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. Standard errors in parentheses.",
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ label = "tab:mxl_NR",
+ 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",
diff --git a/Scripts/treatment.R b/Scripts/treatment.R
index 1919be87f929ce0f8beaa7245eb5c733c0cf9ff9..5a8c217d591112f6cd325ae694399904a060216f 100644
--- a/Scripts/treatment.R
+++ b/Scripts/treatment.R
@@ -37,7 +37,7 @@ ggsave("Figures/barplot_treatment.png", width=7, height=5, dpi="print")
treatment_socio_A <- database_full %>%
group_by(Treatment_A) %>%
summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
- "Naturalness_SQ", "Employment_full", "Pensioner"),
+ "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
~ round(mean(., na.rm = TRUE), 2))
@@ -61,7 +61,7 @@ print(xtable(treatment_socio_B, type ="latex"),
### Case C
treatment_socio <- database_full %>% filter(!is.na(Treatment)) %>% group_by(Treatment) %>%
summarize_at(c('Gender_female', 'Uni_degree', 'Age', 'HHSize', "Rent_SQ", "Kids_Dummy", "WalkingDistance_SQ",
- "Naturalness_SQ", "Employment_full", "Pensioner"),
+ "Naturalness_SQ", "Employment_full", "Z_Mean_NR"),
~ round(mean(., na.rm = TRUE), 2))
treatment_socio_C <- database_full %>% filter(!is.na(Treatment_new)) %>% group_by(Treatment_new) %>%
diff --git a/project_start.qmd b/project_start.qmd
index 352b8f25e99e11cd5d7e7c53a21e3d095dffca61..67a9f8ca586ef293848423cf8ada8a433004ed41 100644
--- a/project_start.qmd
+++ b/project_start.qmd
@@ -53,17 +53,18 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
4. Do people who choose **voluntary** information have a different WTP/preferences?
+
## Discrete Choice Experiment
- Setting: Restructuring of individually most visited UGS in terms of proximity and naturalness financed via incidental costs
- Main attribute of interest here: naturalness defined by five-level graphical scale ▶ Range: hardly natural to very natural
-- Three survey rounds; paper by Bronnmann et al. (2023) based on round 1 & 2, round 3 just finished end of February
+- Three survey rounds; paper by Bronnmann et al. (2023) based on round 1 & 2, our paper is based on last survey round from February 2023
## Choice Card
{width="300"}
-## Treatment
+## Treatment
- Information text about urban heat islands with figure
@@ -75,19 +76,19 @@ list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" =
{width="200"}
-## Treatment Groups
+## Treatment Groups
{width="300"}
-## Scenario A
+## Scenario A
{width="300"}
-## Scenario B
+## Scenario B
{width="300"}
-## Scenario C
+## Scenario C
{width="300"}
@@ -354,7 +355,7 @@ ggplot(data=mxl_melt_info, aes(x=Coefficent, y=abs(value), fill=variable)) +
theme(legend.position = c(0.85, 0.8))
```
-## MXL: Paper Table
+## MXL: Effects on stated preferences
::: {style="font-size: 60%;"}
::: panel-tabset
@@ -385,82 +386,32 @@ htmlreg(c(case_C_cols[1], remGOF(case_C_cols[2:7])),
:::
:::
-## MXL: WTP space
-
-::: panel-tabset
-### Scenario A
-```{r}
-summary(mxl_wtp_case_a_rentINT)
-```
-### Scenario B
+## MXL: WTP space with NR index
-```{r}
-summary(mxl_wtp_case_b_rentINT)
-```
-### Scenario C
+::: {style="font-size: 60%;"}
-```{r}
-summary(mxl_wtp_case_c_rentINT)
+```{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",
+ "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. Standard errors in parentheses.",
+ stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ label = "tab:mxl_NR")
```
-:::
-
-<!-- ## MXL: WTP space without protesters -->
-
-<!-- As protesting is not affected by the treatment we might see a treatment affect removing the protesters, which always choose opt-out. -->
-
-<!-- ::: panel-tabset -->
-
-<!-- ### Scenario A -->
-
-<!-- ```{r} -->
-
-<!-- summary(mxl_wtp_case_a_prot) -->
-
-<!-- ``` -->
-<!-- ### Scenario B -->
-
-<!-- ```{r} -->
-
-<!-- summary(mxl_wtp_case_b_prot) -->
-
-<!-- ``` -->
+:::
-<!-- ### Scenario C -->
+<!-- ## Case D -->
<!-- ```{r} -->
-
-<!-- summary(mxl_wtp_case_c_prot) -->
-
+<!-- summary(case_d) -->
<!-- ``` -->
-<!-- ::: -->
-
-## MXL: WTP space with NR index
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(mxl_wtp_NR_case_a_rentINT)
-```
-
-### Scenario C
-
-```{r}
-summary(mxl_wtp_NR_case_c_rentINT)
-```
-:::
-
-## Case D
-
-```{r}
-summary(case_d)
-```
-
## Takeaways
<!-- ## MXL: WTP space -->