diff --git a/Scripts/MAKE_FILE.R b/Scripts/MAKE_FILE.R
index 258dd185c313c7b4fbc26103dfbf2ef9efe9dd4e..de11490e275b6b7a7238581748affc4b881cb914 100644
--- a/Scripts/MAKE_FILE.R
+++ b/Scripts/MAKE_FILE.R
@@ -6,6 +6,8 @@ library(reshape2)
library(xtable)
library(stargazer)
library(texreg)
+
+
# Set values
n_draws <- 2000
n_cores <- 1
@@ -27,11 +29,15 @@ 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")
@@ -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_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")
+
##############################
diff --git a/Scripts/data_prep.R b/Scripts/data_prep.R
index 2770591c5c23cab7c148e8e4549972325874942d..92173bb46678247e5d0ae65114829a1aee0814a8 100644
--- a/Scripts/data_prep.R
+++ b/Scripts/data_prep.R
@@ -2,13 +2,16 @@
database_full <- database_full %>% rename(Gender = "Q03W123", Education = "Q06W123", HHSize = "Q41W123",
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),
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,
- "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),
Age = 2023-Birthyear,
diff --git a/Scripts/logit/chr_vol_treat.R b/Scripts/logit/chr_vol_treat.R
index c73023fde9a61d97a41af4f51b0b9796eeaf2438..82728301568b4d3dc7dd70170eac9d1b433732a4 100644
--- a/Scripts/logit/chr_vol_treat.R
+++ b/Scripts/logit/chr_vol_treat.R
@@ -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)
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)
summary(logit_choice_treat_uni)
diff --git a/Scripts/logit/protesters.R b/Scripts/logit/protesters.R
index bb621766450c631cb279dec0e35d923ad074d52b..722e38ff5be2444b3947a08e2cbf1fecce5c3f4c 100644
--- a/Scripts/logit/protesters.R
+++ b/Scripts/logit/protesters.R
@@ -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)
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 +
Rent_SQ, data, family=binomial)
summary(logit_choice_prot_tr)
@@ -47,7 +47,7 @@ data$Treatment_C <- as.factor(data$Treatment_C)
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 +
Rent_SQ, data, family=binomial)
summary(logit_choice_prot_trC)
diff --git a/Scripts/ols/ols_consequentiality.R b/Scripts/ols/ols_consequentiality.R
new file mode 100644
index 0000000000000000000000000000000000000000..6effd89726c992d1884b9208afd3629918372d2d
--- /dev/null
+++ b/Scripts/ols/ols_consequentiality.R
@@ -0,0 +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 + 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)
diff --git a/Scripts/ols/ols_nr.R b/Scripts/ols/ols_nr.R
index 63bda1942619f99e25235c4d2c576371e0241a4e..b76905c2fad291f0b9a611cb6e3db500c1aba552 100644
--- a/Scripts/ols/ols_nr.R
+++ b/Scripts/ols/ols_nr.R
@@ -1,22 +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 ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome +
- as.factor(Treatment_A) + Naturalness_SQ, data)
-
-summary(nr_model_treat_A)
-
+# 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 ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ QFIncome +
+ as.factor(Treatment_A) + Naturalness_SQ, data)
+
+summary(nr_model_treat_A)
+
+vif(nr_model_treat)
diff --git a/Scripts/ols/ols_quiz.R b/Scripts/ols/ols_quiz.R
index ff02a62f9df1e89623902853dadee0d7706c05d9..2d04edf5b9a03c55a87bf1493de64202e1eef4b5 100644
--- a/Scripts/ols/ols_quiz.R
+++ b/Scripts/ols/ols_quiz.R
@@ -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)
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)
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+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)
+
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+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)
+vif(ols_percentage_correct_control_C)
#
# # Create an HTML results table with customized names and stars
diff --git a/Scripts/ols/ols_time_spent.R b/Scripts/ols/ols_time_spent.R
index de08c2bc53cc9ee058e2c7619a26ba9cb3a60a27..11cfa56e8dc9c051720378d6315fc3b934e07bbf 100644
--- a/Scripts/ols/ols_time_spent.R
+++ b/Scripts/ols/ols_time_spent.R
@@ -1,24 +1,27 @@
+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+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)
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+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)
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+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)
dir.create("Tables/ols/")
@@ -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)
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)
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+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)
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+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)
# # Create an HTML results table with customized names and stars
# results_table_5 <- stargazer(
diff --git a/project_start.qmd b/project_start.qmd
index 857a1804e5b4ad57de0da049bf4e5f60abd8fce8..088a40bf2c5afdb4620b4b395919f5b54bdab068 100644
--- a/project_start.qmd
+++ b/project_start.qmd
@@ -1,591 +1,627 @@
----
-title: "Hot Topic, Cool Choices?"
-subtitle: "How information treatments on urban heat islands affect WTP for urban green spaces in Germany"
-title-slide-attributes:
- data-background-image: Grafics/iDiv_logo_item.png
- data-background-size: contain
- data-background-opacity: "0.2"
-author: "Nino & Fabian"
-institute: German Centre for Integrative Biodiversity Research (iDiv) Halle-Jena-Leipzig
-date: today
-date-format: long
-format:
- revealjs:
- slide-number: true
- smaller: true
- logo: Grafics/iDiv_logo_item.PNG
- scrollable: true
----
-
-```{r, include=FALSE, cache=FALSE}
-source("Scripts/MAKE_FILE.R")
-```
-
-```{r loadlibs, include=FALSE}
-library(tidyverse)
-library(apollo)
-```
-
-## Motivation
-
-- Discrete choice experiments are increasingly used in environmental valuation
-
-- 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
-
-**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?
-
-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?
-
-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
-
-## Choice Card
-
-{width="300"}
-
-## Treatment Groups
-
-{width="300"}
-
-## Scenario A
-
-{width="300"}
-
-## Scenario B
-
-{width="300"}
-
-## Scenario C
-
-{width="300"}
-
-## Hypotheses
-
-- H1:
-
-- H2:
-
-## Socio Demografics {.smaller}
-
-::: {style="font-size: 50%;"}
-::: panel-tabset
-### Case A
-
-```{r}
-library(DT)
-treatment_socio_A <- treatment_socio_A
-datatable(treatment_socio_A)
-```
-
-### Case C
-
-```{r}
-library(DT)
-treatment_socio_C <- treatment_socio_C %>% select(-Treatment_new) %>% select(Treatment_name, everything())
-datatable(treatment_socio_C)
-```
-:::
-:::
-
-## NR OLS
-
-```{r}
-summary(nr_model_treat_A)
-```
-
-
-
-## Logit Regression I
-
-Characteristics of the voluntarily treated persons
-
-```{r}
-summary(logit_choice_treat)
-```
-
-## Logit Regression II
-
-Does treatment affect "protest" voting?
-
-```{r}
-summary(logit_choice_prot_tr)
-```
-
-## Engagement: Interview Time
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-bxplt_interview_time_A
-```
-
-### Scenario B
-
-```{r}
-bxplt_interview_time_B
-```
-
-### Scenario C
-
-```{r}
-bxplt_interview_time_C
-```
-:::
-
-## OLS Engagement: Interview time
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(ols_time_spent_A)
-```
-
-### Scenario B
-
-```{r}
-summary(ols_time_spent_B)
-```
-
-### Scenario C
-
-```{r}
-summary(ols_time_spent_C)
-```
-:::
-
-## OLS Engagement: Interview time
-
-with controls
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(ols_time_spent_control_A)
-```
-
-### Scenario B
-
-```{r}
-summary(ols_time_spent_control_B)
-```
-
-### Scenario C
-
-```{r}
-summary(ols_time_spent_control_C)
-```
-:::
-
-## Engagement: Choice Card time
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-bxplt_cc_time_A
-```
-
-### Scenario B
-
-```{r}
-bxplt_cc_time_B
-```
-
-### Scenario C
-
-```{r}
-bxplt_cc_time_C
-```
-:::
-
-## OLS Engagement: Choice Card time
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(ols_time_cc_A)
-```
-
-### Scenario B
-
-```{r}
-summary(ols_time_cc_B)
-```
-
-### Scenario C
-
-```{r}
-summary(ols_time_cc_C)
-```
-:::
-
-## OLS Engagement: Choice Card time
-
-with controls
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(ols_time_cc_control_A)
-```
-
-### Scenario B
-
-```{r}
-summary(ols_time_cc_control_B)
-```
-
-### Scenario C
-
-```{r}
-summary(ols_time_cc_control_C)
-```
-:::
-
-## Manipulation check
-
-::: panel-tabset
-### Group A
-
-```{r}
-bxplt_quiz_A
-```
-
-### Group B
-
-```{r}
-bxplt_quiz_B
-```
-
-### Group C
-
-```{r}
-bxplt_quiz_C
-```
-:::
-
-## OLS: Manipulation check
-
-::: panel-tabset
-### Group A
-
-```{r}
-summary(ols_percentage_correct_A)
-```
-
-### Group B
-
-```{r}
-summary(ols_percentage_correct_B)
-```
-
-### Group C
-
-```{r}
-summary(ols_percentage_correct_C)
-```
-:::
-
-## OLS: Manipulation check
-
-with controls
-
-::: panel-tabset
-### Group A
-
-```{r}
-summary(ols_percentage_correct_control_A)
-```
-
-### Group B
-
-```{r}
-summary(ols_percentage_correct_control_B)
-```
-
-### Group C
-
-```{r}
-summary(ols_percentage_correct_control_C)
-```
-:::
-
-## Self Reference
-
-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.
-
-Stimme voll und ganz zu - Stimme gar nicht zu
-
-**Only the treated participants got these questions!**
-
-## Opt Out
-
-::: panel-tabset
-### Group A
-
-```{r}
-bxplt_opt_A
-```
-
-### Group B
-
-```{r}
-bxplt_opt_B
-```
-
-### Group C
-
-```{r}
-bxplt_opt_C
-```
-:::
-
-## OLS: Opt-out
-
-::: panel-tabset
-### Group A
-
-```{r}
-summary(ols_opt_out_A)
-```
-
-### Group B
-
-```{r}
-summary(ols_opt_out_B)
-```
-
-### Group C
-
-```{r}
-summary(ols_opt_out_C)
-```
-:::
-
-## OLS: Opt-out
-
-with controls
-
-::: panel-tabset
-### Group A
-
-```{r}
-summary(ols_opt_out_control_A)
-```
-
-### Group B
-
-```{r}
-summary(ols_opt_out_control_B)
-```
-
-### Group C
-
-```{r}
-summary(ols_opt_out_control_C)
-```
-:::
-
-## MXL: Split Samples
-
-```{r}
-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", "Optional Treatment", "Not Treated"), name="Treatment") +
- theme(legend.position = c(0.85, 0.8))
-```
-
-## MXL: WTP space
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(mxl_wtp_case_a)
-```
-
-### Scenario B
-
-```{r}
-summary(mxl_wtp_case_b)
-```
-
-### Scenario C
-
-```{r}
-summary(mxl_wtp_case_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.
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(mxl_wtp_case_a_prot)
-```
-
-### Scenario B
-
-```{r}
-summary(mxl_wtp_case_b_prot)
-```
-
-### Scenario C
-
-```{r}
-summary(mxl_wtp_case_c_prot)
-```
-:::
-
-## NR Index
-
-**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.
-
-
-## MXL: WTP space
-
-with NR index
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-summary(mxl_wtp_case_a_NR)
-```
-
-### Scenario B
-
-```{r}
-summary(mxl_wtp_case_b_NR)
-```
-
-### Scenario C
-
-```{r}
-summary(mxl_wtp_case_c_NR)
-```
-:::
-
-## MXL: WTP space
-
-::: panel-tabset
-### Scenario A
-
-```{r}
-apollo_modelOutput(mxl_wtp_case_a)
-```
-
-### Scenario B
-
-```{r}
-apollo_modelOutput(mxl_wtp_case_b)
-```
-
-### Scenario C
-
-```{r}
-apollo_modelOutput(mxl_wtp_case_c)
-```
-:::
-
-## MXL: WTP space Graphs
-
-::: panel-tabset
-### Scenario A
-
-::: panel-tabset
-### Naturalness
-
-```{r}
-wtp_nat_a
-```
-
-### Walking Distance
-
-```{r}
-wtp_wd_a
-```
-:::
-
-### Scenario B
-
-::: panel-tabset
-### Naturalness
-
-```{r}
-wtp_nat_b
-```
-
-### Walking Distance
-
-```{r}
-wtp_wd_b
-```
-:::
-
-### Scenario C
-
-::: 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)
-```
-:::
+---
+title: "Hot Topic, Cool Choices?"
+subtitle: "How information treatments on urban heat islands affect WTP for urban green spaces in Germany"
+title-slide-attributes:
+ data-background-image: Grafics/iDiv_logo_item.png
+ data-background-size: contain
+ data-background-opacity: "0.2"
+author: "Nino & Fabian"
+institute: German Centre for Integrative Biodiversity Research (iDiv) Halle-Jena-Leipzig
+date: today
+date-format: long
+format:
+ revealjs:
+ slide-number: true
+ smaller: true
+ logo: Grafics/iDiv_logo_item.PNG
+ scrollable: true
+---
+
+```{r, include=FALSE, cache=FALSE}
+source("Scripts/MAKE_FILE.R")
+```
+
+```{r loadlibs, include=FALSE}
+library(tidyverse)
+library(apollo)
+```
+
+## Motivation
+
+- Discrete choice experiments are increasingly used in environmental valuation
+
+- 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
+
+**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?
+
+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?
+
+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
+
+## Choice Card
+
+{width="300"}
+
+## Treatment Groups
+
+{width="300"}
+
+## Scenario A
+
+{width="300"}
+
+## Scenario B
+
+{width="300"}
+
+## Scenario C
+
+{width="300"}
+
+## Hypotheses
+
+- H1:
+
+- H2:
+
+## Methods
+
+- OLS and Logit regressions
+
+- Mixed logit model with interactions:
+
+```{=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
+ \label{mxl_base}
+\end{equation}
+```
+
+## Socio Demografics {.smaller}
+
+::: {style="font-size: 50%;"}
+::: panel-tabset
+### Case A
+
+```{r}
+library(DT)
+treatment_socio_A <- treatment_socio_A
+datatable(treatment_socio_A)
+```
+
+### Case C
+
+```{r}
+library(DT)
+treatment_socio_C <- treatment_socio_C %>% select(-Treatment_new) %>% select(Treatment_name, everything())
+datatable(treatment_socio_C)
+```
+:::
+:::
+
+## NR OLS
+
+```{r}
+summary(nr_model_treat_A)
+```
+
+## Logit Regression: Who choses treatment?
+
+Characteristics of the voluntarily treated persons
+
+```{r}
+summary(logit_choice_treat)
+```
+
+## Logit Regression: "Protest voting"
+
+Does treatment affect "protest" voting?
+
+```{r}
+summary(logit_choice_prot_tr)
+```
+
+## Engagement: Interview Time
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+bxplt_interview_time_A
+```
+
+### Scenario B
+
+```{r}
+bxplt_interview_time_B
+```
+
+### Scenario C
+
+```{r}
+bxplt_interview_time_C
+```
+:::
+
+## OLS Engagement: Interview time
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+summary(ols_time_spent_A)
+```
+
+### Scenario B
+
+```{r}
+summary(ols_time_spent_B)
+```
+
+### Scenario C
+
+```{r}
+summary(ols_time_spent_C)
+```
+:::
+
+## OLS Engagement: Interview time
+
+with controls
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+summary(ols_time_spent_control_A)
+```
+
+### Scenario B
+
+```{r}
+summary(ols_time_spent_control_B)
+```
+
+### Scenario C
+
+```{r}
+summary(ols_time_spent_control_C)
+```
+:::
+
+## Engagement: Choice Card time
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+bxplt_cc_time_A
+```
+
+### Scenario B
+
+```{r}
+bxplt_cc_time_B
+```
+
+### Scenario C
+
+```{r}
+bxplt_cc_time_C
+```
+:::
+
+## OLS Engagement: Choice Card time
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+summary(ols_time_cc_A)
+```
+
+### Scenario B
+
+```{r}
+summary(ols_time_cc_B)
+```
+
+### Scenario C
+
+```{r}
+summary(ols_time_cc_C)
+```
+:::
+
+## OLS Engagement: Choice Card time
+
+with controls
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+summary(ols_time_cc_control_A)
+```
+
+### Scenario B
+
+```{r}
+summary(ols_time_cc_control_B)
+```
+
+### Scenario C
+
+```{r}
+summary(ols_time_cc_control_C)
+```
+:::
+
+## Manipulation check
+
+::: panel-tabset
+### Group A
+
+```{r}
+bxplt_quiz_A
+```
+
+### Group B
+
+```{r}
+bxplt_quiz_B
+```
+
+### Group C
+
+```{r}
+bxplt_quiz_C
+```
+:::
+
+## OLS: Manipulation check
+
+::: panel-tabset
+### Group A
+
+```{r}
+summary(ols_percentage_correct_A)
+```
+
+### Group B
+
+```{r}
+summary(ols_percentage_correct_B)
+```
+
+### Group C
+
+```{r}
+summary(ols_percentage_correct_C)
+```
+:::
+
+## OLS: Manipulation check
+
+with controls
+
+::: panel-tabset
+### Group A
+
+```{r}
+summary(ols_percentage_correct_control_A)
+```
+
+### Group B
+
+```{r}
+summary(ols_percentage_correct_control_B)
+```
+
+### Group C
+
+```{r}
+summary(ols_percentage_correct_control_C)
+```
+:::
+
+## Self Reference
+
+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.
+
+Stimme voll und ganz zu - Stimme gar nicht zu
+
+**Only the treated participants got these questions!**
+
+## Opt Out
+
+::: panel-tabset
+### Group A
+
+```{r}
+bxplt_opt_A
+```
+
+### Group B
+
+```{r}
+bxplt_opt_B
+```
+
+### Group C
+
+```{r}
+bxplt_opt_C
+```
+:::
+
+## OLS: Opt-out
+
+::: panel-tabset
+### Group A
+
+```{r}
+summary(ols_opt_out_A)
+```
+
+### Group B
+
+```{r}
+summary(ols_opt_out_B)
+```
+
+### Group C
+
+```{r}
+summary(ols_opt_out_C)
+```
+:::
+
+## OLS: Opt-out
+
+with controls
+
+::: panel-tabset
+### Group A
+
+```{r}
+summary(ols_opt_out_control_A)
+```
+
+### Group B
+
+```{r}
+summary(ols_opt_out_control_B)
+```
+
+### Group C
+
+```{r}
+summary(ols_opt_out_control_C)
+```
+:::
+
+
+
+## OLS: Consequentiality
+
+with controls
+
+::: panel-tabset
+### Group A
+
+```{r}
+summary(conseq_model_control_A)
+```
+
+### Group B
+
+```{r}
+summary(conseq_model_control_B)
+```
+
+### Group C
+
+```{r}
+summary(conseq_model_control_C)
+```
+:::
+
+## MXL: Split Samples
+
+```{r}
+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", "Optional Treatment", "Not Treated"), name="Treatment") +
+ theme(legend.position = c(0.85, 0.8))
+```
+
+## MXL: WTP space
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+summary(mxl_wtp_case_a_rentINT)
+```
+
+### Scenario B
+
+```{r}
+summary(mxl_wtp_case_b_rentINT)
+```
+
+### Scenario C
+
+```{r}
+summary(mxl_wtp_case_c_rentINT)
+```
+:::
+
+## 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
+
+```{r}
+summary(mxl_wtp_case_c_prot)
+```
+:::
+
+## NR Index
+
+**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.
+
+## MXL: WTP space
+
+with NR index
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+summary(mxl_wtp_case_a_NR)
+```
+
+### Scenario B
+
+```{r}
+summary(mxl_wtp_case_b_NR)
+```
+
+### Scenario C
+
+```{r}
+summary(mxl_wtp_case_c_NR)
+```
+:::
+
+## MXL: WTP space
+
+::: panel-tabset
+### Scenario A
+
+```{r}
+apollo_modelOutput(mxl_wtp_case_a)
+```
+
+### Scenario B
+
+```{r}
+apollo_modelOutput(mxl_wtp_case_b)
+```
+
+### Scenario C
+
+```{r}
+apollo_modelOutput(mxl_wtp_case_c)
+```
+:::
+
+## MXL: WTP space Graphs
+
+::: panel-tabset
+### Scenario A
+
+::: panel-tabset
+### Naturalness
+
+```{r}
+wtp_nat_a
+```
+
+### Walking Distance
+
+```{r}
+wtp_wd_a
+```
+:::
+
+### Scenario B
+
+::: panel-tabset
+### Naturalness
+
+```{r}
+wtp_nat_b
+```
+
+### Walking Distance
+
+```{r}
+wtp_wd_b
+```
+:::
+
+### Scenario C
+
+::: 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)
+```
+:::