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

Conseq+präsi update

parent 69c75fcb
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Scripts/MAKE_FILE.R
+ 13
− 1
View file @ fb935cc6
...@@ -6,6 +6,8 @@ library(reshape2) ...@@ -6,6 +6,8 @@ library(reshape2)
library(xtable) library(xtable)
library(stargazer) library(stargazer)
library(texreg) library(texreg)
# Set values # Set values
n_draws <- 2000 n_draws <- 2000
n_cores <- 1 n_cores <- 1
...@@ -27,11 +29,15 @@ source("Scripts/ols/ols_time_spent.R") ...@@ -27,11 +29,15 @@ source("Scripts/ols/ols_time_spent.R")
source("Scripts/ols/ols_quiz.R") source("Scripts/ols/ols_quiz.R")
source("Scripts/ols/ols_opt_out.R") source("Scripts/ols/ols_opt_out.R")
source("Scripts/ols/ols_nr.R") source("Scripts/ols/ols_nr.R")
source("Scripts/ols/ols_consequentiality.R")
##### Conditional Logits #####
#source("Scripts/clogit.R") #source("Scripts/clogit.R")
#source("Scripts/clogit_wtp.R") #source("Scripts/clogit_wtp.R")
##### Mixed Logit Models ######
#source("Scripts/mxl/mxl_wtp_space.R") #source("Scripts/mxl/mxl_wtp_space.R")
#source("Scripts/mxl/mxl_wtp_space_4d.R") #source("Scripts/mxl/mxl_wtp_space_4d.R")
#source("Scripts/mxl/mxl_wtp_space_interact_all.R") #source("Scripts/mxl/mxl_wtp_space_interact_all.R")
...@@ -67,6 +73,12 @@ mxl_wtp_case_a_prot <- apollo_loadModel("Estimation_results/mxl/without_proteste ...@@ -67,6 +73,12 @@ mxl_wtp_case_a_prot <- apollo_loadModel("Estimation_results/mxl/without_proteste
mxl_wtp_case_b_prot <- apollo_loadModel("Estimation_results/mxl/without_protesters/MXL_wtp Case B 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") 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")
############################## ##############################
......
Scripts/data_prep.R
+ 5
− 2
View file @ fb935cc6
...@@ -2,13 +2,16 @@ ...@@ -2,13 +2,16 @@
database_full <- database_full %>% rename(Gender = "Q03W123", Education = "Q06W123", HHSize = "Q41W123", database_full <- database_full %>% rename(Gender = "Q03W123", Education = "Q06W123", HHSize = "Q41W123",
WorkingTime = "Q44W123", Birthyear = "Q01W123", Rent_net = "Q07W123", WorkingTime = "Q44W123", Birthyear = "Q01W123", Rent_net = "Q07W123",
Number_Kids = "Q42W123", Employment_type = "Q43W123") Number_Kids = "Q42W123", Employment_type = "Q43W123", Conseq_UGS = "Q28W3",
Conseq_Money = "Q29W3")
database_full <- database_full %>% mutate(Gender = recode(Gender, "A1" = 1, "A2" = 2, "A3"=3), database_full <- database_full %>% mutate(Gender = recode(Gender, "A1" = 1, "A2" = 2, "A3"=3),
Education = recode(Education, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4, "A5" = 5), Education = recode(Education, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4, "A5" = 5),
Employment_type = recode(Employment_type, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4, Employment_type = recode(Employment_type, "A1" = 1, "A2" = 2, "A3"=3, "A4" = 4,
"A5" = 5, "A6" = 6)) "A5" = 5, "A6" = 6),
Conseq_UGS = recode(Conseq_UGS, "A1" = 5, "A2" = 4, "A3"=3, "A4" = 2, "A5" = 1, "A6" = NA_real_),
Conseq_Money = 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), database_full <- database_full %>% mutate(Gender_female = case_when(Gender == 2 ~1, TRUE~0),
Age = 2023-Birthyear, Age = 2023-Birthyear,
......
Scripts/logit/chr_vol_treat.R
+ 2
− 2
View file @ fb935cc6
...@@ -26,12 +26,12 @@ table(data$Choice_Treat) ...@@ -26,12 +26,12 @@ table(data$Choice_Treat)
logit_choice_treat<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean + logit_choice_treat<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean + QFIncome +
as.factor(Education), data, family=binomial) as.factor(Education), data, family=binomial)
summary(logit_choice_treat) summary(logit_choice_treat)
logit_choice_treat_uni<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean + logit_choice_treat_uni<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean + QFIncome +
Uni_degree , data, family=binomial) Uni_degree , data, family=binomial)
summary(logit_choice_treat_uni) summary(logit_choice_treat_uni)
......
Scripts/logit/protesters.R
+ 3
− 3
View file @ fb935cc6
...@@ -27,11 +27,11 @@ table(data$Choice_Prot) ...@@ -27,11 +27,11 @@ table(data$Choice_Prot)
logit_choice_prot<-glm(Choice_Prot ~ Gender_female +Z_Mean_NR+Age_mean + logit_choice_prot<-glm(Choice_Prot ~ Gender_female +Z_Mean_NR+Age_mean + QFIncome +
Uni_degree, data, family=binomial) Uni_degree, data, family=binomial)
summary(logit_choice_prot) summary(logit_choice_prot)
logit_choice_prot_tr<-glm(Choice_Prot ~ Gender_female +Z_Mean_NR+Age_mean + logit_choice_prot_tr<-glm(Choice_Prot ~ Gender_female +Z_Mean_NR+Age_mean + QFIncome +
Uni_degree + as.factor(Treatment_A) + Naturalness_SQ + WalkingDistance_SQ + Uni_degree + as.factor(Treatment_A) + Naturalness_SQ + WalkingDistance_SQ +
Rent_SQ, data, family=binomial) Rent_SQ, data, family=binomial)
summary(logit_choice_prot_tr) summary(logit_choice_prot_tr)
...@@ -47,7 +47,7 @@ data$Treatment_C <- as.factor(data$Treatment_C) ...@@ -47,7 +47,7 @@ data$Treatment_C <- as.factor(data$Treatment_C)
data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3") data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
logit_choice_prot_trC<-glm(Choice_Prot ~ Gender_female +Z_Mean_NR+Age_mean + logit_choice_prot_trC<-glm(Choice_Prot ~ Gender_female +Z_Mean_NR+Age_mean + QFIncome +
Uni_degree + as.factor(Treatment_C) + Naturalness_SQ + WalkingDistance_SQ + Uni_degree + as.factor(Treatment_C) + Naturalness_SQ + WalkingDistance_SQ +
Rent_SQ, data, family=binomial) Rent_SQ, data, family=binomial)
summary(logit_choice_prot_trC) summary(logit_choice_prot_trC)
......
Scripts/ols/ols_consequentiality.R 0 → 100644
+ 28
− 0
View file @ fb935cc6
# 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 + as.factor(Education),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)
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)
summary(conseq_model_control_C)
Scripts/ols/ols_nr.R
+ 23
− 22
View file @ fb935cc6
# Analyze NR Score # Analyze NR Score
data$Treatment_C <- as.factor(data$Treatment_C) data$Treatment_C <- as.factor(data$Treatment_C)
data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3") 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 + nr_model <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ Rent_SQ +
Naturalness_SQ + WalkingDistance_SQ , data) Naturalness_SQ + WalkingDistance_SQ , data)
summary(nr_model) summary(nr_model)
nr_model_treat <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome + nr_model_treat <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome +
as.factor(Treatment_C) + Naturalness_SQ, data) as.factor(Treatment_C) + Naturalness_SQ, data)
summary(nr_model_treat) summary(nr_model_treat)
nr_model_treat_A <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome + nr_model_treat_A <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome +
as.factor(Treatment_A) + Naturalness_SQ, data) as.factor(Treatment_A) + Naturalness_SQ, data)
summary(nr_model_treat_A) summary(nr_model_treat_A)
vif(nr_model_treat)
Scripts/ols/ols_quiz.R
+ 5
− 3
View file @ fb935cc6
...@@ -6,18 +6,20 @@ quiz_data$Treatment_C <- relevel(quiz_data$Treatment_C, ref = "No Treatment 3") ...@@ -6,18 +6,20 @@ 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) ols_percentage_correct_A<- lm( percentage_correct ~ as.factor(Treatment_A) ,quiz_data)
summary(ols_percentage_correct_A) 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+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 + as.factor(Education),quiz_data)
summary(ols_percentage_correct_control_A) summary(ols_percentage_correct_control_A)
ols_percentage_correct_B<- lm( percentage_correct ~ as.factor(Treatment_B) ,quiz_data) ols_percentage_correct_B<- lm( percentage_correct ~ as.factor(Treatment_B) ,quiz_data)
summary(ols_percentage_correct_B) 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+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 + as.factor(Education),quiz_data)
summary(ols_percentage_correct_control_B) summary(ols_percentage_correct_control_B)
ols_percentage_correct_C<- lm( percentage_correct ~ as.factor(Treatment_C) ,quiz_data) ols_percentage_correct_C<- lm( percentage_correct ~ as.factor(Treatment_C) ,quiz_data)
summary(ols_percentage_correct_C) 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+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 + as.factor(Education),quiz_data)
summary(ols_percentage_correct_control_C) summary(ols_percentage_correct_control_C)
vif(ols_percentage_correct_control_C)
# #
# # Create an HTML results table with customized names and stars # # Create an HTML results table with customized names and stars
......
Scripts/ols/ols_time_spent.R
+ 9
− 6
View file @ fb935cc6
library(car)
data <- database_full %>% data <- database_full %>%
group_by(id) %>% group_by(id) %>%
slice(1) %>% slice(1) %>%
ungroup() ungroup()
data$Treatment_C <- as.factor(data$Treatment_C) data$Treatment_C <- as.factor(data$Treatment_C)
data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3") data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
ols_time_spent_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) ,data) ols_time_spent_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) ,data)
summary(ols_time_spent_A) 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+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 + as.factor(Education),data)
summary(ols_time_spent_control_A) summary(ols_time_spent_control_A)
ols_time_spent_B<- lm( interviewtime_net_clean ~ as.factor(Treatment_B) ,data) ols_time_spent_B<- lm( interviewtime_net_clean ~ as.factor(Treatment_B) ,data)
summary(ols_time_spent_B) 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+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 +as.factor(Education),data)
summary(ols_time_spent_control_B) summary(ols_time_spent_control_B)
ols_time_spent_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) ,data) ols_time_spent_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) ,data)
summary(ols_time_spent_C) 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+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 + as.factor(Education),data)
summary(ols_time_spent_control_C) summary(ols_time_spent_control_C)
dir.create("Tables/ols/") dir.create("Tables/ols/")
...@@ -26,16 +29,16 @@ texreg(ols_time_spent_control_C, "Tables/ols/time_spent_control_c.tex") ...@@ -26,16 +29,16 @@ 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) ols_time_cc_A<- lm( CC_time_mean_clean ~ as.factor(Treatment_A) ,data)
summary(ols_time_cc_A) 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+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 +as.factor(Education),data)
summary(ols_time_cc_control_A) summary(ols_time_cc_control_A)
ols_time_cc_B<- lm( CC_time_mean_clean ~ as.factor(Treatment_B) ,data) ols_time_cc_B<- lm( CC_time_mean_clean ~ as.factor(Treatment_B) ,data)
summary(ols_time_cc_B) 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+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 + as.factor(Education),data)
summary(ols_time_cc_control_B) summary(ols_time_cc_control_B)
ols_time_cc_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) ,data) ols_time_cc_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) ,data)
summary(ols_time_cc_C) 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+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 +as.factor(Education),data)
summary(ols_time_cc_control_C) summary(ols_time_cc_control_C)
# # Create an HTML results table with customized names and stars # # Create an HTML results table with customized names and stars
# results_table_5 <- stargazer( # results_table_5 <- stargazer(
......
project_start.qmd
+ 627
− 591
View file @ fb935cc6
--- ---
title: "Hot Topic, Cool Choices?" title: "Hot Topic, Cool Choices?"
subtitle: "How information treatments on urban heat islands affect WTP for urban green spaces in Germany" subtitle: "How information treatments on urban heat islands affect WTP for urban green spaces in Germany"
title-slide-attributes: title-slide-attributes:
data-background-image: Grafics/iDiv_logo_item.png data-background-image: Grafics/iDiv_logo_item.png
data-background-size: contain data-background-size: contain
data-background-opacity: "0.2" data-background-opacity: "0.2"
author: "Nino & Fabian" author: "Nino & Fabian"
institute: German Centre for Integrative Biodiversity Research (iDiv) Halle-Jena-Leipzig institute: German Centre for Integrative Biodiversity Research (iDiv) Halle-Jena-Leipzig
date: today date: today
date-format: long date-format: long
format: format:
revealjs: revealjs:
slide-number: true slide-number: true
smaller: true smaller: true
logo: Grafics/iDiv_logo_item.PNG logo: Grafics/iDiv_logo_item.PNG
scrollable: true scrollable: true
--- ---
```{r, include=FALSE, cache=FALSE} ```{r, include=FALSE, cache=FALSE}
source("Scripts/MAKE_FILE.R") source("Scripts/MAKE_FILE.R")
``` ```
```{r loadlibs, include=FALSE} ```{r loadlibs, include=FALSE}
library(tidyverse) library(tidyverse)
library(apollo) library(apollo)
``` ```
## Motivation ## Motivation
- Discrete choice experiments are increasingly used in environmental valuation - Discrete choice experiments are increasingly used in environmental valuation
- Validity is debated due to potential influence of information provision on welfare estimates - Validity is debated due to potential influence of information provision on welfare estimates
- We employ DCE to test influence of additional information on urban heat island on the valuation of UGS - We employ DCE to test influence of additional information on urban heat island on the valuation of UGS
**Research questions:** **Research questions:**
1. How does an information treatment about urban heat islands affect survey engagement (interview time, cc time), quiz questions, consequentially and NR-Index? 1. How does an information treatment about urban heat islands affect survey engagement (interview time, cc time), quiz questions, consequentially and NR-Index?
2. How does additional information on urban heat islands affect the willingness to pay for UGS in a discrete choice experiment? 2. How does additional information on urban heat islands affect the willingness to pay for UGS in a discrete choice experiment?
3. Who chooses optional information? 3. Who chooses optional information?
4. Do people who choose voluntary information have a different WTP/preferences? 4. Do people who choose voluntary information have a different WTP/preferences?
## Discrete Choice Experiment ## Discrete Choice Experiment
- Setting: Restructuring of individually most visited UGS in terms of proximity and naturalness financed via incidental costs - 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 - 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, round 3 just finished end of February
## Choice Card ## Choice Card
![](images/Figure 2.PNG){width="300"} ![](images/Figure%202.PNG){width="300"}
## Treatment Groups ## Treatment Groups
![](Grafics/FlowChart.png){width="300"} ![](Grafics/FlowChart.png){width="300"}
## Scenario A ## Scenario A
![](Grafics/FlowChart_Sce_A.png){width="300"} ![](Grafics/FlowChart_Sce_A.png){width="300"}
## Scenario B ## Scenario B
![](Grafics/FlowChart_Sce_B.png){width="300"} ![](Grafics/FlowChart_Sce_B.png){width="300"}
## Scenario C ## Scenario C
![](Grafics/FlowChart_Sce_C.png){width="300"} ![](Grafics/FlowChart_Sce_C.png){width="300"}
## Hypotheses ## Hypotheses
- H1: - H1:
- H2: - H2:
## Socio Demografics {.smaller} ## Methods
::: {style="font-size: 50%;"} - OLS and Logit regressions
::: panel-tabset
### Case A - Mixed logit model with interactions:
```{r} ```{=tex}
library(DT) \begin{equation}
treatment_socio_A <- treatment_socio_A 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
datatable(treatment_socio_A) \label{mxl_base}
``` \end{equation}
```
### Case C
## Socio Demografics {.smaller}
```{r}
library(DT) ::: {style="font-size: 50%;"}
treatment_socio_C <- treatment_socio_C %>% select(-Treatment_new) %>% select(Treatment_name, everything()) ::: panel-tabset
datatable(treatment_socio_C) ### Case A
```
::: ```{r}
::: library(DT)
treatment_socio_A <- treatment_socio_A
## NR OLS datatable(treatment_socio_A)
```
```{r}
summary(nr_model_treat_A) ### Case C
```
```{r}
library(DT)
treatment_socio_C <- treatment_socio_C %>% select(-Treatment_new) %>% select(Treatment_name, everything())
## Logit Regression I datatable(treatment_socio_C)
```
Characteristics of the voluntarily treated persons :::
:::
```{r}
summary(logit_choice_treat) ## NR OLS
```
```{r}
## Logit Regression II summary(nr_model_treat_A)
```
Does treatment affect "protest" voting?
## Logit Regression: Who choses treatment?
```{r}
summary(logit_choice_prot_tr) Characteristics of the voluntarily treated persons
```
```{r}
## Engagement: Interview Time summary(logit_choice_treat)
```
::: panel-tabset
### Scenario A ## Logit Regression: "Protest voting"
```{r} Does treatment affect "protest" voting?
bxplt_interview_time_A
``` ```{r}
summary(logit_choice_prot_tr)
### Scenario B ```
```{r} ## Engagement: Interview Time
bxplt_interview_time_B
``` ::: panel-tabset
### Scenario A
### Scenario C
```{r}
```{r} bxplt_interview_time_A
bxplt_interview_time_C ```
```
::: ### Scenario B
## OLS Engagement: Interview time ```{r}
bxplt_interview_time_B
::: panel-tabset ```
### Scenario A
### Scenario C
```{r}
summary(ols_time_spent_A) ```{r}
``` bxplt_interview_time_C
```
### Scenario B :::
```{r} ## OLS Engagement: Interview time
summary(ols_time_spent_B)
``` ::: panel-tabset
### Scenario A
### Scenario C
```{r}
```{r} summary(ols_time_spent_A)
summary(ols_time_spent_C) ```
```
::: ### Scenario B
## OLS Engagement: Interview time ```{r}
summary(ols_time_spent_B)
with controls ```
::: panel-tabset ### Scenario C
### Scenario A
```{r}
```{r} summary(ols_time_spent_C)
summary(ols_time_spent_control_A) ```
``` :::
### Scenario B ## OLS Engagement: Interview time
```{r} with controls
summary(ols_time_spent_control_B)
``` ::: panel-tabset
### Scenario A
### Scenario C
```{r}
```{r} summary(ols_time_spent_control_A)
summary(ols_time_spent_control_C) ```
```
::: ### Scenario B
## Engagement: Choice Card time ```{r}
summary(ols_time_spent_control_B)
::: panel-tabset ```
### Scenario A
### Scenario C
```{r}
bxplt_cc_time_A ```{r}
``` summary(ols_time_spent_control_C)
```
### Scenario B :::
```{r} ## Engagement: Choice Card time
bxplt_cc_time_B
``` ::: panel-tabset
### Scenario A
### Scenario C
```{r}
```{r} bxplt_cc_time_A
bxplt_cc_time_C ```
```
::: ### Scenario B
## OLS Engagement: Choice Card time ```{r}
bxplt_cc_time_B
::: panel-tabset ```
### Scenario A
### Scenario C
```{r}
summary(ols_time_cc_A) ```{r}
``` bxplt_cc_time_C
```
### Scenario B :::
```{r} ## OLS Engagement: Choice Card time
summary(ols_time_cc_B)
``` ::: panel-tabset
### Scenario A
### Scenario C
```{r}
```{r} summary(ols_time_cc_A)
summary(ols_time_cc_C) ```
```
::: ### Scenario B
## OLS Engagement: Choice Card time ```{r}
summary(ols_time_cc_B)
with controls ```
::: panel-tabset ### Scenario C
### Scenario A
```{r}
```{r} summary(ols_time_cc_C)
summary(ols_time_cc_control_A) ```
``` :::
### Scenario B ## OLS Engagement: Choice Card time
```{r} with controls
summary(ols_time_cc_control_B)
``` ::: panel-tabset
### Scenario A
### Scenario C
```{r}
```{r} summary(ols_time_cc_control_A)
summary(ols_time_cc_control_C) ```
```
::: ### Scenario B
## Manipulation check ```{r}
summary(ols_time_cc_control_B)
::: panel-tabset ```
### Group A
### Scenario C
```{r}
bxplt_quiz_A ```{r}
``` summary(ols_time_cc_control_C)
```
### Group B :::
```{r} ## Manipulation check
bxplt_quiz_B
``` ::: panel-tabset
### Group A
### Group C
```{r}
```{r} bxplt_quiz_A
bxplt_quiz_C ```
```
::: ### Group B
## OLS: Manipulation check ```{r}
bxplt_quiz_B
::: panel-tabset ```
### Group A
### Group C
```{r}
summary(ols_percentage_correct_A) ```{r}
``` bxplt_quiz_C
```
### Group B :::
```{r} ## OLS: Manipulation check
summary(ols_percentage_correct_B)
``` ::: panel-tabset
### Group A
### Group C
```{r}
```{r} summary(ols_percentage_correct_A)
summary(ols_percentage_correct_C) ```
```
::: ### Group B
## OLS: Manipulation check ```{r}
summary(ols_percentage_correct_B)
with controls ```
::: panel-tabset ### Group C
### Group A
```{r}
```{r} summary(ols_percentage_correct_C)
summary(ols_percentage_correct_control_A) ```
``` :::
### Group B ## OLS: Manipulation check
```{r} with controls
summary(ols_percentage_correct_control_B)
``` ::: panel-tabset
### Group A
### Group C
```{r}
```{r} summary(ols_percentage_correct_control_A)
summary(ols_percentage_correct_control_C) ```
```
::: ### Group B
## Self Reference ```{r}
summary(ols_percentage_correct_control_B)
1. Es entspricht meiner persönlichen Erfahrung, dass die Grünfläche in meiner Nähe zu einem angenehmen Klima an meinem Wohnort beiträgt. ```
2. Ich bin durch hohe Temperaturen in der Stadt im Sommer eingeschränkt.
3. Die Stadt sollte mehr unternehmen, um Hitzeinseln zu vermeiden. ### Group C
Stimme voll und ganz zu - Stimme gar nicht zu ```{r}
summary(ols_percentage_correct_control_C)
**Only the treated participants got these questions!** ```
:::
## Opt Out
## Self Reference
::: panel-tabset
### Group A 1. Es entspricht meiner persönlichen Erfahrung, dass die Grünfläche in meiner Nähe zu einem angenehmen Klima an meinem Wohnort beiträgt.
2. Ich bin durch hohe Temperaturen in der Stadt im Sommer eingeschränkt.
```{r} 3. Die Stadt sollte mehr unternehmen, um Hitzeinseln zu vermeiden.
bxplt_opt_A
``` Stimme voll und ganz zu - Stimme gar nicht zu
### Group B **Only the treated participants got these questions!**
```{r} ## Opt Out
bxplt_opt_B
``` ::: panel-tabset
### Group A
### Group C
```{r}
```{r} bxplt_opt_A
bxplt_opt_C ```
```
::: ### Group B
## OLS: Opt-out ```{r}
bxplt_opt_B
::: panel-tabset ```
### Group A
### Group C
```{r}
summary(ols_opt_out_A) ```{r}
``` bxplt_opt_C
```
### Group B :::
```{r} ## OLS: Opt-out
summary(ols_opt_out_B)
``` ::: panel-tabset
### Group A
### Group C
```{r}
```{r} summary(ols_opt_out_A)
summary(ols_opt_out_C) ```
```
::: ### Group B
## OLS: Opt-out ```{r}
summary(ols_opt_out_B)
with controls ```
::: panel-tabset ### Group C
### Group A
```{r}
```{r} summary(ols_opt_out_C)
summary(ols_opt_out_control_A) ```
``` :::
### Group B ## OLS: Opt-out
```{r} with controls
summary(ols_opt_out_control_B)
``` ::: panel-tabset
### Group A
### Group C
```{r}
```{r} summary(ols_opt_out_control_A)
summary(ols_opt_out_control_C) ```
```
::: ### Group B
## MXL: Split Samples ```{r}
summary(ols_opt_out_control_B)
```{r} ```
ggplot(data=mxl_melt_info, aes(x=Coefficent, y=abs(value), fill=variable)) +
geom_bar(stat="identity", position='dodge', width = 0.9) + ### Group C
geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
ylab("Absolute Value") + ```{r}
xlab("Coefficient") + summary(ols_opt_out_control_C)
scale_x_discrete(guide = guide_axis(angle = 45)) + ```
scale_fill_brewer(palette = "Set2", labels = c("Treated", "Optional Treatment", "Not Treated"), name="Treatment") + :::
theme(legend.position = c(0.85, 0.8))
```
## MXL: WTP space ## OLS: Consequentiality
::: panel-tabset with controls
### Scenario A
::: panel-tabset
```{r} ### Group A
summary(mxl_wtp_case_a)
``` ```{r}
summary(conseq_model_control_A)
### Scenario B ```
```{r} ### Group B
summary(mxl_wtp_case_b)
``` ```{r}
summary(conseq_model_control_B)
### Scenario C ```
```{r} ### Group C
summary(mxl_wtp_case_c)
``` ```{r}
::: summary(conseq_model_control_C)
```
## 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. ## MXL: Split Samples
::: panel-tabset ```{r}
### Scenario A ggplot(data=mxl_melt_info, aes(x=Coefficent, y=abs(value), fill=variable)) +
geom_bar(stat="identity", position='dodge', width = 0.9) +
```{r} geom_errorbar(aes(x=Coefficent, ymin=abs(value)-ME, ymax=abs(value)+ME), width=0.3, position=position_dodge(0.8)) +
summary(mxl_wtp_case_a_prot) ylab("Absolute Value") +
``` xlab("Coefficient") +
scale_x_discrete(guide = guide_axis(angle = 45)) +
### Scenario B scale_fill_brewer(palette = "Set2", labels = c("Treated", "Optional Treatment", "Not Treated"), name="Treatment") +
theme(legend.position = c(0.85, 0.8))
```{r} ```
summary(mxl_wtp_case_b_prot)
``` ## MXL: WTP space
### Scenario C ::: panel-tabset
### Scenario A
```{r}
summary(mxl_wtp_case_c_prot) ```{r}
``` summary(mxl_wtp_case_a_rentINT)
::: ```
## NR Index ### Scenario B
**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. ```{r}
summary(mxl_wtp_case_b_rentINT)
```
## MXL: WTP space
### Scenario C
with NR index
```{r}
::: panel-tabset summary(mxl_wtp_case_c_rentINT)
### Scenario A ```
:::
```{r}
summary(mxl_wtp_case_a_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.
### Scenario B
::: panel-tabset
```{r} ### Scenario A
summary(mxl_wtp_case_b_NR)
``` ```{r}
summary(mxl_wtp_case_a_prot)
### Scenario C ```
```{r} ### Scenario B
summary(mxl_wtp_case_c_NR)
``` ```{r}
::: summary(mxl_wtp_case_b_prot)
```
## MXL: WTP space
### Scenario C
::: panel-tabset
### Scenario A ```{r}
summary(mxl_wtp_case_c_prot)
```{r} ```
apollo_modelOutput(mxl_wtp_case_a) :::
```
## NR Index
### Scenario B
**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.
```{r}
apollo_modelOutput(mxl_wtp_case_b) ## MXL: WTP space
```
with NR index
### Scenario C
::: panel-tabset
```{r} ### Scenario A
apollo_modelOutput(mxl_wtp_case_c)
``` ```{r}
::: summary(mxl_wtp_case_a_NR)
```
## MXL: WTP space Graphs
### Scenario B
::: panel-tabset
### Scenario A ```{r}
summary(mxl_wtp_case_b_NR)
::: panel-tabset ```
### Naturalness
### Scenario C
```{r}
wtp_nat_a ```{r}
``` summary(mxl_wtp_case_c_NR)
```
### Walking Distance :::
```{r} ## MXL: WTP space
wtp_wd_a
``` ::: panel-tabset
::: ### Scenario A
### Scenario B ```{r}
apollo_modelOutput(mxl_wtp_case_a)
::: panel-tabset ```
### Naturalness
### Scenario B
```{r}
wtp_nat_b ```{r}
``` apollo_modelOutput(mxl_wtp_case_b)
```
### Walking Distance
### Scenario C
```{r}
wtp_wd_b ```{r}
``` apollo_modelOutput(mxl_wtp_case_c)
::: ```
:::
### Scenario C
## MXL: WTP space Graphs
::: panel-tabset
### Naturalness ::: panel-tabset
### Scenario A
```{r}
wtp_nat_c ::: panel-tabset
``` ### Naturalness
### Walking Distance ```{r}
wtp_nat_a
```{r} ```
wtp_wd_c
``` ### Walking Distance
:::
::: ```{r}
wtp_wd_a
## MXL: WTP space ```
:::
with NR index
### Scenario B
::: panel-tabset
### Scenario A ::: panel-tabset
### Naturalness
```{r}
apollo_modelOutput(mxl_wtp_case_a_NR) ```{r}
``` wtp_nat_b
```
### Scenario B
### Walking Distance
```{r}
apollo_modelOutput(mxl_wtp_case_b_NR) ```{r}
``` wtp_wd_b
```
### Scenario C :::
```{r} ### Scenario C
apollo_modelOutput(mxl_wtp_case_c_NR)
``` ::: panel-tabset
::: ### Naturalness
```{r}
wtp_nat_c
```
### Walking Distance
```{r}
wtp_wd_c
```
:::
:::
## MXL: WTP space
with NR index
::: panel-tabset
### Scenario A
```{r}
apollo_modelOutput(mxl_wtp_case_a_NR)
```
### Scenario B
```{r}
apollo_modelOutput(mxl_wtp_case_b_NR)
```
### Scenario C
```{r}
apollo_modelOutput(mxl_wtp_case_c_NR)
```
:::
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment