Power motivations and sexual risk-taking

Show the code

/* APA Style */

.table>thead>tr>th {
 border-color: black;
}


/** Remove borders within the table body **/
.table>tbody>tr>td {
 border: none;
}


/** Add a top border to the table header row **/
.table thead tr:first-child {
 border-top: 2px solid black;
}


/** Add a bottom border to the table body **/
.table tbody tr:last-child {
 border-bottom: 2px solid black;
}


/** Make the table header row a normal weight; not bold **/
.table th {
 font-weight: normal;
}


/** Make the caption italic and black **/
.table caption {
 font-style: italic;
 color: black;
}

Show the code

library(papaja)
library(xtable)
library(tidyr)
library(purrr)
library(ggplot2)
library(brms)
library(bayestestR)
library(rstan)
library(readxl)
library(sjPlot)
library(cmdstanr)
library(plotly)
library(corrplot)
library(htmlwidgets)
library(bayestestR)
library(formatR)
library(kableExtra)
library(tidybayes)
library(blavaan)
library(rmarkdown)
library(tidySEM)
library(ggcorrplot)
library(ggprism)
library(htmlTable)
library(table1)
library(data.table)
library(semPlot)
library(correlation)
library(dplyr)
library(lavaan)
library(dplyr)
library(tibble)
library(stringi)
library(tidyr)
library(kableExtra)
library(rrtable)
library(sjPlot)
library(purrr)
library(stringi)
library(ggplot2)
library(tidyverse)
setwd("/Users/andrew/Documents/1_UoE/Research/PhD/Experiments/DoPL/Experiments/Experiment_2_Study_Past_Sexual_Experiences")
Experiment_4_DF_Final <- read.csv("./Analysis/Experiment_4_DF_Final.csv")
source("./Analysis/Question_index.R")
Experiment_4_DF_Final$Gender <- as.factor(Experiment_4_DF_Final$Gender)
load("Experiment_4_Analysis.RData")
analysis_df <- MutateColumns::column_standardize(dataframe = analysis_df, search_phrase_1 = "SRTB_", search_phrase_2 = "DoPL_", search_phrase_3 = "\\bsum\\b", replace_text_1 = "SRTB_Risk_", replace_text_2 = "", replace_text_3 = "DoPL_sum")

Results

Gender

Show the code

Experiment_4_DF_Final$Gender <- as.factor(Experiment_4_DF_Final$Gender)
analysis_df <- Experiment_4_DF_Final[!grepl(5, Experiment_4_DF_Final$Gender), ]
ggplot(analysis_df, aes(x = Gender, fill = Gender)) +
  geom_histogram(stat = "count") +
  labs(x = "Gender") +
 scale_x_discrete(labels = c("Male", "Female"), guide = "prism_offset") +
  scale_y_continuous(breaks = seq(0, 100, 10), guide = "prism_offset") +
  theme_apa()

Analysis Priors

Show the code

m1_prior <- c(
# SRTB Risk
prior(normal(0.01, 0.005), coef = "Age", resp = "SRTBRiskPerception"), 
prior(normal(-.5, .09), coef = "Dominance", resp = "SRTBRiskPerception"), 
prior(normal(0.11, 0.05), coef = "Leadership", resp = "SRTBRiskPerception"), 
prior(normal(0.07, 0.06), coef = "Prestige", resp = "SRTBRiskPerception"), 
prior(normal(.01, .05), coef = "Gender2", resp = "SRTBRiskPerception"), 
prior(normal(0.15, 0.07), coef = "B_PNI", resp = "SRTBRiskPerception"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskPerception"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskPerception"), 

# SRTB Benefit
prior(normal(-0.02, 0.003), coef = "Age", resp = "SRTBRiskBenefit"), 
prior(normal(.5, .05), coef = "Dominance", resp = "SRTBRiskBenefit"), 
prior(normal(0, 0.05), coef = "Leadership", resp = "SRTBRiskBenefit"), 
prior(normal(-0.02, 0.05), coef = "Prestige", resp = "SRTBRiskBenefit"), 
prior(normal(-0.18, 0.09), coef = "Gender2", resp = "SRTBRiskBenefit"), 
prior(normal(0, 0.07), coef = "B_PNI", resp = "SRTBRiskBenefit"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskBenefit"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskBenefit"), 

# SRTB Frequency
prior(normal(-0.01, 0.005), coef = "Age", resp = "SRTBRiskFrequency"), 
prior(normal(.34, .05), coef = "Dominance", resp = "SRTBRiskFrequency"), 
prior(normal(-0.06, 0.05), coef = "Leadership", resp = "SRTBRiskFrequency"), 
prior(normal(0.10, 0.05), coef = "Prestige", resp = "SRTBRiskFrequency"), 
prior(normal(-0.15, 0.09), coef = "Gender2", resp = "SRTBRiskFrequency"), 
prior(normal(0.04, 0.05), coef = "B_PNI", resp = "SRTBRiskFrequency"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskFrequency"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskFrequency"),

# SRTB Likelihood
prior(normal(-0.01, 0.005), coef = "Age", resp = "SRTBRiskLikelihood"), 
prior(normal(.34, .05), coef = "Dominance", resp = "SRTBRiskLikelihood"), 
prior(normal(-0.06, 0.05), coef = "Leadership", resp = "SRTBRiskLikelihood"), 
prior(normal(0.10, 0.05), coef = "Prestige", resp = "SRTBRiskLikelihood"), 
prior(normal(-0.15, 0.09), coef = "Gender2", resp = "SRTBRiskLikelihood"), 
prior(normal(0.04, 0.05), coef = "B_PNI", resp = "SRTBRiskLikelihood"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskLikelihood"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskLikelihood")
)

