In this report, we reproduce the Study 2 analyses testing H1 and H3 with sharing behavior.

prep data

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

load packages

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

pacman::p_load(tidyverse, knitr, kableExtra, lmerTest, report, EMAtools, install = TRUE)

define functions

# MLM results table function
table_model = function(model_data, eff_size = FALSE, word_count = TRUE, reversed = FALSE, logistic = FALSE) {

  results = 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\\)", "control", term),
           term = gsub("sharing_type", "sharing type (broadcast)", 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("n_c", "word count", term),
           term = gsub(":", " x ", 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)) 
  
  if (word_count == TRUE) {
    results = results %>%
      mutate(term = gsub("control", "intercept", term))
  }

  if (reversed == TRUE) {
    results = results %>%
      mutate(term = gsub("broadcast", "narrowcast", term))
  }
  
  if (eff_size == TRUE) {
    eff_size = lme.dscore(model_data, data = data, type = "lme4") %>%
      rownames_to_column(var = "term") %>%
      mutate(term = gsub("article_cond", "", term),
             term = gsub("article_cond", "", term),
             term = gsub("\\(Intercept\\)", "control", term),
             term = gsub("sharing_type", "sharing type (broadcast)", term),
             term = gsub("msg_rel_self", "self-relevance", term),
             term = gsub("msg_rel_social", "social relevance", term),
             term = gsub("topichealth", "topic (health)", term),
             term = gsub(":", " x ", term),
             d = sprintf("%.2f", d)) %>%
      select(term, d)
    
    results %>%
      left_join(., eff_size) %>%
      mutate(d = ifelse(is.na(d), "--", d)) %>%
      select(term, `b [95% CI]`, d, df, t, p)
    
  } else if (logistic == TRUE) {
    results %>%
      rename("z" = t) %>%
      select(term, `b [95% CI]`, z, p)
    
  } else {
    results %>%
      select(term, `b [95% CI]`, df, t, p)
  }
}

# simple effects function
simple_effects = function(model, sharing = FALSE) {
  if(sharing == FALSE) {
    results = emmeans::contrast(emmeans::emmeans(model, ~ article_cond | group),
                            "revpairwise", by = "group", adjust = "none") %>%
      data.frame() %>%
      filter(grepl("control", contrast)) %>%
      select(contrast, group, estimate, p.value)
  } else {
    results = emmeans::contrast(emmeans::emmeans(model, ~ article_cond | group + sharing_type),
                            "revpairwise", by = "group", adjust = "none") %>%
      data.frame() %>%
      filter(grepl("- control", contrast)) %>%
      filter(!grepl("^control", contrast)) %>%
      extract(contrast, c("exp_sharing", "control_sharing"), ".* (0|1) - control (0|1)", remove = FALSE) %>%
      filter(exp_sharing == control_sharing) %>%
      mutate(sharing_type = ifelse(exp_sharing == 0, "broadcast", "narrowcast"),
             contrast = gsub("0|1", "", contrast)) %>%
      select(contrast, sharing_type, group, estimate, p.value)
  }
  
  results %>%
    mutate(p.value = ifelse(p.value < .001, "< .001",
                      ifelse(p.value == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p.value))))) %>%
    kable(digits = 2) %>%
    kableExtra::kable_styling()
}

define aesthetics

palette_condition = c("self" = "#ee9b00",
                      "control" = "#bb3e03",
                      "other" = "#005f73")
palette_dv = c("self-relevance" = "#ee9b00",
               "social relevance" = "#005f73",
               "broadcast sharing" = "#5F0F40",
               "narrowcast sharing" = "#D295BF")
palette_topic = c("climate" = "#519872",
                 "health" = "#3A3357")

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 data

data = read.csv("../data/study2_data.csv", stringsAsFactors = FALSE) %>%
  group_by(sharing_type) %>%
  mutate(msg_rel_self_z = scale(msg_rel_self, center = TRUE, scale = TRUE),
         msg_rel_social_z = scale(msg_rel_social, center = TRUE, scale = TRUE),
         msg_share_z = scale(msg_share, center = TRUE, scale = TRUE))

descriptives

number of articles

data %>%
  group_by(SID) %>%
  summarize(n = n()) %>%
  ungroup() %>%
  summarize(M = mean(n, na.rm = TRUE),
            SD = sd(n, na.rm = TRUE),
            min = min(n, na.rm = TRUE),
            max = max(n, na.rm = TRUE)) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
M SD min max
16.08 9.35 2 54

percent sharing

data %>%
  filter(sharing_type == 0) %>%
  group_by(sharing_behavior) %>%
  summarize(n = n()) %>%
  ungroup() %>%
  mutate(total = sum(n),
         percent = (n / total) * 100) %>%
  select(-total) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
sharing_behavior n percent
0 3287 98.98
1 34 1.02

number of shares per person

data %>%
  filter(sharing_type == 0) %>%
  group_by(SID) %>%
  mutate(n_shares = sum(sharing_behavior, na.rm = TRUE)) %>%
  ggplot(aes(n_shares)) +
  geom_density(fill = palette_condition[1], color = NA) +
  labs(x = "\nnumber of shares per person") +
  plot_aes

correlation between sharing intentions and sharing behavior

data %>%
  ungroup() %>%
  select(-sharing_type) %>%
  spread(sharing_type_key, msg_share) %>%
  rmcorr::rmcorr(as.factor(SID), sharing_behavior, msg_share_narrow, data = .)
