From fb935cc60463fdd4a35ef16a8ccb7baf50db7ca9 Mon Sep 17 00:00:00 2001
From: Nino Cavallaro <nino.cavallaro@idiv.de>
Date: Mon, 4 Mar 2024 12:35:18 +0100
Subject: [PATCH] =?UTF-8?q?Conseq+pr=C3=A4si=20update?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
Scripts/MAKE_FILE.R | 14 +-
Scripts/data_prep.R | 7 +-
Scripts/logit/chr_vol_treat.R | 4 +-
Scripts/logit/protesters.R | 6 +-
Scripts/ols/ols_consequentiality.R | 28 +
Scripts/ols/ols_nr.R | 45 +-
Scripts/ols/ols_quiz.R | 8 +-
Scripts/ols/ols_time_spent.R | 15 +-
project_start.qmd | 1218 ++++++++++++++--------------
9 files changed, 715 insertions(+), 630 deletions(-)
create mode 100644 Scripts/ols/ols_consequentiality.R
diff --git a/Scripts/MAKE_FILE.R b/Scripts/MAKE_FILE.R
index 258dd18..de11490 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 2770591..92173bb 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 c73023f..8272830 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 bb62176..722e38f 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 0000000..6effd89
--- /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 63bda19..b76905c 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 ff02a62..2d04edf 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 de08c2b..11cfa56 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 857a180..088a40b 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)
+```
+:::
--
GitLab