m1_interaction_prior <- c(
 # SRTB Risk
prior(normal(0.01, 0.005), coef = "Age", resp = "SRTBRiskPerception"), 
prior(normal(-.5, .09), coef = "Dominance", resp = "SRTBRiskPerception"), 
prior(normal(0.11, 0.05), coef = "Leadership", resp = "SRTBRiskPerception"), 
prior(normal(0.07, 0.06), coef = "Prestige", resp = "SRTBRiskPerception"), 
prior(normal(.01, .05), coef = "Gender2", resp = "SRTBRiskPerception"), 
prior(normal(0.15, 0.07), coef = "B_PNI", resp = "SRTBRiskPerception"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskPerception"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskPerception"), 
 prior(normal(.5, .02), coef = "Dominance:Gender2", resp = "SRTBRiskPerception"),
 prior(normal(0, 1), coef = "Gender2:Leadership", resp = "SRTBRiskPerception"),
 prior(normal(0, 1), coef = "Gender2:Prestige", resp = "SRTBRiskPerception"),
 prior(normal(0, 1), coef = "Gender2:B_PNI", resp = "SRTBRiskPerception"),

 # SRTB Benefit
prior(normal(-0.02, 0.003), coef = "Age", resp = "SRTBRiskBenefit"), 
prior(normal(.5, .05), coef = "Dominance", resp = "SRTBRiskBenefit"), 
prior(normal(0, 0.05), coef = "Leadership", resp = "SRTBRiskBenefit"), 
prior(normal(-0.02, 0.05), coef = "Prestige", resp = "SRTBRiskBenefit"), 
prior(normal(-0.18, 0.09), coef = "Gender2", resp = "SRTBRiskBenefit"), 
prior(normal(0, 0.07), coef = "B_PNI", resp = "SRTBRiskBenefit"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskBenefit"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskBenefit"), 
prior(normal(.5, .02), coef = "Dominance:Gender2", resp = "SRTBRiskBenefit"),
 prior(normal(0, 1), coef = "Gender2:Leadership", resp = "SRTBRiskBenefit"),
 prior(normal(0, 1), coef = "Gender2:Prestige", resp = "SRTBRiskBenefit"),
 prior(normal(0, 1), coef = "Gender2:B_PNI", resp = "SRTBRiskBenefit"),
 # SRTB Frequency
prior(normal(-0.01, 0.005), coef = "Age", resp = "SRTBRiskFrequency"), 
prior(normal(.34, .05), coef = "Dominance", resp = "SRTBRiskFrequency"), 
prior(normal(-0.06, 0.05), coef = "Leadership", resp = "SRTBRiskFrequency"), 
prior(normal(0.10, 0.05), coef = "Prestige", resp = "SRTBRiskFrequency"), 
prior(normal(-0.15, 0.09), coef = "Gender2", resp = "SRTBRiskFrequency"), 
prior(normal(0.04, 0.05), coef = "B_PNI", resp = "SRTBRiskFrequency"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskFrequency"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskFrequency"),
prior(normal(.5, .02), coef = "Dominance:Gender2", resp = "SRTBRiskFrequency"),
 prior(normal(0, 1), coef = "Gender2:Leadership", resp = "SRTBRiskFrequency"),
 prior(normal(0, 1), coef = "Gender2:Prestige", resp = "SRTBRiskFrequency"),
 prior(normal(0, 1), coef = "Gender2:B_PNI", resp = "SRTBRiskFrequency"),
 # SRTB Likelihood
prior(normal(-0.01, 0.005), coef = "Age", resp = "SRTBRiskLikelihood"), 
prior(normal(.34, .05), coef = "Dominance", resp = "SRTBRiskLikelihood"), 
prior(normal(-0.06, 0.05), coef = "Leadership", resp = "SRTBRiskLikelihood"), 
prior(normal(0.10, 0.05), coef = "Prestige", resp = "SRTBRiskLikelihood"), 
prior(normal(-0.15, 0.09), coef = "Gender2", resp = "SRTBRiskLikelihood"), 
prior(normal(0.04, 0.05), coef = "B_PNI", resp = "SRTBRiskLikelihood"), 
prior(normal(0, 1), class = "Intercept", resp = "SRTBRiskLikelihood"), 
prior(normal(0, 1), class = "sigma", resp = "SRTBRiskLikelihood"),
 prior(normal(.5, .02), coef = "Dominance:Gender2", resp = "SRTBRiskLikelihood"),
 prior(normal(0, 1), coef = "Gender2:Leadership", resp = "SRTBRiskLikelihood"),
 prior(normal(0, 1), coef = "Gender2:Prestige", resp = "SRTBRiskLikelihood"),
 prior(normal(0, 1), coef = "Gender2:B_PNI", resp = "SRTBRiskLikelihood")
)

Models

Multi model with dopl and pni as predictor variables

Show the code

m1 <- brm(mvbind(SRTB_Risk_Likelihood, SRTB_Risk_Perception, SRTB_Risk_Benefit, SRTB_Risk_Frequency) ~ Dominance + Prestige + Leadership + B_PNI + Age + Gender,
 data = analysis_df,
 prior = m1_prior,
 iter = 10000,
 warmup = 1000,
 chains = 4,
 cores = parallel::detectCores(),
 save_pars = save_pars(all = TRUE), 
 backend =  "cmdstanr"
)

Summary of m1

::: {#tbl-SRTBDoPLPNI .cell}

Show the code

summary(m1)
##  Family: MV(gaussian, gaussian, gaussian, gaussian) 
##   Links: mu = identity; sigma = identity
##          mu = identity; sigma = identity
##          mu = identity; sigma = identity
##          mu = identity; sigma = identity 
## Formula: SRTB_Risk_Likelihood ~ Dominance + Prestige + Leadership + B_PNI + Age + Gender 
##          SRTB_Risk_Perception ~ Dominance + Prestige + Leadership + B_PNI + Age + Gender 
##          SRTB_Risk_Benefit ~ Dominance + Prestige + Leadership + B_PNI + Age + Gender 
##          SRTB_Risk_Frequency ~ Dominance + Prestige + Leadership + B_PNI + Age + Gender 
##    Data: analysis_df (Number of observations: 194) 
##   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
## SRTBRiskLikelihood_Intercept      0.36      0.15     0.07     0.65 1.00
## SRTBRiskPerception_Intercept     -0.21      0.15    -0.50     0.07 1.00
## SRTBRiskBenefit_Intercept         0.66      0.12     0.43     0.89 1.00
## SRTBRiskFrequency_Intercept       0.32      0.15     0.03     0.61 1.00
## SRTBRiskLikelihood_Dominance      0.26      0.04     0.18     0.35 1.00
## SRTBRiskLikelihood_Prestige       0.03      0.04    -0.06     0.11 1.00
## SRTBRiskLikelihood_Leadership    -0.06      0.04    -0.14     0.02 1.00
## SRTBRiskLikelihood_B_PNI         -0.04      0.04    -0.13     0.04 1.00
## SRTBRiskLikelihood_Age           -0.01      0.00    -0.02    -0.00 1.00
## SRTBRiskLikelihood_Gender2       -0.16      0.07    -0.31    -0.02 1.00
## SRTBRiskPerception_Dominance     -0.34      0.06    -0.46    -0.22 1.00
## SRTBRiskPerception_Prestige       0.06      0.05    -0.04     0.15 1.00
## SRTBRiskPerception_Leadership     0.05      0.04    -0.03     0.13 1.00
## SRTBRiskPerception_B_PNI          0.06      0.05    -0.04     0.17 1.00
## SRTBRiskPerception_Age            0.01      0.00    -0.00     0.01 1.00
## SRTBRiskPerception_Gender2        0.07      0.05    -0.03     0.16 1.00
## SRTBRiskBenefit_Dominance         0.38      0.04     0.30     0.47 1.00
## SRTBRiskBenefit_Prestige         -0.01      0.04    -0.09     0.07 1.00
## SRTBRiskBenefit_Leadership       -0.09      0.04    -0.17    -0.01 1.00
## SRTBRiskBenefit_B_PNI            -0.05      0.05    -0.15     0.05 1.00
## SRTBRiskBenefit_Age              -0.02      0.00    -0.02    -0.01 1.00
## SRTBRiskBenefit_Gender2          -0.26      0.07    -0.41    -0.12 1.00
## SRTBRiskFrequency_Dominance       0.28      0.04     0.20     0.37 1.00
## SRTBRiskFrequency_Prestige        0.07      0.04    -0.01     0.15 1.00
## SRTBRiskFrequency_Leadership     -0.08      0.04    -0.16    -0.00 1.00
## SRTBRiskFrequency_B_PNI          -0.03      0.04    -0.12     0.05 1.00
## SRTBRiskFrequency_Age            -0.01      0.00    -0.02    -0.00 1.00
## SRTBRiskFrequency_Gender2        -0.11      0.08    -0.25     0.04 1.00
##                               Bulk_ESS Tail_ESS
## SRTBRiskLikelihood_Intercept     42957    28573
## SRTBRiskPerception_Intercept     42909    27826
## SRTBRiskBenefit_Intercept        36605    30059
## SRTBRiskFrequency_Intercept      43451    28864
## SRTBRiskLikelihood_Dominance     36999    28873
## SRTBRiskLikelihood_Prestige      39995    28264
## SRTBRiskLikelihood_Leadership    39071    28110
## SRTBRiskLikelihood_B_PNI         40078    28322
## SRTBRiskLikelihood_Age           59927    25752
## SRTBRiskLikelihood_Gender2       42494    29713
## SRTBRiskPerception_Dominance     32656    28111
## SRTBRiskPerception_Prestige      42077    27860
## SRTBRiskPerception_Leadership    39219    28313
## SRTBRiskPerception_B_PNI         37107    27931
## SRTBRiskPerception_Age           59299    28520
## SRTBRiskPerception_Gender2       41230    27612
## SRTBRiskBenefit_Dominance        36174    28121
## SRTBRiskBenefit_Prestige         40618    28480
## SRTBRiskBenefit_Leadership       39676    28271
## SRTBRiskBenefit_B_PNI            37408    28639
## SRTBRiskBenefit_Age              64030    28307
## SRTBRiskBenefit_Gender2          39775    28971
## SRTBRiskFrequency_Dominance      36010    28635
## SRTBRiskFrequency_Prestige       41823    27567
## SRTBRiskFrequency_Leadership     38795    28980
## SRTBRiskFrequency_B_PNI          39751    27295
## SRTBRiskFrequency_Age            58337    27183
## SRTBRiskFrequency_Gender2        42322    27378
## 
## Family Specific Parameters: 
##                          Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sigma_SRTBRiskLikelihood     1.07      0.06     0.97     1.19 1.00    30082
## sigma_SRTBRiskPerception     1.09      0.06     0.98     1.21 1.00    28029
## sigma_SRTBRiskBenefit        1.09      0.06     0.98     1.22 1.00    27549
## sigma_SRTBRiskFrequency      1.08      0.06     0.97     1.20 1.00    30438
##                          Tail_ESS
## sigma_SRTBRiskLikelihood    28112
## sigma_SRTBRiskPerception    26475
## sigma_SRTBRiskBenefit       26368
## sigma_SRTBRiskFrequency     28341
## 
## Residual Correlations: 
##                                               Estimate Est.Error l-95% CI
## rescor(SRTBRiskLikelihood,SRTBRiskPerception)    -0.38      0.06    -0.50
## rescor(SRTBRiskLikelihood,SRTBRiskBenefit)        0.48      0.06     0.36
## rescor(SRTBRiskPerception,SRTBRiskBenefit)       -0.59      0.05    -0.68
## rescor(SRTBRiskLikelihood,SRTBRiskFrequency)      0.47      0.06     0.35
## rescor(SRTBRiskPerception,SRTBRiskFrequency)     -0.38      0.06    -0.50
## rescor(SRTBRiskBenefit,SRTBRiskFrequency)         0.50      0.06     0.38
##                                               u-95% CI Rhat Bulk_ESS Tail_ESS
## rescor(SRTBRiskLikelihood,SRTBRiskPerception)    -0.25 1.00    27364    29128
## rescor(SRTBRiskLikelihood,SRTBRiskBenefit)        0.59 1.00    25396    27382
## rescor(SRTBRiskPerception,SRTBRiskBenefit)       -0.49 1.00    27787    27834
## rescor(SRTBRiskLikelihood,SRTBRiskFrequency)      0.58 1.00    28536    27242
## rescor(SRTBRiskPerception,SRTBRiskFrequency)     -0.25 1.00    29537    27534
## rescor(SRTBRiskBenefit,SRTBRiskFrequency)         0.60 1.00    31813    28250
## 
## 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).

:::

Show the code

kable(MutateHDI::mutate_df_multi_not_dospert(m1),
 booktabs = TRUE,
 format = "html",
 linesep = "",
 escape = TRUE,
 col.names = c("Predictor", "Estimate", "HDI (95%)", "ROPE", "Estimate", "HDI (95%)", "ROPE", "Estimate", "HDI (95%)", "ROPE", "Estimate", "HDI (95&)", "ROPE")
) %>%
 kable_styling(full_width = FALSE, latex_options = "scale_down") %>%
 add_header_above(c("", "SRTB Likelihood" = 3, "SRTB Perception" = 3, "SRTB Benefit" = 3, "SRTB Frequency" = 3)) %>%
 footnote(footnote_as_chunk = TRUE, general = "ROPE equates to percentage in region of practical equivalence. HDI equates to high density interval of the posterior distribution.")

Table 1: Experiment 1 | Bayesian regression of individual SRTB domains as response and dominance, prestige, leadership, and pathlogical narcissism as predictors.

	SRTB Likelihood			SRTB Perception			SRTB Benefit			SRTB Frequency
Predictor	Estimate	HDI (95%)	ROPE	Estimate	HDI (95%)	ROPE	Estimate	HDI (95%)	ROPE	Estimate	HDI (95&)	ROPE
Intercept	0.66	0.43, 0.89	0%	0.32	0.03, 0.61	5%	0.36	0.07, 0.65	1%	-0.21	-0.5, 0.07	20%
Dominance	0.38	0.3, 0.47	0%	0.28	0.2, 0.37	0%	0.26	0.18, 0.35	0%	-0.34	-0.46, -0.22	0%
Prestige	-0.01	-0.09, 0.07	100%	0.07	-0.01, 0.15	79%	0.03	-0.06, 0.11	99%	0.06	-0.04, 0.15	84%
Leadership	-0.09	-0.17, -0.01	63%	-0.08	-0.16, 0	66%	-0.06	-0.14, 0.02	86%	0.05	-0.03, 0.13	91%
B-PNI	-0.05	-0.15, 0.05	84%	-0.03	-0.12, 0.05	96%	-0.04	-0.13, 0.04	93%	0.06	-0.04, 0.17	77%
Age	-0.02	-0.02, -0.01	100%	-0.01	-0.02, 0	100%	-0.01	-0.02, 0	100%	0.01	0, 0.01	100%
Gender	-0.26	-0.41, -0.12	0%	-0.11	-0.25, 0.04	47%	-0.16	-0.31, -0.02	18%	0.07	-0.03, 0.16	78%
Note: ROPE equates to percentage in region of practical equivalence. HDI equates to high density interval of the posterior distribution.

Show the code

knitr::include_graphics("../Analysis/t1.jpg")

Figure 1: Experiment 1 | Bayesian regression of individual SRTB domains as response and dominance, prestige, leadership, and pathlogical narcissism as predictors.

Multi model with dopl and pni as predictor variables and interaction terms

Show the code

m1_interaction <- brm(mvbind(SRTB_Risk_Likelihood, SRTB_Risk_Perception, SRTB_Risk_Benefit, SRTB_Risk_Frequency) ~ Dominance * Gender + Prestige * Gender  + Leadership * Gender  + B_PNI * Gender  + Age,
 data = analysis_df,
 prior = m1_interaction_prior,
 iter = 10000,
 warmup = 1000,
 chains = 4,
 cores = parallel::detectCores(),
 save_pars = save_pars(all = TRUE),
 backend = "cmdstanr"
)

Summary of the m1_interaction model

Show the code

summary(m1_interaction)
##  Family: MV(gaussian, gaussian, gaussian, gaussian) 
##   Links: mu = identity; sigma = identity
##          mu = identity; sigma = identity
##          mu = identity; sigma = identity
##          mu = identity; sigma = identity 
## Formula: SRTB_Risk_Likelihood ~ Dominance * Gender + Prestige * Gender + Leadership * Gender + B_PNI * Gender + Age 
##          SRTB_Risk_Perception ~ Dominance * Gender + Prestige * Gender + Leadership * Gender + B_PNI * Gender + Age 
##          SRTB_Risk_Benefit ~ Dominance * Gender + Prestige * Gender + Leadership * Gender + B_PNI * Gender + Age 
##          SRTB_Risk_Frequency ~ Dominance * Gender + Prestige * Gender + Leadership * Gender + B_PNI * Gender + Age 
##    Data: analysis_df (Number of observations: 194) 
##   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
## SRTBRiskLikelihood_Intercept              0.33      0.15     0.03     0.63 1.00
## SRTBRiskPerception_Intercept             -0.26      0.15    -0.55     0.03 1.00
## SRTBRiskBenefit_Intercept                 0.62      0.12     0.38     0.86 1.00
## SRTBRiskFrequency_Intercept               0.28      0.15    -0.02     0.59 1.00
## SRTBRiskLikelihood_Dominance              0.26      0.04     0.17     0.34 1.00
## SRTBRiskLikelihood_Gender2               -0.17      0.08    -0.32    -0.02 1.00
## SRTBRiskLikelihood_Prestige               0.06      0.04    -0.03     0.15 1.00
## SRTBRiskLikelihood_Leadership            -0.06      0.04    -0.14     0.03 1.00
## SRTBRiskLikelihood_B_PNI                  0.01      0.04    -0.08     0.10 1.00
## SRTBRiskLikelihood_Age                   -0.01      0.00    -0.02    -0.00 1.00
## SRTBRiskLikelihood_Dominance:Gender2      0.49      0.02     0.45     0.53 1.00
## SRTBRiskLikelihood_Gender2:Prestige      -0.03      0.16    -0.33     0.28 1.00
## SRTBRiskLikelihood_Gender2:Leadership    -0.04      0.17    -0.37     0.30 1.00
## SRTBRiskLikelihood_Gender2:B_PNI         -0.58      0.15    -0.87    -0.30 1.00
## SRTBRiskPerception_Dominance             -0.49      0.07    -0.62    -0.36 1.00
## SRTBRiskPerception_Gender2                0.06      0.05    -0.03     0.15 1.00
## SRTBRiskPerception_Prestige               0.06      0.05    -0.04     0.17 1.00
## SRTBRiskPerception_Leadership             0.08      0.04    -0.00     0.17 1.00
## SRTBRiskPerception_B_PNI                  0.09      0.06    -0.03     0.20 1.00
## SRTBRiskPerception_Age                    0.01      0.00    -0.00     0.02 1.00
## SRTBRiskPerception_Dominance:Gender2      0.49      0.02     0.45     0.53 1.00
## SRTBRiskPerception_Gender2:Prestige       0.07      0.15    -0.23     0.36 1.00
## SRTBRiskPerception_Gender2:Leadership    -0.22      0.16    -0.53     0.09 1.00
## SRTBRiskPerception_Gender2:B_PNI          0.01      0.14    -0.27     0.29 1.00
## SRTBRiskBenefit_Dominance                 0.36      0.04     0.28     0.45 1.00
## SRTBRiskBenefit_Gender2                  -0.27      0.07    -0.41    -0.12 1.00
## SRTBRiskBenefit_Prestige                 -0.00      0.04    -0.09     0.09 1.00
## SRTBRiskBenefit_Leadership               -0.06      0.04    -0.14     0.03 1.00
## SRTBRiskBenefit_B_PNI                    -0.04      0.06    -0.15     0.07 1.00
## SRTBRiskBenefit_Age                      -0.02      0.00    -0.02    -0.01 1.00
## SRTBRiskBenefit_Dominance:Gender2         0.48      0.02     0.45     0.52 1.00
## SRTBRiskBenefit_Gender2:Prestige          0.08      0.16    -0.24     0.40 1.00
## SRTBRiskBenefit_Gender2:Leadership       -0.27      0.17    -0.61     0.07 1.00
## SRTBRiskBenefit_Gender2:B_PNI            -0.35      0.15    -0.66    -0.05 1.00
## SRTBRiskFrequency_Dominance               0.29      0.04     0.20     0.37 1.00
## SRTBRiskFrequency_Gender2                -0.12      0.08    -0.27     0.03 1.00
## SRTBRiskFrequency_Prestige                0.06      0.04    -0.02     0.15 1.00
## SRTBRiskFrequency_Leadership             -0.05      0.04    -0.14     0.03 1.00
## SRTBRiskFrequency_B_PNI                   0.01      0.04    -0.08     0.09 1.00
## SRTBRiskFrequency_Age                    -0.01      0.00    -0.02    -0.00 1.00
## SRTBRiskFrequency_Dominance:Gender2       0.49      0.02     0.45     0.53 1.00
## SRTBRiskFrequency_Gender2:Prestige        0.25      0.16    -0.06     0.56 1.00
## SRTBRiskFrequency_Gender2:Leadership     -0.35      0.17    -0.69    -0.01 1.00
## SRTBRiskFrequency_Gender2:B_PNI          -0.56      0.15    -0.85    -0.26 1.00
##                                       Bulk_ESS Tail_ESS
## SRTBRiskLikelihood_Intercept             63083    29835
## SRTBRiskPerception_Intercept             72310    27455
## SRTBRiskBenefit_Intercept                43372    30131
## SRTBRiskFrequency_Intercept              60613    29316
## SRTBRiskLikelihood_Dominance             62036    28593
## SRTBRiskLikelihood_Gender2               75400    27460
## SRTBRiskLikelihood_Prestige              63625    28416
## SRTBRiskLikelihood_Leadership            61500    27329
## SRTBRiskLikelihood_B_PNI                 68323    27914
## SRTBRiskLikelihood_Age                   88760    24994
## SRTBRiskLikelihood_Dominance:Gender2     75753    25898
## SRTBRiskLikelihood_Gender2:Prestige      26785    28029
## SRTBRiskLikelihood_Gender2:Leadership    29974    28772
## SRTBRiskLikelihood_Gender2:B_PNI         32254    29644
## SRTBRiskPerception_Dominance             51382    30432
## SRTBRiskPerception_Gender2               79444    26009
## SRTBRiskPerception_Prestige              62887    29732
## SRTBRiskPerception_Leadership            64737    28966
## SRTBRiskPerception_B_PNI                 58363    28243
## SRTBRiskPerception_Age                   95207    25014
## SRTBRiskPerception_Dominance:Gender2     76145    25701
## SRTBRiskPerception_Gender2:Prestige      31257    27803
## SRTBRiskPerception_Gender2:Leadership    35613    29164
## SRTBRiskPerception_Gender2:B_PNI         36674    28926
## SRTBRiskBenefit_Dominance                54165    27405
## SRTBRiskBenefit_Gender2                  72656    27624
## SRTBRiskBenefit_Prestige                 65976    28626
## SRTBRiskBenefit_Leadership               64140    27981
## SRTBRiskBenefit_B_PNI                    61489    28257
## SRTBRiskBenefit_Age                      67230    26511
## SRTBRiskBenefit_Dominance:Gender2        76863    27057
## SRTBRiskBenefit_Gender2:Prestige         24672    27974
## SRTBRiskBenefit_Gender2:Leadership       26293    28470
## SRTBRiskBenefit_Gender2:B_PNI            28698    29036
## SRTBRiskFrequency_Dominance              55653    28511
## SRTBRiskFrequency_Gender2                78568    27098
## SRTBRiskFrequency_Prestige               61997    28859
## SRTBRiskFrequency_Leadership             63479    27383
## SRTBRiskFrequency_B_PNI                  62689    27042
## SRTBRiskFrequency_Age                    87299    26743
## SRTBRiskFrequency_Dominance:Gender2      85645    26866
## SRTBRiskFrequency_Gender2:Prestige       27351    29756
## SRTBRiskFrequency_Gender2:Leadership     30768    29257
## SRTBRiskFrequency_Gender2:B_PNI          31704    29095
## 
## Family Specific Parameters: 
##                          Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## sigma_SRTBRiskLikelihood     1.17      0.06     1.05     1.30 1.00    36388
## sigma_SRTBRiskPerception     1.08      0.06     0.97     1.20 1.00    45723
## sigma_SRTBRiskBenefit        1.21      0.07     1.09     1.35 1.00    33107
## sigma_SRTBRiskFrequency      1.18      0.06     1.06     1.31 1.00    38729
##                          Tail_ESS
## sigma_SRTBRiskLikelihood    29195
## sigma_SRTBRiskPerception    29588
## sigma_SRTBRiskBenefit       30373
## sigma_SRTBRiskFrequency     30737
## 
## Residual Correlations: 
##                                               Estimate Est.Error l-95% CI
## rescor(SRTBRiskLikelihood,SRTBRiskPerception)    -0.34      0.07    -0.47
## rescor(SRTBRiskLikelihood,SRTBRiskBenefit)        0.57      0.05     0.47
## rescor(SRTBRiskPerception,SRTBRiskBenefit)       -0.53      0.06    -0.63
## rescor(SRTBRiskLikelihood,SRTBRiskFrequency)      0.56      0.05     0.46
## rescor(SRTBRiskPerception,SRTBRiskFrequency)     -0.33      0.07    -0.45
## rescor(SRTBRiskBenefit,SRTBRiskFrequency)         0.59      0.05     0.49
##                                               u-95% CI Rhat Bulk_ESS Tail_ESS
## rescor(SRTBRiskLikelihood,SRTBRiskPerception)    -0.20 1.00    37736    31146
## rescor(SRTBRiskLikelihood,SRTBRiskBenefit)        0.66 1.00    31416    30561
## rescor(SRTBRiskPerception,SRTBRiskBenefit)       -0.41 1.00    35556    28622
## rescor(SRTBRiskLikelihood,SRTBRiskFrequency)      0.65 1.00    33082    28760
## rescor(SRTBRiskPerception,SRTBRiskFrequency)     -0.19 1.00    38887    29821
## rescor(SRTBRiskBenefit,SRTBRiskFrequency)         0.68 1.00    37129    30295
## 
## 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).

Show the code

kable(MutateHDI::mutate_df_multi_not_dospert(m1_interaction),
 booktabs = TRUE,
 format = "html",
 linesep = "",
 escape = TRUE,
 col.names = c("Predictor", "Estimate", "HDI (95%)", "ROPE", "Estimate", "HDI (95%)", "ROPE", "Estimate", "HDI (95%)", "ROPE", "Estimate", "HDI (95&)", "ROPE"))%>%
 kable_styling(full_width = FALSE, latex_options = "scale_down")%>%
 add_header_above(c("", "SRTB Risk Likelihood" = 3, "SRTB Risk Perception" = 3, "SRTB Risk Benefit" = 3, "SRTB Risk Frequency" = 3)) %>%
 footnote(footnote_as_chunk = TRUE, general = "ROPE equates to percentage in region of practical equivalence. HDI equates to high density interval of the posterior distribution.")

Table 2: Experiment 1 | Bayesian regression of individual SRTB domains as response and dominance, prestige, leadership, and pathlogical narcissism as predictors with gender interactions.

	SRTB Risk Likelihood			SRTB Risk Perception			SRTB Risk Benefit			SRTB Risk Frequency
Predictor	Estimate	HDI (95%)	ROPE	Estimate	HDI (95%)	ROPE	Estimate	HDI (95%)	ROPE	Estimate	HDI (95&)	ROPE
Intercept	0.62	0.38, 0.86	0%	0.28	-0.02, 0.59	9%	0.33	0.03, 0.63	5%	-0.26	-0.55, 0.03	12%
Dominance	0.36	0.28, 0.45	0%	0.29	0.2, 0.37	0%	0.26	0.17, 0.34	0%	-0.49	-0.62, -0.36	0%
Gender	-0.27	-0.41, -0.12	0%	-0.12	-0.27, 0.03	41%	-0.17	-0.32, -0.02	15%	0.06	-0.03, 0.15	81%
Prestige	0.00	-0.09, 0.09	100%	0.06	-0.02, 0.15	81%	0.06	-0.03, 0.15	83%	0.06	-0.04, 0.17	77%
Leadership	-0.06	-0.14, 0.03	87%	-0.05	-0.14, 0.03	88%	-0.06	-0.14, 0.03	85%	0.08	0, 0.17	65%
B-PNI	-0.04	-0.15, 0.07	89%	0.01	-0.08, 0.09	100%	0.01	-0.08, 0.1	100%	0.09	-0.03, 0.2	61%
Age	-0.02	-0.02, -0.01	100%	-0.01	-0.02, 0	100%	-0.01	-0.02, 0	100%	0.01	0, 0.02	100%
Dominance : Gender	0.48	0.45, 0.52	0%	0.49	0.45, 0.53	0%	0.49	0.45, 0.53	0%	0.49	0.45, 0.53	0%
Prestige : Gender	0.08	-0.24, 0.4	45%	0.25	-0.06, 0.56	15%	-0.03	-0.33, 0.28	50%	0.07	-0.23, 0.36	48%
Leadership : Gender	-0.27	-0.61, 0.07	15%	-0.35	-0.69, -0.01	5%	-0.04	-0.37, 0.3	46%	-0.22	-0.53, 0.09	21%
Gender : B-PNI	-0.35	-0.66, -0.05	3%	-0.56	-0.85, -0.26	0%	-0.58	-0.87, -0.3	0%	0.01	-0.27, 0.29	54%
Note: ROPE equates to percentage in region of practical equivalence. HDI equates to high density interval of the posterior distribution.

Show the code

knitr::include_graphics("../Analysis/t2.jpg")

Figure 2: Experiment 1 | Bayesian regression of individual SRTB domains as response and dominance, prestige, leadership, and pathlogical narcissism as predictors with gender interactions.

m1 model comparison

loo comparison

Show the code

m1_comparison <- loo(m1, m1_interaction)

Show the code

m1_comparison

Output of model 'm1':

Computed from 36000 by 194 log-likelihood matrix

         Estimate   SE
elpd_loo  -1066.0 31.7
p_loo        27.1  4.3
looic      2132.0 63.4
------
Monte Carlo SE of elpd_loo is 0.1.

Pareto k diagnostic values:
                         Count Pct.    Min. n_eff
(-Inf, 0.5]   (good)     193   99.5%   2456      
 (0.5, 0.7]   (ok)         1    0.5%   609       
   (0.7, 1]   (bad)        0    0.0%   <NA>      
   (1, Inf)   (very bad)   0    0.0%   <NA>      

All Pareto k estimates are ok (k < 0.7).
See help('pareto-k-diagnostic') for details.

Output of model 'm1_interaction':

Computed from 36000 by 194 log-likelihood matrix

         Estimate   SE
elpd_loo  -1108.6 31.8
p_loo        38.1  5.0
looic      2217.3 63.5
------
Monte Carlo SE of elpd_loo is 0.1.

Pareto k diagnostic values:
                         Count Pct.    Min. n_eff
(-Inf, 0.5]   (good)     191   98.5%   3863      
 (0.5, 0.7]   (ok)         3    1.5%   579       
   (0.7, 1]   (bad)        0    0.0%   <NA>      
   (1, Inf)   (very bad)   0    0.0%   <NA>      

All Pareto k estimates are ok (k < 0.7).
See help('pareto-k-diagnostic') for details.

Model comparisons:
               elpd_diff se_diff
m1               0.0       0.0  
m1_interaction -42.7       8.8  

bayes factor comparison

Show the code

comparison <- bayesfactor_models(m1, m1_interaction)

Show the code

comparison

	Model	log_BF
m1		0.00000
m1_interaction		-51.72054

Correlation

Show the code

correlation_df <- MutateColumns::column_mutation(analysis_df)

correlation_df <- subset(correlation_df, select = c(
"Age",
"Dominance",
"Leadership",
"Prestige",
"B PNI",
"PNI Grandiosity",
"PNI Vulnerability",
"UMS",
"UMS Intimacy",
"UMS Affiliation",
"SRTB Risk Benefit",
"SRTB Risk Perception",
"SRTB Risk Likelihood",
"SRTB Risk Frequency"
))

correlation_df$Age <- scale(correlation_df$Age)
corr_1 <- correlation(correlation_df, bayesian = TRUE, method = "auto")
saveRDS(corr_1, "corr_1.rds")

Correlation Summary

Show the code

knitr::include_graphics("../test-1.png")

?(caption)