Correlational analyses

In these analyses, we test correlational associations between self and social relevance and broad- and narrowcast sharing intentions.

define functions

# parameter estimate plotting function for purrr models
plot_model = function(model_data, palette, size = .35) {
  model_data %>%
    mutate(term = gsub("msg_", "", term),
           term = gsub("_", " ", term),
           term = gsub(":", " x ", term),
           term = gsub("rel self", "self", term),
           term = gsub("rel social", "social", term),
           term = gsub(" within", "\nwithin", term),
           term = gsub(" between", "\nbetween", term)) %>%
    ggplot(aes(x = term, y = estimate, color = study)) +
    geom_pointrange(aes( ymin = conf.low, ymax = conf.high), position = position_dodge(.5), size = size) +
    geom_hline(yintercept = 0, color = "grey50", linetype = "dotted") +
    coord_flip() +
    scale_fill_manual(name = "", values = palette) +
    scale_color_manual(name = "", values = palette) +
    labs(x = "", y = "\nstandardized  regression coefficient\n") +
    plot_aes
}

# MLM results table function
table_model = function(model_data) {
  model_data %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("value"), -contains("study")), round, 2) %>%
    mutate(term = gsub("msg_", "", term),
           term = gsub("_", " ", term),
           term = gsub(":", " x ", term),
           term = gsub("rel self", "self", term),
           term = gsub("rel social", "social", term),
           term = gsub("within", "within", term),
           term = gsub("between", "between", term),
           term = gsub("sharing type", "sharing type (narrowcast)", term),
           term = ifelse(grepl("between x ", term), "sharing type (narrowcast) x social relevance between", term),
           p = ifelse(p < .001, "< .001",
                      ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
    select(study, term, `b [95% CI]`, df, t, p) %>%
    arrange(study) %>%
    kable() %>%
    kableExtra::kable_styling()
}

prep data

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

load packages

if(!require('pacman')) {
    install.packages('pacman')
}

pacman::p_load(tidyverse, knitr, kableExtra, lmerTest, ggpubr, broom.mixed, rmcorr, report, EMAtools)
report::cite_packages()

##   - Alboukadel Kassambara (2020). ggpubr: 'ggplot2' Based Publication Ready Plots. R package version 0.4.0. https://CRAN.R-project.org/package=ggpubr
##   - Ben Bolker and David Robinson (2022). broom.mixed: Tidying Methods for Mixed Models. R package version 0.2.9.3. https://CRAN.R-project.org/package=broom.mixed
##   - Douglas Bates and Martin Maechler (2021). Matrix: Sparse and Dense Matrix Classes and Methods. R package version 1.3-4. https://CRAN.R-project.org/package=Matrix
##   - Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015). Fitting Linear Mixed-Effects Models Using lme4. Journal of Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01.
##   - Evan Kleiman (2021). EMAtools: Data Management Tools for Real-Time Monitoring/Ecological Momentary Assessment Data. R package version 0.1.4. https://CRAN.R-project.org/package=EMAtools
##   - H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
##   - Hadley Wickham (2019). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.4.0. https://CRAN.R-project.org/package=stringr
##   - Hadley Wickham (2021). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.5.1. https://CRAN.R-project.org/package=forcats
##   - Hadley Wickham and Maximilian Girlich (2022). tidyr: Tidy Messy Data. R package version 1.2.0. https://CRAN.R-project.org/package=tidyr
##   - Hadley Wickham, Jim Hester and Jennifer Bryan (2022). readr: Read Rectangular Text Data. R package version 2.1.2. https://CRAN.R-project.org/package=readr
##   - Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2022). dplyr: A Grammar of Data Manipulation. R package version 1.0.8. https://CRAN.R-project.org/package=dplyr
##   - Hao Zhu (2021). kableExtra: Construct Complex Table with 'kable' and Pipe Syntax. R package version 1.3.4. https://CRAN.R-project.org/package=kableExtra
##   - Jonathan Z. Bakdash and Laura R. Marusich (2021). rmcorr: Repeated Measures Correlation. R package version 0.4.5. https://CRAN.R-project.org/package=rmcorr
##   - Kirill Müller and Hadley Wickham (2021). tibble: Simple Data Frames. R package version 3.1.6. https://CRAN.R-project.org/package=tibble
##   - Kuznetsova A, Brockhoff PB, Christensen RHB (2017). "lmerTest Package:Tests in Linear Mixed Effects Models." _Journal of StatisticalSoftware_, *82*(13), 1-26. doi: 10.18637/jss.v082.i13 (URL:https://doi.org/10.18637/jss.v082.i13).
##   - Lionel Henry and Hadley Wickham (2020). purrr: Functional Programming Tools. R package version 0.3.4. https://CRAN.R-project.org/package=purrr
##   - Makowski, D., Ben-Shachar, M.S., Patil, I. & Lüdecke, D. (2020). Automated Results Reporting as a Practical Tool to Improve Reproducibility and Methodological Best Practices Adoption. CRAN. Available from https://github.com/easystats/report. doi: .
##   - R Core Team (2021). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
##   - Rinker, T. W. & Kurkiewicz, D. (2017). pacman: Package Management for R. version 0.5.0. Buffalo, New York. http://github.com/trinker/pacman
##   - Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
##   - Yihui Xie (2021). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.37.

define aesthetics

palette = c("#001219", "#005F73", "#0A9396", "#94D2BD", "#E9D8A6", "#EE9B00", "#CA6702", "#BB3E03", "#AE2012")
palette_sharing = c("#086E70", "#FFA600")

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

load and merge data

# cleaned study data
study1 = read.csv("../data/study1.csv", stringsAsFactors = FALSE)

study2 = read.csv("../data/study2.csv", stringsAsFactors = FALSE)

study3 = read.csv("../data/study3.csv", stringsAsFactors = FALSE)

study4 = read.csv("../data/study4.csv", stringsAsFactors = FALSE)

study5 = read.csv("../data/study5.csv", stringsAsFactors = FALSE)

study6 = read.csv("../data/study6.csv", stringsAsFactors = FALSE) %>%
  select(-article_cond)

# merge dataframes and z-score within study and sharing type
merged = bind_rows(study1, study2, study3, study4, study5, study6) %>%
  group_by(study, sharing_type) %>%
  mutate(msg_share_std = scale(msg_share, scale = TRUE, center = TRUE))

main manuscript analyses

These analyses are reported in the main manuscript.

descriptives

Generate study descriptives.

data_desc = merged %>%
  select(-contains("within"), -contains("between"), -msg_share_std) %>%
  group_by(SID, sharing_type) %>%
  mutate(msg_rel_self_between = mean(msg_rel_self, na.rm = TRUE),
         msg_rel_social_between = mean(msg_rel_social, na.rm = TRUE),
         sharing_type = ifelse(sharing_type == 0, "broadcast sharing intention",
                        ifelse(sharing_type == 1, "narrowcast sharing intention", NA))) %>%
  spread(sharing_type, msg_share)

participant Ns

merged %>%
  ungroup() %>%
  select(study, SID) %>%
  unique() %>%
  group_by(study) %>%
  summarize(n = n()) %>%
  kable(format = "pandoc")

study	n
study 1	2081
study 2	547
study 3	248
study 4	139
study 5	315
study 6	397

means, SDs, and correlations

Correlations are generated using repeated measures correlations to account for observations nested within participant.

# means
means = data_desc %>%
  gather(variable, val, contains("cast"), contains("rel"), -contains("between")) %>%
  group_by(study, variable) %>%
  summarize(`M (SD)` = sprintf("%s (%s)", round(mean(val, na.rm = TRUE), 2), round(sd(val, na.rm = TRUE), 2))) %>%
  mutate(`scale range` = ifelse(grepl("1", study), "1-7",
                  ifelse(grepl("4", study), "0-10", "0-100"))) %>%
  filter(!grepl("NaN", `M (SD)`)) %>%
  select(study, `scale range`, contains("rel"), everything()) %>%
  mutate(variable = ifelse(variable == "msg_rel_self", "self-relevance",
                    ifelse(variable == "msg_rel_social", "social relevance", variable)))

# correlations with broadcasting intentions
corrs_broad = data_desc %>%
  nest(-c(study)) %>%
  mutate(self_social = map(data, ~ rmcorr::rmcorr(as.factor(SID), msg_rel_self, msg_rel_social, .)),
         self_broad = map(data, ~ rmcorr::rmcorr(as.factor(SID), msg_rel_self, `broadcast sharing intention`, .)),
         social_broad = map(data, ~ rmcorr::rmcorr(as.factor(SID), msg_rel_social, `broadcast sharing intention`, .))) %>%
  select(-data)

# correlations with narrowcasting intentions
corrs_narrow = data_desc %>%
  nest(-study) %>%
  filter(grepl("3|5|6", study)) %>%
  mutate(self_narrow = map(data, ~ rmcorr::rmcorr(as.factor(SID), msg_rel_self, `narrowcast sharing intention`, .)),
         social_narrow = map(data, ~ rmcorr::rmcorr(as.factor(SID), msg_rel_social, `narrowcast sharing intention`, .)),
         broad_narrow = map(data, ~ rmcorr::rmcorr(as.factor(SID), `broadcast sharing intention`, `narrowcast sharing intention`, .))) %>%
  select(-data)

# broadcasting table
broad = corrs_broad %>%
  gather(test, model, contains("self"), contains("social")) %>%
  group_by(study, test) %>%
  filter(!is.null(model)) %>%
  mutate(r = sprintf("%.2f [%.2f, %.2f]", model[[1]][[1]], model[[1]][[4]][1], model[[1]][[4]][2]),
         df = model[[1]][[2]],
         p = round(model[[1]][[3]], 3),
         p = ifelse(p == 0, "< .001", as.character(p))) %>%
  ungroup() %>%
  select(study, test, r) %>%
  extract(test, c("var1", "var2"), "(.*)_(.*)") %>%
  spread(var2, r) %>%
  select(study, var1, everything())

# narrowcasting table
narrow = corrs_narrow %>%
  gather(test, model, contains("self"), contains("social"), contains("broad")) %>%
  group_by(study, test) %>%
  filter(!is.null(model)) %>%
  mutate(r = sprintf("%.2f [%.2f, %.2f]", model[[1]][[1]], model[[1]][[4]][1], model[[1]][[4]][2]),
         df = model[[1]][[2]],
         p = round(model[[1]][[3]], 3),
         p = ifelse(p == 0, "< .001", as.character(p))) %>%
  ungroup() %>%
  select(study, test, r) %>%
  extract(test, c("var1", "var2"), "(.*)_(.*)") %>%
  spread(var2, r) %>%
  select(study, var1, everything())

# combined table
corrs = broad %>%
  bind_rows(., narrow)  %>%
  group_by(study, var1) %>%
  fill(everything(), .direction = "updown") %>%
  unique() %>%
  mutate_if(is.character, ~ ifelse(is.na(.), "--", .)) %>%
  mutate(var1 = ifelse(var1 == "social", "social relevance",
                ifelse(var1 == "self", "self-relevance",
                ifelse(var1 == "broad", "broadcast sharing intention", "narrowcast sharing intention"))),
         `self-relevance` = "--") %>%
  rename("variable" = var1,
         "broadcast sharing intention" = broad,
         "narrowcast sharing intention" = narrow,
         "social relevance" = social) %>%
  select(study, variable, `broadcast sharing intention`, `self-relevance`, `social relevance`, `narrowcast sharing intention`)

# merge descriptors and correlations to generate manuscript table
means %>%
  left_join(., corrs)%>%
  mutate_if(is.character, ~ ifelse(is.na(.), "--", .)) %>%
  kable(format = "pandoc")

study	scale range	variable	M (SD)	broadcast sharing intention	self-relevance	social relevance	narrowcast sharing intention
study 1	1-7	broadcast sharing intention	4.45 (2.03)	–	–	–	–
study 1	1-7	self-relevance	5.42 (1.54)	0.45 [0.43, 0.47]	–	0.66 [0.65, 0.67]	–
study 1	1-7	social relevance	5.68 (1.37)	0.45 [0.43, 0.46]	–	–	–
study 2	0-100	broadcast sharing intention	49.24 (35.85)	–	–	–	–
study 2	0-100	self-relevance	63.03 (30.67)	0.31 [0.27, 0.34]	–	0.60 [0.58, 0.63]	–
study 2	0-100	social relevance	69.22 (26.27)	0.31 [0.27, 0.35]	–	–	–
study 3	0-100	broadcast sharing intention	43.64 (33.33)	–	–	–	0.68 [0.64, 0.71]
study 3	0-100	self-relevance	69.37 (27.1)	0.36 [0.30, 0.41]	–	0.69 [0.65, 0.72]	0.40 [0.35, 0.45]
study 3	0-100	social relevance	76.7 (21.7)	0.35 [0.29, 0.40]	–	–	0.43 [0.37, 0.48]
study 3	0-100	narrowcast sharing intention	48.39 (33.53)	–	–	–	–
study 4	0-10	broadcast sharing intention	3.75 (3.42)	–	–	–	–
study 4	0-10	self-relevance	4.12 (3.38)	0.64 [0.61, 0.68]	–	0.55 [0.50, 0.59]	–
study 4	0-10	social relevance	5.76 (2.65)	0.59 [0.55, 0.63]	–	–	–
study 5	0-100	broadcast sharing intention	49.82 (32.33)	–	–	–	0.67 [0.65, 0.69]
study 5	0-100	self-relevance	56.8 (29.81)	0.52 [0.50, 0.55]	–	0.71 [0.70, 0.73]	0.48 [0.45, 0.51]
study 5	0-100	social relevance	61.53 (27.92)	0.46 [0.43, 0.49]	–	–	0.53 [0.50, 0.55]
study 5	0-100	narrowcast sharing intention	50.25 (32.11)	–	–	–	–
study 6	0-100	broadcast sharing intention	47.19 (34.56)	–	–	–	0.59 [0.57, 0.61]
study 6	0-100	self-relevance	57.26 (32.23)	0.49 [0.46, 0.51]	–	0.67 [0.65, 0.69]	0.48 [0.45, 0.50]
study 6	0-100	social relevance	62.82 (29.62)	0.47 [0.44, 0.49]	–	–	0.57 [0.55, 0.60]
study 6	0-100	narrowcast sharing intention	48.75 (33.53)	–	–	–	–

messages

merged %>%
  ungroup() %>%
  select(item) %>%
  unique() %>%
  summarize(n = n()) %>%
  kable(format = "pandoc")

n
362

mega-analysis

run model

model_compare = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_self_between*sharing_type +
                                 msg_rel_self_within*sharing_type +
                                 msg_rel_social_between*sharing_type +
                                 msg_rel_social_within*sharing_type +
                                 (1 + msg_rel_self_within + msg_rel_social_within | SID) +
                                 (1 + msg_rel_self_within + msg_rel_social_within | item),
                               data = merged,
                       control = lmerControl(optimizer = "bobyqa"))

