Experiment_2_demographics$Gender <- as.factor(Experiment_2_demographics$Gender)
demo_table_j <- d2
table1(~ factor(Gender) + Age + Education + Ethnicity + Ethnic_Origin, data = demo_table_j)
| Overall (N=279) |
|
|---|---|
| factor(Gender) | |
| Female | 124 (44.4%) |
| Male | 155 (55.6%) |
| Age | |
| Mean (SD) | 29.5 (9.92) |
| Median [Min, Max] | 26.0 [18.0, 78.0] |
| Education | |
| A-Levels or Equivalent | 64 (22.9%) |
| Doctoral Degree | 4 (1.4%) |
| GCSEs or Equivalent | 17 (6.1%) |
| Prefer not to respond | 4 (1.4%) |
| Primary School | 5 (1.8%) |
| University Post-Graduate Program | 62 (22.2%) |
| University Undergraduate Program | 123 (44.1%) |
| Ethnicity | |
| African | 49 (17.6%) |
| Asian or Asian Scottish or Asian British | 5 (1.8%) |
| Mixed or Multi-ethnic | 7 (2.5%) |
| Other ethnicity | 3 (1.1%) |
| Prefer not to respond | 1 (0.4%) |
| White | 214 (76.7%) |
| Ethnic_Origin | |
| African | 48 (17.2%) |
| Asian | 7 (2.5%) |
| English | 16 (5.7%) |
| European | 193 (69.2%) |
| Latin American | 6 (2.2%) |
| Other | 9 (3.2%) |
Experiment_2_demographics$Gender <- as.factor(Experiment_2_demographics$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
Experiment_2_demographics_Gender$Gender <- as.factor(Experiment_2_demographics_Gender$Gender)
d2 <- Experiment_2_demographics_Gender %>%
mutate_at(vars(locfunc(Experiment_2_demographics_Gender, "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.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
Experiment_2_demographics$Ethnicity <- as.factor(Experiment_2_demographics$Ethnicity)
ggplot(Experiment_2_demographics, 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
Experiment_2_demographics$Ethnic_Origin <- as.factor(Experiment_2_demographics$Ethnic_Origin)
ggplot(Experiment_2_demographics, 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
Experiment_2_demographics$Education <- as.factor(Experiment_2_demographics$Education)
ggplot(Experiment_2_demographics, 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
correlation_df <- Experiment_2_demographics_Gender[, columns_names]
correlation_df$dominance_Sum_z <- Experiment_2_demographics$dominance_Sum_z
correlation_df$prestige_Sum_z <- Experiment_2_demographics$prestige_Sum_z
correlation_df$leadership_Sum_z <- Experiment_2_demographics$leadership_Sum_z
corr_1 <- cor(correlation_df)
saveRDS(corr_1, "corr_1.rds")
corrplot(corr_1, method = "number", type = "lower")
ggcorrplot(corr_1, type = "lower", lab = TRUE)
brm_corr <- brm(mvbind(ethicalPreference_z, financialPreference_z, healthAndSafetyPreference_z, recreationalPreference_z, socialPreference_z, dominance_Sum, prestige_Sum, leadership_Sum, UMSAffiliationSum_z, UMSIntimacySum_z, UMSSum_z, PNI_Sum) ~ 1, data = Experiment_2_demographics_Gender, warmup = 1000, iter = 10000, backend = "cmdstanr", family = student(), cores = parallel::detectCores())
saveRDS(brm_corr, "brm_corr.rds")
summary(brm_corr)
## Warning: Parts of the model have not converged (some Rhats are > 1.05). Be
## careful when analysing the results! We recommend running more iterations and/or
## setting stronger priors.
## Warning: There were 8797 divergent transitions after warmup. Increasing
## adapt_delta above may help. See http://mc-stan.org/misc/warnings.html#divergent-
## transitions-after-warmup
## Family: MV(student, student, student, student, student, student, student, student, student, student, student, student)
## Links: mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## mu = identity; sigma = identity; nu = identity
## Formula: ethicalPreference_z ~ 1
## financialPreference_z ~ 1
## healthAndSafetyPreference_z ~ 1
## recreationalPreference_z ~ 1
## socialPreference_z ~ 1
## dominance_Sum ~ 1
## prestige_Sum ~ 1
## leadership_Sum ~ 1
## UMSAffiliationSum_z ~ 1
## UMSIntimacySum_z ~ 1
## UMSSum_z ~ 1
## PNI_Sum ~ 1
## Data: Experiment_2_demographics_Gender (Number of observations: 279)
## 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 Rhat
## ethicalPreferencez_Intercept -0.12 0.05 -0.17 -0.05 3.04
## financialPreferencez_Intercept -0.08 0.14 -0.28 0.10 3.32
## healthAndSafetyPreferencez_Intercept -0.10 0.08 -0.19 0.03 3.66
## recreationalPreferencez_Intercept -0.01 0.18 -0.16 0.31 3.80
## socialPreferencez_Intercept -0.12 0.08 -0.22 -0.04 3.50
## dominanceSum_Intercept -0.10 0.08 -0.19 0.02 3.47
## prestigeSum_Intercept -0.04 0.11 -0.20 0.11 3.06
## leadershipSum_Intercept -0.10 0.08 -0.20 0.03 3.82
## UMSAffiliationSumz_Intercept -0.09 0.09 -0.18 0.05 3.04
## UMSIntimacySumz_Intercept -0.06 0.08 -0.13 0.08 3.00
## UMSSumz_Intercept -0.07 0.09 -0.16 0.08 2.99
## PNISum_Intercept -0.05 0.06 -0.12 0.03 3.31
## Bulk_ESS Tail_ESS
## ethicalPreferencez_Intercept 5 11
## financialPreferencez_Intercept 4 16
## healthAndSafetyPreferencez_Intercept 4 12
## recreationalPreferencez_Intercept 4 12
## socialPreferencez_Intercept 4 12
## dominanceSum_Intercept 4 11
## prestigeSum_Intercept 5 14
## leadershipSum_Intercept 4 11
## UMSAffiliationSumz_Intercept 5 11
## UMSIntimacySumz_Intercept 5 11
## UMSSumz_Intercept 5 11
## PNISum_Intercept 4 12
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat
## sigma_ethicalPreferencez 0.98 0.12 0.85 1.17 3.29
## sigma_financialPreferencez 1.08 0.20 0.90 1.39 3.40
## sigma_healthAndSafetyPreferencez 0.99 0.10 0.88 1.09 3.13
## sigma_recreationalPreferencez 1.12 0.14 0.96 1.29 3.97
## sigma_socialPreferencez 1.07 0.16 0.91 1.33 2.92
## sigma_dominanceSum 1.04 0.09 0.95 1.18 3.48
## sigma_prestigeSum 1.02 0.14 0.85 1.15 2.43
## sigma_leadershipSum 1.03 0.14 0.89 1.26 3.36
## sigma_UMSAffiliationSumz 1.02 0.15 0.83 1.24 3.82
## sigma_UMSIntimacySumz 0.89 0.11 0.73 1.02 3.57
## sigma_UMSSumz 0.95 0.12 0.78 1.11 3.86
## sigma_PNISum 1.14 0.16 1.02 1.41 3.36
## nu 1.51 0.51 1.06 2.34 3.00
## nu_ethicalPreferencez 1.00 0.00 1.00 1.00 NA
## nu_financialPreferencez 1.00 0.00 1.00 1.00 NA
## nu_healthAndSafetyPreferencez 1.00 0.00 1.00 1.00 NA
## nu_recreationalPreferencez 1.00 0.00 1.00 1.00 NA
## nu_socialPreferencez 1.00 0.00 1.00 1.00 NA
## nu_dominanceSum 1.00 0.00 1.00 1.00 NA
## nu_prestigeSum 1.00 0.00 1.00 1.00 NA
## nu_leadershipSum 1.00 0.00 1.00 1.00 NA
## nu_UMSAffiliationSumz 1.00 0.00 1.00 1.00 NA
## nu_UMSIntimacySumz 1.00 0.00 1.00 1.00 NA
## nu_UMSSumz 1.00 0.00 1.00 1.00 NA
## nu_PNISum 1.00 0.00 1.00 1.00 NA
## Bulk_ESS Tail_ESS
## sigma_ethicalPreferencez 4 11
## sigma_financialPreferencez 4 11
## sigma_healthAndSafetyPreferencez 4 11
## sigma_recreationalPreferencez 4 13
## sigma_socialPreferencez 5 13
## sigma_dominanceSum 4 11
## sigma_prestigeSum 5 22
## sigma_leadershipSum 4 11
## sigma_UMSAffiliationSumz 4 12
## sigma_UMSIntimacySumz 4 11
## sigma_UMSSumz 4 11
## sigma_PNISum 4 11
## nu 5 11
## nu_ethicalPreferencez NA NA
## nu_financialPreferencez NA NA
## nu_healthAndSafetyPreferencez NA NA
## nu_recreationalPreferencez NA NA
## nu_socialPreferencez NA NA
## nu_dominanceSum NA NA
## nu_prestigeSum NA NA
## nu_leadershipSum NA NA
## nu_UMSAffiliationSumz NA NA
## nu_UMSIntimacySumz NA NA
## nu_UMSSumz NA NA
## nu_PNISum NA NA
##
## Residual Correlations:
## Estimate Est.Error
## rescor(ethicalPreferencez,financialPreferencez) 0.35 0.11
## rescor(ethicalPreferencez,healthAndSafetyPreferencez) 0.49 0.11
## rescor(financialPreferencez,healthAndSafetyPreferencez) 0.28 0.12
## rescor(ethicalPreferencez,recreationalPreferencez) 0.26 0.11
## rescor(financialPreferencez,recreationalPreferencez) 0.40 0.13
## rescor(healthAndSafetyPreferencez,recreationalPreferencez) 0.53 0.07
## rescor(ethicalPreferencez,socialPreferencez) 0.11 0.07
## rescor(financialPreferencez,socialPreferencez) 0.29 0.12
## rescor(healthAndSafetyPreferencez,socialPreferencez) 0.31 0.03
## rescor(recreationalPreferencez,socialPreferencez) 0.43 0.02
## rescor(ethicalPreferencez,dominanceSum) 0.31 0.04
## rescor(financialPreferencez,dominanceSum) 0.19 0.13
## rescor(healthAndSafetyPreferencez,dominanceSum) 0.34 0.02
## rescor(recreationalPreferencez,dominanceSum) 0.23 0.07
## rescor(socialPreferencez,dominanceSum) 0.15 0.11
## rescor(ethicalPreferencez,prestigeSum) 0.12 0.09
## rescor(financialPreferencez,prestigeSum) -0.07 0.09
## rescor(healthAndSafetyPreferencez,prestigeSum) -0.06 0.14
## rescor(recreationalPreferencez,prestigeSum) -0.07 0.16
## rescor(socialPreferencez,prestigeSum) 0.21 0.09
## rescor(dominanceSum,prestigeSum) 0.27 0.08
## rescor(ethicalPreferencez,leadershipSum) -0.10 0.07
## rescor(financialPreferencez,leadershipSum) 0.14 0.14
## rescor(healthAndSafetyPreferencez,leadershipSum) 0.00 0.06
## rescor(recreationalPreferencez,leadershipSum) 0.13 0.06
## rescor(socialPreferencez,leadershipSum) 0.32 0.08
## rescor(dominanceSum,leadershipSum) 0.34 0.05
## rescor(prestigeSum,leadershipSum) 0.38 0.06
## rescor(ethicalPreferencez,UMSAffiliationSumz) 0.02 0.09
## rescor(financialPreferencez,UMSAffiliationSumz) -0.06 0.16
## rescor(healthAndSafetyPreferencez,UMSAffiliationSumz) -0.07 0.11
## rescor(recreationalPreferencez,UMSAffiliationSumz) -0.02 0.15
## rescor(socialPreferencez,UMSAffiliationSumz) 0.30 0.11
## rescor(dominanceSum,UMSAffiliationSumz) 0.15 0.09
## rescor(prestigeSum,UMSAffiliationSumz) 0.49 0.10
## rescor(leadershipSum,UMSAffiliationSumz) 0.40 0.05
## rescor(ethicalPreferencez,UMSIntimacySumz) 0.07 0.10
## rescor(financialPreferencez,UMSIntimacySumz) -0.06 0.14
## rescor(healthAndSafetyPreferencez,UMSIntimacySumz) 0.05 0.12
## rescor(recreationalPreferencez,UMSIntimacySumz) 0.07 0.18
## rescor(socialPreferencez,UMSIntimacySumz) 0.33 0.12
## rescor(dominanceSum,UMSIntimacySumz) 0.20 0.07
## rescor(prestigeSum,UMSIntimacySumz) 0.70 0.06
## rescor(leadershipSum,UMSIntimacySumz) 0.50 0.03
## rescor(UMSAffiliationSumz,UMSIntimacySumz) 0.72 0.02
## rescor(ethicalPreferencez,UMSSumz) 0.06 0.10
## rescor(financialPreferencez,UMSSumz) -0.06 0.15
## rescor(healthAndSafetyPreferencez,UMSSumz) 0.02 0.12
## rescor(recreationalPreferencez,UMSSumz) 0.05 0.17
## rescor(socialPreferencez,UMSSumz) 0.34 0.12
## rescor(dominanceSum,UMSSumz) 0.20 0.08
## rescor(prestigeSum,UMSSumz) 0.68 0.08
## rescor(leadershipSum,UMSSumz) 0.50 0.04
## rescor(UMSAffiliationSumz,UMSSumz) 0.85 0.01
## rescor(UMSIntimacySumz,UMSSumz) 0.98 0.00
## rescor(ethicalPreferencez,PNISum) 0.18 0.05
## rescor(financialPreferencez,PNISum) 0.01 0.06
## rescor(healthAndSafetyPreferencez,PNISum) 0.16 0.06
## rescor(recreationalPreferencez,PNISum) 0.10 0.06
## rescor(socialPreferencez,PNISum) 0.27 0.04
## rescor(dominanceSum,PNISum) 0.40 0.08
## rescor(prestigeSum,PNISum) 0.47 0.02
## rescor(leadershipSum,PNISum) 0.27 0.04
## rescor(UMSAffiliationSumz,PNISum) 0.39 0.06
## rescor(UMSIntimacySumz,PNISum) 0.41 0.03
## rescor(UMSSumz,PNISum) 0.43 0.04
## l-95% CI u-95% CI
## rescor(ethicalPreferencez,financialPreferencez) 0.19 0.48
## rescor(ethicalPreferencez,healthAndSafetyPreferencez) 0.31 0.60
## rescor(financialPreferencez,healthAndSafetyPreferencez) 0.14 0.47
## rescor(ethicalPreferencez,recreationalPreferencez) 0.09 0.40
## rescor(financialPreferencez,recreationalPreferencez) 0.25 0.54
## rescor(healthAndSafetyPreferencez,recreationalPreferencez) 0.48 0.64
## rescor(ethicalPreferencez,socialPreferencez) 0.04 0.22
## rescor(financialPreferencez,socialPreferencez) 0.13 0.45
## rescor(healthAndSafetyPreferencez,socialPreferencez) 0.28 0.36
## rescor(recreationalPreferencez,socialPreferencez) 0.42 0.46
## rescor(ethicalPreferencez,dominanceSum) 0.27 0.36
## rescor(financialPreferencez,dominanceSum) 0.01 0.39
## rescor(healthAndSafetyPreferencez,dominanceSum) 0.32 0.37
## rescor(recreationalPreferencez,dominanceSum) 0.14 0.35
## rescor(socialPreferencez,dominanceSum) 0.03 0.28
## rescor(ethicalPreferencez,prestigeSum) 0.02 0.22
## rescor(financialPreferencez,prestigeSum) -0.20 0.04
## rescor(healthAndSafetyPreferencez,prestigeSum) -0.31 0.07
## rescor(recreationalPreferencez,prestigeSum) -0.32 0.12
## rescor(socialPreferencez,prestigeSum) 0.06 0.28
## rescor(dominanceSum,prestigeSum) 0.19 0.39
## rescor(ethicalPreferencez,leadershipSum) -0.19 -0.02
## rescor(financialPreferencez,leadershipSum) -0.04 0.35
## rescor(healthAndSafetyPreferencez,leadershipSum) -0.07 0.09
## rescor(recreationalPreferencez,leadershipSum) 0.02 0.18
## rescor(socialPreferencez,leadershipSum) 0.22 0.43
## rescor(dominanceSum,leadershipSum) 0.26 0.40
## rescor(prestigeSum,leadershipSum) 0.28 0.44
## rescor(ethicalPreferencez,UMSAffiliationSumz) -0.09 0.12
## rescor(financialPreferencez,UMSAffiliationSumz) -0.25 0.17
## rescor(healthAndSafetyPreferencez,UMSAffiliationSumz) -0.24 0.08
## rescor(recreationalPreferencez,UMSAffiliationSumz) -0.26 0.14
## rescor(socialPreferencez,UMSAffiliationSumz) 0.17 0.47
## rescor(dominanceSum,UMSAffiliationSumz) 0.03 0.24
## rescor(prestigeSum,UMSAffiliationSumz) 0.33 0.59
## rescor(leadershipSum,UMSAffiliationSumz) 0.33 0.48
## rescor(ethicalPreferencez,UMSIntimacySumz) -0.04 0.19
## rescor(financialPreferencez,UMSIntimacySumz) -0.26 0.12
## rescor(healthAndSafetyPreferencez,UMSIntimacySumz) -0.15 0.15
## rescor(recreationalPreferencez,UMSIntimacySumz) -0.23 0.20
## rescor(socialPreferencez,UMSIntimacySumz) 0.17 0.50
## rescor(dominanceSum,UMSIntimacySumz) 0.11 0.31
## rescor(prestigeSum,UMSIntimacySumz) 0.61 0.75
## rescor(leadershipSum,UMSIntimacySumz) 0.46 0.53
## rescor(UMSAffiliationSumz,UMSIntimacySumz) 0.69 0.75
## rescor(ethicalPreferencez,UMSSumz) -0.06 0.18
## rescor(financialPreferencez,UMSSumz) -0.27 0.15
## rescor(healthAndSafetyPreferencez,UMSSumz) -0.18 0.14
## rescor(recreationalPreferencez,UMSSumz) -0.25 0.18
## rescor(socialPreferencez,UMSSumz) 0.18 0.52
## rescor(dominanceSum,UMSSumz) 0.09 0.31
## rescor(prestigeSum,UMSSumz) 0.56 0.74
## rescor(leadershipSum,UMSSumz) 0.44 0.53
## rescor(UMSAffiliationSumz,UMSSumz) 0.84 0.87
## rescor(UMSIntimacySumz,UMSSumz) 0.98 0.98
## rescor(ethicalPreferencez,PNISum) 0.13 0.24
## rescor(financialPreferencez,PNISum) -0.06 0.09
## rescor(healthAndSafetyPreferencez,PNISum) 0.07 0.22
## rescor(recreationalPreferencez,PNISum) -0.01 0.16
## rescor(socialPreferencez,PNISum) 0.20 0.31
## rescor(dominanceSum,PNISum) 0.27 0.47
## rescor(prestigeSum,PNISum) 0.44 0.50
## rescor(leadershipSum,PNISum) 0.22 0.31
## rescor(UMSAffiliationSumz,PNISum) 0.31 0.48
## rescor(UMSIntimacySumz,PNISum) 0.38 0.45
## rescor(UMSSumz,PNISum) 0.39 0.49
## Rhat Bulk_ESS
## rescor(ethicalPreferencez,financialPreferencez) 3.02 5
## rescor(ethicalPreferencez,healthAndSafetyPreferencez) 2.94 5
## rescor(financialPreferencez,healthAndSafetyPreferencez) 3.26 4
## rescor(ethicalPreferencez,recreationalPreferencez) 3.48 4
## rescor(financialPreferencez,recreationalPreferencez) 2.97 5
## rescor(healthAndSafetyPreferencez,recreationalPreferencez) 2.99 5
## rescor(ethicalPreferencez,socialPreferencez) 3.59 4
## rescor(financialPreferencez,socialPreferencez) 3.08 5
## rescor(healthAndSafetyPreferencez,socialPreferencez) 3.60 4
## rescor(recreationalPreferencez,socialPreferencez) 3.31 4
## rescor(ethicalPreferencez,dominanceSum) 3.47 4
## rescor(financialPreferencez,dominanceSum) 3.40 4
## rescor(healthAndSafetyPreferencez,dominanceSum) 3.01 5
## rescor(recreationalPreferencez,dominanceSum) 3.42 4
## rescor(socialPreferencez,dominanceSum) 3.40 4
## rescor(ethicalPreferencez,prestigeSum) 3.22 4
## rescor(financialPreferencez,prestigeSum) 3.00 5
## rescor(healthAndSafetyPreferencez,prestigeSum) 3.11 5
## rescor(recreationalPreferencez,prestigeSum) 3.50 4
## rescor(socialPreferencez,prestigeSum) 3.44 4
## rescor(dominanceSum,prestigeSum) 3.17 5
## rescor(ethicalPreferencez,leadershipSum) 3.19 5
## rescor(financialPreferencez,leadershipSum) 3.71 4
## rescor(healthAndSafetyPreferencez,leadershipSum) 3.48 4
## rescor(recreationalPreferencez,leadershipSum) 3.39 4
## rescor(socialPreferencez,leadershipSum) 3.47 4
## rescor(dominanceSum,leadershipSum) 2.86 5
## rescor(prestigeSum,leadershipSum) 3.50 4
## rescor(ethicalPreferencez,UMSAffiliationSumz) 2.88 5
## rescor(financialPreferencez,UMSAffiliationSumz) 3.17 4
## rescor(healthAndSafetyPreferencez,UMSAffiliationSumz) 3.30 4
## rescor(recreationalPreferencez,UMSAffiliationSumz) 2.92 5
## rescor(socialPreferencez,UMSAffiliationSumz) 3.13 4
## rescor(dominanceSum,UMSAffiliationSumz) 3.29 4
## rescor(prestigeSum,UMSAffiliationSumz) 3.22 4
## rescor(leadershipSum,UMSAffiliationSumz) 3.93 4
## rescor(ethicalPreferencez,UMSIntimacySumz) 3.58 4
## rescor(financialPreferencez,UMSIntimacySumz) 2.93 5
## rescor(healthAndSafetyPreferencez,UMSIntimacySumz) 3.11 5
## rescor(recreationalPreferencez,UMSIntimacySumz) 3.21 4
## rescor(socialPreferencez,UMSIntimacySumz) 3.40 4
## rescor(dominanceSum,UMSIntimacySumz) 3.05 5
## rescor(prestigeSum,UMSIntimacySumz) 3.91 4
## rescor(leadershipSum,UMSIntimacySumz) 3.38 4
## rescor(UMSAffiliationSumz,UMSIntimacySumz) 3.01 5
## rescor(ethicalPreferencez,UMSSumz) 3.44 4
## rescor(financialPreferencez,UMSSumz) 2.94 5
## rescor(healthAndSafetyPreferencez,UMSSumz) 3.06 5
## rescor(recreationalPreferencez,UMSSumz) 3.00 5
## rescor(socialPreferencez,UMSSumz) 3.47 4
## rescor(dominanceSum,UMSSumz) 3.14 5
## rescor(prestigeSum,UMSSumz) 3.36 4
## rescor(leadershipSum,UMSSumz) 3.17 4
## rescor(UMSAffiliationSumz,UMSSumz) 2.90 5
## rescor(UMSIntimacySumz,UMSSumz) 3.23 4
## rescor(ethicalPreferencez,PNISum) 3.35 4
## rescor(financialPreferencez,PNISum) 2.89 5
## rescor(healthAndSafetyPreferencez,PNISum) 3.64 4
## rescor(recreationalPreferencez,PNISum) 3.12 4
## rescor(socialPreferencez,PNISum) 2.88 5
## rescor(dominanceSum,PNISum) 3.27 4
## rescor(prestigeSum,PNISum) 3.47 4
## rescor(leadershipSum,PNISum) 2.95 5
## rescor(UMSAffiliationSumz,PNISum) 3.04 5
## rescor(UMSIntimacySumz,PNISum) 3.11 4
## rescor(UMSSumz,PNISum) 3.25 4
## Tail_ESS
## rescor(ethicalPreferencez,financialPreferencez) 12
## rescor(ethicalPreferencez,healthAndSafetyPreferencez) 16
## rescor(financialPreferencez,healthAndSafetyPreferencez) 13
## rescor(ethicalPreferencez,recreationalPreferencez) 11
## rescor(financialPreferencez,recreationalPreferencez) 14
## rescor(healthAndSafetyPreferencez,recreationalPreferencez) 11
## rescor(ethicalPreferencez,socialPreferencez) 14
## rescor(financialPreferencez,socialPreferencez) 23
## rescor(healthAndSafetyPreferencez,socialPreferencez) 11
## rescor(recreationalPreferencez,socialPreferencez) 11
## rescor(ethicalPreferencez,dominanceSum) 11
## rescor(financialPreferencez,dominanceSum) 11
## rescor(healthAndSafetyPreferencez,dominanceSum) 14
## rescor(recreationalPreferencez,dominanceSum) 11
## rescor(socialPreferencez,dominanceSum) 11
## rescor(ethicalPreferencez,prestigeSum) 19
## rescor(financialPreferencez,prestigeSum) 13
## rescor(healthAndSafetyPreferencez,prestigeSum) 15
## rescor(recreationalPreferencez,prestigeSum) 12
## rescor(socialPreferencez,prestigeSum) 15
## rescor(dominanceSum,prestigeSum) 12
## rescor(ethicalPreferencez,leadershipSum) 13
## rescor(financialPreferencez,leadershipSum) 14
## rescor(healthAndSafetyPreferencez,leadershipSum) 14
## rescor(recreationalPreferencez,leadershipSum) 11
## rescor(socialPreferencez,leadershipSum) 11
## rescor(dominanceSum,leadershipSum) 24
## rescor(prestigeSum,leadershipSum) 14
## rescor(ethicalPreferencez,UMSAffiliationSumz) 23
## rescor(financialPreferencez,UMSAffiliationSumz) 16
## rescor(healthAndSafetyPreferencez,UMSAffiliationSumz) 11
## rescor(recreationalPreferencez,UMSAffiliationSumz) 20
## rescor(socialPreferencez,UMSAffiliationSumz) 20
## rescor(dominanceSum,UMSAffiliationSumz) 11
## rescor(prestigeSum,UMSAffiliationSumz) 13
## rescor(leadershipSum,UMSAffiliationSumz) 11
## rescor(ethicalPreferencez,UMSIntimacySumz) 11
## rescor(financialPreferencez,UMSIntimacySumz) 28
## rescor(healthAndSafetyPreferencez,UMSIntimacySumz) 11
## rescor(recreationalPreferencez,UMSIntimacySumz) 11
## rescor(socialPreferencez,UMSIntimacySumz) 11
## rescor(dominanceSum,UMSIntimacySumz) 11
## rescor(prestigeSum,UMSIntimacySumz) 11
## rescor(leadershipSum,UMSIntimacySumz) 12
## rescor(UMSAffiliationSumz,UMSIntimacySumz) 13
## rescor(ethicalPreferencez,UMSSumz) 11
## rescor(financialPreferencez,UMSSumz) 27
## rescor(healthAndSafetyPreferencez,UMSSumz) 15
## rescor(recreationalPreferencez,UMSSumz) 17
## rescor(socialPreferencez,UMSSumz) 11
## rescor(dominanceSum,UMSSumz) 11
## rescor(prestigeSum,UMSSumz) 11
## rescor(leadershipSum,UMSSumz) 11
## rescor(UMSAffiliationSumz,UMSSumz) 29
## rescor(UMSIntimacySumz,UMSSumz) 11
## rescor(ethicalPreferencez,PNISum) 11
## rescor(financialPreferencez,PNISum) 30
## rescor(healthAndSafetyPreferencez,PNISum) 12
## rescor(recreationalPreferencez,PNISum) 16
## rescor(socialPreferencez,PNISum) 20
## rescor(dominanceSum,PNISum) 11
## rescor(prestigeSum,PNISum) 11
## rescor(leadershipSum,PNISum) 13
## rescor(UMSAffiliationSumz,PNISum) 11
## rescor(UMSIntimacySumz,PNISum) 11
## rescor(UMSSumz,PNISum) 11
##
## 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).
## B-PNI distribution
B_PNI_1 <- ggplot(Experiment_2_demographics, aes(x = Age, y = PNI_Sum)) +
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
riska <- lm(riskBenefitSum ~ riskSum, data = Experiment_2_demographics)
riskb <- lm(riskBenefitSum ~ riskPerceptionSum, data = Experiment_2_demographics)
Experiment_2_demographics$generalRiskPreference <- (Experiment_2_J_Analysis[, "riskBenefitSum"] * riska$coefficients[2]) + (Experiment_2_J_Analysis[, "riskPerceptionSum"] * riskb$coefficients[2])
Experiment_2_demographics_Gender$generalExpectedBenefits <- (Experiment_2_J_Analysis[, "riskBenefitSum"] * riska$coefficients[2])
Experiment_2_demographics_Gender$generalPerceievedRisk <- (Experiment_2_J_Analysis[, "riskPerceptionSum"] * riskb$coefficients[2])
Experiment_2_demographics_Gender$riskBenefitSum_z <- scale(Experiment_2_demographics_Gender$riskBenefitSum)
Experiment_2_demographics_Gender$generalRiskPreference_z <- scale(Experiment_2_demographics$generalRiskPreference)
Experiment_2_demographics_Gender$generalExpectedBenefits_z <- scale(Experiment_2_demographics$generalExpectedBenefits)
Experiment_2_demographics_Gender$generalPerceievedRisk_z <- scale(Experiment_2_demographics$generalPerceievedRisk)
Experiment_2_demographics$UMSSum_z <- scale(Experiment_2_demographics$UMSSum)
Experiment_2_demographics$UMSAffiliationSum_z <- scale(Experiment_2_demographics$UMSAffiliationSum)
Experiment_2_demographics$UMSIntimacySum_z <- scale(Experiment_2_demographics$UMSIntimacySum)
Experiment_2_demographics_Gender <- Experiment_2_demographics[!(Experiment_2_demographics$Gender == "3" | Experiment_2_demographics$Gender == "6"), ]
m1 <- brm(generalRiskPreference_z ~ dominance_Sum * Gender + prestige_Sum * Gender + leadership_Sum * Gender + PNI_Sum * Gender + Age, data = Experiment_2_demographics_Gender, warmup = 1000, iter = 10000, prior = prior_m1_interaction_gen, save_pars = save_pars(all = T))
saveRDS(m1, "m1.rds")
m1_fixef <- MutateHDI::mutate_each_hdi_no_save(brms::fixef(m1))
kable(m1_fixef[
sign_match(m1_fixef[, 4]) == sign_match(m1_fixef[, 5]),
c("Parameter", "Estimate", "CI", "CI Low", "CI High")
], format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
| Parameter | Estimate | CI | CI Low | CI High |
|---|---|---|---|---|
| Dominance | 0.83 | 0.95 | 0.32 | 1.35 |
| Prestige | 1.6 | 0.95 | 1.14 | 2.07 |
| Leadership | -3.77 | 0.95 | -3.85 | -3.69 |
| Prestige : Gender | -1.67 | 0.95 | -2.29 | -1.04 |
| Leadership : Gender | 3.71 | 0.95 | 3.3 | 4.12 |
m2 <- brm(mvbind(riskSum_z, riskBenefitSum_z, riskPerceptionSum_z) ~ dominance_Sum + prestige_Sum + leadership_Sum + PNI_Sum + Gender + Age, data = Experiment_2_demographics_Gender, 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(brms::fixef(m2))
kable(m2_fixef[
sign_match(m2_fixef[, 4]) == sign_match(m2_fixef[, 5]),
c("Parameter", "Estimate", "CI", "CI Low", "CI High")
], format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
| Parameter | Estimate | CI | CI Low | CI High |
|---|---|---|---|---|
| Risk Benefit * Intercept | 0.51 | 0.95 | 0.12 | 0.89 |
| Risk Perception * Intercept | 1.16 | 0.95 | 0.93 | 1.39 |
| Risk * Dominance | 0.27 | 0.95 | 0.14 | 0.39 |
| Risk * Gender | 0.27 | 0.95 | 0.05 | 0.48 |
| Risk Benefit * Dominance | 0.22 | 0.95 | 0.1 | 0.35 |
| Risk Benefit * Age | -0.02 | 0.95 | -0.03 | -0.01 |
| Risk Perception * Dominance | -0.27 | 0.95 | -0.42 | -0.13 |
| Risk Perception * Leadership | 0.15 | 0.95 | 0.02 | 0.29 |
| Risk Perception * Gender | -0.35 | 0.95 | -0.56 | -0.14 |
| Risk Perception * Age | -0.03 | 0.95 | -0.04 | -0.03 |
m2_interaction_gender <- brm(mvbind(riskSum_z, riskBenefitSum_z, riskPerceptionSum_z) ~ dominance_Sum * Gender + prestige_Sum * Gender + leadership_Sum * Gender + PNI_Sum * Gender + Age, data = Experiment_2_demographics_Gender, 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(brms::fixef(m2_interaction_gender))
kable(m2_interaction_gender_fixef[
sign_match(m2_interaction_gender_fixef[, 4]) == sign_match(m2_interaction_gender_fixef[, 5]),
c("Parameter", "Estimate", "CI", "CI Low", "CI High")
], format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
| Parameter | Estimate | CI | CI Low | CI High |
|---|---|---|---|---|
| Risk Benefit * Intercept | 0.47 | 0.95 | 0.08 | 0.86 |
| Risk Perception * Intercept | 1.19 | 0.95 | 0.96 | 1.42 |
| Risk * Dominance | 0.25 | 0.95 | 0.04 | 0.45 |
| Risk * Gender | 0.27 | 0.95 | 0.05 | 0.49 |
| Risk Benefit * Age | -0.02 | 0.95 | -0.03 | -0.01 |
| Risk Perception * Gender | -0.36 | 0.95 | -0.57 | -0.15 |
| Risk Perception * Age | -0.03 | 0.95 | -0.04 | -0.03 |
m3 <- brm(mvbind(ethicalPreference_z, financialPreference_z, healthAndSafetyPreference_z, recreationalPreference_z, socialPreference_z) ~ dominance_Sum + prestige_Sum + leadership_Sum + PNI_Sum + Gender + Age, data = Experiment_2_demographics_Gender, 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(brms::fixef(m3))
kable(m3_fixef[
sign_match(m3_fixef[, 4]) == sign_match(m3_fixef[, 5]),
c("Parameter", "Estimate", "CI", "CI Low", "CI High")
], format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
| Parameter | Estimate | CI | CI Low | CI High |
|---|---|---|---|---|
| Ethical Preferencez * Intercept | 0.42 | 0.95 | 0.06 | 0.79 |
| Health and Safety Preferencez * Intercept | 0.48 | 0.95 | 0.1 | 0.86 |
| Recreational Preferencez * Intercept | 0.71 | 0.95 | 0.33 | 1.09 |
| Social Preferencez * Intercept | 0.67 | 0.95 | 0.31 | 1.03 |
| Ethical Preferencez * Dominance | 0.31 | 0.95 | 0.19 | 0.44 |
| Ethical Preferencez * Leadership | -0.18 | 0.95 | -0.3 | -0.06 |
| Ethical Preferencez * Gender | 0.27 | 0.95 | 0.06 | 0.49 |
| Ethical Preferencez * Age | -0.02 | 0.95 | -0.03 | -0.01 |
| Health and Safety Preferencez * Dominance | 0.27 | 0.95 | 0.14 | 0.41 |
| Health and Safety Preferencez * Prestige | -0.26 | 0.95 | -0.39 | -0.13 |
| Health and Safety Preferencez * Age | -0.02 | 0.95 | -0.03 | -0.01 |
| Recreational Preferencez * Dominance | 0.15 | 0.95 | 0.02 | 0.28 |
| Recreational Preferencez * Prestige | -0.28 | 0.95 | -0.4 | -0.16 |
| Recreational Preferencez * Leadership | 0.17 | 0.95 | 0.05 | 0.3 |
| Recreational Preferencez * Age | -0.03 | 0.95 | -0.04 | -0.02 |
| Social Preferencez * Leadership | 0.27 | 0.95 | 0.14 | 0.39 |
| Social Preferencez * PNI | 0.17 | 0.95 | 0.04 | 0.3 |
| Social Preferencez * Gender | -0.44 | 0.95 | -0.65 | -0.22 |
m3_interaction_gender <- brm(mvbind(ethicalPreference_z, financialPreference_z, healthAndSafetyPreference_z, recreationalPreference_z, socialPreference_z) ~ dominance_Sum * Gender + prestige_Sum * Gender + leadership_Sum * Gender + PNI_Sum * Gender + Age, data = Experiment_2_demographics_Gender, 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(brms::fixef(m3_interaction_gender))
kable(m3_interaction_gender_fixef[
sign_match(m3_interaction_gender_fixef[, 4]) == sign_match(m3_interaction_gender_fixef[, 5]),
c("Parameter", "Estimate", "CI", "CI Low", "CI High")
], format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>%
kable_styling(full_width = T) %>%
remove_column(1)
| Parameter | Estimate | CI | CI Low | CI High |
|---|---|---|---|---|
| Ethical Preferencez * Intercept | 0.4 | 0.95 | 0.03 | 0.77 |
| Health and Safety Preferencez * Intercept | 0.42 | 0.95 | 0.03 | 0.81 |
| Recreational Preferencez * Intercept | 0.66 | 0.95 | 0.27 | 1.04 |
| Social Preferencez * Intercept | 0.63 | 0.95 | 0.26 | 1.01 |
| Ethical Preferencez * Dominance | 0.23 | 0.95 | 0.03 | 0.43 |
| Ethical Preferencez * Gender | 0.28 | 0.95 | 0.07 | 0.5 |
| Ethical Preferencez * Age | -0.02 | 0.95 | -0.03 | -0.01 |
| Health and Safety Preferencez * Prestige | -0.44 | 0.95 | -0.63 | -0.24 |
| Health and Safety Preferencez * PNI | 0.27 | 0.95 | 0.05 | 0.49 |
| Health and Safety Preferencez * Prestige : Gender | 0.32 | 0.95 | 0.06 | 0.58 |
| Health and Safety Preferencez * Gender: PNI | -0.29 | 0.95 | -0.56 | -0.02 |
| Recreational Preferencez * Gender | 0.23 | 0.95 | 0.01 | 0.45 |
| Recreational Preferencez * Prestige | -0.41 | 0.95 | -0.57 | -0.24 |
| Recreational Preferencez * PNI | 0.31 | 0.95 | 0.1 | 0.53 |
| Recreational Preferencez * Age | -0.03 | 0.95 | -0.04 | -0.02 |
| Recreational Preferencez * Gender: PNI | -0.47 | 0.95 | -0.74 | -0.2 |
| Social Preferencez * Gender | -0.43 | 0.95 | -0.65 | -0.21 |
| Social Preferencez * Leadership | 0.24 | 0.95 | 0.05 | 0.42 |
| Social Preferencez * PNI | 0.24 | 0.95 | 0.03 | 0.45 |
mediation_model.1 <- bf(riskSum_z ~ riskBenefitSum_z + riskPerceptionSum_z + PNI_Sum)
mediation_model.2 <- bf(riskBenefitSum_z ~ riskSum_z + riskPerceptionSum_z + PNI_Sum)
mediation_model_1 <- brm(mediation_model.1 + mediation_model.2 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", save_pars = save_pars(all = TRUE))
mediation_model.3 <- bf(riskSum_z ~ riskBenefitSum_z + riskPerceptionSum_z + dominance_Sum)
mediation_model.4 <- bf(riskBenefitSum_z ~ riskSum_z + riskPerceptionSum_z + dominance_Sum)
mediation_model_2 <- brm(mediation_model.3 + mediation_model.4 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", save_pars = save_pars(all = TRUE))
mediation_model.5 <- bf(riskSum_z ~ riskBenefitSum_z + riskPerceptionSum_z + prestige_Sum)
mediation_model.6 <- bf(riskBenefitSum_z ~ riskSum_z + riskPerceptionSum_z + prestige_Sum)
mediation_model_3 <- brm(mediation_model.5 + mediation_model.6 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", save_pars = save_pars(all = TRUE))
mediation_model.7 <- bf(riskSum_z ~ riskBenefitSum_z + riskPerceptionSum_z + leadership_Sum)
mediation_model.8 <- bf(riskBenefitSum_z ~ riskSum_z + riskPerceptionSum_z + leadership_Sum)
mediation_model_4 <- brm(mediation_model.7 + mediation_model.8 + set_rescor(FALSE), warmup = 1000, iter = 10000, data = mediation_dataset, backend = "cmdstanr", 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 279 log-likelihood matrix
##
## Estimate SE
## elpd_loo -668.7 23.7
## p_loo 11.8 1.6
## looic 1337.4 47.5
## ------
## 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 279 log-likelihood matrix
##
## Estimate SE
## elpd_loo -667.7 23.3
## p_loo 11.5 1.5
## looic 1335.5 46.6
## ------
## 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 279 log-likelihood matrix
##
## Estimate SE
## elpd_loo -670.6 23.5
## p_loo 11.8 1.5
## looic 1341.2 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_4':
##
## Computed from 36000 by 279 log-likelihood matrix
##
## Estimate SE
## elpd_loo -673.7 24.1
## p_loo 11.7 1.5
## looic 1347.4 48.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.
##
## Model comparisons:
## elpd_diff se_diff
## mediation_model_2 0.0 0.0
## mediation_model_1 -1.0 3.1
## mediation_model_3 -2.9 4.4
## mediation_model_4 -6.0 3.0
mediation_comparison
## Bayes Factors for Model Comparison
##
## Model BF
## [1] 143.56
## [2] 354.27
## [3] 21.71
##
## * Against Denominator: [4]
## * Bayes Factor Type: marginal likelihoods (bridgesampling)