Experiment 1 Demographics
kable(demographic_table, format = "html", bootabs = T, escape = F, longtable = T,
col.names = c("", "Overall *n* = 92"),
align = c("l", "c"),
caption = "*Participant Demographic Information*") %>%
kable_styling(full_width = F)%>%
row_spec(row = 0, align = "c")%>%
column_spec(column = 1, width = "1.5in" )%>%
column_spec(column = 2, width = "1in") %>%
pack_rows("Age",1, 2 )%>%
pack_rows("Gender", 3, 4)%>%
pack_rows("Ethnicity", 11, 17)%>%
pack_rows("Ethnic Origin", 18, 22)%>%
pack_rows("Educational Attainment", 5, 10)
Participant Demographic Information
|
|
Overall n = 92
|
|
Age
|
|
Mean (SD)
|
26.14 (8.69)
|
|
Median [Min, Max]
|
23 [18,60]
|
|
Gender
|
|
Female
|
30 (32.6%)
|
|
Male
|
62 (67.4%)
|
|
Educational Attainment
|
|
A-Levels or Equivalent
|
32 (34.8%)
|
|
GCSes or Equivalent
|
8 (8.7%)
|
|
Prefer not to answer
|
1 (1.1%)
|
|
Primary School
|
3 (3.3%)
|
|
University Post-Graduate Program
|
17 (18.5%)
|
|
University Undergraduate Program
|
31 (33.7%)
|
|
Ethnicity
|
|
Arab
|
1 (1.1%)
|
|
Asian
|
5 (5.4%)
|
|
English
|
10 (10.9%)
|
|
European
|
69 (75.0%)
|
|
Latin American
|
2 (2.2%)
|
|
Other
|
2 (2.2%)
|
|
Prefer not to answer
|
1 (1.1%)
|
|
Ethnic Origin
|
|
Scottish
|
2 (2.2%)
|
|
Asian or Asian Scottish or Asian British
|
5 (5.4%)
|
|
Mixed or Multiple ethnic origins
|
4 (4.3%)
|
|
Other ethnic group
|
1 (1.1%)
|
|
White
|
82 (89.1%)
|
DoPL motives predicting risky behavior (by content) ggplot
Dominance
ggplot(analysisDF, aes(x = Dominance, y = Justification, col = Content)) +
geom_point(size = .7,
alpha = .8,
position = "jitter") +
geom_smooth(method = "lm",
se = F,
size = 2,
alpha = .8)
## `geom_smooth()` using formula 'y ~ x'
Prestige
ggplot(analysisDF, aes(x = Prestige, y = Justification, col = Content)) +
geom_point(size = .7,
alpha = .8,
position = "jitter") +
geom_smooth(method = "lm",
se = F,
size = 2,
alpha = .8)
## `geom_smooth()` using formula 'y ~ x'
Leadership
ggplot(analysisDF, aes(x = Leadership, y = Justification, col = Content)) +
geom_point(size = .7,
alpha = .8,
position = "jitter") +
geom_smooth(method = "lm",
se = F,
size = 2,
alpha = .8)
## `geom_smooth()` using formula 'y ~ x'
Spitefulness
ggplot(analysisDF, aes(x = Spite, y = Justification, col = Content)) +
geom_point(size = .7,
alpha = .8,
position = "jitter") +
geom_smooth(method = "lm",
se = F,
size = 2,
alpha = .8)
## `geom_smooth()` using formula 'y ~ x'
Initial Bayesian Analysis
m0 <- brm(Justification_z ~ 1 + (1|Vignette) + (1|subjectID), data = analysisDF,
warmup = 500, control = list(adapt_delta = 0.95), iter = 8000, chains = 4, cores = 6, save_all_pars = T,
prior = prior_m0)
# models
m1 <- brm(Justification_z ~ Spite_z * Content + (1|Vignette) + (1|subjectID), data = analysisDF,
warmup = 500, control = list(adapt_delta = 0.95)), iter = 8000, chains = 4, cores = 6, save_all_pars = T,
prior = prior_m1)
summary(m1)
m2 <- brm(Justification ~ Spite_z * Content + Realism_z + (1|Vignette) + (1|subjectID), data = analysisDF,
warmup = 500, control = list(adapt_delta = 0.95)), iter = 8000, chains = 4, cores = 4, save_all_pars = T,
prior = prior_m2)
summary(m2)
m3 <- brm(Justification ~ Spite_z * Content + Realism_z + SSES + SRPS + SJS + (1|Vignette) +
(1|subjectID), data = analysisDF,warmup = 500, control = list(adapt_delta = 0.95)), iter = 8000, chains = 4, cores = 6,
save_all_pars = T,
prior = prior_m3)
summary(m3)
m4 <- brm(Justification ~ Spite_z * Content * Realism_z + SSES_z + SRPS_z + SJS_z + (1|Vignette) +
(1|subjectID), data = analysisDF,warmup = 500, control = list(adapt_delta = 0.95), iter = 8000, chains = 4, cores = 6,
save_all_pars = T,
prior = prior_m4)
Bayesian Correlation
scale_corr <- brm(mvbind(SSES, SRPS, Spite, SJS, Dominance, Prestige, Leadership) ~ 1, data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6,
prior = c(prior(normal(0, 1), class = "Intercept")), save_all_pars = T)
cor_1 <- summary(scale_corr)
corr_table <- cor_1[["rescor_pars"]]
kable(corr_table, format = "html", booktabs = T, escape = F, longtabe = F, digits = 2, col.names = c('Estimate', 'Est.Error', 'l-95% CI', 'u-95% CI', 'Rhat', 'Bulk_ESS', 'Tail_ESS')) %>%
kable_styling(full_width = F) %>%
remove_column(6:8)
|
|
Estimate
|
Est.Error
|
l-95% CI
|
u-95% CI
|
|
rescor(SSES,SRPS)
|
-0.41
|
0.03
|
-0.47
|
-0.36
|
|
rescor(SSES,Spite)
|
0.19
|
0.04
|
0.12
|
0.26
|
|
rescor(SRPS,Spite)
|
-0.20
|
0.04
|
-0.27
|
-0.13
|
|
rescor(SSES,SJS)
|
0.26
|
0.03
|
0.20
|
0.33
|
|
rescor(SRPS,SJS)
|
-0.28
|
0.03
|
-0.34
|
-0.22
|
|
rescor(Spite,SJS)
|
0.24
|
0.04
|
0.17
|
0.31
|
|
rescor(SSES,Dominance)
|
-0.11
|
0.04
|
-0.18
|
-0.04
|
|
rescor(SRPS,Dominance)
|
0.03
|
0.03
|
-0.04
|
0.10
|
|
rescor(Spite,Dominance)
|
0.55
|
0.03
|
0.50
|
0.60
|
|
rescor(SJS,Dominance)
|
0.29
|
0.03
|
0.22
|
0.35
|
|
rescor(SSES,Prestige)
|
-0.01
|
0.04
|
-0.08
|
0.06
|
|
rescor(SRPS,Prestige)
|
0.24
|
0.03
|
0.18
|
0.31
|
|
rescor(Spite,Prestige)
|
0.13
|
0.04
|
0.06
|
0.20
|
|
rescor(SJS,Prestige)
|
0.02
|
0.03
|
-0.05
|
0.09
|
|
rescor(Dominance,Prestige)
|
0.22
|
0.03
|
0.16
|
0.29
|
|
rescor(SSES,Leadership)
|
-0.25
|
0.03
|
-0.32
|
-0.19
|
|
rescor(SRPS,Leadership)
|
0.29
|
0.03
|
0.22
|
0.35
|
|
rescor(Spite,Leadership)
|
0.01
|
0.04
|
-0.06
|
0.08
|
|
rescor(SJS,Leadership)
|
-0.07
|
0.03
|
-0.13
|
0.00
|
|
rescor(Dominance,Leadership)
|
0.31
|
0.03
|
0.25
|
0.37
|
|
rescor(Prestige,Leadership)
|
0.38
|
0.03
|
0.32
|
0.43
|
DoPL motives predicting risky behavior (by content) in addition to spitefulness
dm0 <- brm(Justification ~ 1 + (1|Vignette) + (1|subjectID), data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6
,prior = prior_dm0, save_all_pars = T)
summary(dm0)
dm1 <- brm(Justification ~ Dominance_z * Gender + Prestige_z * Gender + Leadership_z * Gender + (1|Vignette) + (1|subjectID), data = analysisDF, iter = 8000,control = list(adapt_delta = 0.99), warmup = 500, chains = 4, cores = 6
,prior = prior_dm1, save_all_pars = T)
summary(dm1)
dm3 <- brm(Justification ~ Dominance_z * Gender + Prestige_z * Gender + Leadership_z * Gender + Age + (1|Vignette) + (1|subjectID), data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6
,prior = c(prior(normal(0, 1), class = "Intercept")), save_all_pars = T)
summary(dm3)
dm2 <- brm(Justification ~ Dominance_z * Gender + Prestige_z * Gender + Leadership_z * Gender + SJS_z + SRPS_z + SSES_z + Spite_z + (1|Vignette) + (1|subjectID), control = list(adapt_delta = 0.99), data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6
,prior = prior_dm2, save_all_pars = T)
summary(dm2)
dm4 <- brm(Justification ~ Dominance_z * Gender * Content + Prestige_z * Gender * Content + Leadership_z * Gender * Content + SJS_z + SRPS_z + SSES_z + Spite_z + (1|Vignette) + (1|subjectID), control = list(adapt_delta = 0.99), data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6
,prior = prior_dm4, save_all_pars = T)
summary(dm4)
dm4_hdi <- bayestestR::hdi(dm4, effects = "fixed", component = "conditional", ci = .95)
dm4_hdi[sign(dm4_hdi$CI_low) == sign(dm4_hdi$CI_high),
c('Parameter', 'CI','CI_low', 'CI_high')]
dm5 <- brm(Justification ~ Dominance_z * Realism_z * Content * Gender + Prestige_z * Realism_z * Content * Gender + Leadership_z * Gender * Realism_z * Content + Spite_z * Content + (1|Vignette) + (1|subjectID), control = list(adapt_delta = 0.99), data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6
,prior = prior_dm5, save_all_pars = T)
summary(dm5)
bm4 <- brm(Justification ~ Dominance_z * Realism_z * Content * Gender + Prestige_z * Realism_z * Content * Gender + Leadership_z * Realism_z * Content * Gender + Spite_z * Content * Gender + (1|Vignette) + (1|subjectID), control = list(adapt_delta = 0.99), data = analysisDF, iter = 8000, warmup = 500, chains = 4, cores = 6, save_all_pars = T)
loo(dm1, dm2, dm4, dm5)
DoPL motives predicting risky behavior (by content) in addition to spitefulness HDI
dm5_hdi <- bayestestR::hdi(dm5, effects = "fixed", component = "conditional", ci = .95)
kable(dm5_hdi[sign(dm5_hdi$CI_low) == sign(dm5_hdi$CI_high),
c('Parameter', 'CI','CI_low', 'CI_high')], format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>% kable_styling(full_width = T)
|
|
Parameter
|
CI
|
CI_low
|
CI_high
|
|
8
|
b_Intercept
|
0.95
|
0.74
|
3.27
|
|
18
|
b_Spite_z
|
0.95
|
0.06
|
0.24
|
|
5
|
b_Dominance_z.ContentSexual
|
0.95
|
0.01
|
0.28
|
Bayesian analysis m4
summary(m4)
## Warning: There were 2 divergent transitions after warmup. Increasing adapt_delta
## above may help. See http://mc-stan.org/misc/warnings.html#divergent-transitions-
## after-warmup
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: Justification ~ Spite_z * Content * Realism_z + SSES + SRPS + SJS + (1 | Vignette) + (1 | subjectID)
## Data: analysisDF (Number of observations: 920)
## Samples: 4 chains, each with iter = 8000; warmup = 1000; thin = 1;
## total post-warmup samples = 28000
##
## Group-Level Effects:
## ~subjectID (Number of levels: 92)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.18 0.06 0.04 0.30 1.00 5343 3628
##
## ~Vignette (Number of levels: 10)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 1.33 0.40 0.79 2.33 1.00 7556 10705
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat
## Intercept 1.71 0.71 0.25 3.05 1.00
## Spite_z 0.12 0.05 0.03 0.21 1.00
## ContentSexual -0.10 0.63 -1.36 1.15 1.00
## Realism_z -0.10 0.06 -0.21 0.01 1.00
## SSES -0.00 0.00 -0.01 0.01 1.00
## SRPS 0.08 0.12 -0.16 0.32 1.00
## SJS 0.02 0.02 -0.02 0.05 1.00
## Spite_z:ContentSexual 0.07 0.05 -0.02 0.17 1.00
## Spite_z:Realism_z -0.11 0.05 -0.21 -0.02 1.00
## ContentSexual:Realism_z -0.02 0.07 -0.16 0.13 1.00
## Spite_z:ContentSexual:Realism_z 0.06 0.06 -0.06 0.19 1.00
## Bulk_ESS Tail_ESS
## Intercept 10635 14416
## Spite_z 27293 23384
## ContentSexual 9986 14758
## Realism_z 24794 22641
## SSES 34317 23121
## SRPS 30251 23206
## SJS 32126 22822
## Spite_z:ContentSexual 35115 23079
## Spite_z:Realism_z 24685 22889
## ContentSexual:Realism_z 25942 23012
## Spite_z:ContentSexual:Realism_z 26408 22494
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.99 0.02 0.95 1.04 1.00 25851 19058
##
## Samples were drawn 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).
m4_hdi <- bayestestR::hdi(m4, effects = "fixed", component = "conditional", ci = .95)
kable(m4_hdi[sign(m4_hdi$CI_low) == sign(m4_hdi$CI_high),
c('Parameter', 'CI','CI_low', 'CI_high')] , format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>% kable_styling(full_width = T)
|
|
Parameter
|
CI
|
CI_low
|
CI_high
|
|
3
|
b_Intercept
|
0.95
|
0.26
|
3.07
|
|
6
|
b_Spite_z
|
0.95
|
0.03
|
0.21
|
|
9
|
b_Spite_z.Realism_z
|
0.95
|
-0.21
|
-0.02
|
m5 <- brm(Justification ~ Dominance_z + Leadership_z + Prestige_z + (1|Vignette) + (1|subjectID), data = analysisDF,warmup = 500, control = list(adapt_delta = 0.95)), iter = 8000, chains = 4, cores = 6, prior = c(prior(normal(0,1), class = 'Intercept'),
prior(normal(0,1), class = 'b')))
summary(m5)
m5_gen <- brm(Justification_z ~ Dominance_z*Gender + Leadership_z*Gender + Prestige_z*Gender + (1|Vignette) + (1|subjectID), data = analysisDF, warmup = 500, control = list(adapt_delta = 0.95), iter = 8000, chains = 4, cores = 6,
prior = c(prior(normal(0,1), class = 'Intercept'),
prior(normal(3, 1), class = 'b', coef = "Dominance_z:Gender"),
prior(normal(0, 1), class = 'b', coef = "Gender:Leadership_z"),
prior(normal(0, 1), class = 'b', coef = "Gender:Prestige_z")),
save_all_pars = T)
summary(m5_gen)
DoPL and Justification
summary(m5_gen)
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: Justification_z ~ Dominance_z * Gender + Leadership_z * Gender + Prestige_z * Gender + (1 | Vignette) + (1 | Vignette)
## Data: analysisDF (Number of observations: 920)
## Samples: 4 chains, each with iter = 8000; warmup = 1000; thin = 1;
## total post-warmup samples = 28000
##
## Group-Level Effects:
## ~Vignette (Number of levels: 10)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.86 0.24 0.53 1.44 1.00 6759 11597
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept 0.01 0.27 -0.53 0.55 1.00 5588 8686
## Dominance_z 0.08 0.03 0.03 0.14 1.00 27825 21036
## Gender -0.03 0.05 -0.13 0.07 1.00 35643 18845
## Leadership_z -0.00 0.03 -0.07 0.06 1.00 22254 20736
## Prestige_z 0.04 0.03 -0.02 0.10 1.00 22906 22421
## Dominance_z:Gender 0.01 0.06 -0.10 0.13 1.00 27002 20763
## Gender:Leadership_z -0.08 0.05 -0.19 0.02 1.00 22612 20831
## Gender:Prestige_z -0.01 0.05 -0.12 0.10 1.00 24251 20699
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.70 0.02 0.67 0.74 1.00 33649 19043
##
## Samples were drawn 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).
m5_gen_hdi <- bayestestR::hdi(m5_gen, effects = "fixed", component = "conditional", ci = .95)
kable(m5_gen_hdi[sign(m5_gen_hdi$CI_low) == sign(m5_gen_hdi$CI_high),
c('Parameter', 'CI','CI_low', 'CI_high')] , format = "html", booktabs = T, escape = F, longtable = F, digits = 2) %>% kable_styling(full_width = T)
|
Parameter
|
CI
|
CI_low
|
CI_high
|
|
b_Dominance_z
|
0.95
|
0.03
|
0.14
|