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

interaction_plots

parent b7c7427d
Branches 21-things-to-take-care-of-before-submission
No related tags found
No related merge requests found
......@@ -10,6 +10,7 @@ Thumbs.db
*.pptx
/Data
/Tables
*.pdf
# Presentation quarto output
project_start.html
......
......@@ -87,6 +87,8 @@ source("Scripts/compare_split_samples.R")
source("Scripts/create_tables.R")
source("Scripts/interaction_plots_presi.R")
### Old models ###
......
# Create Interaction Term Plot for Presentation
alpha = 0.1
z_value <- qnorm(1-alpha/2)
### Interview time A
plot_interview <- summary(ols_time_spent_control_A)
plot_interview <- as.data.frame(plot_interview$coefficients)
plot_interview$ME <- z_value*plot_interview$`Std. Error`
plot_interview <- rownames_to_column(plot_interview, "Coefficient")
plot_interview <- plot_interview %>% filter(str_detect(Coefficient, "Treatment"))
plot_interview$Coefficient <- c("Treated", "Voluntary Treated")
plot_interview_A <- ggplot(data=plot_interview) +
geom_bar(aes(x=Coefficient, 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 = 45)) +
guides(fill = "none") +
xlab("Treatment Group")
### Interview time C
plot_interview <- summary(ols_time_spent_control_C)
plot_interview <- as.data.frame(plot_interview$coefficients)
plot_interview$ME <- z_value*plot_interview$`Std. Error`
plot_interview <- rownames_to_column(plot_interview, "Coefficient")
plot_interview <- plot_interview %>% filter(str_detect(Coefficient, "Treatment"))
plot_interview$Coefficient <- c("No Info 2", "Text 1", "Text 2", "Video 1", "Video 2")
plot_interview_C <- ggplot(data=plot_interview) +
geom_bar(aes(x=Coefficient, 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 = 45)) +
guides(fill = "none") +
xlab("Treatment Group")
####
create_interaction_term_plot <- function(ols_summary, treatment_labels, unit) {
create_interaction_term_plot <- function(ols_summary, treatment_labels, ord, unit, down, up) {
alpha <- 0.1
z_value <- qnorm(1 - alpha / 2)
......@@ -56,10 +16,11 @@ create_interaction_term_plot <- function(ols_summary, treatment_labels, unit) {
plot_data$Coefficient <- treatment_labels
plot <- ggplot(data = plot_data) +
geom_bar(aes(x = Coefficient, y = Estimate, fill = Coefficient), stat = "identity", position = 'dodge', width = 0.5, alpha = 0.7) +
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 = 45)) +
scale_x_discrete(guide = guide_axis(angle = 0)) +
guides(fill = "none") +
coord_cartesian(ylim=c(down, up)) +
xlab("Treatment Group") +
ylab(paste0(unit))
......@@ -69,14 +30,29 @@ create_interaction_term_plot <- function(ols_summary, treatment_labels, unit) {
case_A_labels <- c("Treated", "Voluntary Treated")
case_C_labels <- c("No Info 2", "Text 1", "Text 2", "Video 1", "Video 2")
plot_interview_A <- create_interaction_term_plot(ols_time_spent_control_A, case_A_labels, "Interview Time in Seconds")
plot_interview_C <- create_interaction_term_plot(ols_time_spent_control_C, case_C_labels, "Interview Time in Seconds")
plot_cc_A <- create_interaction_term_plot(ols_time_cc_control_A, case_A_labels, "Mean Choice Card Time in Seconds")
plot_cc_C <- create_interaction_term_plot(ols_time_cc_control_C, case_C_labels, "Mean Choice Card Time in Seconds")
plot_mani_A <- create_interaction_term_plot(ols_percentage_correct_control_A, case_A_labels,
"Percentage of Correct Quiz Statements")
plot_mani_C <- create_interaction_term_plot(ols_percentage_correct_control_C, case_C_labels,
"Percentage of Correct Quiz Statements")
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)
......@@ -183,26 +183,14 @@ htmlreg(l=list(logit_choice_treat_uni), stars = c(0.01, 0.05, 0.1), float.pos="t
```
:::
## 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%;"}
::: panel-tabset
### Table
::: {style="font-size: 55%;"}
```{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"),
......@@ -214,26 +202,24 @@ htmlreg(l=list(ols_time_spent_A, ols_time_spent_control_A, ols_time_spent_C, o
```
:::
## Engagement: Choice Card time
::: panel-tabset
### Case A
### Plot
```{r}
bxplt_cc_time_A
ggpubr::ggarrange(plot_interview_A, plot_interview_C)
```
:::
### Case B
## OLS Engagement: Choice Card Time
::: panel-tabset
### Plot
```{r}
bxplt_cc_time_C
ggpubr::ggarrange(plot_cc_A, plot_cc_C)
```
:::
## OLS Engagement: Choice Card Time
::: {style="font-size: 60%;"}
### Table
::: {style="font-size: 55%;"}
```{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"),
......@@ -245,26 +231,21 @@ htmlreg(l=list(ols_time_cc_A, ols_time_cc_control_A, ols_time_cc_C, ols_time_c
```
:::
## Manipulation check
:::
::: panel-tabset
### Case A
```{r}
bxplt_quiz_A
```
## OLS: Manipulation check
### Case B
::: panel-tabset
### Plot
```{r}
bxplt_quiz_C
ggpubr::ggarrange(plot_mani_A, plot_mani_C)
```
:::
## OLS: Manipulation check
::: {style="font-size: 60%;"}
### Table
::: {style="font-size: 55%;"}
```{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"),
......@@ -276,6 +257,8 @@ htmlreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_
```
:::
:::
<!-- ## 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. -->
......@@ -290,7 +273,15 @@ htmlreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_
## OLS: Consequentiality
::: {style="font-size: 60%;"}
::: panel-tabset
### Plot
```{r}
ggpubr::ggarrange(plot_cons_A, plot_cons_C)
```
### Table
::: {style="font-size: 55%;"}
```{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"),
......@@ -302,25 +293,20 @@ htmlreg(l=list(conseq_model_A, conseq_model_control_A, conseq_model_C, conseq_mo
```
:::
## Opt Out
::: panel-tabset
### Case A
:::
```{r}
bxplt_opt_A
```
## OLS: Opt-out
### Case B
::: panel-tabset
### Plot
```{r}
bxplt_opt_C
ggpubr::ggarrange(plot_opt_A, plot_opt_C)
```
:::
## OLS: Opt-out
### Table
::: {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),
......@@ -333,6 +319,8 @@ htmlreg(l=list(ols_opt_out_A, ols_opt_out_control_A, ols_opt_out_C, ols_opt_out_
```
:::
:::
## MXL: Split Samples
```{r}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment