Study 3 analyses

In this report, we reproduce the analyses testing H4-6 in Study 3, exploratory analyses examining moderation by topic and cultural context, and parallel mediation analyses.

prep data

First, we load the relevant packages, define functions and plotting aesthetics, and load and tidy the data.

load packages

library(pacman)
pacman::p_load(tidyverse, purrr, fs, knitr, lmerTest, ggeffects, kableExtra, boot, devtools, brms, tidybayes, install = TRUE)

define functions

source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")

# MLM results table function
table_model = function(model_data, print = TRUE) {
  table = model_data %>%
    broom.mixed::tidy(conf.int = TRUE) %>%
    filter(effect == "fixed") %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("p")), round, 2) %>%
    mutate(term = gsub("article_cond", "", term),
           term = gsub("\\(Intercept\\)", "intercept", term),
           term = gsub("other$", "other - control", term),
           term = gsub("self$", "self - control", term),
           term = gsub("siteUSA", "sample (USA)", term),
           term = gsub("self_referential", "self-referential", term),
           term = gsub("social_cognitive", "social cognitive", term),
           term = gsub("msg_rel_self_z", "self-relevance", term),
           term = gsub("msg_rel_social_z", "social relevance", term),
           term = gsub("topichealth", "topic (health)", term),
           term = gsub(":", " x ", term),
           term = gsub("sample \\(USA\\) x social relevance", "social relevance x sample (USA)", term),
           p = ifelse(p < .001, "< .001",
               ifelse(p > .999, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
    select(term, `b [95% CI]`, df, t, p) %>%
    arrange(term)
  
  if (isTRUE(print)) {
    table  %>%
      kable() %>%
      kableExtra::kable_styling()
  } else {
    table
  }
}

simple_slopes = function(model, var, moderator, continuous = TRUE) {
  
  if (isTRUE(continuous)) {
    emmeans::emtrends(model, as.formula(paste("~", moderator)), var = var) %>%
      data.frame() %>%
      rename("trend" = 2) %>%
      mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", trend, asymp.LCL, asymp.UCL)) %>%
      select(!!moderator, `b [95% CI]`) %>%
      kable()  %>%
      kableExtra::kable_styling()
    
  } else {
    confint(emmeans::contrast(emmeans::emmeans(model, as.formula(paste("~", var, "|", moderator))), "revpairwise", by = moderator, adjust = "none")) %>%
      data.frame() %>%
      filter(grepl("control", contrast)) %>%
      mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, asymp.LCL, asymp.UCL)) %>%
      select(contrast, !!moderator, `b [95% CI]`) %>%
      arrange(contrast) %>%
      kable()  %>%
      kableExtra::kable_styling()
  }
}

define aesthetics

palette_condition = c("self" = "#ee9b00",
                      "control" = "#0a9396",
                      "other" = "#005f73")
palette_roi = c("self-referential" = "#ee9b00",
               "social cognitive" = "#005f73")
palette_dv = c("self-relevance" = "#ee9b00",
               "social relevance" = "#005f73",
               "narrowcast sharing" = "#D295BF")
palette_sample = c("Netherlands" = "#027EA1",
                 "USA" = "#334456")
palette_topic = c("climate" = "#519872",
                 "health" = "#5F0F40")

