Analysis

Demographics Section

Demographic table

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%)

Gender

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

Age

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.

Ethnicity

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

Ethnic Origin

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

Education

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

Analysis

General Correlation

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)

brms Correlation

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 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 Interaction model

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 Additive Model with DoPL and DOSPERT + PNI

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

Additive Model with DoPL and DOSPERT + PNI Gender Interaction

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

DOSPERT and DoPL and PNI

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 DOSPERT, DoPL, and PNI

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

Mediation Model attempt

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)