Demographics Section
Demographic table
Experiment_2_Analysis_DF$Gender <- as.factor(Experiment_2_Analysis_DF$Gender)
demo_table_j <- d2
label(demo_table_j$Ethnic_Origin) <- "Ethnic Origin"
table1(~ Gender + Age + Education + Ethnicity + Ethnic_Origin, data = demo_table_j)
|
Overall
(N=287) |
| Gender |
|
| Female |
127 (44.3%) |
| Male |
160 (55.7%) |
| Age |
|
| Mean (SD) |
29.5 (9.89) |
| Median [Min, Max] |
26.0 [18.0, 78.0] |
| Education |
|
| Primary School |
5 (1.7%) |
| GCSEs or Equivalent |
18 (6.3%) |
| A-Levels or Equivalent |
65 (22.6%) |
| University Undergraduate Program |
126 (43.9%) |
| University Post-Graduate Program |
64 (22.3%) |
| Doctoral Degree |
4 (1.4%) |
| Prefer not to respond |
5 (1.7%) |
| Ethnicity |
|
| White |
221 (77.0%) |
| Mixed or Multi-ethnic |
7 (2.4%) |
| Asian or Asian Scottish or Asian British |
5 (1.7%) |
| African |
50 (17.4%) |
| Other ethnicity |
3 (1.0%) |
| Prefer not to respond |
1 (0.3%) |
| Ethnic Origin |
|
| English |
17 (5.9%) |
| European |
199 (69.3%) |
| Latin American |
6 (2.1%) |
| Asian |
7 (2.4%) |
| African |
49 (17.1%) |
| Other |
9 (3.1%) |
Gender
Experiment_2_Analysis_DF$Gender <- as.factor(Experiment_2_Analysis_DF$Gender)
ggplot(d2, aes(x = Gender, fill = Gender)) +
geom_histogram(stat = "count") +
labs(x = "Gender2") +
scale_x_discrete(labels = c("Female", "Male", "Gender \nNon-Binary", "Prefer not \nto respond"), guide = "prism_offset") +
scale_y_continuous(breaks = seq(0, 160, 10), guide = "prism_offset") +
theme(legend.position = "none")
## Warning: Ignoring unknown parameters: binwidth, bins, pad
Age
Experiment_2_Demographics_DF$Gender <- as.factor(Experiment_2_Demographics_DF$Gender)
d2 <- Experiment_2_Demographics_DF %>%
mutate_at(vars(locfunc(Experiment_2_Demographics_DF, "Gender")), ~ as.factor(recode(., "1" = "Female", "2" = "Male")))
age_plot <- ggplot(d2, aes(x = Age, fill = Gender)) +
geom_bar(data = subset(d2, Gender == "Female")) +
geom_bar(data = subset(d2, Gender == "Male"), aes(y = ..count.. * (-1))) +
scale_y_continuous(breaks = seq(-30, 30, 1), labels = abs(seq(-30, 30, 1))) +
scale_x_continuous(breaks = seq(20, 80, 5)) +
ylab("Number of Participants") +
xlab("Age of Participants (In years)") +
geom_hline(yintercept = 0) +
coord_flip()
ggplotly(age_plot)
## Warning: `gather_()` was deprecated in tidyr 1.2.0.
## Please use `gather()` instead.
Ethnicity
Experiment_2_Analysis_DF$Ethnicity <- as.factor(Experiment_2_Analysis_DF$Ethnicity)
ggplot(Experiment_2_Analysis_DF, aes(x = Ethnicity, fill = Ethnicity)) +
geom_histogram(stat = "count") +
scale_x_discrete(labels = c("White ", "Mixed \nor \nMulti-ethnic ", "Asian \nor \nAsian Scottish \nor \nAsian British", "African", "Caribbean \nor \nBlack", "Arab ", "Other ethnicity", "Prefer not \nto respond"), guide = "prism_offset") +
scale_y_continuous(breaks = seq(0, 250, 20), guide = "prism_offset") +
theme(legend.position = "none")
## Warning: Ignoring unknown parameters: binwidth, bins, pad
Ethnic Origin
Experiment_2_Analysis_DF$Ethnic_Origin <- as.factor(Experiment_2_Analysis_DF$Ethnic_Origin)
ggplot(Experiment_2_Analysis_DF, aes(x = Ethnic_Origin, fill = Ethnic_Origin)) +
geom_histogram(stat = "count") +
scale_x_discrete(labels = c("Scottish", "English", "European", "Latin \nAmerican", "Asian", "Arab", "African", "Other", "Prefer not \nto respond"), guide = "prism_offset") +
scale_y_continuous(breaks = seq(0, 250, 20), guide = "prism_offset") +
theme(legend.position = "none")
## Warning: Ignoring unknown parameters: binwidth, bins, pad
Education
Experiment_2_Analysis_DF$Education <- as.factor(Experiment_2_Analysis_DF$Education)
ggplot(Experiment_2_Analysis_DF, aes(x = Education, fill = Education)) +
geom_histogram(stat = "count") +
scale_x_discrete(labels = c("Primary School ", "GCSEs \nor \nEquivalent", "A-Levels \nor \nEquivalent", "University \nUndergraduate \nProgram", "University \nPost-Graduate \nProgram", "Doctoral \nDegree", "Prefer not \nto respond"), guide = "prism_offset") +
scale_y_continuous(breaks = seq(0, 250, 20), guide = "prism_offset") +
theme(legend.position = "none")
## Warning: Ignoring unknown parameters: binwidth, bins, pad
Analysis
General Correlation
correlation_df <- Experiment_2_Analysis_DF %>% rename(
"Ethical Preference" = "DOSPERT_Ethical_Preference_z",
"Financial Preference" = "DOSPERT_Financial_Preference_z",
"Health and Safety Preference" = "DOSPERT_HS_Preference_z",
"Social Preference" = "DOSPERT_Social_Preference_z",
"Recreational Preference" = "DOSPERT_Recreation_Preference_z",
"Dominance" = "dominance_z",
"Prestige" = "prestige_z",
"Leadership" = "leadership_z",
"UMS Affiliation" = "UMS_Affiliation_Questions_z",
"UMS Intimacy" = "UMS_Intimacy_Questions_z",
"UMS Sum" = "UMS_Questions_z",
"B-PNI" = "PNI_z",
"Risk Perception" = "DOSPERT_Perception_z",
"Risk Benefit" = "DOSPERT_Benefit_z",
"Risk Sum" = "DOSPERT_Likelihood_z",
"General Expected Benefits" = "DOSPERT_Benefit_z",
"General Risk Preference" = "DOSPERT_General_Preference_z"
)
corr_1 <- correlation(correlation_df, bayesian = TRUE, method = "auto")
saveRDS(corr_1, "corr_1.rds")
corr_1 <- readRDS("corr_1.rds")
print(summary(corr_1))
## # Correlation Matrix (auto-method)
##
## Parameter | DOSPERT_General_Perceived_Risk_z | DOSPERT_General_Expected_Benefits_z | General Risk Preference | Recreational Preference | Health and Safety Preference | Social Preference | Financial Preference | Ethical Preference | DOSPERT_Social_Benefit_z | DOSPERT_Recreation_Benefit_z | DOSPERT_Financial_Benefit_z | DOSPERT_Ethical_Benefit_z | DOSPERT_Social_Perception_z | DOSPERT_Recreation_Perception_z | DOSPERT_HS_Perception_z | DOSPERT_Financial_Perception_z | DOSPERT_Ethical_Perception_z | DOSPERT_Social_Likelihood_z | DOSPERT_Recreation_Likelihood_z | DOSPERT_HS_Likelihood_z | DOSPERT_Financial_Likelihood_z | DOSPERT_Ethical_Likelihood_z | B-PNI | Leadership | Prestige | Dominance | UMS Sum | UMS Affiliation | UMS Intimacy | General Expected Benefits | Risk Perception | Risk Sum | Age | Contact
## ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
## X | 0.10 | 0.06 | 0.09 | 0.08 | 0.06 | 0.05 | 0.11 | 0.08 | 0.02 | 0.05 | 0.08 | 0.05 | -0.07 | -0.11 | -0.06 | -0.10 | -0.07 | -0.02 | 0.08 | 0.03 | 0.05 | -0.04 | -0.03 | -0.01 | -0.09 | 0.02 | -0.07 | -0.04 | -0.08 | 0.06 | -0.10 | 0.02 | 0.01 | 1.00***
## Contact | 0.10 | 0.06 | 0.09 | 0.08 | 0.06 | 0.05 | 0.10 | 0.08 | 0.03 | 0.05 | 0.08 | 0.06 | -0.07 | -0.11 | -0.06 | -0.10 | -0.08 | -0.03 | 0.07 | 0.02 | 0.04 | -0.04 | -0.03 | -0.02 | -0.09 | 0.02 | -0.07 | -0.04 | -0.08 | 0.06 | -0.10 | 0.02 | 0.01 |
## Age | -0.08 | -0.30*** | -0.28*** | -0.25*** | -0.25*** | -0.25*** | -0.29*** | -0.13* | -0.27*** | -0.23*** | -0.32*** | -0.18*** | 0.03 | 0.18*** | 0.07 | 0.06 | -6.51e-03 | -0.18** | -0.17** | -0.18*** | -0.18*** | -0.07 | -0.32*** | -0.03 | -0.17** | -0.20*** | -0.08 | -0.15** | 0.02 | -0.30*** | 0.08 | -0.19*** | |
## Risk Sum | 0.40*** | 0.54*** | 0.61*** | 0.48*** | 0.49*** | 0.48*** | 0.57*** | 0.53*** | 0.41*** | 0.43*** | 0.51*** | 0.48*** | -0.32*** | -0.36*** | -0.32*** | -0.36*** | -0.32*** | 0.76*** | 0.82*** | 0.80*** | 0.83*** | 0.85*** | 0.26*** | 0.14* | 0.17*** | 0.36*** | 0.12* | 0.23*** | -0.03 | 0.54*** | -0.40*** | | |
## Risk Perception | -1.00*** | -0.23*** | -0.58*** | -0.60*** | -0.51*** | -0.29*** | -0.50*** | -0.59*** | -0.05 | -0.26*** | -0.22*** | -0.22*** | 0.78*** | 0.82*** | 0.87*** | 0.86*** | 0.89*** | -0.23*** | -0.36*** | -0.40*** | -0.29*** | -0.36*** | 0.04 | 0.07 | 0.06 | -0.19*** | 0.12* | -2.06e-03 | 0.21*** | -0.23*** | | | |
## General Expected Benefits | 0.23*** | 1.00*** | 0.92*** | 0.72*** | 0.76*** | 0.78*** | 0.76*** | 0.76*** | 0.80*** | 0.83*** | 0.82*** | 0.87*** | -0.16** | -0.30*** | -0.15** | -0.17** | -0.17** | 0.38*** | 0.56*** | 0.47*** | 0.40*** | 0.41*** | 0.21*** | 0.13** | 0.05 | 0.30*** | 0.04 | 0.17*** | -0.11* | | | | |
## UMS Intimacy | -0.21*** | -0.11 | -0.17*** | -0.29*** | -0.12* | -0.04 | -0.08 | -0.19** | -9.77e-03 | -0.21*** | -0.03 | -0.14** | 0.11 | 0.28*** | 0.17** | 0.15** | 0.17*** | 0.10 | -0.22*** | -0.02 | -4.54e-03 | 3.45e-03 | 0.18*** | 0.23*** | 0.44*** | -0.13* | 0.84*** | 0.48*** | | | | | |
## UMS Affiliation | -4.95e-04 | 0.17** | 0.14* | 0.06 | 0.14* | 0.15** | 0.15** | 0.08 | 0.18** | 0.09 | 0.17** | 0.10 | 0.03 | -3.65e-04 | -0.01 | -0.03 | -1.29e-03 | 0.21*** | 0.12* | 0.17** | 0.24*** | 0.18*** | 0.33*** | 0.48*** | 0.69*** | 0.26*** | 0.87*** | | | | | | |
## UMS Sum | -0.12* | 0.04 | -0.01 | -0.12* | 0.01 | 0.07 | 0.05 | -0.06 | 0.10 | -0.06 | 0.09 | -0.02 | 0.08 | 0.15** | 0.08 | 0.07 | 0.09 | 0.19*** | -0.05 | 0.09 | 0.14** | 0.11* | 0.31*** | 0.42*** | 0.67*** | 0.09 | | | | | | | |
## Dominance | 0.19*** | 0.30*** | 0.32*** | 0.33*** | 0.24*** | 0.21*** | 0.30*** | 0.28*** | 0.22*** | 0.28*** | 0.28*** | 0.27*** | -0.03 | -0.29*** | -0.17** | -0.17** | -0.13* | 0.23*** | 0.35*** | 0.29*** | 0.30*** | 0.28*** | 0.47*** | 0.29*** | 0.30*** | | | | | | | | |
## Prestige | -0.07 | 0.06 | 0.02 | -0.04 | 0.07 | 0.03 | 0.08 | -0.05 | 0.07 | -0.04 | 0.13* | -0.01 | 0.10 | 0.03 | -0.01 | 0.07 | 0.09 | 0.20*** | 0.04 | 0.15** | 0.19*** | 0.11* | 0.45*** | 0.46*** | | | | | | | | | |
## Leadership | -0.07 | 0.13* | 0.08 | -0.02 | 0.02 | 0.21*** | 0.07 | 0.04 | 0.24*** | 0.02 | 0.11* | 0.09 | 0.03 | 0.07 | 0.08 | 0.05 | 0.07 | 0.25*** | 0.02 | 0.05 | 0.14** | 0.09 | 0.28*** | | | | | | | | | | |
## B-PNI | -0.04 | 0.21*** | 0.15** | 0.10 | 0.13* | 0.11* | 0.17** | 0.13** | 0.18** | 0.09 | 0.21*** | 0.20*** | 0.15** | -0.07 | 0.02 | 0.03 | 0.05 | 0.18** | 0.20*** | 0.23*** | 0.22*** | 0.22*** | | | | | | | | | | | |
## DOSPERT_Ethical_Likelihood_z | 0.36*** | 0.40*** | 0.48*** | 0.37*** | 0.36*** | 0.32*** | 0.44*** | 0.51*** | 0.26*** | 0.30*** | 0.39*** | 0.43*** | -0.26*** | -0.32*** | -0.26*** | -0.30*** | -0.37*** | 0.52*** | 0.65*** | 0.62*** | 0.65*** | | | | | | | | | | | | |
## DOSPERT_Financial_Likelihood_z | 0.29*** | 0.40*** | 0.45*** | 0.33*** | 0.30*** | 0.31*** | 0.58*** | 0.36*** | 0.28*** | 0.29*** | 0.52*** | 0.32*** | -0.18*** | -0.26*** | -0.21*** | -0.36*** | -0.23*** | 0.53*** | 0.63*** | 0.55*** | | | | | | | | | | | | | |
## DOSPERT_HS_Likelihood_z | 0.40*** | 0.47*** | 0.55*** | 0.41*** | 0.61*** | 0.34*** | 0.47*** | 0.47*** | 0.26*** | 0.36*** | 0.40*** | 0.43*** | -0.32*** | -0.32*** | -0.40*** | -0.36*** | -0.29*** | 0.52*** | 0.60*** | | | | | | | | | | | | | | |
## DOSPERT_Recreation_Likelihood_z | 0.36*** | 0.56*** | 0.61*** | 0.62*** | 0.47*** | 0.41*** | 0.51*** | 0.52*** | 0.36*** | 0.58*** | 0.48*** | 0.49*** | -0.25*** | -0.44*** | -0.26*** | -0.28*** | -0.29*** | 0.47*** | | | | | | | | | | | | | | | |
## DOSPERT_Social_Likelihood_z | 0.22*** | 0.38*** | 0.41*** | 0.23*** | 0.31*** | 0.54*** | 0.33*** | 0.29*** | 0.48*** | 0.24*** | 0.30*** | 0.28*** | -0.31*** | -0.14** | -0.19*** | -0.18** | -0.13* | | | | | | | | | | | | | | | | |
## DOSPERT_Ethical_Perception_z | -0.89*** | -0.17** | -0.49*** | -0.51*** | -0.39*** | -0.21*** | -0.39*** | -0.64*** | -3.48e-03 | -0.23*** | -0.16** | -0.21*** | 0.64*** | 0.69*** | 0.73*** | 0.69*** | | | | | | | | | | | | | | | | | |
## DOSPERT_Financial_Perception_z | -0.85*** | -0.17** | -0.48*** | -0.45*** | -0.41*** | -0.20*** | -0.54*** | -0.46*** | -0.02 | -0.17** | -0.21*** | -0.17** | 0.59*** | 0.65*** | 0.70*** | | | | | | | | | | | | | | | | | | |
## DOSPERT_HS_Perception_z | -0.87*** | -0.15** | -0.47*** | -0.46*** | -0.55*** | -0.16** | -0.40*** | -0.44*** | 0.03 | -0.19*** | -0.18** | -0.12* | 0.62*** | 0.64*** | | | | | | | | | | | | | | | | | | | |
## DOSPERT_Recreation_Perception_z | -0.82*** | -0.30*** | -0.57*** | -0.77*** | -0.46*** | -0.22*** | -0.46*** | -0.56*** | -0.08 | -0.37*** | -0.25*** | -0.29*** | 0.48*** | | | | | | | | | | | | | | | | | | | | |
## DOSPERT_Social_Perception_z | -0.78*** | -0.16** | -0.44*** | -0.35*** | -0.35*** | -0.43*** | -0.32*** | -0.40*** | -0.13* | -0.15** | -0.13* | -0.13* | | | | | | | | | | | | | | | | | | | | | |
## DOSPERT_Ethical_Benefit_z | 0.22*** | 0.87*** | 0.81*** | 0.62*** | 0.62*** | 0.62*** | 0.59*** | 0.88*** | 0.64*** | 0.69*** | 0.62*** | | | | | | | | | | | | | | | | | | | | | | |
## DOSPERT_Financial_Benefit_z | 0.22*** | 0.82*** | 0.77*** | 0.57*** | 0.59*** | 0.53*** | 0.93*** | 0.56*** | 0.54*** | 0.64*** | | | | | | | | | | | | | | | | | | | | | | | |
## DOSPERT_Recreation_Benefit_z | 0.26*** | 0.83*** | 0.80*** | 0.88*** | 0.61*** | 0.53*** | 0.61*** | 0.65*** | 0.53*** | | | | | | | | | | | | | | | | | | | | | | | | |
## DOSPERT_Social_Benefit_z | 0.05 | 0.80*** | 0.68*** | 0.41*** | 0.47*** | 0.95*** | 0.47*** | 0.50*** | | | | | | | | | | | | | | | | | | | | | | | | | |
## Ethical Preference | 0.59*** | 0.76*** | 0.87*** | 0.73*** | 0.67*** | 0.59*** | 0.65*** | | | | | | | | | | | | | | | | | | | | | | | | | | |
## Financial Preference | 0.50*** | 0.76*** | 0.83*** | 0.65*** | 0.66*** | 0.52*** | | | | | | | | | | | | | | | | | | | | | | | | | | | |
## Social Preference | 0.29*** | 0.78*** | 0.76*** | 0.48*** | 0.54*** | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
## Health and Safety Preference | 0.51*** | 0.76*** | 0.84*** | 0.66*** | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
## Recreational Preference | 0.60*** | 0.72*** | 0.84*** | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
## General Risk Preference | 0.58*** | 0.92*** | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
## DOSPERT_General_Expected_Benefits_z | 0.23*** | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
ggcorrplot(corr_1, type = "lower", lab = TRUE, insig = "blank", show.diag = TRUE, sig.level = 0.05) + scale_x_discrete(labels = 1:17) + theme(axis.text.x = element_text(angle = 0, hjust = .5))
apa_table(correlation_table_1, landscape = TRUE, row.names = FALSE, placement = "ht", note = "* denotes significance level", caption = "General Correlaiton Matrix | Experiment 2")
B-PNI distribution
## B-PNI distribution
B_PNI_1 <- ggplot(Experiment_2_Analysis_DF, aes(x = Age, y = PNI_z)) +
geom_point(size = 0.7, alpha = 0.8, position = "jitter") +
geom_smooth(method = "lm", se = FALSE, size = 2, alpha = 0.8)
ggplotly(B_PNI_1)
## brms SEM attempt
m1 Interaction model
m1_interaction <- brm(DOSPERT_General_Preference_z ~ dominance_z * Gender + prestige_z * Gender + leadership_z * Gender + PNI_z * Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, prior = prior_m1_interaction_gen, save_pars = save_pars(all = T), cores = parallel::detectCores(), backend = "cmdstanr")
saveRDS(m1_interaction, "m1_interaction.rds")
m1_interaction_no_pni <- brm(DOSPERT_General_Preference_z ~ dominance_z * Gender + prestige_z * Gender + leadership_z * Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, prior = prior_m1_interaction_gen_no_pni, save_pars = save_pars(all = T), cores = parallel::detectCores(), backend = "cmdstanr")
saveRDS(m1_interaction_no_pni, "m1_interaction_no_pni.rds")
# Model without PNI is favored over model with PNI
m1 <- brm(DOSPERT_General_Preference_z ~ dominance_z + prestige_z + leadership_z + PNI_z + Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, , cores = parallel::detectCores(), backend = "cmdstanr", prior = prior_m1, save_pars = save_pars(all = T))
saveRDS(m1, "m1.rds")
m1_fixef <- MutateHDI::mutate_each_hdi_no_save((m1))
kable(m1_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
Intercept
|
0.73
|
0.18
|
0.38 - 1.09
|
|
Dominance
|
0.30
|
0.05
|
0.19 - 0.4
|
|
Prestige
|
-0.03
|
0.05
|
-0.14 - 0.07
|
|
Leadership
|
-0.02
|
0.05
|
-0.12 - 0.08
|
|
PNI
|
-0.04
|
0.07
|
-0.17 - 0.08
|
|
Gender
|
0.01
|
0.09
|
-0.18 - 0.19
|
|
Age
|
-0.02
|
0.01
|
-0.04 - -0.01
|
Model comparison
m1_comparison <- loo(m1, m1_interaction)
m1_comparison
bayes_factor(m1, m1_interaction)
# m1_interaction over m1
m2 multivariate Model with DoPL and DOSPERT + PNI
m2 <- brm(mvbind(DOSPERT_Likelihood_z, DOSPERT_Benefit_z, DOSPERT_Perception_z) ~ dominance_z + prestige_z + leadership_z + PNI_z + Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, prior = prior_m2, save_pars = save_pars(all = T), cores = parallel::detectCores(), backend = "cmdstanr")
saveRDS(m2, "m2.rds")
m2_fixef <- MutateHDI::mutate_each_hdi_no_save((m2))
kable(m2_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
DOSPERTLikelihoodz * Intercept
|
0.42
|
0.19
|
0.05 - 0.79
|
|
DOSPERT Benefitz * Intercept
|
0.86
|
0.18
|
0.5 - 1.23
|
|
DOSPERT Perceptionz * Intercept
|
-0.30
|
0.19
|
-0.68 - 0.08
|
|
DOSPERTLikelihoodz * Dominance
|
0.34
|
0.05
|
0.24 - 0.45
|
|
DOSPERTLikelihoodz * Prestige
|
0.10
|
0.05
|
-0.01 - 0.2
|
|
DOSPERTLikelihoodz * Leadership
|
-0.06
|
0.05
|
-0.15 - 0.03
|
|
DOSPERTLikelihoodz * PNI
|
0.04
|
0.07
|
-0.1 - 0.17
|
|
DOSPERTLikelihoodz * Gender
|
-0.15
|
0.09
|
-0.33 - 0.02
|
|
DOSPERTLikelihoodz * Age
|
-0.01
|
0.01
|
-0.02 - 0
|
|
DOSPERT Benefitz * Dominance
|
0.28
|
0.05
|
0.17 - 0.38
|
|
DOSPERT Benefitz * Prestige
|
-0.02
|
0.05
|
-0.13 - 0.08
|
|
DOSPERT Benefitz * Leadership
|
0.00
|
0.05
|
-0.1 - 0.1
|
|
DOSPERT Benefitz * PNI
|
0.00
|
0.07
|
-0.13 - 0.13
|
|
DOSPERT Benefitz * Gender
|
-0.18
|
0.09
|
-0.37 - 0
|
|
DOSPERT Benefitz * Age
|
-0.02
|
0.01
|
-0.04 - -0.01
|
|
DOSPERT Perceptionz * Dominance
|
-0.30
|
0.05
|
-0.41 - -0.19
|
|
DOSPERT Perceptionz * Prestige
|
0.07
|
0.06
|
-0.04 - 0.18
|
|
DOSPERT Perceptionz * Leadership
|
0.11
|
0.05
|
0.01 - 0.21
|
|
DOSPERT Perceptionz * PNI
|
0.15
|
0.07
|
0.01 - 0.28
|
|
DOSPERT Perceptionz * Gender
|
0.01
|
0.10
|
-0.18 - 0.2
|
|
DOSPERT Perceptionz * Age
|
0.01
|
0.01
|
0 - 0.02
|
Additive Model with DoPL and DOSPERT + PNI Gender Interaction
m2_interaction_gender <- brm(mvbind(DOSPERT_Likelihood_z, DOSPERT_Benefit_z, DOSPERT_Perception_z) ~ dominance_z * Gender + prestige_z * Gender + leadership_z * Gender + PNI_z * Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, prior = prior_m2_interaction_gender, save_pars = save_pars(all = T), cores = parallel::detectCores(), backend = "cmdstanr")
saveRDS(m2_interaction_gender, "m2_interaction_gender.rds")
m2_interaction_gender_fixef <- MutateHDI::mutate_each_hdi_no_save((m2_interaction_gender))
kable(m2_interaction_gender_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
DOSPERTLikelihoodz * Intercept
|
0.50
|
0.19
|
0.12 - 0.88
|
|
DOSPERT Benefitz * Intercept
|
0.89
|
0.19
|
0.52 - 1.26
|
|
DOSPERT Perceptionz * Intercept
|
-0.28
|
0.20
|
-0.67 - 0.1
|
|
DOSPERTLikelihoodz * Dominance
|
0.43
|
0.06
|
0.31 - 0.55
|
|
DOSPERTLikelihoodz * Gender
|
-0.15
|
0.09
|
-0.33 - 0.03
|
|
DOSPERTLikelihoodz * Prestige
|
0.11
|
0.06
|
-0.01 - 0.24
|
|
DOSPERTLikelihoodz * Leadership
|
-0.08
|
0.06
|
-0.19 - 0.03
|
|
DOSPERTLikelihoodz * PNI
|
-0.08
|
0.10
|
-0.27 - 0.11
|
|
DOSPERTLikelihoodz * Age
|
-0.01
|
0.01
|
-0.02 - 0
|
|
DOSPERTLikelihoodz * Dominance : Gender
|
-0.21
|
0.09
|
-0.39 - -0.04
|
|
DOSPERTLikelihoodz * Prestige : Gender
|
-0.02
|
0.09
|
-0.21 - 0.16
|
|
DOSPERTLikelihoodz * Leadership : Gender
|
0.09
|
0.09
|
-0.08 - 0.26
|
|
DOSPERTLikelihoodz * Gender: PNI
|
0.23
|
0.13
|
-0.02 - 0.47
|
|
DOSPERT Benefitz * Dominance
|
0.27
|
0.07
|
0.14 - 0.4
|
|
DOSPERT Benefitz * Gender
|
-0.18
|
0.09
|
-0.36 - 0
|
|
DOSPERT Benefitz * Prestige
|
-0.02
|
0.07
|
-0.14 - 0.11
|
|
DOSPERT Benefitz * Leadership
|
-0.03
|
0.06
|
-0.15 - 0.09
|
|
DOSPERT Benefitz * PNI
|
0.01
|
0.10
|
-0.18 - 0.19
|
|
DOSPERT Benefitz * Age
|
-0.03
|
0.01
|
-0.04 - -0.01
|
|
DOSPERT Benefitz * Dominance : Gender
|
-0.04
|
0.09
|
-0.22 - 0.14
|
|
DOSPERT Benefitz * Prestige : Gender
|
-0.02
|
0.09
|
-0.2 - 0.16
|
|
DOSPERT Benefitz * Leadership : Gender
|
0.09
|
0.09
|
-0.08 - 0.26
|
|
DOSPERT Benefitz * Gender: PNI
|
0.01
|
0.13
|
-0.24 - 0.26
|
|
DOSPERT Perceptionz * Dominance
|
-0.32
|
0.07
|
-0.46 - -0.18
|
|
DOSPERT Perceptionz * Gender
|
0.01
|
0.10
|
-0.18 - 0.2
|
|
DOSPERT Perceptionz * Prestige
|
0.09
|
0.07
|
-0.05 - 0.23
|
|
DOSPERT Perceptionz * Leadership
|
0.07
|
0.06
|
-0.05 - 0.2
|
|
DOSPERT Perceptionz * PNI
|
0.06
|
0.10
|
-0.14 - 0.26
|
|
DOSPERT Perceptionz * Age
|
0.01
|
0.01
|
0 - 0.02
|
|
DOSPERT Perceptionz * Dominance : Gender
|
0.07
|
0.10
|
-0.12 - 0.26
|
|
DOSPERT Perceptionz * Prestige : Gender
|
-0.04
|
0.10
|
-0.24 - 0.15
|
|
DOSPERT Perceptionz * Leadership : Gender
|
0.10
|
0.09
|
-0.08 - 0.27
|
|
DOSPERT Perceptionz * Gender: PNI
|
0.15
|
0.13
|
-0.1 - 0.41
|
Model Comparison
m2_comparison <- loo(m2, m2_interaction_gender)
m2_comparison
bayes_factor(m2_interaction_gender, m2)
# m2 over m2_interaction_gender
DOSPERT and DoPL and PNI
m3 <- brm(mvbind(DOSPERT_Ethical_Preference_z, DOSPERT_Financial_Preference_z, DOSPERT_HS_Preference_z, DOSPERT_Recreation_Preference_z, DOSPERT_Social_Preference_z) ~ dominance_z + prestige_z + leadership_z + PNI_z + Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, prior = prior_m3, save_pars = save_pars(all = T), cores = parallel::detectCores(), backend = "cmdstanr")
saveRDS(m3, "m3.rds")
m3_fixef <- MutateHDI::mutate_each_hdi_no_save((m3))
kable(m3_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
DOSPERTEthicalPreference * Intercept
|
0.31
|
0.18
|
-0.05 - 0.67
|
|
DOSPERTFinancialPreference * Intercept
|
0.85
|
0.18
|
0.49 - 1.21
|
|
DOSPERTHSPreference * Intercept
|
0.66
|
0.19
|
0.29 - 1.02
|
|
DOSPERTRecreationPreference * Intercept
|
0.69
|
0.18
|
0.34 - 1.04
|
|
DOSPERTSocialPreference * Intercept
|
0.82
|
0.19
|
0.45 - 1.19
|
|
DOSPERTEthicalPreference * Dominance
|
0.36
|
0.04
|
0.27 - 0.44
|
|
DOSPERTEthicalPreference * Prestige
|
-0.09
|
0.05
|
-0.18 - 0.01
|
|
DOSPERTEthicalPreference * Leadership
|
-0.02
|
0.05
|
-0.11 - 0.07
|
|
DOSPERTEthicalPreference * PNI
|
-0.01
|
0.07
|
-0.14 - 0.12
|
|
DOSPERTEthicalPreference * Gender
|
-0.13
|
0.09
|
-0.3 - 0.03
|
|
DOSPERTEthicalPreference * Age
|
-0.01
|
0.01
|
-0.02 - 0.01
|
|
DOSPERTFinancialPreference * Dominance
|
0.31
|
0.04
|
0.22 - 0.4
|
|
DOSPERTFinancialPreference * Prestige
|
0.05
|
0.05
|
-0.04 - 0.15
|
|
DOSPERTFinancialPreference * Leadership
|
-0.03
|
0.05
|
-0.12 - 0.06
|
|
DOSPERTFinancialPreference * PNI
|
-0.07
|
0.07
|
-0.2 - 0.06
|
|
DOSPERTFinancialPreference * Gender
|
-0.23
|
0.09
|
-0.4 - -0.05
|
|
DOSPERTFinancialPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTHSPreference * Dominance
|
0.29
|
0.04
|
0.21 - 0.38
|
|
DOSPERTHSPreference * Prestige
|
0.07
|
0.05
|
-0.03 - 0.16
|
|
DOSPERTHSPreference * Leadership
|
-0.08
|
0.05
|
-0.17 - 0.02
|
|
DOSPERTHSPreference * PNI
|
-0.07
|
0.07
|
-0.2 - 0.05
|
|
DOSPERTHSPreference * Gender
|
-0.12
|
0.09
|
-0.29 - 0.05
|
|
DOSPERTHSPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTRecreationPreference * Dominance
|
0.43
|
0.04
|
0.35 - 0.52
|
|
DOSPERTRecreationPreference * Prestige
|
-0.07
|
0.05
|
-0.16 - 0.02
|
|
DOSPERTRecreationPreference * Leadership
|
-0.08
|
0.04
|
-0.16 - 0.01
|
|
DOSPERTRecreationPreference * PNI
|
-0.11
|
0.06
|
-0.24 - 0.01
|
|
DOSPERTRecreationPreference * Gender
|
-0.04
|
0.08
|
-0.21 - 0.12
|
|
DOSPERTRecreationPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTSocialPreference * Dominance
|
0.22
|
0.05
|
0.12 - 0.31
|
|
DOSPERTSocialPreference * Prestige
|
-0.03
|
0.05
|
-0.13 - 0.07
|
|
DOSPERTSocialPreference * Leadership
|
0.16
|
0.05
|
0.06 - 0.26
|
|
DOSPERTSocialPreference * PNI
|
-0.10
|
0.07
|
-0.23 - 0.03
|
|
DOSPERTSocialPreference * Gender
|
-0.17
|
0.09
|
-0.35 - 0.01
|
|
DOSPERTSocialPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
m3 Interaction Gender DOSPERT, DoPL, and PNI
m3_interaction_gender <- brm(mvbind(DOSPERT_Ethical_Preference_z, DOSPERT_Financial_Preference_z, DOSPERT_HS_Preference_z, DOSPERT_Recreation_Preference_z, DOSPERT_Social_Preference_z) ~ dominance_z * Gender + prestige_z * Gender + leadership_z * Gender + PNI_z * Gender + Age, data = Experiment_2_Analysis_DF, warmup = 1000, iter = 10000, prior = prior_m3_interaction_gender, save_pars = save_pars(all = T), cores = parallel::detectCores(), backend = "cmdstanr")
saveRDS(m3_interaction_gender, "m3_interaction_gender.rds")
m3_interaction_gender_fixef <- MutateHDI::mutate_each_hdi_no_save((m3_interaction_gender))
kable(m3_interaction_gender_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
DOSPERTEthicalPreference * Intercept
|
0.34
|
0.19
|
-0.03 - 0.71
|
|
DOSPERTFinancialPreference * Intercept
|
0.87
|
0.19
|
0.5 - 1.24
|
|
DOSPERTHSPreference * Intercept
|
0.68
|
0.19
|
0.31 - 1.06
|
|
DOSPERTRecreationPreference * Intercept
|
0.75
|
0.18
|
0.39 - 1.11
|
|
DOSPERTSocialPreference * Intercept
|
0.82
|
0.19
|
0.45 - 1.19
|
|
DOSPERTEthicalPreference * Dominance
|
0.40
|
0.07
|
0.26 - 0.53
|
|
DOSPERTEthicalPreference * Gender
|
-0.13
|
0.09
|
-0.3 - 0.03
|
|
DOSPERTEthicalPreference * Prestige
|
-0.22
|
0.07
|
-0.35 - -0.09
|
|
DOSPERTEthicalPreference * Leadership
|
0.00
|
0.06
|
-0.12 - 0.13
|
|
DOSPERTEthicalPreference * PNI
|
0.09
|
0.10
|
-0.1 - 0.28
|
|
DOSPERTEthicalPreference * Age
|
-0.01
|
0.01
|
-0.02 - 0.01
|
|
DOSPERTEthicalPreference * Dominance : Gender
|
-0.12
|
0.09
|
-0.3 - 0.05
|
|
DOSPERTEthicalPreference * Prestige : Gender
|
0.14
|
0.09
|
-0.04 - 0.31
|
|
DOSPERTEthicalPreference * Leadership : Gender
|
-0.03
|
0.08
|
-0.19 - 0.14
|
|
DOSPERTEthicalPreference * Gender: PNI
|
-0.13
|
0.12
|
-0.37 - 0.12
|
|
DOSPERTFinancialPreference * Dominance
|
0.38
|
0.07
|
0.24 - 0.52
|
|
DOSPERTFinancialPreference * Gender
|
-0.24
|
0.09
|
-0.41 - -0.07
|
|
DOSPERTFinancialPreference * Prestige
|
-0.02
|
0.07
|
-0.16 - 0.11
|
|
DOSPERTFinancialPreference * Leadership
|
0.04
|
0.07
|
-0.09 - 0.17
|
|
DOSPERTFinancialPreference * PNI
|
-0.13
|
0.10
|
-0.32 - 0.06
|
|
DOSPERTFinancialPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTFinancialPreference * Dominance : Gender
|
-0.11
|
0.09
|
-0.29 - 0.07
|
|
DOSPERTFinancialPreference * Prestige : Gender
|
0.07
|
0.09
|
-0.11 - 0.25
|
|
DOSPERTFinancialPreference * Leadership : Gender
|
-0.12
|
0.09
|
-0.29 - 0.05
|
|
DOSPERTFinancialPreference * Gender: PNI
|
0.13
|
0.12
|
-0.12 - 0.37
|
|
DOSPERTHSPreference * Dominance
|
0.35
|
0.07
|
0.2 - 0.49
|
|
DOSPERTHSPreference * Gender
|
-0.12
|
0.09
|
-0.29 - 0.06
|
|
DOSPERTHSPreference * Prestige
|
-0.04
|
0.07
|
-0.17 - 0.1
|
|
DOSPERTHSPreference * Leadership
|
0.00
|
0.07
|
-0.13 - 0.14
|
|
DOSPERTHSPreference * PNI
|
-0.07
|
0.10
|
-0.27 - 0.12
|
|
DOSPERTHSPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTHSPreference * Dominance : Gender
|
-0.14
|
0.09
|
-0.33 - 0.04
|
|
DOSPERTHSPreference * Prestige : Gender
|
0.13
|
0.09
|
-0.05 - 0.31
|
|
DOSPERTHSPreference * Leadership : Gender
|
-0.13
|
0.09
|
-0.3 - 0.04
|
|
DOSPERTHSPreference * Gender: PNI
|
0.03
|
0.13
|
-0.21 - 0.28
|
|
DOSPERTRecreationPreference * Dominance
|
0.56
|
0.07
|
0.43 - 0.69
|
|
DOSPERTRecreationPreference * Gender
|
-0.05
|
0.08
|
-0.22 - 0.11
|
|
DOSPERTRecreationPreference * Prestige
|
-0.20
|
0.07
|
-0.33 - -0.08
|
|
DOSPERTRecreationPreference * Leadership
|
-0.01
|
0.06
|
-0.13 - 0.12
|
|
DOSPERTRecreationPreference * PNI
|
-0.13
|
0.09
|
-0.31 - 0.05
|
|
DOSPERTRecreationPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTRecreationPreference * Dominance : Gender
|
-0.26
|
0.09
|
-0.43 - -0.09
|
|
DOSPERTRecreationPreference * Prestige : Gender
|
0.17
|
0.09
|
0 - 0.34
|
|
DOSPERTRecreationPreference * Leadership : Gender
|
-0.10
|
0.08
|
-0.26 - 0.06
|
|
DOSPERTRecreationPreference * Gender: PNI
|
0.06
|
0.12
|
-0.18 - 0.3
|
|
DOSPERTSocialPreference * Dominance
|
0.20
|
0.07
|
0.05 - 0.34
|
|
DOSPERTSocialPreference * Gender
|
-0.17
|
0.09
|
-0.36 - 0
|
|
DOSPERTSocialPreference * Prestige
|
-0.12
|
0.07
|
-0.27 - 0.02
|
|
DOSPERTSocialPreference * Leadership
|
0.16
|
0.07
|
0.02 - 0.29
|
|
DOSPERTSocialPreference * PNI
|
0.05
|
0.10
|
-0.14 - 0.24
|
|
DOSPERTSocialPreference * Age
|
-0.02
|
0.01
|
-0.03 - -0.01
|
|
DOSPERTSocialPreference * Dominance : Gender
|
0.01
|
0.10
|
-0.18 - 0.19
|
|
DOSPERTSocialPreference * Prestige : Gender
|
0.07
|
0.09
|
-0.12 - 0.25
|
|
DOSPERTSocialPreference * Leadership : Gender
|
0.04
|
0.09
|
-0.14 - 0.22
|
|
DOSPERTSocialPreference * Gender: PNI
|
-0.23
|
0.13
|
-0.47 - 0.02
|
Model Comparison
m3_comparison <- loo(m3, m3_interaction_gender)
m3_comparison
bayes_factor(m3_interaction_gender, m3)
# m3 over m3_interaction_gender
Mediation
Mediation Model attempt
mediation_model.1 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + PNI_z)
mediation_model.2 <- bf(DOSPERT_Benefit_z ~ DOSPERT_Likelihood_z + DOSPERT_Perception_z + PNI_z)
## cyclical in mediation_model .1 and .2
mediation_model_1 <- brm(mediation_model.1 + mediation_model.2 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", cores = parallel::detectCores(), save_pars = save_pars(all = TRUE))
mediation_model.3 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + dominance_z)
mediation_model.4 <- bf(DOSPERT_Benefit_z ~ DOSPERT_Likelihood_z + DOSPERT_Perception_z + dominance_z)
## cyclical in mediation_model .3 and .4
mediation_model_2 <- brm(mediation_model.3 + mediation_model.4 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", cores = parallel::detectCores(), save_pars = save_pars(all = TRUE))
mediation_model.5 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + prestige_z)
mediation_model.6 <- bf(DOSPERT_Benefit_z ~ DOSPERT_Likelihood_z + DOSPERT_Perception_z + prestige_z)
mediation_model_3 <- brm(mediation_model.5 + mediation_model.6 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", cores = parallel::detectCores(), save_pars = save_pars(all = TRUE))
## cyclical in mediation_model .5 and .6
mediation_model.7 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + leadership_z)
mediation_model.8 <- bf(DOSPERT_Benefit_z ~ DOSPERT_Likelihood_z + DOSPERT_Perception_z + leadership_z)
## cyclical in mediation_model .7 and .8
mediation_model_4 <- brm(mediation_model.7 + mediation_model.8 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", cores = parallel::detectCores(), save_pars = save_pars(all = TRUE))
mediation_loo <- brms::loo(mediation_model_1, mediation_model_2, mediation_model_3, mediation_model_4)
mediation_comparison <- bayesfactor_models(mediation_model_1, mediation_model_2, mediation_model_3, mediation_model_4, denominator = mediation_model_4)
saveRDS(mediation_loo, "mediation_loo.rds")
saveRDS(mediation_comparison, "mediation_comparison.rds")
# I think this indicates that model 4 with dominance is the strongest predictor
mediation_loo
## Output of model 'mediation_model_1':
##
## Computed from 36000 by 287 log-likelihood matrix
##
## Estimate SE
## elpd_loo -688.4 23.5
## p_loo 11.7 1.5
## looic 1376.8 47.0
## ------
## Monte Carlo SE of elpd_loo is 0.0.
##
## All Pareto k estimates are good (k < 0.5).
## See help('pareto-k-diagnostic') for details.
##
## Output of model 'mediation_model_2':
##
## Computed from 36000 by 287 log-likelihood matrix
##
## Estimate SE
## elpd_loo -687.5 23.1
## p_loo 11.4 1.4
## looic 1375.0 46.1
## ------
## Monte Carlo SE of elpd_loo is 0.0.
##
## All Pareto k estimates are good (k < 0.5).
## See help('pareto-k-diagnostic') for details.
##
## Output of model 'mediation_model_3':
##
## Computed from 36000 by 287 log-likelihood matrix
##
## Estimate SE
## elpd_loo -690.0 23.2
## p_loo 11.7 1.5
## looic 1380.1 46.4
## ------
## Monte Carlo SE of elpd_loo is 0.0.
##
## All Pareto k estimates are good (k < 0.5).
## See help('pareto-k-diagnostic') for details.
##
## Output of model 'mediation_model_4':
##
## Computed from 36000 by 287 log-likelihood matrix
##
## Estimate SE
## elpd_loo -694.0 23.9
## p_loo 11.6 1.5
## looic 1388.0 47.7
## ------
## Monte Carlo SE of elpd_loo is 0.0.
##
## All Pareto k estimates are good (k < 0.5).
## See help('pareto-k-diagnostic') for details.
##
## Model comparisons:
## elpd_diff se_diff
## mediation_model_2 0.0 0.0
## mediation_model_1 -0.9 3.4
## mediation_model_3 -2.5 4.7
## mediation_model_4 -6.5 3.2
mediation_comparison
## Bayes Factors for Model Comparison
##
## Model BF
## [1] 270.55
## [2] 558.76
## [3] 50.69
##
## * Against Denominator: [4]
## * Bayes Factor Type: marginal likelihoods (bridgesampling)
m_model_1 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + DOSPERT_Perception_z + PNI_z)
m_model_2 <- bf(DOSPERT_Benefit_z ~ PNI_z)
Mediation_comparison_1 <- brm(m_model_1 + m_model_2 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", save_pars = save_pars(all = TRUE))
summary(Mediation_comparison_1)
## Family: MV(gaussian, gaussian)
## Links: mu = identity; sigma = identity
## mu = identity; sigma = identity
## Formula: DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + DOSPERT_Perception_z + PNI_z
## DOSPERT_Benefit_z ~ PNI_z
## Data: mediation_dataset (Number of observations: 287)
## Draws: 4 chains, each with iter = 10000; warmup = 1000; thin = 1;
## total post-warmup draws = 36000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI
## DOSPERTLikelihoodz_Intercept 0.00 0.05 -0.09 0.09
## DOSPERTBenefitz_Intercept -0.03 0.06 -0.14 0.09
## DOSPERTLikelihoodz_DOSPERT_Benefit_z 0.45 0.05 0.35 0.54
## DOSPERTLikelihoodz_DOSPERT_Perception_z -0.31 0.05 -0.40 -0.22
## DOSPERTLikelihoodz_PNI_z 0.18 0.05 0.09 0.27
## DOSPERTBenefitz_PNI_z 0.21 0.06 0.09 0.32
## Rhat Bulk_ESS Tail_ESS
## DOSPERTLikelihoodz_Intercept 1.00 64087 26079
## DOSPERTBenefitz_Intercept 1.00 59917 25430
## DOSPERTLikelihoodz_DOSPERT_Benefit_z 1.00 58360 29348
## DOSPERTLikelihoodz_DOSPERT_Perception_z 1.00 57925 27793
## DOSPERTLikelihoodz_PNI_z 1.00 61032 28172
## DOSPERTBenefitz_PNI_z 1.00 63745 26697
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sigma_DOSPERTLikelihoodz 0.77 0.03 0.71 0.84 1.00 60971
## sigma_DOSPERTBenefitz 0.97 0.04 0.89 1.05 1.00 62137
## Tail_ESS
## sigma_DOSPERTLikelihoodz 27436
## sigma_DOSPERTBenefitz 27162
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Mediation_comparison_1_fixef <- MutateHDI::mutate_each_hdi_no_save((Mediation_comparison_1))
kable(Mediation_comparison_1_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
DOSPERTLikelihoodz * Intercept
|
0.00
|
0.05
|
-0.09 - 0.09
|
|
DOSPERT Benefitz * Intercept
|
-0.03
|
0.06
|
-0.14 - 0.09
|
|
DOSPERTLikelihoodz * DOSPERT * Benefit
|
0.45
|
0.05
|
0.35 - 0.54
|
|
DOSPERTLikelihoodz * DOSPERT * Perception
|
-0.31
|
0.05
|
-0.4 - -0.22
|
|
DOSPERTLikelihoodz * PNI
|
0.18
|
0.05
|
0.09 - 0.27
|
|
DOSPERT Benefitz * PNI
|
0.21
|
0.06
|
0.09 - 0.32
|
m_model_3 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + PNI_z + dominance_z)
m_model_4 <- bf(DOSPERT_Benefit_z ~ PNI_z + dominance_z)
Mediation_comparison_2 <- brm(m_model_3 + m_model_4 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", save_pars = save_pars(all = TRUE))
saveRDS(Mediation_comparison_2, "Mediation_comparison_2.rds")
summary(Mediation_comparison_2)
## Family: MV(gaussian, gaussian)
## Links: mu = identity; sigma = identity
## mu = identity; sigma = identity
## Formula: DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + PNI_z + dominance_z
## DOSPERT_Benefit_z ~ PNI_z + dominance_z
## Data: mediation_dataset (Number of observations: 287)
## Draws: 4 chains, each with iter = 10000; warmup = 1000; thin = 1;
## total post-warmup draws = 36000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI
## DOSPERTLikelihoodz_Intercept 0.00 0.05 -0.09 0.09
## DOSPERTBenefitz_Intercept -0.03 0.06 -0.14 0.08
## DOSPERTLikelihoodz_DOSPERT_Benefit_z 0.43 0.05 0.33 0.53
## DOSPERTLikelihoodz_DOSPERT_Perception_z -0.29 0.05 -0.38 -0.19
## DOSPERTLikelihoodz_PNI_z 0.13 0.05 0.03 0.23
## DOSPERTLikelihoodz_dominance_z 0.11 0.05 0.01 0.22
## DOSPERTBenefitz_PNI_z 0.08 0.06 -0.04 0.21
## DOSPERTBenefitz_dominance_z 0.26 0.06 0.13 0.38
## Rhat Bulk_ESS Tail_ESS
## DOSPERTLikelihoodz_Intercept 1.00 70382 26642
## DOSPERTBenefitz_Intercept 1.00 62107 28821
## DOSPERTLikelihoodz_DOSPERT_Benefit_z 1.00 59127 29200
## DOSPERTLikelihoodz_DOSPERT_Perception_z 1.00 58904 28855
## DOSPERTLikelihoodz_PNI_z 1.00 47850 29965
## DOSPERTLikelihoodz_dominance_z 1.00 44939 31198
## DOSPERTBenefitz_PNI_z 1.00 47336 30081
## DOSPERTBenefitz_dominance_z 1.00 47167 29328
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sigma_DOSPERTLikelihoodz 0.76 0.03 0.70 0.83 1.00 67785
## sigma_DOSPERTBenefitz 0.94 0.04 0.87 1.02 1.00 61505
## Tail_ESS
## sigma_DOSPERTLikelihoodz 26416
## sigma_DOSPERTBenefitz 27727
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
Mediation_comparison_2_fixef <- MutateHDI::mutate_each_hdi_no_save((Mediation_comparison_2))
kable(Mediation_comparison_2_fixef, format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
|
Parameter
|
Estimate
|
Est.Error
|
CI (95%)
|
|
DOSPERTLikelihoodz * Intercept
|
0.00
|
0.05
|
-0.09 - 0.09
|
|
DOSPERT Benefitz * Intercept
|
-0.03
|
0.06
|
-0.14 - 0.08
|
|
DOSPERTLikelihoodz * DOSPERT * Benefit
|
0.43
|
0.05
|
0.33 - 0.53
|
|
DOSPERTLikelihoodz * DOSPERT * Perception
|
-0.29
|
0.05
|
-0.38 - -0.19
|
|
DOSPERTLikelihoodz * PNI
|
0.13
|
0.05
|
0.03 - 0.23
|
|
DOSPERTLikelihoodz * Dominance
|
0.11
|
0.05
|
0.01 - 0.22
|
|
DOSPERT Benefitz * PNI
|
0.08
|
0.06
|
-0.04 - 0.21
|
|
DOSPERT Benefitz * Dominance
|
0.26
|
0.06
|
0.13 - 0.38
|
m_model_5 <- bf(DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + PNI_z + dominance_z + leadership_z + prestige_z)
m_model_6 <- bf(DOSPERT_Benefit_z ~ PNI_z + dominance_z + leadership_z + prestige_z)
Mediation_comparison_3 <- brm(m_model_5 + m_model_6 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", save_pars = save_pars(all = TRUE), cores = parallel::detectCores())
model_blavaan_test <- "
DOSPERT_Likelihood_z ~ DOSPERT_Benefit_z + DOSPERT_Perception_z + PNI_z + dominance_z
DOSPERT_Benefit_z ~ PNI_z + dominance_z
"
fit2 <- sem(model_blavaan_test, data = mediation_dataset)
graph_sem(fit2)
