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

Tables C NR

parent 8feffdb4
No related branches found
No related tags found
No related merge requests found
Show whitespace changes
Inline Side-by-side
Scripts/MAKE_FILE.R
+ 17
− 18
View file @ f4eec3a6
......@@ -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")
### 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
Scripts/create_tables.R
+ 20
− 0
View file @ f4eec3a6
......@@ -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",
......
Scripts/treatment.R
+ 2
− 2
View file @ f4eec3a6
......@@ -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) %>%
......
project_start.qmd
+ 22
− 71
View file @ f4eec3a6
......@@ -53,11 +53,12 @@ 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
......@@ -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 -->
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment