---
title: "Hot Topic, Cool Choices?" 
subtitle: "The Impact of Mandatory vs. Voluntary Treatments on Green Space Valuation"
title-slide-attributes:
  data-background-image: Grafics/iDiv_logo_item.png
  data-background-size: contain
  data-background-opacity: "0.2"
author: "Nino Cavallaro, Fabian Marder, Julian Sagebiel"
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
    embed-resources: true
---

```{r, include=FALSE, cache=FALSE}
source("Scripts/MAKE_FILE.R")
```

```{r loadlibs, include=FALSE}
library(tidyverse)
library(apollo)
library(texreg)
list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
                 "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
                 "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
                 "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
                 "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree")
```

## 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.  Who chooses optional information?

2a. How does an information treatment about urban heat islands affect survey engagement (interview time, cc time), quiz questions, and consequentially?

2b. How are these factors influenced by voluntary information access?

3.  How do the different treatments affect the WTP for urban green spaces in the choice experiment?

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, our paper is based on last survey round from February 2023

## Choice Card

![](images/Figure%202.PNG){width="300"}

## Treatment 

-   Information text about urban heat islands with figure

-   Quiz questions

-   Self-reference questions

-   OPTIONAL: Video about urban heat islands

![](images/waermeinsel.png){width="200"}

## Treatment Groups 

![](Grafics/FlowChart.png){width="300"}

## Case A 

![](Grafics/FlowChart_Sce_A.png){width="300"}

<!-- ## Scenario B  -->

<!-- ![](Grafics/FlowChart_Sce_B.png){width="300"} -->

## Case B

![](Grafics/FlowChart_Sce_C.png){width="300"}


## Methods

-   Logit regression (voluntary information access):

```{=tex}
\begin{equation}
    Y = \beta_0 + \beta_{Control} \cdot v_{Control} + \epsilon
    \label{simple_logit}
\end{equation}
```


-   OLS regression (survey engagement):

```{=tex}
\begin{equation}
    Y = \beta_0 +  \beta_{Treat} \cdot v_{Treat} + \beta_{Control} \cdot v_{Control} + \epsilon
    \label{ols}
\end{equation}
```

-   Mixed logit model with interactions in WTP space:

```{=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}
kableExtra::kable(treatment_socio_A)
```

### Case B

```{r}
kableExtra::kable(treatment_socio_C)
```
:::
:::


## NR

**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.

## NR OLS

::: {style="font-size: 65%;"}
```{r, results='asis'}
htmlreg(l=list(nr_model_treat_A), single.row = TRUE,
       custom.model.names = c("OLS regression"),
       custom.header = list("Dependent variable: NR-Index" = 1),
       custom.coef.map = list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
                              "as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
                              "as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
                              "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
                              "Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree", "Kids_Dummy" = "Children",
                              "Naturalness_SQ" = "Naturalness SQ", "WalkingDistance_SQ" = "Walking Distance SQ"),
       stars = c(0.01, 0.05, 0.1), float.pos="tb",
       custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:nr_ols",
        caption = "Results of OLS on the NR-index.")
```
:::

## Logit Regression: Who choses treatment?

::: {style="font-size: 65%;"}
```{r, results='asis'}


htmlreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="tb",
       custom.model.names = c("Logit regression"),
       custom.header = list("Dependent variable: Voluntary Information Access" = 1),
       custom.coef.map = list_ols, custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:logit_vt", single.row = TRUE,
       caption = "Results of logit regression on access of optional information.")


```
:::

## Engagement: Interview Time

::: panel-tabset
### Case A

```{r}
bxplt_interview_time_A
```


### Case B

```{r}
bxplt_interview_time_C
```
:::

## OLS Engagement: Interview time

::: {style="font-size: 60%;"}
```{r, results='asis'}
htmlreg(l=list(ols_time_spent_A,  ols_time_spent_control_A, ols_time_spent_C,  ols_time_spent_control_C),
       custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
       custom.header = list("Dependent variable: Net interview time" = 1:4),
       custom.coef.map = list_ols,  stars = c(0.01, 0.05, 0.1), float.pos="tb",
       custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:net_int", single.row = TRUE,
       caption = "Results of OLS on net interview time.")
```
:::

## Engagement: Choice Card time

::: panel-tabset
### Case A

```{r}
bxplt_cc_time_A
```


### Case B

```{r}
bxplt_cc_time_C
```
:::

## OLS Engagement: Choice Card Time

::: {style="font-size: 60%;"}
```{r, results='asis'}
htmlreg(l=list(ols_time_cc_A,  ols_time_cc_control_A, ols_time_cc_C,  ols_time_cc_control_C),
       custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
       custom.header = list("Dependent variable: Mean choice card time" = 1:4),
       custom.coef.map = list_ols,  stars = c(0.01, 0.05, 0.1), float.pos="tb",
       custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:cctime", single.row = TRUE,
       caption = "Results of OLS on mean choice card time.")
```
:::