plot_aes = theme_minimal() +
  theme(legend.position = "top",
        legend.text = element_text(size = 12),
        text = element_text(size = 16, family = "Futura Medium"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text = element_text(color = "black"),
        axis.line = element_line(colour = "black"),
        axis.ticks.y = element_blank())

load and tidy data

merged_all = read.csv("../data/study3_data.csv")

ratings_z = merged_all %>%
  select(SID, trial, article_number, article_cond, msg_rel_self, msg_rel_social, msg_share) %>%
  unique() %>%
  mutate(msg_share_z = scale(msg_share, scale = TRUE, center = TRUE),
         msg_rel_self_z = scale(msg_rel_self, center = TRUE, scale = TRUE),
         msg_rel_social_z = scale(msg_rel_social, center = TRUE, scale = TRUE))

merged = merged_all %>%
  mutate(atlas = gsub("mentalizing", "social_cognitive", atlas)) %>%
  filter(outlier == "no" | is.na(outlier)) %>%
  filter(atlas %in% c("self-referential", "social_cognitive")) %>%
  group_by(SID, atlas) %>%
  mutate(parameter_estimate_std = parameter_estimate / sd(parameter_estimate, na.rm = TRUE)) %>%
  left_join(., ratings_z)

merged_wide = merged %>%
  select(SID, site, trial, article_number, topic, article_cond, msg_share, msg_share_z,
         msg_rel_self, msg_rel_self_z, msg_rel_social, msg_rel_social_z, atlas, parameter_estimate_std) %>%
  spread(atlas, parameter_estimate_std) %>%
  rename("self_referential" = `self-referential`)

quality check

Check the data quality and identify missing data

check number of participants

merged_wide %>%
  select(SID, site) %>%
  group_by(site) %>%
  unique() %>%
  summarize(n = n()) %>%
  arrange(n) %>%
  rename("sample" = site) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()

sample	n
Netherlands	40
USA	45

check number of trials

Print participant IDs who have < 72 trials

merged_wide %>%
  group_by(SID) %>%
  summarize(n = n()) %>%
  filter(n < 72) %>%
  arrange(n) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()

SID	n
BPP65	59
BPA34	62
BPP52	62
BPA23	63
BPP21	63
BPP05	66
BPA45	67
BPP61	67
BPA29	68
BPA47	68
BPP64	68
BPA04	69
BPP56	69
BPA12	70
BPP20	70
BPP58	70
BPA02	71
BPA05	71
BPA08	71
BPA16	71
BPA26	71
BPA27	71
BPA31	71
BPA32	71
BPA33	71
BPA35	71
BPA37	71
BPA38	71
BPA46	71
BPP22	71
BPP67	71

check missing response data

Print participant IDs who have > 0 missing responses

merged_wide %>%
  filter(is.na(msg_share)) %>%
  group_by(SID) %>%
  summarize(n = n()) %>%
  arrange(-n) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()

SID	n
BPA10	12
BPA35	12
BPP21	10
BPA45	9
BPA12	8
BPA33	4
BPP60	3
BPP20	2
BPP26	2
BPP56	2
BPP66	2
BPA02	1
BPA03	1
BPA04	1
BPA08	1
BPA27	1
BPA32	1
BPP12	1
BPP15	1
BPP29	1
BPP33	1
BPP47	1
BPP49	1
BPP65	1

check global signal

These plots are before outliers were excluded

all trials

merged_all %>%
  ggplot(aes("", global_mean, fill = article_cond)) +
  geom_flat_violin(position = position_nudge(x = .15, y = 0), color = FALSE, alpha = .5) +
  coord_flip() +
  geom_point(aes(color = article_cond), position = position_jitter(width = .05), size = .1, alpha = .2) + 
  geom_boxplot(width = .1, outlier.shape = NA, color = "black", position = position_dodge(.15)) +
  scale_fill_manual(values = palette_condition) +
  scale_color_manual(values = palette_condition) +
  scale_x_discrete(expand = c(0, .1)) +
  labs(x = "") + 
  plot_aes

individual averages

merged_all %>%
  group_by(SID, article_cond) %>%
  summarize(global_mean = mean(global_mean, na.rm = TRUE)) %>%
  ggplot(aes("", global_mean, fill = article_cond)) +
  geom_flat_violin(position = position_nudge(x = .15, y = 0), color = FALSE, alpha = .5) +
  coord_flip() +
  geom_point(aes(color = article_cond), position = position_jitter(width = .05), size = 1, alpha = .5) + 
  geom_boxplot(width = .1, outlier.shape = NA, color = "black", position = position_dodge(.15)) +
  scale_fill_manual(values = palette_condition) +
  scale_color_manual(values = palette_condition) +
  scale_x_discrete(expand = c(0, .1)) +
  labs(x = "") + 
  plot_aes

number of outliers

merged_all %>%
  group_by(outlier) %>%
  summarize(n = n()) %>%
  spread(outlier, n) %>%
  mutate(percent = round((yes / (yes + no)) * 100, 1))

descriptives

Summarize means, SDs, and correlations between the ROIs

ratings

merged_wide %>%
  gather(variable, value, msg_share, msg_rel_self, msg_rel_social) %>%
  group_by(variable) %>%
  summarize(M = mean(value, na.rm = TRUE),
            SD = sd(value, na.rm = TRUE)) %>%
  mutate(variable = ifelse(variable == "msg_rel_self", "self-relevance",
                    ifelse(variable == "msg_rel_social", "social relevance", "sharing intention"))) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()

variable	M	SD
self-relevance	2.57	1.02
social relevance	2.67	0.96
sharing intention	2.62	1.02

ROI activity

merged_wide %>%
  gather(variable, value, social_cognitive, self_referential) %>%
  group_by(variable) %>%
  summarize(M = mean(value, na.rm = TRUE),
            SD = sd(value, na.rm = TRUE)) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()

variable	M	SD
self_referential	0.14	1.11
social_cognitive	0.37	1.10

ROI correlations

Correlation between self-referential and social cognitive ROIs. Given the high correlations, we also report sensitivity analyses with alternative, less highly correlated ROIs. Note, we do not include both ROIs in the same model, so multicollinearity is not an issue.

merged %>%
  select(SID, trial, article_cond, atlas, parameter_estimate) %>%
  spread(atlas, parameter_estimate) %>%
  rmcorr::rmcorr(as.factor(SID), social_cognitive, `self-referential`, data = .)

## 
## Repeated measures correlation
## 
## r
## 0.9382227
## 
## degrees of freedom
## 5928
## 
## p-value
## 0
## 
## 95% confidence interval
## 0.9351005 0.9411993

H4: relevance ~ ROI activity

Greater activity in the (a) self-referential region of interest (ROI) will be associated with higher self-relevance ratings, and (b) greater activity in the social cognitive ROI will be associated with higher social relevance ratings.

self-referential ROI

mod_h4a =  lmer(msg_rel_self_z ~ self_referential + (1 + self_referential | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h4a)

term	b [95% CI]	df	t	p
intercept	-0.01 [-0.08, 0.07]	84.10	-0.20	.841
self-referential	0.05 [0.02, 0.07]	82.76	3.68	< .001

summary

summary(mod_h4a)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self_z ~ self_referential + (1 + self_referential | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16572.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4362 -0.7057  0.1481  0.6856  2.3548 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.110897 0.33301       
##           self_referential 0.001635 0.04044  -0.76
##  Residual                  0.889874 0.94333       
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                   Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)      -0.007675   0.038196 84.097620  -0.201 0.841236    
## self_referential  0.047262   0.012846 82.763170   3.679 0.000416 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## self_rfrntl -0.294

social cognitive ROI

✅ H4b: Greater activity in the social cognitive ROI will be associated with higher social relevance ratings

mod_h4b = lmer(msg_rel_social_z ~ social_cognitive + (1 + social_cognitive | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h4b)

term	b [95% CI]	df	t	p
intercept	-0.02 [-0.10, 0.07]	84.49	-0.41	.685
social cognitive	0.05 [0.02, 0.08]	83.18	3.80	< .001

summary

summary(mod_h4b)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_social_z ~ social_cognitive + (1 + social_cognitive |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16360.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8332 -0.7255  0.1643  0.6507  2.6739 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.146769 0.38310       
##           social_cognitive 0.002784 0.05276  -0.11
##  Residual                  0.853657 0.92394       
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                  Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)      -0.01773    0.04353 84.49484  -0.407 0.684809    
## social_cognitive  0.05016    0.01320 83.18394   3.800 0.000274 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## socil_cgntv -0.139

combined plot

predicted_h1 = ggeffects::ggpredict(mod_h4a, c("self_referential [-4.5:5]")) %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h4b, c("social_cognitive [-4.5:5]")) %>%
              data.frame() %>%
              mutate(roi = "social cognitive",
                     variable = "social relevance"))

predicted_sub_h1 = ggeffects::ggpredict(mod_h4a, terms = c("self_referential [-4.5:5]", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h4b, c("social_cognitive [-4.5:5]", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(roi = "social cognitive",
                     variable = "social relevance"))

predicted_h1 %>%
  ggplot(aes(x, predicted)) +
  stat_smooth(data = predicted_sub_h1, aes(group = group, color = roi), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = roi), alpha = .5, color = NA) +
  geom_line(aes(color = roi), size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_roi, guide = FALSE) +
  scale_fill_manual(name = "", values = palette_roi, guide = FALSE) +
  labs(x = "\nROI activity (SD)", y = "predicted rating (SD)\n") +
  plot_aes

H5: sharing ~ ROI activity

Greater activity in the (a) self-referential and (b) social cognitive ROIs will be associated with stronger news sharing intentions.

self-referential ROI

mod_h5a = lmer(msg_share_z ~ self_referential + (1 + self_referential | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h5a)

term	b [95% CI]	df	t	p
intercept	-0.01 [-0.08, 0.06]	84.43	-0.27	.791
self-referential	0.08 [0.05, 0.11]	81.64	6.11	< .001

summary

summary(mod_h5a)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ self_referential + (1 + self_referential | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16364.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5959 -0.7247  0.1135  0.7333  2.2539 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.103501 0.32172       
##           self_referential 0.002396 0.04895  -0.22
##  Residual                  0.890352 0.94358       
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                   Estimate Std. Error        df t value     Pr(>|t|)    
## (Intercept)      -0.009864   0.037109 84.429688  -0.266        0.791    
## self_referential  0.081337   0.013305 81.636634   6.113 0.0000000319 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## self_rfrntl -0.128

social cognitive ROI

mod_h5b = lmer(msg_share_z ~ social_cognitive + (1 + social_cognitive | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h5b)

term	b [95% CI]	df	t	p
intercept	-0.02 [-0.10, 0.05]	85.39	-0.66	.511
social cognitive	0.07 [0.05, 0.10]	81.87	5.48	< .001

summary

summary(mod_h5b)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ social_cognitive + (1 + social_cognitive | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16374.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5853 -0.7230  0.1157  0.7363  2.1999 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.103377 0.32152       
##           social_cognitive 0.002026 0.04502  -0.11
##  Residual                  0.892212 0.94457       
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                  Estimate Std. Error       df t value    Pr(>|t|)    
## (Intercept)      -0.02466    0.03732 85.39356  -0.661       0.511    
## social_cognitive  0.07207    0.01316 81.87395   5.477 0.000000465 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## socil_cgntv -0.151

combined plot

vals = seq(-4.5, 4.5, .1)

predicted_h5 = ggeffects::ggpredict(mod_h5a, c("self_referential [vals]")) %>%
  data.frame() %>%
  mutate(roi = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h5b, c("social_cognitive [vals]")) %>%
              data.frame() %>%
              mutate(roi = "social cognitive")) %>%
  mutate(roi = factor(roi, levels = c("self-referential", "social cognitive")))

predicted_sub_h5 = ggeffects::ggpredict(mod_h5a, terms = c("self_referential [vals]", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(roi = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h5b, c("social_cognitive [vals]", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(roi = "social cognitive")) %>%
  mutate(roi = factor(roi, levels = c("self-referential", "social cognitive")))

predicted_h5 %>%
  ggplot(aes(x = x, y = predicted, color = roi, fill = roi)) +
  stat_smooth(data = predicted_sub_h5, aes(group = group), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
  geom_line(size = 2) +
  facet_grid(~roi) +
  scale_color_manual(name = "", values = palette_roi) +
  scale_fill_manual(name = "", values = palette_roi) +
  labs(y = "predicted sharing intention (SD)\n", x = "\nROI activity (SD)") +
  plot_aes +
  theme(legend.position = "none")

H6 ROI activity ~ intervention condition

Compared to the control condition, the (a) self-focused condition will increase activity in the self-referential ROI, and the (b) other-focused condition will increase activity in the social cognitive ROI.

self-referential ROI

mod_h6a = lmer(self_referential ~ article_cond + (1 + article_cond | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h6a)

term	b [95% CI]	df	t	p
intercept	0.08 [-0.03, 0.20]	84.07	1.46	.147
other - control	0.09 [0.01, 0.16]	83.53	2.19	.032
self - control	0.09 [0.00, 0.17]	83.67	2.06	.043

summary

summary(mod_h6a)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ article_cond + (1 + article_cond | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17285
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7918 -0.6605  0.0028  0.6473  3.6030 
## 
## Random effects:
##  Groups   Name              Variance Std.Dev. Corr       
##  SID      (Intercept)       0.23308  0.4828              
##           article_condother 0.04602  0.2145   -0.18      
##           article_condself  0.07364  0.2714   -0.07  0.59
##  Residual                   0.97964  0.9898              
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                   Estimate Std. Error       df t value Pr(>|t|)  
## (Intercept)        0.08318    0.05685 84.06819   1.463   0.1471  
## article_condother  0.08524    0.03898 83.53395   2.187   0.0316 *
## article_condself   0.08831    0.04295 83.66774   2.056   0.0429 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.321           
## artcl_cndsl -0.246  0.534

social cognitive ROI

mod_h6b = lmer(social_cognitive ~ article_cond + (1 + article_cond | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h6b)

term	b [95% CI]	df	t	p
intercept	0.33 [0.22, 0.44]	84.10	5.93	< .001
other - control	0.06 [-0.02, 0.14]	83.34	1.58	.117
self - control	0.07 [-0.01, 0.16]	83.73	1.72	.089

summary

summary(mod_h6b)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_cognitive ~ article_cond + (1 + article_cond | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17288.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6193 -0.6570  0.0214  0.6732  3.3254 
## 
## Random effects:
##  Groups   Name              Variance Std.Dev. Corr       
##  SID      (Intercept)       0.21885  0.4678              
##           article_condother 0.03877  0.1969   -0.19      
##           article_condself  0.06933  0.2633   -0.05  0.61
##  Residual                   0.98228  0.9911              
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                   Estimate Std. Error       df t value     Pr(>|t|)    
## (Intercept)        0.32819    0.05537 84.09849   5.928 0.0000000656 ***
## article_condother  0.05999    0.03790 83.34491   1.583       0.1173    
## article_condself   0.07296    0.04239 83.72988   1.721       0.0889 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.331           
## artcl_cndsl -0.240  0.537

combined plot

predicted_h6 = ggeffects::ggpredict(mod_h6a, c("article_cond")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6b, c("article_cond")) %>%
              data.frame() %>%
              mutate(atlas = "social cognitive")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "social cognitive")))

predicted_sub_h6 = ggeffects::ggpredict(mod_h6a, terms = c("article_cond", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6b, c("article_cond", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(atlas = "social cognitive")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "social cognitive")))

predicted_h6 %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = predicted_sub_h6, aes(group = group), fun = "mean", geom = "line",
               size = .1, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .75) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted ROI activity (SD)\n") +
  plot_aes

exploratory H5 including self-reported relevance

Does ROI activity account for unique variance and improve model fit compared to models that include self-reported relevance ratings?

self-referential ROI

mod_h5a_rating = lmer(msg_share_z ~ msg_rel_self_z + (1 + msg_rel_self_z | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

mod_h5a_combined = lmer(msg_share_z ~ self_referential + msg_rel_self_z + (1 + self_referential +  msg_rel_self_z | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

compare model fits

anova(mod_h5a_combined, mod_h5a, mod_h5a_rating) %>%
      kable() %>%
      kableExtra::kable_styling()

	npar	AIC	BIC	logLik	deviance	Chisq	Df	Pr(>Chisq)
mod_h5a	6	16364.80	16404.93	-8176.401	16352.80	NA	NA	NA
mod_h5a_rating	6	14930.55	14970.68	-7459.276	14918.55	1434.24909	0	NA
mod_h5a_combined	10	14908.82	14975.70	-7444.408	14888.82	29.73679	4	0.0000055

model table

table_model(mod_h5a_combined)

term	b [95% CI]	df	t	p
intercept	0.00 [-0.05, 0.06]	83.16	0.11	.913
self-referential	0.06 [0.03, 0.08]	81.24	5.00	< .001
self-relevance	0.46 [0.42, 0.49]	78.17	26.21	< .001

summary

summary(mod_h5a_combined)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share_z ~ self_referential + msg_rel_self_z + (1 + self_referential +  
##     msg_rel_self_z | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 14907.5
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -3.06620 -0.70637  0.06621  0.67844  2.92039 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr       
##  SID      (Intercept)      0.05778  0.24037             
##           self_referential 0.00136  0.03688   0.26      
##           msg_rel_self_z   0.01424  0.11933  -0.23 -0.16
##  Residual                  0.69120  0.83138             
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                   Estimate Std. Error        df t value             Pr(>|t|)
## (Intercept)       0.003116   0.028472 83.158257   0.109                0.913
## self_referential  0.057443   0.011486 81.243501   5.001           0.00000323
## msg_rel_self_z    0.459305   0.017521 78.170731  26.214 < 0.0000000000000002
##                     
## (Intercept)         
## self_referential ***
## msg_rel_self_z   ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf
## self_rfrntl  0.033       
## msg_rl_slf_ -0.158 -0.076

social cognitive ROI

mod_h5b_rating = lmer(msg_share_z ~ msg_rel_social_z + (1 + msg_rel_social_z | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

mod_h5b_combined = lmer(msg_share_z ~ social_cognitive + msg_rel_social_z + (1 + social_cognitive + msg_rel_social_z | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

compare model fits

anova(mod_h5b_combined, mod_h5b, mod_h5b_rating) %>%
      kable() %>%
      kableExtra::kable_styling()

	npar	AIC	BIC	logLik	deviance	Chisq	Df	Pr(>Chisq)
mod_h5b	6	16375.31	16415.44	-8181.656	16363.31	NA	NA	NA
mod_h5b_rating	6	15080.92	15121.05	-7534.458	15068.92	1294.39580	0	NA
mod_h5b_combined	10	15068.54	15135.43	-7524.269	15048.54	20.37653	4	0.0004208

model table

table_model(mod_h5b_combined)

term	b [95% CI]	df	t	p
intercept	-0.00 [-0.06, 0.06]	86.06	-0.11	.912
social cognitive	0.05 [0.03, 0.07]	4336.61	4.49	< .001
social relevance	0.43 [0.39, 0.47]	81.49	20.32	< .001

summary

summary(mod_h5b_combined)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share_z ~ social_cognitive + msg_rel_social_z + (1 + social_cognitive +  
##     msg_rel_social_z | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 15066.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.1072 -0.7063  0.1038  0.6966  3.0993 
## 
## Random effects:
##  Groups   Name             Variance   Std.Dev. Corr       
##  SID      (Intercept)      0.06053680 0.246042            
##           social_cognitive 0.00002829 0.005319 -1.00      
##           msg_rel_social_z 0.02542330 0.159447 -0.04  0.04
##  Residual                  0.70791190 0.841375            
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                     Estimate  Std. Error          df t value
## (Intercept)        -0.003258    0.029395   86.055708  -0.111
## social_cognitive    0.049054    0.010928 4336.608346   4.489
## msg_rel_social_z    0.432303    0.021273   81.493212  20.322
##                              Pr(>|t|)    
## (Intercept)                     0.912    
## social_cognitive           0.00000735 ***
## msg_rel_social_z < 0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl_cg
## socil_cgntv -0.189       
## msg_rl_scl_ -0.031 -0.031
## optimizer (bobyqa) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')

exploratory moderation by topic

These analyses explore whether the analyses testing H4-6 are moderated by topic (climate or health).

H4: relevance ~ ROI activity

Are the relationships between ROI activity and self and social relevance ratings moderated by cultural context?

self-referential ROI

mod_h4am =  lmer(msg_rel_self_z ~ self_referential * topic + (1 + self_referential | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h4am = table_model(mod_h4am, print = FALSE)

table_h4am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.08 [-0.15, 0.00]	101.83	-1.88	.063
self-referential	0.03 [0.00, 0.07]	250.16	1.97	.050
self-referential x topic (health)	0.02 [-0.02, 0.06]	5883.47	0.92	.355
topic (health)	0.14 [0.09, 0.18]	5923.21	5.52	< .001

simple slopes

simple_slopes(mod_h4am, "self_referential", "topic")

topic	b [95% CI]
climate	0.03 [0.00, 0.07]
health	0.05 [0.02, 0.09]

summary

summary(mod_h4am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self_z ~ self_referential * topic + (1 + self_referential |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16550.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4927 -0.6882  0.1329  0.6765  2.4258 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.110883 0.33299       
##           self_referential 0.001203 0.03468  -0.91
##  Residual                  0.885702 0.94112       
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                                Estimate Std. Error         df t value
## (Intercept)                    -0.07526    0.04004  101.83269  -1.880
## self_referential                0.03321    0.01684  250.16040   1.972
## topichealth                     0.13540    0.02452 5923.20627   5.523
## self_referential:topichealth    0.02037    0.02204 5883.47393   0.924
##                                  Pr(>|t|)    
## (Intercept)                        0.0630 .  
## self_referential                   0.0497 *  
## topichealth                  0.0000000347 ***
## self_referential:topichealth       0.3555    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf tpchlt
## self_rfrntl -0.221              
## topichealth -0.302  0.044       
## slf_rfrntl:  0.024 -0.661 -0.127

social cognitive ROI

These data are not consistent with moderation by cultural context.

mod_h4bm = lmer(msg_rel_social_z ~ social_cognitive * topic + (1 + social_cognitive | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h4bm = table_model(mod_h4bm, print = FALSE)

table_h4bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.17 [-0.26, -0.08]	97.93	-3.69	< .001
social cognitive	0.04 [0.00, 0.07]	226.60	2.16	.032
social cognitive x topic (health)	0.01 [-0.03, 0.06]	5903.41	0.66	.512
topic (health)	0.30 [0.25, 0.35]	5924.99	12.18	< .001

simple slopes

simple_slopes(mod_h4bm, "social_cognitive", "topic")

topic	b [95% CI]
climate	0.04 [0.00, 0.07]
health	0.05 [0.02, 0.08]

summary

summary(mod_h4bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_social_z ~ social_cognitive * topic + (1 + social_cognitive |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16202.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7740 -0.7047  0.1262  0.6762  2.7725 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.147416 0.38395       
##           social_cognitive 0.002149 0.04635  -0.17
##  Residual                  0.830401 0.91126       
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                                Estimate Std. Error         df t value
## (Intercept)                    -0.16690    0.04519   97.92854  -3.693
## social_cognitive                0.03581    0.01656  226.60224   2.162
## topichealth                     0.30318    0.02490 5924.99396  12.178
## social_cognitive:topichealth    0.01407    0.02148 5903.41024   0.655
##                                          Pr(>|t|)    
## (Intercept)                              0.000365 ***
## social_cognitive                         0.031673 *  
## topichealth                  < 0.0000000000000002 ***
## social_cognitive:topichealth             0.512335    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl_cg tpchlt
## socil_cgntv -0.156              
## topichealth -0.267  0.173       
## scl_cgntv:t  0.076 -0.636 -0.323

combined plot

vals = seq(-4.5,4.5,.1)

predicted_h1m = ggeffects::ggpredict(mod_h4am, c("self_referential [vals]", "topic")) %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h4bm, c("social_cognitive [vals]", "topic")) %>%
              data.frame() %>%
              mutate(roi = "social_cognitive",
                     variable = "social relevance"))

predicted_sub_h1m = ggeffects::ggpredict(mod_h4am, terms = c("self_referential [vals]", "topic", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h4bm, c("social_cognitive [vals]", "topic", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(roi = "social_cognitive",
                     variable = "social relevance"))

predicted_h1m %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  stat_smooth(data = predicted_sub_h1m, aes(group = interaction(group, facet)),
              geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
  geom_line(size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_topic) +
  scale_fill_manual(name = "", values = palette_topic) +
  labs(x = "\nROI activity (SD)", y = "predicted rating (SD)\n") +
  plot_aes +
  theme(legend.position = "top",
        legend.key.width=unit(1,"cm"))

H5: sharing ~ ROI activity

Are the relationships between ROI activity positively and sharing intentions moderated by cultural context?

self-referential ROI

mod_h5am = lmer(msg_share_z ~ self_referential * topic + (1 + self_referential | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h5am = table_model(mod_h5am, print = FALSE)

table_h5am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.13 [-0.20, -0.05]	103.54	-3.25	.002
self-referential	0.07 [0.04, 0.11]	241.01	4.18	< .001
self-referential x topic (health)	0.01 [-0.04, 0.05]	5837.06	0.31	.759
topic (health)	0.24 [0.19, 0.28]	5845.60	9.56	< .001

simple slopes

simple_slopes(mod_h5am, "self_referential", "topic", continuous = TRUE)

topic	b [95% CI]
climate	0.07 [0.04, 0.11]
health	0.08 [0.05, 0.11]

summary

summary(mod_h5am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ self_referential * topic + (1 + self_referential |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16282.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5112 -0.7286  0.1045  0.7516  2.1642 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.103371 0.3215        
##           self_referential 0.001789 0.0423   -0.32
##  Residual                  0.877221 0.9366        
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                                 Estimate  Std. Error          df t value
## (Intercept)                    -0.126828    0.038984  103.544212  -3.253
## self_referential                0.071661    0.017153  241.007845   4.178
## topichealth                     0.235047    0.024586 5845.604339   9.560
## self_referential:topichealth    0.006793    0.022140 5837.058862   0.307
##                                          Pr(>|t|)    
## (Intercept)                               0.00154 ** 
## self_referential                        0.0000412 ***
## topichealth                  < 0.0000000000000002 ***
## self_referential:topichealth              0.75897    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf tpchlt
## self_rfrntl -0.114              
## topichealth -0.312  0.047       
## slf_rfrntl:  0.027 -0.655 -0.129

social cognitive ROI

These data are not consistent with moderation by cultural context.

mod_h5bm = lmer(msg_share_z ~ social_cognitive * topic + (1 + social_cognitive | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h5bm = table_model(mod_h5bm, print = FALSE)

table_h5bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.14 [-0.22, -0.07]	105.80	-3.65	< .001
social cognitive	0.07 [0.04, 0.11]	240.64	4.31	< .001
social cognitive x topic (health)	-0.01 [-0.06, 0.03]	5824.61	-0.51	.607
topic (health)	0.24 [0.19, 0.29]	5840.93	9.37	< .001

simple slopes

simple_slopes(mod_h5bm, "social_cognitive", "topic", continuous = TRUE)

topic	b [95% CI]
climate	0.07 [0.04, 0.11]
health	0.06 [0.03, 0.09]

summary

summary(mod_h5bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ social_cognitive * topic + (1 + social_cognitive |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16292
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4759 -0.7331  0.1117  0.7614  2.1251 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.103677 0.32199       
##           social_cognitive 0.001159 0.03404  -0.18
##  Residual                  0.879058 0.93758       
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                                Estimate Std. Error         df t value
## (Intercept)                    -0.14351    0.03937  105.79614  -3.645
## social_cognitive                0.07231    0.01678  240.63847   4.310
## topichealth                     0.24189    0.02580 5840.93079   9.374
## social_cognitive:topichealth   -0.01144    0.02224 5824.61179  -0.514
##                                          Pr(>|t|)    
## (Intercept)                              0.000416 ***
## social_cognitive                        0.0000238 ***
## topichealth                  < 0.0000000000000002 ***
## social_cognitive:topichealth             0.607155    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl_cg tpchlt
## socil_cgntv -0.170              
## topichealth -0.319  0.182       
## scl_cgntv:t  0.093 -0.654 -0.327

combined plot

vals = seq(-4.5,4.5,.1)

predicted_h5m = ggeffects::ggpredict(mod_h5am, c("self_referential [vals]", "topic")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h5bm, c("social_cognitive [vals]", "topic")) %>%
              data.frame() %>%
              mutate(atlas = "social_cognitive")) %>%
  mutate(atlas = factor(atlas, levels = c("self-referential", "social_cognitive")))

predicted_sub_h5m = ggeffects::ggpredict(mod_h5am, terms = c("self_referential [vals]", "topic", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(roi = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h5bm, c("social_cognitive [vals]", "topic", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(roi = "social_cognitive")) %>%
  mutate(roi = factor(roi, levels = c("self-referential", "social_cognitive")))

predicted_h5m %>%
  ggplot(aes(x = x, y = predicted, color = group, fill = group)) +
  stat_smooth(data = predicted_sub_h5m, aes(group = interaction(group, facet)),
              geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
  geom_line(size = 2) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_topic) +
  scale_fill_manual(name = "", values = palette_topic) +
  labs(y = "predicted sharing intention\n", x = "\nROI activity (SD)") +
  plot_aes +
  theme(legend.position = "top")

H6: ROI activity ~ intervention condition

Are the effects of the experimental manipulations on ROI activity moderated by cultural context?

self-referential ROI

mod_h6am = lmer(self_referential ~ article_cond * topic + (1 + article_cond | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h6am = table_model(mod_h6am, print = FALSE)

table_h6am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.01 [-0.11, 0.13]	111.15	0.23	.817
other - control	0.09 [-0.01, 0.19]	223.56	1.76	.080
other x topic (health)	-0.01 [-0.13, 0.12]	5759.09	-0.10	.923
self - control	0.13 [0.02, 0.23]	194.40	2.38	.018
self x topic (health)	-0.08 [-0.20, 0.05]	5759.09	-1.23	.219
topic (health)	0.14 [0.05, 0.23]	5759.54	3.14	.002

simple slopes

simple_slopes(mod_h6am, "article_cond", "topic", continuous = FALSE)

contrast	topic	b [95% CI]
other - control	climate	0.09 [-0.01, 0.19]
other - control	health	0.08 [-0.02, 0.18]
self - control	climate	0.13 [0.02, 0.23]
self - control	health	0.05 [-0.05, 0.15]

summary

summary(mod_h6am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ article_cond * topic + (1 + article_cond |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17277.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8287 -0.6532  0.0009  0.6469  3.6402 
## 
## Random effects:
##  Groups   Name              Variance Std.Dev. Corr       
##  SID      (Intercept)       0.23296  0.4827              
##           article_condother 0.04633  0.2152   -0.18      
##           article_condself  0.07389  0.2718   -0.07  0.59
##  Residual                   0.97663  0.9882              
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                                  Estimate  Std. Error          df t value
## (Intercept)                      0.014164    0.060933  111.151471   0.232
## article_condother                0.087816    0.049945  223.557377   1.758
## article_condself                 0.126442    0.053085  194.397285   2.382
## topichealth                      0.138468    0.044161 5759.543979   3.136
## article_condother:topichealth   -0.006027    0.062437 5759.089566  -0.097
## article_condself:topichealth    -0.076784    0.062454 5759.092347  -1.229
##                               Pr(>|t|)   
## (Intercept)                    0.81662   
## article_condother              0.08007 . 
## article_condself               0.01819 * 
## topichealth                    0.00172 **
## article_condother:topichealth  0.92311   
## article_condself:topichealth   0.21895   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt artcl_cnds tpchlt artcl_cndt:
## artcl_cndth -0.393                                         
## artcl_cndsl -0.335  0.520                                  
## topichealth -0.361  0.441      0.415                       
## artcl_cndt:  0.255 -0.625     -0.293     -0.707            
## artcl_cnds:  0.255 -0.312     -0.588     -0.707  0.500

social cognitive ROI

There is a main effect of topic, such that the American cohort has greater activity in the self-referential ROI compared to the Dutch cohort.

These data are not consistent with moderation by cultural context.

mod_h6bm = lmer(social_cognitive ~ article_cond * topic + (1 + article_cond | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h6bm = table_model(mod_h6bm, print = FALSE)

table_h6bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.27 [0.15, 0.39]	112.87	4.55	< .001
other - control	0.06 [-0.04, 0.15]	233.74	1.16	.249
other x topic (health)	0.01 [-0.12, 0.13]	5759.16	0.09	.929
self - control	0.10 [-0.00, 0.20]	198.59	1.91	.057
self x topic (health)	-0.06 [-0.18, 0.07]	5759.10	-0.89	.371
topic (health)	0.11 [0.03, 0.20]	5759.59	2.58	.010

simple slopes

simple_slopes(mod_h6bm, "article_cond", "topic", continuous = FALSE)

contrast	topic	b [95% CI]
other - control	climate	0.06 [-0.04, 0.15]
other - control	health	0.06 [-0.03, 0.16]
self - control	climate	0.10 [-0.00, 0.20]
self - control	health	0.04 [-0.06, 0.15]

summary

summary(mod_h6bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_cognitive ~ article_cond * topic + (1 + article_cond |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17285.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6809 -0.6608  0.0154  0.6675  3.2685 
## 
## Random effects:
##  Groups   Name              Variance Std.Dev. Corr       
##  SID      (Intercept)       0.21874  0.4677              
##           article_condother 0.03899  0.1975   -0.19      
##           article_condself  0.06951  0.2637   -0.05  0.61
##  Residual                   0.98011  0.9900              
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                                  Estimate  Std. Error          df t value
## (Intercept)                      0.271239    0.059574  112.871194   4.553
## article_condother                0.056826    0.049143  233.737739   1.156
## article_condself                 0.100709    0.052663  198.594002   1.912
## topichealth                      0.114265    0.044239 5759.592770   2.583
## article_condother:topichealth    0.005579    0.062548 5759.155157   0.089
## article_condself:topichealth    -0.055923    0.062564 5759.104454  -0.894
##                                Pr(>|t|)    
## (Intercept)                   0.0000134 ***
## article_condother               0.24873    
## article_condself                0.05727 .  
## topichealth                     0.00982 ** 
## article_condother:topichealth   0.92893    
## article_condself:topichealth    0.37144    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt artcl_cnds tpchlt artcl_cndt:
## artcl_cndth -0.403                                         
## artcl_cndsl -0.334  0.521                                  
## topichealth -0.370  0.449      0.419                       
## artcl_cndt:  0.262 -0.636     -0.296     -0.707            
## artcl_cnds:  0.262 -0.317     -0.593     -0.707  0.500

combined plot

predicted_h4m = ggeffects::ggpredict(mod_h6am, c("article_cond", "topic")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6bm, c("article_cond", "topic")) %>%
              data.frame() %>%
              mutate(atlas = "social_cognitive")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "social_cognitive")))

predicted_sub_h4m = ggeffects::ggpredict(mod_h6am, terms = c("article_cond", "topic", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6bm, c("article_cond", "topic", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(atlas = "social_cognitive")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "social_cognitive")))

predicted_h4m %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = predicted_sub_h4m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75, position = position_dodge(.1)) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_topic) +
  labs(x = "", y = "predicted ROI activity (SD)\n") +
  plot_aes +
  theme(legend.position = c(.18, .95))

combined table

table_h4am %>% mutate(DV = "H4b: Self-relevance") %>%
  bind_rows(table_h4bm %>% mutate(DV = "H4b: Social relevance")) %>%
  bind_rows(table_h5am %>% mutate(DV = "H5a: Narrowcast sharing intention")) %>%
  bind_rows(table_h5bm %>% mutate(DV = "H5b: Narrowcast sharing intention")) %>%
  bind_rows(table_h6am %>% mutate(DV = "H6a: Self-referential ROI")) %>%
  bind_rows(table_h6bm %>% mutate(DV = "H6b: social cognitive ROI")) %>%
  select(DV, everything()) %>%
  kable() %>%
  kable_styling()

DV	term	b [95% CI]	df	t	p
H4b: Self-relevance	intercept	-0.08 [-0.15, 0.00]	101.83	-1.88	.063
H4b: Self-relevance	self-referential	0.03 [0.00, 0.07]	250.16	1.97	.050
H4b: Self-relevance	self-referential x topic (health)	0.02 [-0.02, 0.06]	5883.47	0.92	.355
H4b: Self-relevance	topic (health)	0.14 [0.09, 0.18]	5923.21	5.52	< .001
H4b: Social relevance	intercept	-0.17 [-0.26, -0.08]	97.93	-3.69	< .001
H4b: Social relevance	social cognitive	0.04 [0.00, 0.07]	226.60	2.16	.032
H4b: Social relevance	social cognitive x topic (health)	0.01 [-0.03, 0.06]	5903.41	0.66	.512
H4b: Social relevance	topic (health)	0.30 [0.25, 0.35]	5924.99	12.18	< .001
H5a: Narrowcast sharing intention	intercept	-0.13 [-0.20, -0.05]	103.54	-3.25	.002
H5a: Narrowcast sharing intention	self-referential	0.07 [0.04, 0.11]	241.01	4.18	< .001
H5a: Narrowcast sharing intention	self-referential x topic (health)	0.01 [-0.04, 0.05]	5837.06	0.31	.759
H5a: Narrowcast sharing intention	topic (health)	0.24 [0.19, 0.28]	5845.60	9.56	< .001
H5b: Narrowcast sharing intention	intercept	-0.14 [-0.22, -0.07]	105.80	-3.65	< .001
H5b: Narrowcast sharing intention	social cognitive	0.07 [0.04, 0.11]	240.64	4.31	< .001
H5b: Narrowcast sharing intention	social cognitive x topic (health)	-0.01 [-0.06, 0.03]	5824.61	-0.51	.607
H5b: Narrowcast sharing intention	topic (health)	0.24 [0.19, 0.29]	5840.93	9.37	< .001
H6a: Self-referential ROI	intercept	0.01 [-0.11, 0.13]	111.15	0.23	.817
H6a: Self-referential ROI	other - control	0.09 [-0.01, 0.19]	223.56	1.76	.080
H6a: Self-referential ROI	other x topic (health)	-0.01 [-0.13, 0.12]	5759.09	-0.10	.923
H6a: Self-referential ROI	self - control	0.13 [0.02, 0.23]	194.40	2.38	.018
H6a: Self-referential ROI	self x topic (health)	-0.08 [-0.20, 0.05]	5759.09	-1.23	.219
H6a: Self-referential ROI	topic (health)	0.14 [0.05, 0.23]	5759.54	3.14	.002
H6b: social cognitive ROI	intercept	0.27 [0.15, 0.39]	112.87	4.55	< .001
H6b: social cognitive ROI	other - control	0.06 [-0.04, 0.15]	233.74	1.16	.249
H6b: social cognitive ROI	other x topic (health)	0.01 [-0.12, 0.13]	5759.16	0.09	.929
H6b: social cognitive ROI	self - control	0.10 [-0.00, 0.20]	198.59	1.91	.057
H6b: social cognitive ROI	self x topic (health)	-0.06 [-0.18, 0.07]	5759.10	-0.89	.371
H6b: social cognitive ROI	topic (health)	0.11 [0.03, 0.20]	5759.59	2.58	.010

exploratory moderation by cultural context

These analyses explore whether the analyses testing H1-6 are moderated by cultural context (the Netherlands or the USA).

H1: sharing ~ self-relvance + social relevance

Are the relationships between self and social relevance and sharing intentions moderated by cultural context?

mod_h1m = lmer(msg_share_z ~ msg_rel_self_z * site + msg_rel_social_z * site + (1 + msg_rel_self_z + msg_rel_social_z | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted_h1m = ggeffects::ggpredict(mod_h1m, c("msg_rel_self_z", "site")) %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h1m, c("msg_rel_social_z", "site")) %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

predicted_sub_h1m = ggeffects::ggpredict(mod_h1m, terms = c("msg_rel_self_z", "site", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h1m, c("msg_rel_social_z", "site", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(variable = "social relevance")) %>%
  filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))

predicted_h1m %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  stat_smooth(data = predicted_sub_h1m, aes(group = interaction(group, facet)),
              geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
  geom_line(size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_sample) +
  scale_fill_manual(name = "", values = palette_sample) +
  labs(x = "\nrating (SD)", y = "predicted sharing intention\n") +
  plot_aes +
  theme(legend.key.width=unit(1,"cm"))

model table

table_h1m = table_model(mod_h1m, print = FALSE)

table_h1m %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.03 [-0.11, 0.04]	82.76	-0.89	.377
sample (USA)	0.09 [-0.01, 0.20]	82.28	1.78	.078
self-relevance	0.32 [0.26, 0.38]	89.64	11.01	< .001
self-relevance x sample (USA)	-0.03 [-0.11, 0.04]	84.71	-0.87	.385
social relevance	0.22 [0.14, 0.29]	88.54	5.95	< .001
social relevance x sample (USA)	0.04 [-0.06, 0.14]	82.51	0.79	.429

simple slopes

self-relevance

simple_slopes(mod_h1m, "msg_rel_self_z", "site", continuous = TRUE)

site	b [95% CI]
Netherlands	0.32 [0.26, 0.38]
USA	0.29 [0.24, 0.34]

social -relevance

simple_slopes(mod_h1m, "msg_rel_social_z", "site", continuous = TRUE)

site	b [95% CI]
Netherlands	0.22 [0.14, 0.29]
USA	0.25 [0.19, 0.32]

summary

summary(mod_h1m)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ msg_rel_self_z * site + msg_rel_social_z * site +  
##     (1 + msg_rel_self_z + msg_rel_social_z | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 14653.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3723 -0.6976  0.0547  0.6917  3.0523 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr       
##  SID      (Intercept)      0.04897  0.2213              
##           msg_rel_self_z   0.01157  0.1075   -0.38      
##           msg_rel_social_z 0.02831  0.1683    0.20 -0.55
##  Residual                  0.65721  0.8107              
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                          Estimate Std. Error       df t value
## (Intercept)              -0.03443    0.03874 82.75583  -0.889
## msg_rel_self_z            0.32094    0.02914 89.64057  11.013
## siteUSA                   0.09480    0.05317 82.28352   1.783
## msg_rel_social_z          0.21524    0.03618 88.54225   5.949
## msg_rel_self_z:siteUSA   -0.03408    0.03902 84.70847  -0.874
## siteUSA:msg_rel_social_z  0.03870    0.04868 82.51251   0.795
##                                      Pr(>|t|)    
## (Intercept)                            0.3768    
## msg_rel_self_z           < 0.0000000000000002 ***
## siteUSA                                0.0782 .  
## msg_rel_social_z                 0.0000000528 ***
## msg_rel_self_z:siteUSA                 0.3849    
## siteUSA:msg_rel_social_z               0.4289    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) msg_rl_sl_ sitUSA msg_rl_sc_ m___:U
## msg_rl_slf_ -0.200                                    
## siteUSA     -0.729  0.146                             
## msg_rl_scl_  0.112 -0.590     -0.082                  
## msg_r__:USA  0.149 -0.747     -0.210  0.441           
## stUSA:ms___ -0.083  0.439      0.129 -0.743     -0.593

H2: relevance ~ intervention condition

Are the effects of the experimental manipulations on relevance moderated by cultural context?

self-relevance

mod_h2am = lmer(msg_rel_self_z ~ article_cond * site + (1 | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h2am = table_model(mod_h2am, print = FALSE)

table_h2am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.01 [-0.11, 0.13]	121.34	0.22	.827
other - control	0.04 [-0.05, 0.12]	5925.43	0.83	.409
other x sample (USA)	-0.06 [-0.17, 0.06]	5925.30	-0.94	.347
sample (USA)	-0.05 [-0.21, 0.12]	121.28	-0.58	.560
self - control	0.04 [-0.05, 0.12]	5925.22	0.89	.372
self x sample (USA)	-0.01 [-0.13, 0.11]	5925.33	-0.20	.843

simple slopes

simple_slopes(mod_h2am, "article_cond", "site", continuous = FALSE)

contrast	site	b [95% CI]
other - control	Netherlands	0.04 [-0.05, 0.12]
other - control	USA	-0.02 [-0.10, 0.06]
self - control	Netherlands	0.04 [-0.05, 0.12]
self - control	USA	0.03 [-0.05, 0.11]

summary

summary(mod_h2am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self_z ~ article_cond * site + (1 | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16605
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4248 -0.7129  0.1645  0.6768  2.3191 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.1083   0.3291  
##  Residual             0.8939   0.9455  
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                             Estimate Std. Error         df t value Pr(>|t|)
## (Intercept)                  0.01327    0.06048  121.33565   0.219    0.827
## article_condother            0.03595    0.04357 5925.43253   0.825    0.409
## article_condself             0.03884    0.04352 5925.21630   0.892    0.372
## siteUSA                     -0.04860    0.08311  121.27909  -0.585    0.560
## article_condother:siteUSA   -0.05622    0.05984 5925.30373  -0.940    0.347
## article_condself:siteUSA    -0.01186    0.05984 5925.33152  -0.198    0.843
## 
## Correlation of Fixed Effects:
##                (Intr) artcl_cndt artcl_cnds sitUSA artcl_cndt:USA
## artcl_cndth    -0.360                                            
## artcl_cndsl    -0.361  0.501                                     
## siteUSA        -0.728  0.262      0.262                          
## artcl_cndt:USA  0.262 -0.728     -0.364     -0.360               
## artcl_cnds:USA  0.262 -0.364     -0.727     -0.360  0.500

social relevance

These data are not consistent with moderation by cultural context.

mod_h2bm = lmer(msg_rel_social_z ~ article_cond * site + (1 | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h2bm = table_model(mod_h2bm, print = FALSE)

table_h2bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.06 [-0.07, 0.19]	111.11	0.87	.388
other - control	0.02 [-0.07, 0.10]	5925.36	0.39	.694
other x sample (USA)	0.06 [-0.06, 0.17]	5925.26	0.99	.321
sample (USA)	-0.17 [-0.35, 0.02]	111.07	-1.81	.074
self - control	0.00 [-0.08, 0.08]	5925.20	0.00	1.000
self x sample (USA)	0.09 [-0.03, 0.20]	5925.28	1.52	.128

simple slopes

simple_slopes(mod_h2bm, "article_cond", "site", continuous = FALSE)

contrast	site	b [95% CI]
other - control	Netherlands	0.02 [-0.07, 0.10]
other - control	USA	0.07 [-0.00, 0.15]
self - control	Netherlands	0.00 [-0.08, 0.08]
self - control	USA	0.09 [0.01, 0.17]

summary

summary(mod_h2bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_social_z ~ article_cond * site + (1 | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16387.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7612 -0.7255  0.1759  0.6447  2.7087 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.1429   0.3781  
##  Residual             0.8587   0.9266  
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                                Estimate    Std. Error            df t value
## (Intercept)                  0.05804452    0.06696997  111.10552293   0.867
## article_condother            0.01677308    0.04270320 5925.36015579   0.393
## article_condself             0.00002459    0.04265496 5925.19694739   0.001
## siteUSA                     -0.16612725    0.09203319  111.06530939  -1.805
## article_condother:siteUSA    0.05816273    0.05864508 5925.26321172   0.992
## article_condself:siteUSA     0.08939993    0.05865191 5925.28388039   1.524
##                           Pr(>|t|)  
## (Intercept)                 0.3880  
## article_condother           0.6945  
## article_condself            0.9995  
## siteUSA                     0.0738 .
## article_condother:siteUSA   0.3213  
## article_condself:siteUSA    0.1275  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                (Intr) artcl_cndt artcl_cnds sitUSA artcl_cndt:USA
## artcl_cndth    -0.319                                            
## artcl_cndsl    -0.319  0.501                                     
## siteUSA        -0.728  0.232      0.232                          
## artcl_cndt:USA  0.232 -0.728     -0.364     -0.319               
## artcl_cnds:USA  0.232 -0.364     -0.727     -0.319  0.500

combined plot

predicted_h2m = ggeffects::ggpredict(mod_h2am, c("article_cond", "site")) %>%
  data.frame() %>%
  mutate(model = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h2bm, c("article_cond", "site")) %>%
              data.frame() %>%
              mutate(model = "social relevance")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

predicted_sub_h2m = ggeffects::ggpredict(mod_h2am, terms = c("article_cond", "site", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(model = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h2bm, c("article_cond", "site", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(model = "social relevance")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other"))) %>%
  filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
  
predicted_h2m %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = predicted_sub_h2m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1, alpha = .5) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75) +
  facet_grid(~model) +
  scale_color_manual(name = "", values = palette_sample) +
  labs(x = "", y = "predicted rating (SD)\n") +
  plot_aes +
  theme(legend.position = c(.85, .15))

H3: sharing ~ intervention condition

Are the effects of the experimental manipulations on sharing intentions moderated by cultural context?

mod_h3m = lmer(msg_share_z ~ article_cond * site + (1 | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted_h3m = ggeffects::ggpredict(mod_h3m, c("article_cond", "site")) %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

predicted_sub_h3m = ggeffects::ggpredict(mod_h3m, terms = c("article_cond", "site", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other"))) %>%
    filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
  
predicted_h3m %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = predicted_sub_h3m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75, position = position_dodge(.1)) +
  scale_color_manual(name = "", values = palette_sample) +
  labs(x = "", y = "predicted sharing intention\n") +
  plot_aes +
  theme(legend.position = c(.85, .15))

model table

table_h3m = table_model(mod_h3m, print = FALSE)

table_h3m %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.00 [-0.12, 0.12]	124.80	-0.04	.969
other - control	-0.01 [-0.10, 0.07]	5846.72	-0.26	.792
other x sample (USA)	-0.04 [-0.16, 0.08]	5846.55	-0.63	.528
sample (USA)	0.06 [-0.10, 0.22]	124.32	0.70	.483
self - control	-0.05 [-0.13, 0.04]	5846.54	-1.07	.283
self x sample (USA)	0.01 [-0.11, 0.13]	5846.55	0.11	.909

simple slopes

simple_slopes(mod_h3m, "article_cond", "site", continuous = FALSE)

contrast	site	b [95% CI]
other - control	Netherlands	-0.01 [-0.10, 0.07]
other - control	USA	-0.05 [-0.13, 0.03]
self - control	Netherlands	-0.05 [-0.13, 0.04]
self - control	USA	-0.04 [-0.12, 0.04]

summary

summary(mod_h3m)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ article_cond * site + (1 | SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16422.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5651 -0.7038  0.1163  0.7265  2.0366 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.1025   0.3202  
##  Residual             0.8997   0.9485  
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                              Estimate  Std. Error          df t value Pr(>|t|)
## (Intercept)                 -0.002351    0.059484  124.802956  -0.040    0.969
## article_condother           -0.011628    0.044126 5846.721684  -0.264    0.792
## article_condself            -0.047300    0.044064 5846.539716  -1.073    0.283
## siteUSA                      0.057411    0.081674  124.324219   0.703    0.483
## article_condother:siteUSA   -0.038103    0.060439 5846.545015  -0.630    0.528
## article_condself:siteUSA     0.006886    0.060457 5846.553345   0.114    0.909
## 
## Correlation of Fixed Effects:
##                (Intr) artcl_cndt artcl_cnds sitUSA artcl_cndt:USA
## artcl_cndth    -0.371                                            
## artcl_cndsl    -0.372  0.501                                     
## siteUSA        -0.728  0.270      0.271                          
## artcl_cndt:USA  0.271 -0.730     -0.366     -0.370               
## artcl_cnds:USA  0.271 -0.365     -0.729     -0.370  0.500

H4: relevance ~ ROI activity

Are the relationships between ROI activity and self and social relevance ratings moderated by cultural context?

self-referential ROI

mod_h4am =  lmer(msg_rel_self_z ~ self_referential * site + (1 + self_referential | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h4am = table_model(mod_h4am, print = FALSE)

table_h4am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.04 [-0.07, 0.15]	82.64	0.74	.464
sample (USA)	-0.09 [-0.24, 0.06]	83.66	-1.21	.229
self-referential	0.04 [0.00, 0.08]	84.47	2.23	.028
self-referential x sample (USA)	0.01 [-0.04, 0.06]	82.89	0.42	.673

simple slopes

simple_slopes(mod_h4am, "self_referential", "site")

site	b [95% CI]
Netherlands	0.04 [0.01, 0.08]
USA	0.05 [0.02, 0.09]

summary

summary(mod_h4am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self_z ~ self_referential * site + (1 + self_referential |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16579.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4404 -0.7064  0.1525  0.6834  2.3586 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.110209 0.33198       
##           self_referential 0.001787 0.04228  -0.72
##  Residual                  0.889861 0.94332       
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                          Estimate Std. Error       df t value Pr(>|t|)  
## (Intercept)               0.04080    0.05545 82.64212   0.736   0.4639  
## self_referential          0.04238    0.01896 84.46516   2.235   0.0281 *
## siteUSA                  -0.09262    0.07645 83.66025  -1.211   0.2291  
## self_referential:siteUSA  0.01099    0.02595 82.88796   0.424   0.6730  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf sitUSA
## self_rfrntl -0.220              
## siteUSA     -0.725  0.160       
## slf_rfr:USA  0.161 -0.731 -0.280

social cognitive ROI

These data are not consistent with moderation by cultural context.

mod_h4bm = lmer(msg_rel_social_z ~ social_cognitive * site + (1 + social_cognitive | SID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h4bm = table_model(mod_h4bm, print = FALSE)

table_h4bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.06 [-0.07, 0.18]	81.87	0.88	.381
sample (USA)	-0.14 [-0.31, 0.03]	83.42	-1.61	.111
social cognitive	0.05 [0.01, 0.09]	83.25	2.42	.018
social cognitive x sample (USA)	0.01 [-0.05, 0.06]	82.63	0.29	.772

simple slopes

simple_slopes(mod_h4bm, "social_cognitive", "site")

site	b [95% CI]
Netherlands	0.05 [0.01, 0.09]
USA	0.05 [0.02, 0.09]

summary

summary(mod_h4bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_social_z ~ social_cognitive * site + (1 + social_cognitive |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16366.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8378 -0.7241  0.1647  0.6494  2.6771 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.143590 0.37893       
##           social_cognitive 0.002986 0.05465  -0.10
##  Residual                  0.853633 0.92392       
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                           Estimate Std. Error        df t value Pr(>|t|)  
## (Intercept)               0.055052   0.062535 81.872606   0.880   0.3813  
## social_cognitive          0.046946   0.019424 83.247769   2.417   0.0178 *
## siteUSA                  -0.139120   0.086375 83.423613  -1.611   0.1110  
## social_cognitive:siteUSA  0.007734   0.026653 82.631162   0.290   0.7724  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl_cg sitUSA
## socil_cgntv -0.088              
## siteUSA     -0.724  0.064       
## scl_cgn:USA  0.064 -0.729 -0.129

combined plot

vals = seq(-4.5,4.5,.1)

predicted_h1m = ggeffects::ggpredict(mod_h4am, c("self_referential [vals]", "site")) %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h4bm, c("social_cognitive [vals]", "site")) %>%
              data.frame() %>%
              mutate(roi = "social_cognitive",
                     variable = "social relevance"))

predicted_sub_h1m = ggeffects::ggpredict(mod_h4am, terms = c("self_referential [vals]", "site", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h4bm, c("social_cognitive [vals]", "site", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(roi = "social_cognitive",
                     variable = "social relevance")) %>%
  filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))

predicted_h1m %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  stat_smooth(data = predicted_sub_h1m, aes(group = interaction(group, facet)),
              geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
  geom_line(size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_sample) +
  scale_fill_manual(name = "", values = palette_sample) +
  labs(x = "\nROI activity (SD)", y = "predicted rating (SD)\n") +
  plot_aes +
  theme(legend.position = "top",
        legend.key.width=unit(1,"cm"))

H5: sharing ~ ROI activity

Are the relationships between ROI activity positively and sharing intentions moderated by cultural context?

self-referential ROI

mod_h5am = lmer(msg_share_z ~ self_referential * site + (1 + self_referential | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h5am = table_model(mod_h5am, print = FALSE)

table_h5am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.02 [-0.13, 0.09]	82.89	-0.31	.754
sample (USA)	0.01 [-0.14, 0.16]	83.88	0.09	.928
self-referential	0.06 [0.02, 0.10]	82.76	3.10	.003
self-referential x sample (USA)	0.04 [-0.01, 0.09]	81.13	1.51	.135

simple slopes

simple_slopes(mod_h5am, "self_referential", "site", continuous = TRUE)

site	b [95% CI]
Netherlands	0.06 [0.02, 0.10]
USA	0.10 [0.06, 0.14]

summary

summary(mod_h5am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ self_referential * site + (1 + self_referential |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16370.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.6103 -0.7252  0.1129  0.7407  2.3052 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.105267 0.32445       
##           self_referential 0.002113 0.04597  -0.25
##  Residual                  0.890366 0.94359       
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                           Estimate Std. Error        df t value Pr(>|t|)   
## (Intercept)              -0.017083   0.054410 82.886305  -0.314  0.75434   
## self_referential          0.059856   0.019335 82.758013   3.096  0.00268 **
## siteUSA                   0.006816   0.075014 83.881506   0.091  0.92782   
## self_referential:siteUSA  0.039956   0.026476 81.132656   1.509  0.13514   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf sitUSA
## self_rfrntl -0.063              
## siteUSA     -0.725  0.046       
## slf_rfr:USA  0.046 -0.730 -0.123

social cognitive ROI

These data are not consistent with moderation by cultural context.

mod_h5bm = lmer(msg_share_z ~ social_cognitive * site + (1 + social_cognitive | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h5bm = table_model(mod_h5bm, print = FALSE)

table_h5bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.03 [-0.14, 0.08]	82.49	-0.61	.544
sample (USA)	0.01 [-0.14, 0.16]	84.55	0.17	.865
social cognitive	0.06 [0.02, 0.10]	82.57	3.10	.003
social cognitive x sample (USA)	0.02 [-0.03, 0.08]	81.34	0.87	.389

simple slopes

simple_slopes(mod_h5bm, "social_cognitive", "site", continuous = TRUE)

site	b [95% CI]
Netherlands	0.06 [0.02, 0.10]
USA	0.08 [0.05, 0.12]

summary

summary(mod_h5bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share_z ~ social_cognitive * site + (1 + social_cognitive |  
##     SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16382.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5921 -0.7264  0.1166  0.7388  2.2269 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  SID      (Intercept)      0.104787 0.32371       
##           social_cognitive 0.002041 0.04517  -0.12
##  Residual                  0.892236 0.94458       
## Number of obs: 5935, groups:  SID, 85
## 
## Fixed effects:
##                          Estimate Std. Error       df t value Pr(>|t|)   
## (Intercept)              -0.03314    0.05440 82.48975  -0.609  0.54410   
## social_cognitive          0.05968    0.01928 82.57244   3.096  0.00268 **
## siteUSA                   0.01284    0.07526 84.55327   0.171  0.86497   
## social_cognitive:siteUSA  0.02290    0.02643 81.33633   0.867  0.38866   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl_cg sitUSA
## socil_cgntv -0.098              
## siteUSA     -0.723  0.071       
## scl_cgn:USA  0.071 -0.729 -0.147

combined plot

vals = seq(-4.5,4.5,.1)

predicted_h5m = ggeffects::ggpredict(mod_h5am, c("self_referential [vals]", "site")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h5bm, c("social_cognitive [vals]", "site")) %>%
              data.frame() %>%
              mutate(atlas = "social cognitive")) %>%
  mutate(atlas = factor(atlas, levels = c("self-referential", "social cognitive")))

predicted_sub_h5m = ggeffects::ggpredict(mod_h5am, terms = c("self_referential [vals]", "site", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(roi = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h5bm, c("social_cognitive [vals]", "site", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(roi = "social cognitive")) %>%
  mutate(roi = factor(roi, levels = c("self-referential", "social cognitive"))) %>%
    filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))

predicted_h5m %>%
  ggplot(aes(x = x, y = predicted, color = group, fill = group)) +
  stat_smooth(data = predicted_sub_h5m, aes(group = interaction(group, facet)),
              geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
  geom_line(size = 2) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_sample) +
  scale_fill_manual(name = "", values = palette_sample) +
  labs(y = "predicted sharing intention (SD)\n", x = "\nROI activity (SD)") +
  plot_aes +
  theme(legend.position = "top")

H6 ROI activity ~ intervention condition

Are the effects of the experimental manipulations on ROI activity moderated by cultural context?

self-referential ROI

mod_h6am = lmer(self_referential ~ article_cond * site + (1 + article_cond | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h6am = table_model(mod_h6am, print = FALSE)

table_h6am %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	-0.14 [-0.29, 0.01]	83.01	-1.87	.064
other - control	0.10 [-0.01, 0.22]	82.72	1.81	.074
other x sample (USA)	-0.03 [-0.19, 0.12]	82.55	-0.44	.663
sample (USA)	0.43 [0.22, 0.63]	82.99	4.08	< .001
self - control	0.08 [-0.05, 0.20]	82.60	1.23	.222
self x sample (USA)	0.02 [-0.15, 0.19]	82.68	0.24	.814

simple slopes

simple_slopes(mod_h6am, "article_cond", "site", continuous = FALSE)

contrast	site	b [95% CI]
other - control	Netherlands	0.10 [-0.01, 0.22]
other - control	USA	0.07 [-0.04, 0.17]
self - control	Netherlands	0.08 [-0.05, 0.20]
self - control	USA	0.10 [-0.02, 0.21]

summary

summary(mod_h6am)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ article_cond * site + (1 + article_cond |      SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17277.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7968 -0.6584  0.0043  0.6447  3.6151 
## 
## Random effects:
##  Groups   Name              Variance Std.Dev. Corr       
##  SID      (Intercept)       0.18992  0.4358              
##           article_condother 0.04730  0.2175   -0.17      
##           article_condself  0.07548  0.2747   -0.10  0.59
##  Residual                   0.97964  0.9898              
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                           Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)               -0.14260    0.07608 83.01341  -1.874 0.064421 .  
## article_condother          0.10338    0.05713 82.72177   1.810 0.073998 .  
## article_condself           0.07752    0.06296 82.59525   1.231 0.221714    
## siteUSA                    0.42645    0.10456 82.98785   4.079 0.000104 ***
## article_condother:siteUSA -0.03429    0.07848 82.55160  -0.437 0.663349    
## article_condself:siteUSA   0.02041    0.08655 82.67697   0.236 0.814160    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                (Intr) artcl_cndt artcl_cnds sitUSA artcl_cndt:USA
## artcl_cndth    -0.331                                            
## artcl_cndsl    -0.282  0.536                                     
## siteUSA        -0.728  0.241      0.205                          
## artcl_cndt:USA  0.241 -0.728     -0.390     -0.331               
## artcl_cnds:USA  0.205 -0.390     -0.727     -0.281  0.536

social cognitive ROI

mod_h6bm = lmer(social_cognitive ~ article_cond * site + (1 + article_cond | SID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h6bm = table_model(mod_h6bm, print = FALSE)

table_h6bm %>%
    kable()  %>%
    kableExtra::kable_styling()

term	b [95% CI]	df	t	p
intercept	0.12 [-0.03, 0.27]	83.11	1.66	.102
other - control	0.11 [0.00, 0.22]	82.55	2.01	.047
other x sample (USA)	-0.10 [-0.25, 0.05]	82.37	-1.27	.208
sample (USA)	0.38 [0.18, 0.59]	83.09	3.73	< .001
self - control	0.07 [-0.06, 0.19]	82.65	1.10	.276
self x sample (USA)	0.01 [-0.16, 0.18]	82.73	0.11	.915

simple slopes

simple_slopes(mod_h6bm, "article_cond", "site", continuous = FALSE)

contrast	site	b [95% CI]
other - control	Netherlands	0.11 [0.00, 0.22]
other - control	USA	0.01 [-0.09, 0.12]
self - control	Netherlands	0.07 [-0.05, 0.19]
self - control	USA	0.08 [-0.04, 0.19]

summary

summary(mod_h6bm)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_cognitive ~ article_cond * site + (1 + article_cond |      SID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17283.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6509 -0.6550  0.0194  0.6722  3.3344 
## 
## Random effects:
##  Groups   Name              Variance Std.Dev. Corr       
##  SID      (Intercept)       0.18415  0.4291              
##           article_condother 0.03791  0.1947   -0.10      
##           article_condself  0.07119  0.2668   -0.07  0.63
##  Residual                   0.98227  0.9911              
## Number of obs: 6014, groups:  SID, 85
## 
## Fixed effects:
##                           Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)                0.12439    0.07515 83.11408   1.655 0.101642    
## article_condother          0.11088    0.05509 82.55132   2.013 0.047401 *  
## article_condself           0.06819    0.06215 82.64789   1.097 0.275746    
## siteUSA                    0.38494    0.10327 83.08742   3.727 0.000352 ***
## article_condother:siteUSA -0.09608    0.07568 82.36611  -1.270 0.207806    
## article_condself:siteUSA   0.00910    0.08544 82.73055   0.107 0.915436    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                (Intr) artcl_cndt artcl_cnds sitUSA artcl_cndt:USA
## artcl_cndth    -0.305                                            
## artcl_cndsl    -0.264  0.544                                     
## siteUSA        -0.728  0.222      0.192                          
## artcl_cndt:USA  0.222 -0.728     -0.396     -0.305               
## artcl_cnds:USA  0.192 -0.396     -0.727     -0.264  0.544

combined plot

predicted_h4m = ggeffects::ggpredict(mod_h6am, c("article_cond", "site")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6bm, c("article_cond", "site")) %>%
              data.frame() %>%
              mutate(atlas = "social_cognitive")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "social_cognitive")))

predicted_sub_h4m = ggeffects::ggpredict(mod_h6am, terms = c("article_cond", "site", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6bm, c("article_cond", "site", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(atlas = "social_cognitive")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "social_cognitive"))) %>%
  filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))

predicted_h4m %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = predicted_sub_h4m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75, position = position_dodge(.1)) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_sample) +
  labs(x = "", y = "predicted ROI activity (SD)\n") +
  plot_aes +
  theme(legend.position = c(.18, .95))

combined table

table_h1m %>% mutate(DV = "H1a-b: Narrowcast sharing intention") %>%
  bind_rows(table_h2am %>% mutate(DV = "H2a: Self-relevance")) %>%
  bind_rows(table_h2bm %>% mutate(DV = "H2b: Social relevance")) %>%
  bind_rows(table_h3m %>% mutate(DV = "H3: Narrowcast sharing intention")) %>%
  bind_rows(table_h4am %>% mutate(DV = "H4b: Self-relevance")) %>%
  bind_rows(table_h4bm %>% mutate(DV = "H4b: Social relevance")) %>%
  bind_rows(table_h5am %>% mutate(DV = "H5a: Narrowcast sharing intention")) %>%
  bind_rows(table_h5bm %>% mutate(DV = "H5b: Narrowcast sharing intention")) %>%
  bind_rows(table_h6am %>% mutate(DV = "H6a: Self-referential ROI")) %>%
  bind_rows(table_h6bm %>% mutate(DV = "H6b: Social cognitive ROI")) %>%
  select(DV, everything()) %>%
  kable() %>%
  kable_styling()

DV	term	b [95% CI]	df	t	p
H1a-b: Narrowcast sharing intention	intercept	-0.03 [-0.11, 0.04]	82.76	-0.89	.377
H1a-b: Narrowcast sharing intention	sample (USA)	0.09 [-0.01, 0.20]	82.28	1.78	.078
H1a-b: Narrowcast sharing intention	self-relevance	0.32 [0.26, 0.38]	89.64	11.01	< .001
H1a-b: Narrowcast sharing intention	self-relevance x sample (USA)	-0.03 [-0.11, 0.04]	84.71	-0.87	.385
H1a-b: Narrowcast sharing intention	social relevance	0.22 [0.14, 0.29]	88.54	5.95	< .001
H1a-b: Narrowcast sharing intention	social relevance x sample (USA)	0.04 [-0.06, 0.14]	82.51	0.79	.429
H2a: Self-relevance	intercept	0.01 [-0.11, 0.13]	121.34	0.22	.827
H2a: Self-relevance	other - control	0.04 [-0.05, 0.12]	5925.43	0.83	.409
H2a: Self-relevance	other x sample (USA)	-0.06 [-0.17, 0.06]	5925.30	-0.94	.347
H2a: Self-relevance	sample (USA)	-0.05 [-0.21, 0.12]	121.28	-0.58	.560
H2a: Self-relevance	self - control	0.04 [-0.05, 0.12]	5925.22	0.89	.372
H2a: Self-relevance	self x sample (USA)	-0.01 [-0.13, 0.11]	5925.33	-0.20	.843
H2b: Social relevance	intercept	0.06 [-0.07, 0.19]	111.11	0.87	.388
H2b: Social relevance	other - control	0.02 [-0.07, 0.10]	5925.36	0.39	.694
H2b: Social relevance	other x sample (USA)	0.06 [-0.06, 0.17]	5925.26	0.99	.321
H2b: Social relevance	sample (USA)	-0.17 [-0.35, 0.02]	111.07	-1.81	.074
H2b: Social relevance	self - control	0.00 [-0.08, 0.08]	5925.20	0.00	1.000
H2b: Social relevance	self x sample (USA)	0.09 [-0.03, 0.20]	5925.28	1.52	.128
H3: Narrowcast sharing intention	intercept	-0.00 [-0.12, 0.12]	124.80	-0.04	.969
H3: Narrowcast sharing intention	other - control	-0.01 [-0.10, 0.07]	5846.72	-0.26	.792
H3: Narrowcast sharing intention	other x sample (USA)	-0.04 [-0.16, 0.08]	5846.55	-0.63	.528
H3: Narrowcast sharing intention	sample (USA)	0.06 [-0.10, 0.22]	124.32	0.70	.483
H3: Narrowcast sharing intention	self - control	-0.05 [-0.13, 0.04]	5846.54	-1.07	.283
H3: Narrowcast sharing intention	self x sample (USA)	0.01 [-0.11, 0.13]	5846.55	0.11	.909
H4b: Self-relevance	intercept	0.04 [-0.07, 0.15]	82.64	0.74	.464
H4b: Self-relevance	sample (USA)	-0.09 [-0.24, 0.06]	83.66	-1.21	.229
H4b: Self-relevance	self-referential	0.04 [0.00, 0.08]	84.47	2.23	.028
H4b: Self-relevance	self-referential x sample (USA)	0.01 [-0.04, 0.06]	82.89	0.42	.673
H4b: Social relevance	intercept	0.06 [-0.07, 0.18]	81.87	0.88	.381
H4b: Social relevance	sample (USA)	-0.14 [-0.31, 0.03]	83.42	-1.61	.111
H4b: Social relevance	social cognitive	0.05 [0.01, 0.09]	83.25	2.42	.018
H4b: Social relevance	social cognitive x sample (USA)	0.01 [-0.05, 0.06]	82.63	0.29	.772
H5a: Narrowcast sharing intention	intercept	-0.02 [-0.13, 0.09]	82.89	-0.31	.754
H5a: Narrowcast sharing intention	sample (USA)	0.01 [-0.14, 0.16]	83.88	0.09	.928
H5a: Narrowcast sharing intention	self-referential	0.06 [0.02, 0.10]	82.76	3.10	.003
H5a: Narrowcast sharing intention	self-referential x sample (USA)	0.04 [-0.01, 0.09]	81.13	1.51	.135
H5b: Narrowcast sharing intention	intercept	-0.03 [-0.14, 0.08]	82.49	-0.61	.544
H5b: Narrowcast sharing intention	sample (USA)	0.01 [-0.14, 0.16]	84.55	0.17	.865
H5b: Narrowcast sharing intention	social cognitive	0.06 [0.02, 0.10]	82.57	3.10	.003
H5b: Narrowcast sharing intention	social cognitive x sample (USA)	0.02 [-0.03, 0.08]	81.34	0.87	.389
H6a: Self-referential ROI	intercept	-0.14 [-0.29, 0.01]	83.01	-1.87	.064
H6a: Self-referential ROI	other - control	0.10 [-0.01, 0.22]	82.72	1.81	.074
H6a: Self-referential ROI	other x sample (USA)	-0.03 [-0.19, 0.12]	82.55	-0.44	.663
H6a: Self-referential ROI	sample (USA)	0.43 [0.22, 0.63]	82.99	4.08	< .001
H6a: Self-referential ROI	self - control	0.08 [-0.05, 0.20]	82.60	1.23	.222
H6a: Self-referential ROI	self x sample (USA)	0.02 [-0.15, 0.19]	82.68	0.24	.814
H6b: Social cognitive ROI	intercept	0.12 [-0.03, 0.27]	83.11	1.66	.102
H6b: Social cognitive ROI	other - control	0.11 [0.00, 0.22]	82.55	2.01	.047
H6b: Social cognitive ROI	other x sample (USA)	-0.10 [-0.25, 0.05]	82.37	-1.27	.208
H6b: Social cognitive ROI	sample (USA)	0.38 [0.18, 0.59]	83.09	3.73	< .001
H6b: Social cognitive ROI	self - control	0.07 [-0.06, 0.19]	82.65	1.10	.276
H6b: Social cognitive ROI	self x sample (USA)	0.01 [-0.16, 0.18]	82.73	0.11	.915

bayesian parallel mediation

Test whether there are indirect effects of the interventions on narrowcast sharing through self and social relevance

define functions

# Run bayesian mediation model
run_brm_model = function(model_name, model_formula, y_var, data) {
  if (file.exists(sprintf("models/model_%s.RDS", model_name))) {
    assign(get("model_name"), readRDS(sprintf("models/model_%s.RDS", model_name)))
  } else {
    
    assign(get("model_name"),
           brm(
             model_formula,
             data = data,
             cores = 4,
             thin = 4,
             chains = 8,
             seed = seed,
             control = list(adapt_delta = .99, max_treedepth = 15)
        ))
    
    saveRDS(eval(parse(text = model_name)), sprintf("models/model_%s.RDS", model_name))
    return(eval(parse(text = model_name)))
  }
}

# Get path estimates from bayesian mediation models
create_paths = function(model, x_var, y_var) {
  y_var = gsub("_", "", y_var)
  paths = posterior_samples(model) %>% 
    mutate(a1 = get(sprintf("b_selfreferential_article_cond%s", x_var)),
           a2 = get(sprintf("b_socialcognitive_article_cond%s", x_var)),
           b1 = get(sprintf("b_%s_self_referential", y_var)),
           b2 = get(sprintf("b_%s_social_cognitive", y_var)),
           c_prime = get(sprintf("b_%s_article_cond%s", y_var, x_var)),
           a1b1 = a1 * b1,
           a2b2 = a2 * b2,
           c = c_prime + a1b1 + a2b2,
           cor1 = get(sprintf("cor_SID__selfreferential_article_cond%s__%s_self_referential", x_var, y_var)),
           cor2 = get(sprintf("cor_SID__socialcognitive_article_cond%s__%s_social_cognitive", x_var, y_var)),
           sd_a1 = get(sprintf("sd_SID__selfreferential_article_cond%s", x_var)),
           sd_b1 = get(sprintf("sd_SID__%s_self_referential", y_var)),
           sd_a2 = get(sprintf("sd_SID__socialcognitive_article_cond%s", x_var)),
           sd_b2 = get(sprintf("sd_SID__%s_social_cognitive", y_var)),
           cov_a1b1 = cor1*sd_a1*sd_b1,
           cov_a2b2 = cor2*sd_a2*sd_b2,
           a1b1_cov_a1b1 = a1b1 + cov_a1b1,
           a2b2_cov_a2b2 = a2b2 + cov_a2b2,
           model = x_var,
           outcome = y_var)
  
  return(paths)
}

create_paths_between = function(model, x_var, y_var) {
  y_var = gsub("_", "", y_var)
  paths = posterior_samples(model) %>% 
    mutate(a1 = get(sprintf("b_selfreferential_article_cond%s", x_var)),
           a2 = get(sprintf("b_socialcognitive_article_cond%s", x_var)),
           b1 = get(sprintf("b_%s_self_referential", y_var)),
           b2 = get(sprintf("b_%s_social_cognitive", y_var)),
           c_prime = get(sprintf("b_%s_article_cond%s", y_var, x_var)),
           a1b1 = a1 * b1,
           a2b2 = a2 * b2,
           c = c_prime + a1b1 + a2b2,
           model = x_var,
           outcome = y_var)
  
  return(paths)
}

get_paths = function(model, x_var, y_var, between = FALSE) {
  
  if (isTRUE(between)) {
    paths = create_paths_between(model, x_var, y_var) %>% 
      select(a1:c) %>% 
      gather(path, value) %>% 
      group_by(path) %>% 
      summarize(median = median(value),
                `Mdn [95% CI]` = sprintf("%.2f [%.2f, %.2f]", median(value), quantile(value, probs = .025), quantile(value, probs = .975))) %>%
      mutate(path = factor(path, levels = c("a1", "b1", "a1b1", "a2", "b2", "a2b2", "c", "c_prime")))
    
  } else {
    paths = create_paths(model, x_var, y_var) %>% 
      select(a1:a2b2_cov_a2b2, -contains("sd"), -contains("cor"), -starts_with("cov")) %>% 
      gather(path, value) %>% 
      group_by(path) %>% 
      summarize(median = median(value),
                `Mdn [95% CI]` = sprintf("%.2f [%.2f, %.2f]", median(value), quantile(value, probs = .025), quantile(value, probs = .975))) %>%
      mutate(path = factor(path, levels = c("a1", "b1", "a1b1", "a1b1_cov_a1b1", "a2", "b2", "a2b2", "a2b2_cov_a2b2", "c", "c_prime")))
  }
  paths %>%
    arrange(path) %>%
    select(-median) %>%
    kable() %>%
    kableExtra::kable_styling()
}

percent_mediated = function(model, x_var, y_var, between = FALSE) {
  if (isTRUE(between)) {
    paths = create_paths_between(model, x_var, y_var) %>% 
      select(a1b1, a2b2, c) %>% 
      gather(path, value) %>% 
      group_by(path) %>% 
      summarize(median = median(value)) %>%
      select(path, median) %>%
      spread(path, median) %>%
      mutate(self = round((a1b1 / c) * 100, 0),
             other = round((a2b2 / c) * 100, 0),
             total = self + other)
    
  } else {
    paths = create_paths(model, x_var, y_var) %>% 
      select(a1b1_cov_a1b1, a2b2_cov_a2b2, c) %>% 
      gather(path, value) %>% 
      group_by(path) %>% 
      summarize(median = median(value)) %>%
      select(path, median) %>%
      spread(path, median) %>%
      mutate(self = round((a1b1_cov_a1b1 / c) * 100, 0),
             other = round((a2b2_cov_a2b2 / c) * 100, 0),
             total = self + other)
    
  }
  paths  %>%
    select(self, other, total) %>%
    kable(caption = "percent mediated") %>%
    kableExtra::kable_styling()
}

prep data

# create self condition dataframe
data_med_self = merged_wide %>%
  filter(!article_cond == "other") %>%
  select(SID, article_cond, article_number, msg_share_z, self_referential, social_cognitive)

# create social condition dataframe
data_med_other = merged_wide %>%
  filter(!article_cond == "self") %>%
  select(SID, article_cond, article_number, msg_share_z, self_referential, social_cognitive)

# set seed
seed = 6523

self-focused condition

x_var = "self"
y_var = "msg_share_z"
model_name = "mediation_self_narrowcast_roi_brm"
data = data_med_self

model_formula = bf(social_cognitive ~ article_cond + (1 + article_cond |i| SID)) +
  bf(self_referential ~ article_cond + (1 + article_cond |i| SID)) +
  bf(paste0(y_var, " ~ article_cond + social_cognitive + self_referential + (1 + article_cond + social_cognitive + self_referential |i| SID)")) +
  set_rescor(FALSE)

model_self_narrow = run_brm_model(model_name, model_formula, y_var, data)
get_paths(model_self_narrow, x_var, y_var)

path	Mdn [95% CI]
a1	0.10 [0.00, 0.19]
b1	0.10 [0.02, 0.18]
a1b1	0.01 [-0.00, 0.02]
a1b1_cov_a1b1	0.01 [-0.00, 0.03]
a2	0.08 [-0.01, 0.18]
b2	-0.02 [-0.10, 0.06]
a2b2	-0.00 [-0.01, 0.01]
a2b2_cov_a2b2	0.00 [-0.01, 0.02]
c	-0.05 [-0.11, 0.01]
c_prime	-0.06 [-0.12, 0.00]

percent_mediated(model_self_narrow, x_var, y_var)

percent mediated

self	other	total
-23	-5	-28

other-focused condition

x_var = "other"
y_var = "msg_share_z"
model_name = "mediation_other_narrowcast_roi_brm"
data = data_med_other

model_formula = bf(social_cognitive ~ article_cond + (1 + article_cond |i| SID)) +
  bf(self_referential ~ article_cond + (1 + article_cond |i| SID)) +
  bf(paste0(y_var, " ~ article_cond + social_cognitive + self_referential + (1 + article_cond + social_cognitive + self_referential |i| SID)")) +
  set_rescor(FALSE)

model_other_narrow = run_brm_model(model_name, model_formula, y_var, data)
get_paths(model_other_narrow, x_var, y_var)

path	Mdn [95% CI]
a1	0.09 [0.00, 0.17]
b1	0.11 [0.02, 0.19]
a1b1	0.01 [-0.00, 0.02]
a1b1_cov_a1b1	0.01 [-0.00, 0.03]
a2	0.06 [-0.02, 0.14]
b2	-0.02 [-0.10, 0.07]
a2b2	-0.00 [-0.01, 0.01]
a2b2_cov_a2b2	0.00 [-0.01, 0.01]
c	-0.03 [-0.10, 0.03]
c_prime	-0.04 [-0.11, 0.02]

percent_mediated(model_other_narrow, x_var, y_var)

percent mediated

self	other	total
-28	-1	-29

plots

labels = data.frame(model = c("self", "other"),
                    path = c("self-referential", "social cognition"),
                    value = c(.4, .4))

plot_data = create_paths(model_self_narrow, "self", "msg_share_z") %>%
  bind_rows(create_paths(model_other_narrow, "other", "msg_share_z"))
  
plot_data %>%
  select(model, outcome, a1b1_cov_a1b1, a2b2_cov_a2b2) %>% 
  gather(path, value, -model, -outcome) %>%
  mutate(path = ifelse(path == "a1b1_cov_a1b1", "self-relevance", "social relevance"),
        outcome = ifelse(outcome == "msg_share_z", "narrowcast sharing", outcome)) %>%
  ggplot(aes(x = value, y = "", fill = path)) +
  geom_vline(xintercept = 0, linetype = "dotted") +
  stat_halfeye(alpha = .8) +
  facet_grid(model ~ outcome) +
  scale_y_discrete(expand = c(.1, 0)) +
  scale_fill_manual(values = palette_dv, name = "mediator") +
  labs(x = "indirect effect", y = "") +
  plot_aes

cite packages

report::cite_packages()

##   - Angelo Canty, B. D. Ripley (2024). _boot: Bootstrap R (S-Plus) Functions_. R package version 1.3-30. A. C. Davison, D. V. Hinkley (1997). _Bootstrap Methods and Their Applications_. Cambridge University Press, Cambridge. ISBN 0-521-57391-2, <doi:10.1017/CBO9780511802843>.
##   - Bates D, Mächler M, Bolker B, Walker S (2015). "Fitting Linear Mixed-Effects Models Using lme4." _Journal of Statistical Software_, *67*(1), 1-48. doi:10.18637/jss.v067.i01 <https://doi.org/10.18637/jss.v067.i01>.
##   - Bates D, Maechler M, Jagan M (2024). _Matrix: Sparse and Dense Matrix Classes and Methods_. R package version 1.7-0, <https://CRAN.R-project.org/package=Matrix>.
##   - Bürkner P (2017). "brms: An R Package for Bayesian Multilevel Models Using Stan." _Journal of Statistical Software_, *80*(1), 1-28. doi:10.18637/jss.v080.i01 <https://doi.org/10.18637/jss.v080.i01>. Bürkner P (2018). "Advanced Bayesian Multilevel Modeling with the R Package brms." _The R Journal_, *10*(1), 395-411. doi:10.32614/RJ-2018-017 <https://doi.org/10.32614/RJ-2018-017>. Bürkner P (2021). "Bayesian Item Response Modeling in R with brms and Stan." _Journal of Statistical Software_, *100*(5), 1-54. doi:10.18637/jss.v100.i05 <https://doi.org/10.18637/jss.v100.i05>.
##   - Eddelbuettel D, Francois R, Allaire J, Ushey K, Kou Q, Russell N, Ucar I, Bates D, Chambers J (2024). _Rcpp: Seamless R and C++ Integration_. R package version 1.0.13, <https://CRAN.R-project.org/package=Rcpp>. Eddelbuettel D, François R (2011). "Rcpp: Seamless R and C++ Integration." _Journal of Statistical Software_, *40*(8), 1-18. doi:10.18637/jss.v040.i08 <https://doi.org/10.18637/jss.v040.i08>. Eddelbuettel D (2013). _Seamless R and C++ Integration with Rcpp_. Springer, New York. doi:10.1007/978-1-4614-6868-4 <https://doi.org/10.1007/978-1-4614-6868-4>, ISBN 978-1-4614-6867-7. Eddelbuettel D, Balamuta J (2018). "Extending R with C++: A Brief Introduction to Rcpp." _The American Statistician_, *72*(1), 28-36. doi:10.1080/00031305.2017.1375990 <https://doi.org/10.1080/00031305.2017.1375990>.
##   - Grolemund G, Wickham H (2011). "Dates and Times Made Easy with lubridate." _Journal of Statistical Software_, *40*(3), 1-25. <https://www.jstatsoft.org/v40/i03/>.
##   - Hester J, Wickham H, Csárdi G (2024). _fs: Cross-Platform File System Operations Based on 'libuv'_. R package version 1.6.4, <https://CRAN.R-project.org/package=fs>.
##   - Kay M (2023). _tidybayes: Tidy Data and Geoms for Bayesian Models_. doi:10.5281/zenodo.1308151 <https://doi.org/10.5281/zenodo.1308151>, R package version 3.0.6, <http://mjskay.github.io/tidybayes/>.
##   - Kuznetsova A, Brockhoff PB, Christensen RHB (2017). "lmerTest Package: Tests in Linear Mixed Effects Models." _Journal of Statistical Software_, *82*(13), 1-26. doi:10.18637/jss.v082.i13 <https://doi.org/10.18637/jss.v082.i13>.
##   - Lüdecke D (2018). "ggeffects: Tidy Data Frames of Marginal Effects from Regression Models." _Journal of Open Source Software_, *3*(26), 772. doi:10.21105/joss.00772 <https://doi.org/10.21105/joss.00772>.
##   - Müller K, Wickham H (2023). _tibble: Simple Data Frames_. R package version 3.2.1, <https://CRAN.R-project.org/package=tibble>.
##   - R Core Team (2024). _R: A Language and Environment for Statistical Computing_. R Foundation for Statistical Computing, Vienna, Austria. <https://www.R-project.org/>.
##   - Rinker TW, Kurkiewicz D (2018). _pacman: Package Management for R_. version 0.5.0, <http://github.com/trinker/pacman>.
##   - Wickham H (2016). _ggplot2: Elegant Graphics for Data Analysis_. Springer-Verlag New York. ISBN 978-3-319-24277-4, <https://ggplot2.tidyverse.org>.
##   - Wickham H (2023). _forcats: Tools for Working with Categorical Variables (Factors)_. R package version 1.0.0, <https://CRAN.R-project.org/package=forcats>.
##   - Wickham H (2023). _stringr: Simple, Consistent Wrappers for Common String Operations_. R package version 1.5.1, <https://CRAN.R-project.org/package=stringr>.
##   - Wickham H, Averick M, Bryan J, Chang W, McGowan LD, François R, Grolemund G, Hayes A, Henry L, Hester J, Kuhn M, Pedersen TL, Miller E, Bache SM, Müller K, Ooms J, Robinson D, Seidel DP, Spinu V, Takahashi K, Vaughan D, Wilke C, Woo K, Yutani H (2019). "Welcome to the tidyverse." _Journal of Open Source Software_, *4*(43), 1686. doi:10.21105/joss.01686 <https://doi.org/10.21105/joss.01686>.
##   - Wickham H, Bryan J, Barrett M, Teucher A (2024). _usethis: Automate Package and Project Setup_. R package version 2.2.3, <https://CRAN.R-project.org/package=usethis>.
##   - Wickham H, François R, Henry L, Müller K, Vaughan D (2023). _dplyr: A Grammar of Data Manipulation_. R package version 1.1.4, <https://CRAN.R-project.org/package=dplyr>.
##   - Wickham H, Henry L (2023). _purrr: Functional Programming Tools_. R package version 1.0.2, <https://CRAN.R-project.org/package=purrr>.
##   - Wickham H, Hester J, Bryan J (2024). _readr: Read Rectangular Text Data_. R package version 2.1.5, <https://CRAN.R-project.org/package=readr>.
##   - Wickham H, Hester J, Chang W, Bryan J (2022). _devtools: Tools to Make Developing R Packages Easier_. R package version 2.4.5, <https://CRAN.R-project.org/package=devtools>.
##   - Wickham H, Vaughan D, Girlich M (2024). _tidyr: Tidy Messy Data_. R package version 1.3.1, <https://CRAN.R-project.org/package=tidyr>.
##   - Xie Y (2024). _knitr: A General-Purpose Package for Dynamic Report Generation in R_. R package version 1.47, <https://yihui.org/knitr/>. Xie Y (2015). _Dynamic Documents with R and knitr_, 2nd edition. Chapman and Hall/CRC, Boca Raton, Florida. ISBN 978-1498716963, <https://yihui.org/knitr/>. Xie Y (2014). "knitr: A Comprehensive Tool for Reproducible Research in R." In Stodden V, Leisch F, Peng RD (eds.), _Implementing Reproducible Computational Research_. Chapman and Hall/CRC. ISBN 978-1466561595.
##   - Zhu H (2024). _kableExtra: Construct Complex Table with 'kable' and Pipe Syntax_. R package version 1.4.0, <https://CRAN.R-project.org/package=kableExtra>.