Fabio Votta The Date
pacman::p_load(tidyverse, haven, psych, sjPlot, ggpubr, glue)trolley <- read_spss("data/TrolleyExperimentArgumentNew.sav") %>%
janitor::clean_names(.) %>%
filter(general_finisher == 1) %>%
drop_na(t1_eqp_eqp1, t1_eqp_eqp3, t1_eqp_eqp7, t1_eqp_eqp8, t1_eqp_eqp9,
t1_eqp_eqp11, t1_eqp_eqp12 ,t1_eqp_eqp13, t1_eqp_eqp14, t1_eqp_eqp18,
t1_eqp_eqp2, t1_eqp_eqp4, t1_eqp_eqp5, t1_eqp_eqp6, t1_eqp_eqp10,
t1_eqp_eqp15, t1_eqp_eqp16 ,t1_eqp_eqp17, t1_eqp_eqp19, t1_eqp_eqp20,
t1_szenario1q2, t2_szenario1q2, t1_szenario2q2, t2_szenario2q2) %>%
filter(t2_gender != 2) %>%
mutate(gender = ifelse(t2_gender == 1, "Men", "Women")) %>%
mutate(leftright = t2_pol_alignment) %>%
mutate(pol_interest = 5 - t2_pol_interest) %>%
mutate(church_attendance = 7 - t2_religion_church) %>%
mutate(age = 2018 - as.numeric(t2_year_of_birth)) %>%
mutate(university = ifelse(t2_university == 4, 0, 1)) %>%
mutate(groups = case_when(
general_group_control == 1 ~ "Control Group",
general_group_discussion == 1 ~ "Discussion Group",
general_group_information == 1 ~ "Information Group",
))
trolley %>%
group_by(university) %>%
tally() %>% knitr::kable()| university | n |
|---|---|
| 0 | 15 |
| 1 | 275 |
trolley %>%
group_by(gender) %>%
tally() %>% knitr::kable()| gender | n |
|---|---|
| Men | 157 |
| Women | 133 |
trolley %>%
group_by(groups) %>%
tally() %>% knitr::kable()| groups | n |
|---|---|
| Control Group | 92 |
| Discussion Group | 99 |
| Information Group | 99 |
trolley %>%
select(leftright, pol_interest, church_attendance, age) %>%
describe() %>% knitr::kable()| vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| leftright | 1 | 278 | 4.730216 | 1.8701205 | 5 | 4.709821 | 1.4826 | 1 | 10 | 9 | 0.1718862 | -0.3668182 | 0.1121624 |
| pol_interest | 2 | 288 | 3.232639 | 0.7019465 | 3 | 3.293103 | 1.4826 | 1 | 4 | 3 | -0.4148235 | -0.7018793 | 0.0413626 |
| church_attendance | 3 | 278 | 1.866907 | 1.0442822 | 2 | 1.700893 | 1.4826 | 1 | 6 | 5 | 1.3843362 | 2.0577066 | 0.0626319 |
| age | 4 | 289 | 24.089965 | 3.8584597 | 23 | 23.643777 | 2.9652 | 18 | 53 | 35 | 2.1419261 | 10.5203843 | 0.2269682 |
eqp <- trolley %>%
select(contains("eqp")) %>%
# na.omit() %>%
select(t1_eqp_eqp1, t1_eqp_eqp3, t1_eqp_eqp7, t1_eqp_eqp8, t1_eqp_eqp9,
t1_eqp_eqp11, t1_eqp_eqp12 ,t1_eqp_eqp13, t1_eqp_eqp14, t1_eqp_eqp18,
t1_eqp_eqp2, t1_eqp_eqp4, t1_eqp_eqp5, t1_eqp_eqp6, t1_eqp_eqp10,
t1_eqp_eqp15, t1_eqp_eqp16 ,t1_eqp_eqp17, t1_eqp_eqp19, t1_eqp_eqp20)
trolley$mean_eqp <- rowMeans(eqp)
trolley <- eqp %>%
psych::pca(2, rotate = "varimax") %>%
predict.psych(data = eqp) %>%
cbind(trolley, .)
trolley <- trolley %>%
rename(idealism_pca = RC1) %>%
rename(relativism_pca = RC2) my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
age_compare <- trolley %>%
ggplot(aes(groups, age)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Age") +
ggtitle("Age Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
age_compare
tidytemplate::ggsave_it(age_compare, width = 10, height = 6)gender_compare <- sjp.xtab(trolley$groups, trolley$gender,
margin = "row", bar.pos = "stack",
show.summary = TRUE, coord.flip = TRUE,
prnt.plot = F)$plot +
ggthemes::theme_hc() +
ggthemes::scale_fill_gdocs("Gender") +
xlab("") +
ggtitle("Gender Comparison between Experimental Groups") +
scale_alpha(range = c(0.4, 0.8))
gender_compare
tidytemplate::ggsave_it(gender_compare, width = 10, height = 6)dem_compare <- cowplot::plot_grid(age_compare, gender_compare)
dem_compare
tidytemplate::ggsave_it(dem_compare, width = 14, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
idealism_pca_compare <- trolley %>%
ggplot(aes(groups, idealism_pca)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Idealism") +
ggtitle("Idealism Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
idealism_pca_compare
tidytemplate::ggsave_it(idealism_pca_compare, width = 10, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
relativism_pca_compare <- trolley %>%
ggplot(aes(groups, relativism_pca)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Relativism") +
ggtitle("Relativism Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
relativism_pca_compare
tidytemplate::ggsave_it(relativism_pca_compare, width = 10, height = 6)uv_compare <- cowplot::plot_grid(relativism_pca_compare, idealism_pca_compare)
uv_compare
tidytemplate::ggsave_it(uv_compare, width = 12, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
t1_szenario1q2_compare <- trolley %>%
ggplot(aes(groups, t1_szenario1q2)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Morally justifiable: Switch Track") +
ggtitle("'Switch Track' Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario1q2_compare
tidytemplate::ggsave_it(t1_szenario1q2_compare, width = 10, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
t1_szenario2q2_compare <- trolley %>%
ggplot(aes(groups, t1_szenario2q2)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Morally justifiable: Push Person") +
ggtitle("'Push Person' Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario2q2_compare
tidytemplate::ggsave_it(t1_szenario2q2_compare, width = 10, height = 6)av_compare <- cowplot::plot_grid(t1_szenario1q2_compare, t1_szenario2q2_compare)
av_compare
tidytemplate::ggsave_it(av_compare, width = 12, height = 6)t1_szenario1q2_gender <- trolley %>%
ggplot(aes(gender, t1_szenario1q2)) +
geom_violin(aes(fill = gender), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Gender") + ylab("Morally justifiable: Switch Track") +
ggtitle("Morally Justifiable to Switch Track by Gender") +
ggpubr::stat_compare_means(label.x.npc = .4) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario1q2_gender
tidytemplate::ggsave_it(t1_szenario1q2_gender, width = 10, height = 6)
t1_szenario2q2_gender <- trolley %>%
ggplot(aes(gender, t1_szenario2q2)) +
geom_violin(aes(fill = gender), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Gender") + ylab("Morally justifiable: Push Person") +
ggtitle("Morally Justifiable to Push Person by Gender") +
ggpubr::stat_compare_means(label.x.npc = .5) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario2q2_gender
tidytemplate::ggsave_it(t1_szenario2q2_gender, width = 10, height = 6)
gender_av_compare1 <- cowplot::plot_grid(t1_szenario1q2_gender, t1_szenario2q2_gender)
gender_av_compare1
tidytemplate::ggsave_it(gender_av_compare1, width = 12, height = 6)t1_szenario1q2_gender <- trolley %>%
ggplot(aes(age, t1_szenario1q2)) +
geom_jitter(aes(color = gender), alpha = 0.6) +
geom_smooth(aes(color = gender),method = "lm") +
xlab("Age") + ylab("Morally justifiable: Switch Track") +
ggtitle("Morally Justifiable to Switch Track by Gender and Age") +
ggpubr::stat_compare_means(label.x.npc = .4) +
ggthemes::scale_color_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario1q2_gender
tidytemplate::ggsave_it(t1_szenario1q2_gender, width = 10, height = 6)
t1_szenario2q2_gender <- trolley %>%
ggplot(aes(age, t1_szenario2q2)) +
geom_jitter(aes(color = gender), alpha = 0.6) +
geom_smooth(aes(color = gender),method = "lm") +
xlab("Age") + ylab("Morally justifiable: Push Person") +
ggtitle("Morally Justifiable to Push Person by Gender and Age") +
ggpubr::stat_compare_means(label.x.npc = .5) +
ggthemes::scale_color_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario2q2_gender
tidytemplate::ggsave_it(t1_szenario2q2_gender, width = 10, height = 6)
gender_av_compare2 <- cowplot::plot_grid(t1_szenario1q2_gender, t1_szenario2q2_gender)
gender_av_compare2
tidytemplate::ggsave_it(gender_av_compare2, width = 12, height = 6)# eqp %>% psych::alpha()
# psych::pca(2, rotate = "varimax") %>%
# .$loadings %>% unclass() %>% as.data.frame() %>%
# rownames_to_column("eqp_variable")
strip_away_stuff <- function(x) {
x <- str_remove(x, "t1_eqp_")
x <- parse_number(x) %>%
ifelse(. %in% 1:9, paste0("eqp0", .), .) %>%
ifelse(. %in% 10:20, paste0("eqp", .), .)
}
eqp <- eqp %>%
set_names(eqp %>% names %>% strip_away_stuff)
factor_names <- c(`1` = "Idealism",
`2` = "Relativism")
factor_analysis <- sjp.pca(eqp, rotation = "varimax",
nmbr.fctr = 2, prnt.plot = F, show.cronb = T,
show.values = T)$plot +
ggthemes::scale_color_gdocs("") +
ggthemes::theme_hc() +
ggtitle("Ethical Positions Questionnaire - PCA") +
facet_grid(~xpos, labeller = as_labeller(factor_names)) +
labs(captions = "Cronbach's Alpha = 0.80")
factor_analysis
tidytemplate::ggsave_it(factor_analysis, width = 10, height = 6)save(trolley, file = "text/data/trolley.Rdata")
trolley %>%
select(t1_szenario1q2, t2_szenario1q2, t1_szenario2q2, t2_szenario2q2, idealism_pca, relativism_pca, gender, age, church_attendance, general_group_control, general_group_discussion, general_group_information) %>%
describe() %>%
select(-vars, -trimmed, -mad, -se) %>%
knitr::kable()| n | mean | sd | median | min | max | range | skew | kurtosis | |
|---|---|---|---|---|---|---|---|---|---|
| t1_szenario1q2 | 290 | 5.7551724 | 2.9113887 | 6.0000000 | 1.000000 | 11.000000 | 10.000000 | -0.0312365 | -0.9024947 |
| t2_szenario1q2 | 290 | 5.5586207 | 2.9136972 | 6.0000000 | 1.000000 | 11.000000 | 10.000000 | 0.0144578 | -0.9380239 |
| t1_szenario2q2 | 290 | 4.2931034 | 2.8321475 | 4.0000000 | 1.000000 | 11.000000 | 10.000000 | 0.5494000 | -0.7245725 |
| t2_szenario2q2 | 290 | 4.1827586 | 2.8644787 | 4.0000000 | 1.000000 | 11.000000 | 10.000000 | 0.5966912 | -0.6429501 |
| idealism_pca | 290 | 0.0000000 | 1.0000000 | 0.1817619 | -3.400484 | 1.733352 | 5.133836 | -0.8568363 | 0.3662967 |
| relativism_pca | 290 | 0.0000000 | 1.0000000 | 0.1126772 | -3.209701 | 2.336790 | 5.546491 | -0.3456592 | 0.0152953 |
| gender* | 290 | NaN | NA | NA | Inf | -Inf | -Inf | NA | NA |
| age | 289 | 24.0899654 | 3.8584597 | 23.0000000 | 18.000000 | 53.000000 | 35.000000 | 2.1419261 | 10.5203843 |
| church_attendance | 278 | 1.8669065 | 1.0442822 | 2.0000000 | 1.000000 | 6.000000 | 5.000000 | 1.3843362 | 2.0577066 |
| general_group_control | 290 | 0.3172414 | 0.4662068 | 0.0000000 | 0.000000 | 1.000000 | 1.000000 | 0.7813203 | -1.3943109 |
| general_group_discussion | 290 | 0.3413793 | 0.4749921 | 0.0000000 | 0.000000 | 1.000000 | 1.000000 | 0.6655847 | -1.5623488 |
| general_group_information | 290 | 0.3413793 | 0.4749921 | 0.0000000 | 0.000000 | 1.000000 | 1.000000 | 0.6655847 | -1.5623488 |
trolley %<>%
mutate(groups = factor(groups)) %>%
mutate(gender = factor(gender)) - t1 als AV
- t1 als AV und gender interaction (Idealism)
- t1 als AV und gender interaction (Relativism)
- t2 mit Controls für t1 und für treatments
- Modelle aus 4. mit Treatment-Interaktion (Idealism)
- Modelle aus 4. mit Treatment-Interaktion (Relativism)
- Szenario 1 (a = Switch Track)
- Szenario 2b (b = Push Person)
cowplot::plot_grid(reg1_s1, reg1_s2, ncol = 1)
ggsave(filename = "text/images/reg1_combined.png", width = 8, height = 9)cowplot::plot_grid(reg2_s1_int_idealism, reg2_s2_int_idealism, ncol = 1)
ggsave(filename = "text/images/reg2_c1_idealism.png", width = 8, height = 9)bind_rows(
get_model_data(fit2_s1_int_idealism, type = "pred",
terms = c("idealism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 2a - Switch Track"),
get_model_data(fit2_s2_int_idealism, type = "pred",
terms = c("idealism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 2b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 2 - Idealism X Gender") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Gender") +
ggthemes::scale_color_fivethirtyeight("Gender") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Idealism") 
ggsave(filename = "text/images/reg2_c2_idealism.png", width = 8, height = 5)cowplot::plot_grid(reg3_s1_int_relativism, reg3_s2_int_relativism, ncol = 1)
ggsave(filename = "text/images/reg3_c1_relativism.png", width = 8, height = 9)bind_rows(
get_model_data(fit3_s1_int_relativism, type = "pred",
terms = c("relativism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 3a - Switch Track"),
get_model_data(fit3_s2_int_relativism, type = "pred",
terms = c("relativism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 3b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 3 - Relativism X Gender") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Gender") +
ggthemes::scale_color_fivethirtyeight("Gender") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Relativism") 
ggsave(filename = "text/images/reg3_c2_relativism.png", width = 8, height = 5)cowplot::plot_grid(reg4_s1, reg4_s2, ncol = 1)
ggsave(filename = "text/images/reg4_combined.png", width = 8, height = 9)cowplot::plot_grid(reg5_s1, reg5_s2, ncol = 1)
ggsave(filename = "text/images/reg5_c1_idealism.png", width = 8, height = 9)bind_rows(
get_model_data(fit5_s1, type = "pred",
terms = c("idealism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 5a - Switch Track"),
get_model_data(fit5_s2, type = "pred",
terms = c("idealism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 5b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 5 - Idealism X Experimental Groups") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Experimental Groups") +
ggthemes::scale_color_fivethirtyeight("Experimental Groups") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Idealism") 
ggsave(filename = "text/images/reg5_c2_idealism.png", width = 8, height = 5)cowplot::plot_grid(reg6_s1, reg6_s2, ncol = 1)
ggsave(filename = "text/images/reg6_c1_relativism.png", width = 7, height = 8)bind_rows(
get_model_data(fit6_s1, type = "pred",
terms = c("relativism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 6a - Switch Track"),
get_model_data(fit6_s2, type = "pred",
terms = c("relativism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 6b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 6 - Relativism X Experimental Groups") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Experimental Groups") +
ggthemes::scale_color_fivethirtyeight("Experimental Groups") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Relativism") 
ggsave(filename = "text/images/reg6_c2_relativism.png", width = 8, height = 5)Fabio Votta The Date
pacman::p_load(tidyverse, haven, psych, sjPlot, ggpubr, glue)trolley <- read_spss("data/TrolleyExperimentArgumentNew.sav") %>%
janitor::clean_names(.) %>%
filter(general_finisher == 1) %>%
drop_na(t1_eqp_eqp1, t1_eqp_eqp3, t1_eqp_eqp7, t1_eqp_eqp8, t1_eqp_eqp9,
t1_eqp_eqp11, t1_eqp_eqp12 ,t1_eqp_eqp13, t1_eqp_eqp14, t1_eqp_eqp18,
t1_eqp_eqp2, t1_eqp_eqp4, t1_eqp_eqp5, t1_eqp_eqp6, t1_eqp_eqp10,
t1_eqp_eqp15, t1_eqp_eqp16 ,t1_eqp_eqp17, t1_eqp_eqp19, t1_eqp_eqp20,
t1_szenario1q2, t2_szenario1q2, t1_szenario2q2, t2_szenario2q2) %>%
filter(t2_gender != 2) %>%
mutate(gender = ifelse(t2_gender == 1, "Men", "Women")) %>%
mutate(leftright = t2_pol_alignment) %>%
mutate(pol_interest = 5 - t2_pol_interest) %>%
mutate(church_attendance = 7 - t2_religion_church) %>%
mutate(age = 2018 - as.numeric(t2_year_of_birth)) %>%
mutate(university = ifelse(t2_university == 4, 0, 1)) %>%
mutate(groups = case_when(
general_group_control == 1 ~ "Control Group",
general_group_discussion == 1 ~ "Discussion Group",
general_group_information == 1 ~ "Information Group",
))
trolley %>%
group_by(university) %>%
tally() %>% knitr::kable()| university | n |
|---|---|
| 0 | 15 |
| 1 | 275 |
trolley %>%
group_by(gender) %>%
tally() %>% knitr::kable()| gender | n |
|---|---|
| Men | 157 |
| Women | 133 |
trolley %>%
group_by(groups) %>%
tally() %>% knitr::kable()| groups | n |
|---|---|
| Control Group | 92 |
| Discussion Group | 99 |
| Information Group | 99 |
trolley %>%
select(leftright, pol_interest, church_attendance, age) %>%
describe() %>% knitr::kable()| vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| leftright | 1 | 278 | 4.730216 | 1.8701205 | 5 | 4.709821 | 1.4826 | 1 | 10 | 9 | 0.1718862 | -0.3668182 | 0.1121624 |
| pol_interest | 2 | 288 | 3.232639 | 0.7019465 | 3 | 3.293103 | 1.4826 | 1 | 4 | 3 | -0.4148235 | -0.7018793 | 0.0413626 |
| church_attendance | 3 | 278 | 1.866907 | 1.0442822 | 2 | 1.700893 | 1.4826 | 1 | 6 | 5 | 1.3843362 | 2.0577066 | 0.0626319 |
| age | 4 | 289 | 24.089965 | 3.8584597 | 23 | 23.643777 | 2.9652 | 18 | 53 | 35 | 2.1419261 | 10.5203843 | 0.2269682 |
eqp <- trolley %>%
select(contains("eqp")) %>%
# na.omit() %>%
select(t1_eqp_eqp1, t1_eqp_eqp3, t1_eqp_eqp7, t1_eqp_eqp8, t1_eqp_eqp9,
t1_eqp_eqp11, t1_eqp_eqp12 ,t1_eqp_eqp13, t1_eqp_eqp14, t1_eqp_eqp18,
t1_eqp_eqp2, t1_eqp_eqp4, t1_eqp_eqp5, t1_eqp_eqp6, t1_eqp_eqp10,
t1_eqp_eqp15, t1_eqp_eqp16 ,t1_eqp_eqp17, t1_eqp_eqp19, t1_eqp_eqp20)
trolley$mean_eqp <- rowMeans(eqp)
trolley <- eqp %>%
psych::pca(2, rotate = "varimax") %>%
predict.psych(data = eqp) %>%
cbind(trolley, .)
trolley <- trolley %>%
rename(idealism_pca = RC1) %>%
rename(relativism_pca = RC2) my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
age_compare <- trolley %>%
ggplot(aes(groups, age)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Age") +
ggtitle("Age Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
age_compare
tidytemplate::ggsave_it(age_compare, width = 10, height = 6)gender_compare <- sjp.xtab(trolley$groups, trolley$gender,
margin = "row", bar.pos = "stack",
show.summary = TRUE, coord.flip = TRUE,
prnt.plot = F)$plot +
ggthemes::theme_hc() +
ggthemes::scale_fill_gdocs("Gender") +
xlab("") +
ggtitle("Gender Comparison between Experimental Groups") +
scale_alpha(range = c(0.4, 0.8))
gender_compare
tidytemplate::ggsave_it(gender_compare, width = 10, height = 6)dem_compare <- cowplot::plot_grid(age_compare, gender_compare)
dem_compare
tidytemplate::ggsave_it(dem_compare, width = 14, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
idealism_pca_compare <- trolley %>%
ggplot(aes(groups, idealism_pca)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Idealism") +
ggtitle("Idealism Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
idealism_pca_compare
tidytemplate::ggsave_it(idealism_pca_compare, width = 10, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
relativism_pca_compare <- trolley %>%
ggplot(aes(groups, relativism_pca)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Relativism") +
ggtitle("Relativism Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
relativism_pca_compare
tidytemplate::ggsave_it(relativism_pca_compare, width = 10, height = 6)uv_compare <- cowplot::plot_grid(relativism_pca_compare, idealism_pca_compare)
uv_compare
tidytemplate::ggsave_it(uv_compare, width = 12, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
t1_szenario1q2_compare <- trolley %>%
ggplot(aes(groups, t1_szenario1q2)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Morally justifiable: Switch Track") +
ggtitle("'Switch Track' Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario1q2_compare
tidytemplate::ggsave_it(t1_szenario1q2_compare, width = 10, height = 6)my_comparisons <- list( c("Control Group", "Discussion Group"),
c("Discussion Group", "Information Group"),
c("Control Group", "Information Group") )
t1_szenario2q2_compare <- trolley %>%
ggplot(aes(groups, t1_szenario2q2)) +
geom_violin(aes(fill = groups), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Experimental Groups") + ylab("Morally justifiable: Push Person") +
ggtitle("'Push Person' Comparison between Experimental Groups") +
ggpubr::stat_compare_means(comparisons = my_comparisons) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario2q2_compare
tidytemplate::ggsave_it(t1_szenario2q2_compare, width = 10, height = 6)av_compare <- cowplot::plot_grid(t1_szenario1q2_compare, t1_szenario2q2_compare)
av_compare
tidytemplate::ggsave_it(av_compare, width = 12, height = 6)t1_szenario1q2_gender <- trolley %>%
ggplot(aes(gender, t1_szenario1q2)) +
geom_violin(aes(fill = gender), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Gender") + ylab("Morally justifiable: Switch Track") +
ggtitle("Morally Justifiable to Switch Track by Gender") +
ggpubr::stat_compare_means(label.x.npc = .4) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario1q2_gender
tidytemplate::ggsave_it(t1_szenario1q2_gender, width = 10, height = 6)
t1_szenario2q2_gender <- trolley %>%
ggplot(aes(gender, t1_szenario2q2)) +
geom_violin(aes(fill = gender), alpha = 0.6) +
geom_boxplot(width = 0.2) +
xlab("Gender") + ylab("Morally justifiable: Push Person") +
ggtitle("Morally Justifiable to Push Person by Gender") +
ggpubr::stat_compare_means(label.x.npc = .5) +
ggthemes::scale_fill_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario2q2_gender
tidytemplate::ggsave_it(t1_szenario2q2_gender, width = 10, height = 6)
gender_av_compare1 <- cowplot::plot_grid(t1_szenario1q2_gender, t1_szenario2q2_gender)
gender_av_compare1
tidytemplate::ggsave_it(gender_av_compare1, width = 12, height = 6)t1_szenario1q2_gender <- trolley %>%
ggplot(aes(age, t1_szenario1q2)) +
geom_jitter(aes(color = gender), alpha = 0.6) +
geom_smooth(aes(color = gender),method = "lm") +
xlab("Age") + ylab("Morally justifiable: Switch Track") +
ggtitle("Morally Justifiable to Switch Track by Gender and Age") +
ggpubr::stat_compare_means(label.x.npc = .4) +
ggthemes::scale_color_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario1q2_gender
tidytemplate::ggsave_it(t1_szenario1q2_gender, width = 10, height = 6)
t1_szenario2q2_gender <- trolley %>%
ggplot(aes(age, t1_szenario2q2)) +
geom_jitter(aes(color = gender), alpha = 0.6) +
geom_smooth(aes(color = gender),method = "lm") +
xlab("Age") + ylab("Morally justifiable: Push Person") +
ggtitle("Morally Justifiable to Push Person by Gender and Age") +
ggpubr::stat_compare_means(label.x.npc = .5) +
ggthemes::scale_color_gdocs("") +
ggthemes::theme_hc() +
guides(fill = F)
t1_szenario2q2_gender
tidytemplate::ggsave_it(t1_szenario2q2_gender, width = 10, height = 6)
gender_av_compare2 <- cowplot::plot_grid(t1_szenario1q2_gender, t1_szenario2q2_gender)
gender_av_compare2
tidytemplate::ggsave_it(gender_av_compare2, width = 12, height = 6)# eqp %>% psych::alpha()
# psych::pca(2, rotate = "varimax") %>%
# .$loadings %>% unclass() %>% as.data.frame() %>%
# rownames_to_column("eqp_variable")
strip_away_stuff <- function(x) {
x <- str_remove(x, "t1_eqp_")
x <- parse_number(x) %>%
ifelse(. %in% 1:9, paste0("eqp0", .), .) %>%
ifelse(. %in% 10:20, paste0("eqp", .), .)
}
eqp <- eqp %>%
set_names(eqp %>% names %>% strip_away_stuff)
factor_names <- c(`1` = "Idealism",
`2` = "Relativism")
factor_analysis <- sjp.pca(eqp, rotation = "varimax",
nmbr.fctr = 2, prnt.plot = F, show.cronb = T,
show.values = T)$plot +
ggthemes::scale_color_gdocs("") +
ggthemes::theme_hc() +
ggtitle("Ethical Positions Questionnaire - PCA") +
facet_grid(~xpos, labeller = as_labeller(factor_names)) +
labs(captions = "Cronbach's Alpha = 0.80")
factor_analysis
tidytemplate::ggsave_it(factor_analysis, width = 10, height = 6)save(trolley, file = "text/data/trolley.Rdata")
trolley %>%
select(t1_szenario1q2, t2_szenario1q2, t1_szenario2q2, t2_szenario2q2, idealism_pca, relativism_pca, gender, age, church_attendance, general_group_control, general_group_discussion, general_group_information) %>%
describe() %>%
select(-vars, -trimmed, -mad, -se) %>%
knitr::kable()| n | mean | sd | median | min | max | range | skew | kurtosis | |
|---|---|---|---|---|---|---|---|---|---|
| t1_szenario1q2 | 290 | 5.7551724 | 2.9113887 | 6.0000000 | 1.000000 | 11.000000 | 10.000000 | -0.0312365 | -0.9024947 |
| t2_szenario1q2 | 290 | 5.5586207 | 2.9136972 | 6.0000000 | 1.000000 | 11.000000 | 10.000000 | 0.0144578 | -0.9380239 |
| t1_szenario2q2 | 290 | 4.2931034 | 2.8321475 | 4.0000000 | 1.000000 | 11.000000 | 10.000000 | 0.5494000 | -0.7245725 |
| t2_szenario2q2 | 290 | 4.1827586 | 2.8644787 | 4.0000000 | 1.000000 | 11.000000 | 10.000000 | 0.5966912 | -0.6429501 |
| idealism_pca | 290 | 0.0000000 | 1.0000000 | 0.1817619 | -3.400484 | 1.733352 | 5.133836 | -0.8568363 | 0.3662967 |
| relativism_pca | 290 | 0.0000000 | 1.0000000 | 0.1126772 | -3.209701 | 2.336790 | 5.546491 | -0.3456592 | 0.0152953 |
| gender* | 290 | NaN | NA | NA | Inf | -Inf | -Inf | NA | NA |
| age | 289 | 24.0899654 | 3.8584597 | 23.0000000 | 18.000000 | 53.000000 | 35.000000 | 2.1419261 | 10.5203843 |
| church_attendance | 278 | 1.8669065 | 1.0442822 | 2.0000000 | 1.000000 | 6.000000 | 5.000000 | 1.3843362 | 2.0577066 |
| general_group_control | 290 | 0.3172414 | 0.4662068 | 0.0000000 | 0.000000 | 1.000000 | 1.000000 | 0.7813203 | -1.3943109 |
| general_group_discussion | 290 | 0.3413793 | 0.4749921 | 0.0000000 | 0.000000 | 1.000000 | 1.000000 | 0.6655847 | -1.5623488 |
| general_group_information | 290 | 0.3413793 | 0.4749921 | 0.0000000 | 0.000000 | 1.000000 | 1.000000 | 0.6655847 | -1.5623488 |
trolley %<>%
mutate(groups = factor(groups)) %>%
mutate(gender = factor(gender)) - t1 als AV
- t1 als AV und gender interaction (Idealism)
- t1 als AV und gender interaction (Relativism)
- t2 mit Controls für t1 und für treatments
- Modelle aus 4. mit Treatment-Interaktion (Idealism)
- Modelle aus 4. mit Treatment-Interaktion (Relativism)
- Szenario 1 (a = Switch Track)
- Szenario 2b (b = Push Person)
cowplot::plot_grid(reg1_s1, reg1_s2, ncol = 1)
ggsave(filename = "text/images/reg1_combined.png", width = 8, height = 9)cowplot::plot_grid(reg2_s1_int_idealism, reg2_s2_int_idealism, ncol = 1)
ggsave(filename = "text/images/reg2_c1_idealism.png", width = 8, height = 9)bind_rows(
get_model_data(fit2_s1_int_idealism, type = "pred",
terms = c("idealism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 2a - Switch Track"),
get_model_data(fit2_s2_int_idealism, type = "pred",
terms = c("idealism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 2b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 2 - Idealism X Gender") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Gender") +
ggthemes::scale_color_fivethirtyeight("Gender") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Idealism")
ggsave(filename = "text/images/reg2_c2_idealism.png", width = 8, height = 5)cowplot::plot_grid(reg3_s1_int_relativism, reg3_s2_int_relativism, ncol = 1)
ggsave(filename = "text/images/reg3_c1_relativism.png", width = 8, height = 9)bind_rows(
get_model_data(fit3_s1_int_relativism, type = "pred",
terms = c("relativism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 3a - Switch Track"),
get_model_data(fit3_s2_int_relativism, type = "pred",
terms = c("relativism_pca", "gender"), ci.lvl = .9) %>%
mutate(type = "Model 3b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 3 - Relativism X Gender") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Gender") +
ggthemes::scale_color_fivethirtyeight("Gender") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Relativism")
ggsave(filename = "text/images/reg3_c2_relativism.png", width = 8, height = 5)cowplot::plot_grid(reg4_s1, reg4_s2, ncol = 1)
ggsave(filename = "text/images/reg4_combined.png", width = 8, height = 9)cowplot::plot_grid(reg5_s1, reg5_s2, ncol = 1)
ggsave(filename = "text/images/reg5_c1_idealism.png", width = 8, height = 9)bind_rows(
get_model_data(fit5_s1, type = "pred",
terms = c("idealism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 5a - Switch Track"),
get_model_data(fit5_s2, type = "pred",
terms = c("idealism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 5b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 5 - Idealism X Experimental Groups") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Experimental Groups") +
ggthemes::scale_color_fivethirtyeight("Experimental Groups") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Idealism")
ggsave(filename = "text/images/reg5_c2_idealism.png", width = 8, height = 5)cowplot::plot_grid(reg6_s1, reg6_s2, ncol = 1)
ggsave(filename = "text/images/reg6_c1_relativism.png", width = 7, height = 8)bind_rows(
get_model_data(fit6_s1, type = "pred",
terms = c("relativism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 6a - Switch Track"),
get_model_data(fit6_s2, type = "pred",
terms = c("relativism_pca", "groups"), ci.lvl = .9) %>%
mutate(type = "Model 6b - Push Person")
) %>%
ggplot(aes(x, predicted)) +
geom_ribbon(aes(ymin = conf.low,
ymax = conf.high,
fill = group), alpha = 0.11) +
geom_line(aes(color = group), size = 1.2) +
ggtitle("Model 6 - Relativism X Experimental Groups") +
ggthemes::theme_hc() +
ggthemes::scale_fill_fivethirtyeight("Experimental Groups") +
ggthemes::scale_color_fivethirtyeight("Experimental Groups") +
facet_wrap(~type) +
ylab("Morally justifiable 1 - 11") +
xlab("Relativism")
ggsave(filename = "text/images/reg6_c2_relativism.png", width = 8, height = 5)be74a443fc2c19d263592bbe77254754f8227b89
React
Typescript
Django
Laravel
Facebook
Microsoft
Google
Alibaba
D3
Tencent