diff --git a/Scripts/interaction_plots_presi.R b/Scripts/interaction_plots_presi.R index 0ab7a740a6d05476f9cb0b34fc2db2a8861a3045..967a8618aa6ea87bd8eac3d1e6cd6dd69ec75e33 100644 --- a/Scripts/interaction_plots_presi.R +++ b/Scripts/interaction_plots_presi.R @@ -1,58 +1,58 @@ -# Create Interaction Term Plot for Presentation - - -#### -create_interaction_term_plot <- function(ols_summary, treatment_labels, ord, unit, down, up) { - alpha <- 0.1 - z_value <- qnorm(1 - alpha / 2) - - plot_data <- summary(ols_summary) - plot_data <- as.data.frame(plot_data$coefficients) - plot_data$ME <- z_value * plot_data$`Std. Error` - plot_data <- rownames_to_column(plot_data, "Coefficient") - - plot_data <- plot_data %>% filter(str_detect(Coefficient, "Treatment")) - - plot_data$Coefficient <- treatment_labels - - plot <- ggplot(data = plot_data) + - geom_bar(aes(x = factor(Coefficient, levels=c(ord)), y = Estimate, fill = Coefficient), stat = "identity", position = 'dodge', width = 0.5, alpha = 0.7) + - geom_errorbar(aes(x = Coefficient, ymin = Estimate - ME, ymax = Estimate + ME), width = 0.3, position = position_dodge(0.8)) + - scale_x_discrete(guide = guide_axis(angle = 0)) + - guides(fill = "none") + - coord_cartesian(ylim=c(down, up)) + - xlab("Treatment Group") + - ylab(paste0(unit)) - - return(plot) -} - - -case_A_labels <- c("Treated", "Voluntary Treated") -case_C_labels <- c("No Info 2", "Text 1", "Text 2", "Video 1", "Video 2") -case_C_labels_re <- c("Text 1", "Text 2", "Video 1", "Video 2", "No Info 2") - -plot_interview_A <- create_interaction_term_plot(ols_time_spent_control_A, case_A_labels, case_A_labels, - "Interview Time in Seconds", -250, 380) -plot_interview_C <- create_interaction_term_plot(ols_time_spent_control_C, case_C_labels, case_C_labels_re, - "Interview Time in Seconds", -250, 380) - -plot_cc_A <- create_interaction_term_plot(ols_time_cc_control_A, case_A_labels, case_A_labels, - "Mean Choice Card Time in Seconds", -5, 5) -plot_cc_C <- create_interaction_term_plot(ols_time_cc_control_C, case_C_labels, case_C_labels_re, - "Mean Choice Card Time in Seconds", -5, 5) - -plot_mani_A <- create_interaction_term_plot(ols_percentage_correct_control_A, case_A_labels, case_A_labels, - "Percentage of Correct Quiz Statements", -5, 15) -plot_mani_C <- create_interaction_term_plot(ols_percentage_correct_control_C, case_C_labels, case_C_labels_re, - "Percentage of Correct Quiz Statements", -5, 15) - -plot_cons_A <- create_interaction_term_plot(conseq_model_control_A, case_A_labels, case_A_labels, - "Consequentiality Score", -0.5, 0.8) -plot_cons_C <- create_interaction_term_plot(conseq_model_control_C, case_C_labels, case_C_labels_re, - "Consequentiality Score", -0.5, 0.8) - -plot_opt_A <- create_interaction_term_plot(ols_opt_out_control_A, case_A_labels, case_A_labels, - "Number of Opt-out Choices", -1.5, 1) -plot_opt_C <- create_interaction_term_plot(ols_opt_out_control_C, case_C_labels, case_C_labels_re, - "Number of Opt-out Choices", -1.5, 1) +# Create Interaction Term Plot for Presentation + + +#### +create_interaction_term_plot <- function(ols_summary, treatment_labels, ord, unit, down, up) { + alpha <- 0.1 + z_value <- qnorm(1 - alpha / 2) + + plot_data <- summary(ols_summary) + plot_data <- as.data.frame(plot_data$coefficients) + plot_data$ME <- z_value * plot_data$`Std. Error` + plot_data <- rownames_to_column(plot_data, "Coefficient") + + plot_data <- plot_data %>% filter(str_detect(Coefficient, "Treatment")) + + plot_data$Coefficient <- treatment_labels + + plot <- ggplot(data = plot_data) + + geom_bar(aes(x = factor(Coefficient, levels=c(ord)), y = Estimate, fill = Coefficient), stat = "identity", position = 'dodge', width = 0.5, alpha = 0.7) + + geom_errorbar(aes(x = Coefficient, ymin = Estimate - ME, ymax = Estimate + ME), width = 0.3, position = position_dodge(0.8)) + + scale_x_discrete(guide = guide_axis(angle = 0)) + + guides(fill = "none") + + coord_cartesian(ylim=c(down, up)) + + xlab("Treatment Group") + + ylab(paste0(unit)) + + return(plot) +} + + +case_A_labels <- c("Treated", "Voluntary Treated") +case_C_labels <- c("No Info 2", "Text 1", "Text 2", "Video 1", "Video 2") +case_C_labels_re <- c("Text 1", "Text 2", "Video 1", "Video 2", "No Info 2") + +plot_interview_A <- create_interaction_term_plot(ols_time_spent_control_A, case_A_labels, case_A_labels, + "Interview Time in Seconds", -250, 380) +plot_interview_C <- create_interaction_term_plot(ols_time_spent_control_C, case_C_labels, case_C_labels_re, + "Interview Time in Seconds", -250, 380) + +plot_cc_A <- create_interaction_term_plot(ols_time_cc_control_A, case_A_labels, case_A_labels, + "Mean Choice Card Time in Seconds", -5, 5) +plot_cc_C <- create_interaction_term_plot(ols_time_cc_control_C, case_C_labels, case_C_labels_re, + "Mean Choice Card Time in Seconds", -5, 5) + +plot_mani_A <- create_interaction_term_plot(ols_percentage_correct_control_A, case_A_labels, case_A_labels, + "Percentage of Correct Quiz Statements", -5, 15) +plot_mani_C <- create_interaction_term_plot(ols_percentage_correct_control_C, case_C_labels, case_C_labels_re, + "Percentage of Correct Quiz Statements", -5, 15) + +plot_cons_A <- create_interaction_term_plot(conseq_model_control_A, case_A_labels, case_A_labels, + "Consequentiality Score", -0.5, 0.8) +plot_cons_C <- create_interaction_term_plot(conseq_model_control_C, case_C_labels, case_C_labels_re, + "Consequentiality Score", -0.5, 0.8) + +plot_opt_A <- create_interaction_term_plot(ols_opt_out_control_A, case_A_labels, case_A_labels, + "Number of Status Quo Choices", -1.5, 1) +plot_opt_C <- create_interaction_term_plot(ols_opt_out_control_C, case_C_labels, case_C_labels_re, + "Number of Status Quo Choices", -1.5, 1) diff --git a/project_start.qmd b/project_start.qmd index ebf9a2404ccbd594c13613d9ec54d6434ae4ad6f..844420d2e7105926c1b5cf30efaad2f09484a29d 100644 --- a/project_start.qmd +++ b/project_start.qmd @@ -148,9 +148,9 @@ To what extent do you agree or disagree with the following statements? - Timings: We saved the net interview time and the mean Choice Card time.-\> **Survey engagement** - **Consequentiality**: --- To what extent do you believe that the decisions you make will have an impact on how the green spaces in your neighbourhood are designed in the future? +- To what extent do you believe that the decisions you make will have an impact on how the green spaces in your neighborhood are designed in the future? --- To what extent do you believe that the decisions you make will affect whether you have to pay a contribution for urban greening in the future? +- To what extent do you believe that the decisions you make will affect whether you have to pay a contribution for urban greening in the future? ::: ## Methods (1) {auto-animate="true"} @@ -337,7 +337,7 @@ htmlreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_mo ::: ::: -## OLS: Opt-out +## OLS: Status quo ::: panel-tabset ### Plot @@ -352,27 +352,16 @@ ggpubr::ggarrange(plot_opt_A, plot_opt_C) ```{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.header = list("Dependent variable: Number of status quo 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.") + caption = "Results of OLS on number of status quo 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 @@ -469,12 +458,28 @@ htmlreg(c(case_C_cols_NR[1], remGOF(case_C_cols_NR[2:8])), ::: incremental -- Respondents that voluntary access information do engage differently in the survey +- Respondents that voluntary access information do engage more in the survey & have a higher consequentiality score + +- Voluntary information access is negatively correlated with number of status quo choices + +- Higher willingness to pay values in groups that voluntary access information ::: ## Conclusion +::: incremental + +- Obligatory and voluntary information treatments increase information recall and willingness to pay for naturalness of and proximity to urban green spaces + +- Exogenous treatments do not affect consequentiality + +- Voluntary information access is correlated with increased consequentiality, higher survey engagement and higher willingness to pay + +- Obligatory information treatment is more effective + +::: + ## Appendix Information provision (Video) Link to the video: https://idiv.limequery.com/upload/surveys/682191/files/urban-heat-island-effekt.mp4 @@ -488,23 +493,23 @@ Information provision (Video) Link to the video: https://idiv.limequery.com/uplo {width="300"} -## Socio Demografics {.smaller} +<!-- ## Socio Demografics {.smaller} --> -::: {style="font-size: 50%;"} -::: panel-tabset -### Case A +<!-- ::: {style="font-size: 50%;"} --> +<!-- ::: panel-tabset --> +<!-- ### Case A --> -```{r} -kableExtra::kable(treatment_socio_A) -``` +<!-- ```{r} --> +<!-- kableExtra::kable(treatment_socio_A) --> +<!-- ``` --> -### Case B +<!-- ### Case B --> -```{r} -kableExtra::kable(treatment_socio_C) -``` -::: -::: +<!-- ```{r} --> +<!-- kableExtra::kable(treatment_socio_C) --> +<!-- ``` --> +<!-- ::: --> +<!-- ::: --> ## NR OLS @@ -526,136 +531,16 @@ htmlreg(l=list(nr_model_treat_A), single.row = TRUE, ``` ::: -<!-- ## 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) --> +## 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)) +``` -<!-- ::: -->