summary(model_compare)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share_std ~ 0 + msg_rel_self_between * sharing_type + msg_rel_self_within *  
##     sharing_type + msg_rel_social_between * sharing_type + msg_rel_social_within *  
##     sharing_type + (1 + msg_rel_self_within + msg_rel_social_within |  
##     SID) + (1 + msg_rel_self_within + msg_rel_social_within |      item)
##    Data: merged
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 53677.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.0640 -0.4375  0.0096  0.4480  5.6898 
## 
## Random effects:
##  Groups   Name                  Variance Std.Dev. Corr       
##  SID      (Intercept)           0.405874 0.63708             
##           msg_rel_self_within   0.021877 0.14791   0.12      
##           msg_rel_social_within 0.019432 0.13940   0.23 -0.08
##  item     (Intercept)           0.003904 0.06248             
##           msg_rel_self_within   0.006721 0.08198  -0.08      
##           msg_rel_social_within 0.003998 0.06323   0.11 -0.41
##  Residual                       0.215839 0.46458             
## Number of obs: 30954, groups:  SID, 3727; item, 362
## 
## Fixed effects:
##                                           Estimate     Std. Error
## msg_rel_self_between                    0.35257870     0.01964775
## sharing_type                           -0.00004825     0.00709173
## msg_rel_self_within                     0.18222310     0.00822365
## msg_rel_social_between                  0.16321504     0.01958424
## msg_rel_social_within                   0.13023465     0.00744762
## msg_rel_self_between:sharing_type      -0.10333082     0.01460147
## sharing_type:msg_rel_self_within       -0.06175949     0.00940276
## sharing_type:msg_rel_social_between     0.10656637     0.01460149
## sharing_type:msg_rel_social_within      0.11050229     0.00932810
##                                                 df t value             Pr(>|t|)
## msg_rel_self_between                 3778.05560833  17.945 < 0.0000000000000002
## sharing_type                        23772.62233028  -0.007                0.995
## msg_rel_self_within                   325.23586960  22.158 < 0.0000000000000002
## msg_rel_social_between               3743.23037282   8.334 < 0.0000000000000002
## msg_rel_social_within                 287.62531345  17.487 < 0.0000000000000002
## msg_rel_self_between:sharing_type   23690.56968189  -7.077    0.000000000001517
## sharing_type:msg_rel_self_within    13738.52922270  -6.568    0.000000000052749
## sharing_type:msg_rel_social_between 23694.57333988   7.298    0.000000000000301
## sharing_type:msg_rel_social_within  11895.65604095  11.846 < 0.0000000000000002
##                                        
## msg_rel_self_between                ***
## sharing_type                           
## msg_rel_self_within                 ***
## msg_rel_social_between              ***
## msg_rel_social_within               ***
## msg_rel_self_between:sharing_type   ***
## sharing_type:msg_rel_self_within    ***
## sharing_type:msg_rel_social_between ***
## sharing_type:msg_rel_social_within  ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                        msg_rl_slf_b shrng_ msg_rl_slf_w msg_rl_scl_b
## sharing_typ             0.000                                       
## msg_rl_slf_w           -0.004        0.005                          
## msg_rl_scl_b           -0.830        0.000  0.003                   
## msg_rl_scl_w           -0.005        0.011 -0.463       -0.009      
## msg_rl_s_:_            -0.089        0.000  0.000        0.076      
## shrng_typ:msg_rl_sl_    0.000        0.000 -0.307       -0.001      
## shrng_typ:msg_rl_scl_b  0.076        0.000  0.000       -0.089      
## shrng_typ:msg_rl_scl_w -0.001        0.004  0.207        0.002      
##                        msg_rl_scl_w m___:_ shrng_typ:msg_rl_sl_
## sharing_typ                                                    
## msg_rl_slf_w                                                   
## msg_rl_scl_b                                                   
## msg_rl_scl_w                                                   
## msg_rl_s_:_            -0.001                                  
## shrng_typ:msg_rl_sl_    0.224        0.000                     
## shrng_typ:msg_rl_scl_b  0.000       -0.873  0.000              
## shrng_typ:msg_rl_scl_w -0.330        0.000 -0.671              
##                        shrng_typ:msg_rl_scl_b
## sharing_typ                                  
## msg_rl_slf_w                                 
## msg_rl_scl_b                                 
## msg_rl_scl_w                                 
## msg_rl_s_:_                                  
## shrng_typ:msg_rl_sl_                         
## shrng_typ:msg_rl_scl_b                       
## shrng_typ:msg_rl_scl_w  0.000

print variance inflation factors

car::vif(model_compare)

##                msg_rel_self_between                        sharing_type 
##                            3.251348                            1.000333 
##                 msg_rel_self_within              msg_rel_social_between 
##                            1.367452                            3.251244 
##               msg_rel_social_within   msg_rel_self_between:sharing_type 
##                            1.391017                            4.241421 
##    sharing_type:msg_rel_self_within sharing_type:msg_rel_social_between 
##                            1.945520                            4.241281 
##  sharing_type:msg_rel_social_within 
##                            1.967190

plot

This is the plot in Figure 1.

predicted = ggeffects::ggpredict(model_compare, c("msg_rel_self_between [-3:3]", "sharing_type")) %>%
  data.frame() %>%
  mutate(type = "self_between") %>%
  bind_rows(ggeffects::ggpredict(model_compare, c("msg_rel_self_within [-3:3]", "sharing_type")) %>%
              data.frame() %>%
              mutate(type = "self_within")) %>%
  bind_rows(ggeffects::ggpredict(model_compare, c("msg_rel_social_between [-3:3]", "sharing_type")) %>%
              data.frame() %>%
              mutate(type = "social_between")) %>%
  bind_rows(ggeffects::ggpredict(model_compare, c("msg_rel_social_within [-3:3]", "sharing_type")) %>%
              data.frame() %>%
              mutate(type = "social_within"))

points = merged %>%
  select(-group) %>%
  rename("group" = sharing_type,
         "predicted" = msg_share_std) %>%
  select(study, SID, group, predicted, contains("within"), contains("between")) %>%
  gather(type, x, contains("msg")) %>%
  mutate(type = gsub("msg_rel_", "", type),
         group = ifelse(group == 0, "broadcast", "narrowcast")) %>%
  extract(type, c("variable", "type"), "(.*)_(.*)") %>%
  filter(x < 3 & x > -3)

predicted %>%
  mutate(group = ifelse(group == 0, "broadcast", "narrowcast")) %>%
  extract(type, c("variable", "type"), "(.*)_(.*)") %>%
  ggplot(aes(x, predicted, color = group, fill = group, linetype = type)) +
  geom_point(data = points, aes(x, predicted), alpha = .02, size = .25) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
  geom_line(size = 1) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_sharing) +
  scale_fill_manual(name = "", values = palette_sharing) +
  scale_linetype_manual(name = "", values = c("solid", "dashed")) +
  guides(linetype = guide_legend(override.aes = list(fill = NA))) +
  labs(x = "\nstandardized relevance rating", y = "predicted standardized sharing intention rating\n") +
  plot_aes  +
  theme(legend.position = "top",
        legend.key.width=unit(2,"cm"))

model summary table

eff_size = cbind(summary(model_compare)$coefficients[,4],
                 summary(model_compare)$coefficients[,3]) %>%
  data.frame() %>%
  rename("t" = X1,
         "df" = X2) %>%
  mutate(d = (2*t) / sqrt(df)) %>%
  rownames_to_column(var = "term") %>%
  mutate(term = gsub(":", " x ", term),
         term = gsub("msg_", "", term),
         term = gsub("_", " ", term),
         term = gsub("within", "within", term),
         term = gsub("between", "between", term),
         term = gsub("rel self", "Self", term),
         term = gsub("rel social", "Social", term),
         term = gsub("sharing type", "Sharing type", term),
         term = gsub("Sharing type x (.*)", "\\1 x Sharing type", term),
         d = sprintf("%.2f", d)) %>%
  select(term, d)