## 
## Repeated measures correlation
## 
## r
## 0.08280991
## 
## degrees of freedom
## 2907
## 
## p-value
## 0.00000774452
## 
## 95% confidence interval
## 0.04660816 0.1187944

H1

Greater (a) self-relevance and (b) social relevance ratings will be associated with stronger news sharing behavior.

mod_h1_binary = glmer(sharing_behavior ~ msg_rel_self_z + msg_rel_social_z + (1 | SID),
              data = filter(data, sharing_type == 0),
              family = "binomial",
              control = glmerControl(optimizer = "bobyqa"))

plot

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

predicted_sub_h1_binary = ggeffects::ggpredict(mod_h1_binary, terms = c("msg_rel_self_z", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h1_binary, c("msg_rel_social_z", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

predicted_h1_binary %>%
  ggplot(aes(x, predicted)) +
  stat_smooth(data = predicted_sub_h1_binary, aes(group = group, color = variable),
              geom ='line', method = "lm", alpha = .1, linewidth = .75, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = variable), alpha = .5, color = NA) +
  geom_line(aes(color = variable), size = 1.5) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_dv) +
  scale_fill_manual(name = "", values = palette_dv) +
  labs(x = "\nrelevance rating", y = "predicted probability of sharing\n") +
  plot_aes +
    theme(legend.position = "none")
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

model table

table_h1_binary = table_model(mod_h1_binary, logistic = TRUE)

table_h1_binary %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] z p
intercept -10.82 [-12.84, -8.79] -10.47 < .001
self-relevance 0.04 [-0.68, 0.76] 0.11 .914
social relevance 1.01 [0.06, 1.96] 2.08 .038

summary

summary(mod_h1_binary)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: sharing_behavior ~ msg_rel_self_z + msg_rel_social_z + (1 | SID)
##    Data: filter(data, sharing_type == 0)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##    253.7    278.2   -122.9    245.7     3317 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.0529 -0.0071 -0.0051 -0.0031  9.1816 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  SID    (Intercept) 62.89    7.93    
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error z value            Pr(>|z|)    
## (Intercept)      -10.81776    1.03279 -10.474 <0.0000000000000002 ***
## msg_rel_self_z     0.03993    0.36923   0.108              0.9139    
## msg_rel_social_z   1.00903    0.48511   2.080              0.0375 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) msg_rl_sl_
## msg_rl_slf_  0.042           
## msg_rl_scl_ -0.277 -0.625

H3

Compared to the control condition, the (a) self-focused and (b) other-focused conditions will increase news sharing behavior.

mod_h3_binary = glmer(sharing_behavior ~ 1 + article_cond + (1 | SID),
              data = filter(data, sharing_type == 0),
              family = "binomial",
              control = glmerControl(optimizer = "bobyqa"))

plot

predicted_h3_binary = ggeffects::ggpredict(mod_h3_binary, c("article_cond")) %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))
  
predicted_sub_h3_binary = ggeffects::ggpredict(mod_h3_binary, terms = c("article_cond", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

predicted_h3_binary %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = predicted_sub_h3_binary, aes(group = group), fun = "mean", geom = "line",
               size = .08, 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 = .5) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted probability of sharing\n") +
  plot_aes

model table

table_h3_binary = table_model(mod_h3_binary, logistic = TRUE)

table_h3_binary %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] z p
intercept -11.30 [-13.47, -9.12] -10.19 < .001
other 0.71 [-0.54, 1.97] 1.11 .267
self 1.45 [0.25, 2.65] 2.36 .018

summary

summary(mod_h3_binary)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: sharing_behavior ~ 1 + article_cond + (1 | SID)
##    Data: filter(data, sharing_type == 0)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##    256.6    281.1   -124.3    248.6     3317 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.3058 -0.0072 -0.0050 -0.0035  4.6930 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  SID    (Intercept) 62.78    7.924   
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error z value            Pr(>|z|)    
## (Intercept)       -11.2967     1.1091 -10.186 <0.0000000000000002 ***
## article_condother   0.7108     0.6404   1.110              0.2670    
## article_condself    1.4467     0.6121   2.364              0.0181 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.388           
## artcl_cndsl -0.464  0.650

combined table

table_h1_binary %>% mutate(DV = "h1a-b: Sharing") %>%
  bind_rows(table_h3_binary %>% mutate(DV = "h3: Sharing")) %>%
  select(DV, everything()) %>%
  kable() %>%
  kable_styling()
DV term b [95% CI] z p
h1a-b: Sharing intercept -10.82 [-12.84, -8.79] -10.47 < .001
h1a-b: Sharing self-relevance 0.04 [-0.68, 0.76] 0.11 .914
h1a-b: Sharing social relevance 1.01 [0.06, 1.96] 2.08 .038
h3: Sharing intercept -11.30 [-13.47, -9.12] -10.19 < .001
h3: Sharing other 0.71 [-0.54, 1.97] 1.11 .267
h3: Sharing self 1.45 [0.25, 2.65] 2.36 .018

cite packages

report::cite_packages()
##   - 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>.
##   - 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/>.
##   - Kleiman E (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>.
##   - 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>.
##   - Makowski D, Lüdecke D, Patil I, Thériault R, Ben-Shachar M, Wiernik B (2023). "Automated Results Reporting as a Practical Tool to Improve Reproducibility and Methodological Best Practices Adoption." _CRAN_. <https://easystats.github.io/report/>.
##   - 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, 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, 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>.