## Manipulation check

::: panel-tabset
### Case A

```{r}
bxplt_quiz_A
```


### Case B

```{r}
bxplt_quiz_C
```
:::

## OLS: Manipulation check

::: {style="font-size: 60%;"}
```{r, results='asis'}
htmlreg(l=list(ols_percentage_correct_A,  ols_percentage_correct_control_A, ols_percentage_correct_C, ols_percentage_correct_control_C),
       custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
       custom.header = list("Dependent Variable: Percentage of correct quiz statements" = 1:4),
       custom.coef.map = list_ols,  stars = c(0.01, 0.05, 0.1), float.pos="tb", 
       custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:mani", single.row = TRUE,
       caption = "Results of OLS on percentage of correct quiz statements.")
```
:::

<!-- ## 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!** -->

## OLS: Consequentiality

::: {style="font-size: 60%;"}
```{r, results='asis'}
htmlreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_model_control_C),
       custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
       custom.header = list("Dependent variable: Consequentiality score" = 1:4),
       custom.coef.map = list_ols,  stars = c(0.01, 0.05, 0.1), float.pos="tb",
       custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:conseq", single.row = TRUE,
       caption = "Results of OLS on consequentiality score.")
```
:::

## Opt Out

::: panel-tabset
### Case A

```{r}
bxplt_opt_A
```


### Case B

```{r}
bxplt_opt_C
```
:::

## OLS: Opt-out

::: {style="font-size: 60%;"}
```{r, results='asis'}
htmlreg(l=list(ols_opt_out_A, ols_opt_out_control_A, ols_opt_out_C, ols_opt_out_control_C),
       custom.model.names = c("Case A", "with Controls", "Case B", "with Controls"),
       custom.header = list("Dependent variable: Number of opt-out choices" = 1:4),
       custom.coef.map = list_ols,  stars = c(0.01, 0.05, 0.1), float.pos="tb",
       custom.note = "%stars. Standard errors in parentheses.",
       label = "tab:optout", single.row = TRUE,
       caption = "Results of OLS on number of opt-out choices.")
```
:::

## 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: Effects on stated preferences

::: {style="font-size: 60%;"}
::: panel-tabset
### Case A

```{r, results='asis'}
htmlreg(c(case_A_cols[1], remGOF(case_A_cols[2:4])),
       custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
                              "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
                              "wd" = "Walking Distance", "asc" = "ASC SQ"),
       custom.model.names = c("Mean", "SD", "Treated", "Voluntary Treated"), custom.note = "%stars. Standard errors in parentheses.",
       stars = c(0.01, 0.05, 0.1), float.pos="tb", 
       label = "tab:mxl_A",
       caption = "Results of mixed logit model with treatment interactions for Case A.")
```

### Case B

```{r, results='asis'}
htmlreg(c(case_C_cols[1], remGOF(case_C_cols[2:7])),
       custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
                              "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
                              "wd" = "Walking Distance", "asc" = "ASC SQ",
                              "ASC_sq_info" = "ASC SQ", "rent_info" = "Rent", "nat_info" = "Naturalness", "walking_info" = "Walking Distance"),
       custom.model.names = c("Mean", "SD", "Video 1", "Video 2", "Text 1", "Text 2", "No Info"), custom.note = "%stars. Standard errors in parentheses.",
       stars = c(0.01, 0.05, 0.1), float.pos="tb",
       label = "tab:mxl_C",
       caption = "Results of mixed logit model with treatment interactions for Case B.")
```
:::
:::



## MXL: WTP space with NR index


::: {style="font-size: 60%;"}

```{r, results='asis'}
htmlreg(c(case_C_cols_NR[1], remGOF(case_C_cols_NR[2:8])),
       custom.coef.map = list("natural" = "Naturalness", "walking" = "Walking Distance", "rent" = "Rent",
                              "ASC_sq" = "ASC SQ", "_natural" = "Naturalness", "nat" = "Naturalness",
                              "wd" = "Walking Distance", "asc" = "ASC SQ",
                              "ASC_sq_info" = "ASC SQ", "rent_info" = "Rent", "nat_info" = "Naturalness", "walking_info" = "Walking Distance"),
       custom.model.names = c("Mean", "SD", "Video 1", "Video 2", "Text 1", "Text 2", "No Info", "NR"), custom.note = "%stars. Standard errors in parentheses.",
       stars = c(0.01, 0.05, 0.1), float.pos="tb",
       label = "tab:mxl_NR",
       caption = "Results of mixed logit model with treatment and NR-index interactions for Case B.")
```

:::

<!-- ## Case D -->

<!-- ```{r} -->
<!-- summary(case_d) -->
<!-- ``` -->

## Takeaways
<!-- ## 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) -->

<!-- ``` -->

<!-- ::: -->