model_compare %>%
  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.value")), round, 2) %>%
  mutate(term = gsub(":", " x ", term),
         term = gsub("msg_", "", term),
         term = gsub("_", " ", term),
         term = gsub("within", "within", term),
         term = gsub("between", "between", term),
         term = gsub("rel self", "Self", term),
         term = gsub("rel social", "Social", term),
         term = gsub("sharing type", "Sharing type", term),
         term = gsub("Sharing type x (.*)", "\\1 x Sharing type", term),
         p = ifelse(p < .001, "< .001",
                    ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
         `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
  left_join(., eff_size) %>%
  mutate(d = ifelse(is.na(d), "--", d)) %>%
  select(term, `b [95% CI]`, d, df, t, p) %>%
  kable()  %>%
  kableExtra::kable_styling()

term	b [95% CI]	d	df	t	p
Self between	0.35 [0.31, 0.39]	0.58	3778.06	17.94	< .001
Sharing type	-0.00 [-0.01, 0.01]	-0.00	23772.62	-0.01	.990
Self within	0.18 [0.17, 0.20]	2.46	325.24	22.16	< .001
Social between	0.16 [0.12, 0.20]	0.27	3743.23	8.33	< .001
Social within	0.13 [0.12, 0.14]	2.06	287.63	17.49	< .001
Self between x Sharing type	-0.10 [-0.13, -0.07]	-0.09	23690.57	-7.08	< .001
Self within x Sharing type	-0.06 [-0.08, -0.04]	-0.11	13738.53	-6.57	< .001
Social between x Sharing type	0.11 [0.08, 0.14]	0.09	23694.57	7.30	< .001
Social within x Sharing type	0.11 [0.09, 0.13]	0.22	11895.66	11.85	< .001

supplementary material analyses

These analyses are reported in the supplementary material. Each model is estimated separately for each study rather than being combined as in the mega-analysis.

separate models

Estimate models with self and social relevance separately.

self relevance

run models

# define model function
fit_mod = function(data){
  mod = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_self_between + msg_rel_self_within +
                         (1 + msg_rel_self_within | SID) +
                         (1 | item), data = data,
                       control = lmerControl(optimizer = "bobyqa"))
  return(mod)
}

# estimate models
model_lmer_self = merged %>%
  mutate(study = ifelse(sharing_type == 0, sprintf("%s\n%s", study, "broadcast"), sprintf("%s\n%s", study, "narrowcast"))) %>%
  group_by(study) %>%
  nest() %>%
  mutate(test = map(data, fit_mod))

# tidy models
model_data_self = model_lmer_self %>% 
  mutate(tidied = map(test, broom.mixed::tidy, conf.int = TRUE)) %>%
  select(-data, -test) %>%
  unnest() %>%
  filter(effect == "fixed" & grepl("msg", term)) %>%
  rename("term" = term) %>%
  ungroup()

model summary table

table_model(model_data_self)

study	term	b [95% CI]	df	t	p
study 1 broadcast	self between	0.47 [0.44, 0.50]	2145.50	30.47	< .001
study 1 broadcast	self within	0.26 [0.24, 0.27]	1181.80	32.32	< .001
study 2 broadcast	self between	0.41 [0.35, 0.48]	555.65	11.81	< .001
study 2 broadcast	self within	0.14 [0.11, 0.16]	265.79	11.74	< .001
study 3 broadcast	self between	0.43 [0.34, 0.52]	247.14	9.51	< .001
study 3 broadcast	self within	0.19 [0.15, 0.23]	158.23	8.82	< .001
study 3 narrowcast	self between	0.42 [0.33, 0.51]	249.16	9.32	< .001
study 3 narrowcast	self within	0.22 [0.17, 0.26]	161.08	10.14	< .001
study 4 broadcast	self between	0.54 [0.47, 0.61]	142.31	15.88	< .001
study 4 broadcast	self within	0.44 [0.39, 0.49]	121.19	17.93	< .001
study 5 broadcast	self between	0.68 [0.62, 0.73]	324.22	23.96	< .001
study 5 broadcast	self within	0.28 [0.25, 0.31]	245.44	19.97	< .001
study 5 narrowcast	self between	0.64 [0.58, 0.70]	317.64	21.03	< .001
study 5 narrowcast	self within	0.25 [0.22, 0.28]	229.36	16.06	< .001
study 6 broadcast	self between	0.56 [0.50, 0.62]	405.99	18.60	< .001
study 6 broadcast	self within	0.25 [0.23, 0.28]	334.94	20.35	< .001
study 6 narrowcast	self between	0.59 [0.54, 0.64]	398.73	22.62	< .001
study 6 narrowcast	self within	0.28 [0.25, 0.31]	328.95	20.12	< .001

social relevance

run model

This plot is supplementary and not reported in the manuscript.

# define model function
fit_mod = function(data){
  mod = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_social_between + msg_rel_social_within +
                         (1 + msg_rel_social_within | SID) +
                         (1 | item), data = data,
                       control = lmerControl(optimizer = "bobyqa"))

  return(mod)
}

# estimate models
model_lmer_social = merged  %>%
  mutate(study = ifelse(sharing_type == 0, sprintf("%s\n%s", study, "broadcast"), sprintf("%s\n%s", study, "narrowcast"))) %>%
  group_by(study) %>%
  nest() %>%
  mutate(test = map(data, fit_mod))

# tidy models
model_data_social = model_lmer_social %>% 
  mutate(tidied = map(test, broom.mixed::tidy, conf.int = TRUE)) %>%
  select(-data, -test) %>%
  unnest() %>%
  filter(effect == "fixed" & grepl("msg", term)) %>%
  ungroup()

model summary table

table_model(model_data_social)

study	term	b [95% CI]	df	t	p
study 1 broadcast	social between	0.45 [0.42, 0.48]	2133.49	28.84	< .001
study 1 broadcast	social within	0.25 [0.23, 0.26]	967.20	30.88	< .001
study 2 broadcast	social between	0.41 [0.34, 0.48]	548.93	11.74	< .001
study 2 broadcast	social within	0.14 [0.11, 0.16]	272.42	10.95	< .001
study 3 broadcast	social between	0.35 [0.26, 0.44]	239.36	7.41	< .001
study 3 broadcast	social within	0.18 [0.14, 0.22]	128.06	8.95	< .001
study 3 narrowcast	social between	0.40 [0.31, 0.49]	234.77	8.95	< .001
study 3 narrowcast	social within	0.23 [0.19, 0.26]	111.96	12.07	< .001
study 4 broadcast	social between	0.41 [0.33, 0.49]	139.34	10.66	< .001
study 4 broadcast	social within	0.40 [0.36, 0.45]	103.95	17.47	< .001
study 5 broadcast	social between	0.59 [0.52, 0.66]	316.18	17.05	< .001
study 5 broadcast	social within	0.24 [0.21, 0.26]	224.97	16.29	< .001
study 5 narrowcast	social between	0.59 [0.52, 0.65]	317.74	17.76	< .001
study 5 narrowcast	social within	0.28 [0.26, 0.31]	225.47	19.10	< .001
study 6 broadcast	social between	0.52 [0.46, 0.59]	402.78	16.68	< .001
study 6 broadcast	social within	0.25 [0.22, 0.27]	303.88	20.92	< .001
study 6 narrowcast	social between	0.55 [0.50, 0.60]	401.49	20.42	< .001
study 6 narrowcast	social within	0.34 [0.32, 0.37]	287.96	26.55	< .001

combined models

Estimate models with self and social relevance in the same model.

run models

fit_mod = function(data){
  mod = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_self_between + msg_rel_self_within +
                         msg_rel_social_between + msg_rel_social_within +
                         (1 + msg_rel_self_within + msg_rel_social_within | SID) +
                         (1 | item), data = data,
                       control = lmerControl(optimizer = "bobyqa"))
  return(mod)
}

model_lmer = merged  %>%
  mutate(study = ifelse(sharing_type == 0, sprintf("%s\n%s", study, "broadcast"), sprintf("%s\n%s", study, "narrowcast"))) %>%
  group_by(study) %>%
  nest() %>%
  mutate(test = map(data, fit_mod))

model_data = model_lmer %>% 
  mutate(tidied = map(test, broom.mixed::tidy, conf.int = TRUE)) %>%
  select(-data, -test) %>%
  unnest() %>%
  filter(effect == "fixed" & grepl("msg", term)) %>%
  ungroup()

model summary table

table_model(model_data)

study	term	b [95% CI]	df	t	p
study 1 broadcast	self between	0.31 [0.25, 0.37]	2097.70	10.85	< .001
study 1 broadcast	self within	0.16 [0.14, 0.18]	833.22	17.79	< .001
study 1 broadcast	social between	0.19 [0.13, 0.24]	2073.58	6.59	< .001
study 1 broadcast	social within	0.14 [0.13, 0.16]	781.23	16.49	< .001
study 2 broadcast	self between	0.23 [0.12, 0.33]	548.60	4.23	< .001
study 2 broadcast	self within	0.08 [0.05, 0.10]	182.45	5.83	< .001
study 2 broadcast	social between	0.24 [0.13, 0.34]	538.39	4.45	< .001
study 2 broadcast	social within	0.10 [0.07, 0.12]	258.92	6.72	< .001
study 3 broadcast	self between	0.35 [0.22, 0.47]	246.17	5.35	< .001
study 3 broadcast	self within	0.13 [0.08, 0.18]	115.16	4.86	< .001
study 3 broadcast	social between	0.10 [-0.03, 0.23]	242.43	1.54	.130
study 3 broadcast	social within	0.09 [0.05, 0.14]	128.47	3.88	< .001
study 3 narrowcast	self between	0.25 [0.13, 0.38]	252.18	3.99	< .001
study 3 narrowcast	self within	0.11 [0.06, 0.16]	91.05	4.28	< .001
study 3 narrowcast	social between	0.22 [0.09, 0.34]	245.30	3.45	< .001
study 3 narrowcast	social within	0.16 [0.11, 0.21]	109.51	6.18	< .001
study 4 broadcast	self between	0.42 [0.34, 0.49]	134.43	11.03	< .001
study 4 broadcast	self within	0.33 [0.28, 0.38]	120.99	13.08	< .001
study 4 broadcast	social between	0.15 [0.07, 0.22]	136.50	3.83	< .001
study 4 broadcast	social within	0.22 [0.18, 0.27]	130.95	9.96	< .001
study 5 broadcast	self between	0.78 [0.65, 0.90]	322.02	12.28	< .001
study 5 broadcast	self within	0.21 [0.18, 0.24]	220.10	13.76	< .001
study 5 broadcast	social between	-0.12 [-0.24, 0.01]	319.53	-1.88	.060
study 5 broadcast	social within	0.10 [0.07, 0.13]	199.76	7.33	< .001
study 5 narrowcast	self between	0.57 [0.43, 0.70]	316.41	8.42	< .001
study 5 narrowcast	self within	0.13 [0.09, 0.16]	240.21	7.33	< .001
study 5 narrowcast	social between	0.07 [-0.06, 0.20]	316.03	1.02	.310
study 5 narrowcast	social within	0.20 [0.17, 0.23]	235.61	11.72	< .001
study 6 broadcast	self between	0.46 [0.33, 0.60]	376.82	6.97	< .001
study 6 broadcast	self within	0.17 [0.14, 0.19]	316.63	12.71	< .001
study 6 broadcast	social between	0.10 [-0.03, 0.23]	374.09	1.46	.140
study 6 broadcast	social within	0.14 [0.11, 0.16]	250.99	11.81	< .001
study 6 narrowcast	self between	0.42 [0.30, 0.53]	380.44	7.25	< .001
study 6 narrowcast	self within	0.11 [0.08, 0.14]	279.68	7.92	< .001
study 6 narrowcast	social between	0.17 [0.06, 0.29]	378.34	3.03	< .001
study 6 narrowcast	social within	0.26 [0.23, 0.29]	281.19	17.57	< .001

model VIF

model_lmer %>%
  mutate(vif = map(test, car::vif)) %>%
  select(-data, -test) %>%
  unnest(vif) %>%
  bind_cols(data.frame(variable = rep(c("self between", "self within", "social between", "social within"), 9)))   %>%
  mutate(vif = round(vif, 2)) %>%
    reactable::reactable(filterable = TRUE)

separate and combined plot

This plot is reported in supplementary material Figure S6.

self_social = bind_rows(model_data_self, model_data_social) %>%
  plot_model(., palette) +
  annotate("label", x = Inf, y = -Inf, hjust = -.05, vjust = 1,
           label = " separated relevance models", family = "Futura Medium", size = 6,
           fill = "white", label.size = NA) +
  scale_y_continuous(limits = c(-.25, 1), breaks = seq(-.25, 1, .25)) +
  guides(colour = guide_legend(nrow = 1)) +
  theme(legend.position = "none",
        legend.text = element_text(size = 12),
        text = element_text(size = 18, family = "Futura Medium"))

combined = plot_model(model_data, palette) +
  annotate("label", x = Inf, y = -Inf, hjust = -.05, vjust = 1, label = "combined relevance models",
           family = "Futura Medium", size = 6, fill = "white", label.size = NA) +
  scale_y_continuous(limits = c(-.25, 1), breaks = seq(-.25, 1, .25)) +
  theme(legend.position = "none",
        legend.text = element_text(size = 12),
        text = element_text(size = 18, family = "Futura Medium"))

ggarrange(self_social, combined, ncol = 2, common.legend = TRUE, legend = "top", labels = c("A", "B"))

sharing type

Estimate models including interactions with sharing type.

run models

fit_mod = function(data){
  mod = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_social_between*sharing_type +
                         msg_rel_social_within*sharing_type +
                         msg_rel_self_between*sharing_type +
                         msg_rel_self_within*sharing_type +
                         (1 + msg_rel_self_within + msg_rel_social_within | SID) +
                         (1 | item), data = data,
                       control = lmerControl(optimizer = "bobyqa"))
  return(mod)
}

model_lmer = merged  %>%
  filter(grepl("3|5|6", study)) %>%
  group_by(study) %>%
  nest() %>%
  mutate(test = map(data, fit_mod))


model_data = model_lmer %>% 
  mutate(tidied = map(test, broom.mixed::tidy, conf.int = TRUE)) %>%
  select(-data, -test) %>%
  unnest() %>%
  filter(effect == "fixed" & grepl("msg|sharing", term)) %>%
  ungroup()

model summary table

table_model(model_data)

study	term	b [95% CI]	df	t	p
study 3	social between	0.11 [-0.01, 0.23]	281.29	1.74	.080
study 3	sharing type (narrowcast)	-0.00 [-0.04, 0.04]	1987.51	-0.08	.940
study 3	social within	0.10 [0.05, 0.15]	248.94	3.64	< .001
study 3	self between	0.34 [0.22, 0.46]	284.52	5.60	< .001
study 3	self within	0.13 [0.07, 0.18]	180.74	4.48	< .001
study 3	sharing type (narrowcast) x social relevance between	0.10 [0.03, 0.16]	1926.52	3.04	< .001
study 3	sharing type (narrowcast) x social within	0.05 [-0.01, 0.11]	1927.26	1.54	.120
study 3	sharing type (narrowcast) x self between	-0.08 [-0.14, -0.01]	1926.33	-2.40	.020
study 3	sharing type (narrowcast) x self within	-0.01 [-0.07, 0.05]	1938.52	-0.29	.770
study 5	social between	-0.14 [-0.27, -0.02]	346.17	-2.27	.020
study 5	sharing type (narrowcast)	-0.00 [-0.02, 0.02]	5741.47	0.00	1.000
study 5	social within	0.10 [0.06, 0.13]	372.59	6.17	< .001
study 5	self between	0.81 [0.68, 0.93]	347.20	12.78	< .001
study 5	self within	0.21 [0.18, 0.24]	408.53	12.96	< .001
study 5	sharing type (narrowcast) x social relevance between	0.23 [0.18, 0.28]	5436.83	9.12	< .001
study 5	sharing type (narrowcast) x social within	0.11 [0.08, 0.14]	5436.83	6.98	< .001
study 5	sharing type (narrowcast) x self between	-0.26 [-0.31, -0.21]	5436.83	-10.14	< .001
study 5	sharing type (narrowcast) x self within	-0.09 [-0.12, -0.06]	5436.83	-5.58	< .001
study 6	social between	0.13 [0.01, 0.25]	418.42	2.14	.030
study 6	sharing type (narrowcast)	-0.00 [-0.02, 0.02]	7181.45	0.00	1.000
study 6	social within	0.12 [0.10, 0.15]	509.14	9.41	< .001
study 6	self between	0.45 [0.33, 0.57]	419.87	7.39	< .001
study 6	self within	0.16 [0.14, 0.19]	543.19	12.43	< .001
study 6	sharing type (narrowcast) x social relevance between	0.04 [-0.01, 0.08]	6801.62	1.46	.140
study 6	sharing type (narrowcast) x social within	0.14 [0.11, 0.17]	6801.63	9.93	< .001
study 6	sharing type (narrowcast) x self between	-0.02 [-0.07, 0.03]	6801.62	-0.92	.360
study 6	sharing type (narrowcast) x self within	-0.06 [-0.09, -0.03]	6801.72	-4.03	< .001

model VIF

model_lmer %>%
  mutate(vif = map(test, car::vif)) %>%
  select(-data, -test) %>%
  unnest(vif) %>%
  bind_cols(data.frame(variable = rep(c("social between", "sharing type", "social within", "self between", "self within", "social between x sharing type", "social within x sharing type", "self between x sharing type", "self within x sharing type"), 3))) %>%
  mutate(vif = round(vif, 2)) %>%
    reactable::reactable(filterable = TRUE)

separate mega-analyses

self-relevance

model_self = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_self_between*sharing_type +
                                 msg_rel_self_within*sharing_type +
                                 (1 + msg_rel_self_within | SID) +
                                 (1 + msg_rel_self_within | item),
                               data = merged,
                       control = lmerControl(optimizer = "bobyqa"))

model_self %>%
  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.value")), round, 2) %>%
  mutate(term = gsub(":", " x ", term),
         term = gsub("msg_", "", term),
         term = gsub("_", " ", term),
         term = gsub("within", "within", term),
         term = gsub("between", "between", term),
         term = gsub("rel self", "Self", term),
         term = gsub("rel social", "Social", term),
         term = gsub("sharing type", "Sharing type", term),
         term = gsub("Sharing type x (.*)", "\\1 x Sharing type", term),
         p = ifelse(p < .001, "< .001",
                    ifelse(p == 1, "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) %>%
  kable()  %>%
  kableExtra::kable_styling()

term	b [95% CI]	df	t	p
Self between	0.50 [0.47, 0.52]	3835.90	44.57	< .001
Sharing type	-0.00 [-0.01, 0.01]	25634.78	-0.02	.990
Self within	0.26 [0.24, 0.28]	428.70	32.55	< .001
Self between x Sharing type	-0.01 [-0.02, 0.00]	25347.91	-1.31	.190
Self within x Sharing type	0.01 [-0.00, 0.03]	22988.68	1.91	.060

social relevance

model_social = lmerTest::lmer(msg_share_std ~ 0 + msg_rel_social_between*sharing_type +
                                 msg_rel_social_within*sharing_type +
                                 (1 + msg_rel_social_within | SID) +
                                 (1 + msg_rel_social_within | item),
                               data = merged,
                       control = lmerControl(optimizer = "bobyqa"))

model_social %>%
  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.value")), round, 2) %>%
  mutate(term = gsub(":", " x ", term),
         term = gsub("msg_", "", term),
         term = gsub("_", " ", term),
         term = gsub("within", "within", term),
         term = gsub("between", "between", term),
         term = gsub("rel self", "Self", term),
         term = gsub("rel social", "Social", term),
         term = gsub("sharing type", "Sharing type", term),
         term = gsub("Sharing type x (.*)", "\\1 x Sharing type", term),
         p = ifelse(p < .001, "< .001",
                    ifelse(p == 1, "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) %>%
  kable()  %>%
  kableExtra::kable_styling()

term	b [95% CI]	df	t	p
Social between	0.46 [0.44, 0.48]	3812.97	40.34	< .001
Sharing type	-0.00 [-0.01, 0.01]	25349.81	-0.05	.960
Social within	0.24 [0.23, 0.26]	409.77	32.52	< .001
Social between x Sharing type	0.02 [0.00, 0.03]	25050.87	2.28	.020
Social within x Sharing type	0.07 [0.06, 0.08]	22318.42	9.59	< .001

plot

predicted = ggeffects::ggpredict(model_self, c("msg_rel_self_between [-3:3]", "sharing_type")) %>%
  data.frame() %>%
  mutate(type = "self_between") %>%
  bind_rows(ggeffects::ggpredict(model_self, c("msg_rel_self_within [-3:3]", "sharing_type")) %>%
              data.frame() %>%
              mutate(type = "self_within")) %>%
  bind_rows(ggeffects::ggpredict(model_social, c("msg_rel_social_between [-3:3]", "sharing_type")) %>%
              data.frame() %>%
              mutate(type = "social_between")) %>%
  bind_rows(ggeffects::ggpredict(model_social, c("msg_rel_social_within [-3:3]", "sharing_type")) %>%
              data.frame() %>%
              mutate(type = "social_within"))

points = merged %>%
  select(-group) %>%
  rename("group" = sharing_type,
         "predicted" = msg_share_std) %>%
  select(study, SID, group, predicted, contains("within"), contains("between")) %>%
  gather(type, x, contains("msg")) %>%
  mutate(type = gsub("msg_rel_", "", type),
         group = ifelse(group == 0, "broadcast", "narrowcast")) %>%
  extract(type, c("variable", "type"), "(.*)_(.*)") %>%
  filter(x < 3 & x > -3)

predicted %>%
  mutate(group = ifelse(group == 0, "broadcast", "narrowcast")) %>%
  extract(type, c("variable", "type"), "(.*)_(.*)") %>%
  ggplot(aes(x, predicted, color = group, fill = group, linetype = type)) +
  geom_point(data = points, aes(x, predicted), alpha = .02, size = .25) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
  geom_line(size = 1) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_sharing) +
  scale_fill_manual(name = "", values = palette_sharing) +
  scale_linetype_manual(name = "", values = c("solid", "dashed")) +
  guides(linetype = guide_legend(override.aes = list(fill = NA))) +
  labs(x = "\nstandardized relevance rating", y = "predicted standardized sharing intention rating\n") +
  plot_aes  +
  theme(legend.position = "top",
        legend.key.width=unit(2,"cm"))