In this report, we reproduce the exploratory Study 1 analyses examining differences in intervention effectiveness as a function of beliefs about climate change causes.

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, boot, report, brms, tidybayes, ggpubr, tidyText, EMAtools, broom.mixed, devtools, emmeans)

if (!require(emo)) {
  devtools::install_github('hadley/emo')
}

define functions

# MLM results table function
table_model = function(model_data, sharing_type = FALSE, intercept = FALSE, spread = FALSE, study = TRUE) {
  
  mod = model_data %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("value"), -contains("study"), -contains("sharing_type"), -p), round, 2) %>%
    mutate(term = gsub("msg_", "", term),
           term = gsub("_", " ", term),
           term = gsub(":", " x ", term),
           term = gsub("z", "", term),
           term = gsub("topichealth", "topic (health)", term),
           term = gsub("rel self", "self-relevance", term),
           term = gsub("rel social", "social relevance", 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),
           term = gsub("article condother", "other - control", term),
           term = gsub("article condself", "self - control", term),
           term = gsub("\\(Intercept\\)", "control", term),
           term = gsub("n c", "word count", 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 (isTRUE(intercept)) {
    mod = mod %>%
      mutate(term = recode(term, "control" = "intercept"))
  }
  
  if (isTRUE(sharing_type) & isTRUE(study)) {
    mod = mod %>%
      mutate(sharing_type = recode(sharing_type, "msg_share_broad" = "broadcast sharing",
                                   "msg_share_narrow" = "narrowcast sharing")) %>%
      select(study, sharing_type, term, `b [95% CI]`, df, t, p) %>%
      arrange(study)
    
  } else if (isTRUE(sharing_type) & isFALSE(study)) {
    mod = mod %>%
      mutate(sharing_type = recode(sharing_type, "msg_share_broad" = "broadcast sharing",
                                   "msg_share_narrow" = "narrowcast sharing")) %>%
      select(sharing_type, term, `b [95% CI]`, df, t, p)
    
  } else if (isFALSE(sharing_type) & isFALSE(study)) {
    mod = mod %>%
      select(term, `b [95% CI]`, df, t, p)
    
  } else {
    
    mod = mod %>%
      select(study, term, `b [95% CI]`, df, t, p) %>%
      arrange(study)
  }
  
  if (isTRUE(spread)) {
    mod %>%
      select(-df, -t, -p) %>%
      spread(study, `b [95% CI]`) %>%
      kable() %>%
      kableExtra::kable_styling()
    
  } else {
    mod %>%
      kable() %>%
      kableExtra::kable_styling()
  }
}

define aesthetics

palette_condition = c("self" = "#ee9b00",
                      "control" = "#0a9396",
                      "other" = "#005f73")
palette_dv = c("self-relevance" = "#ee9b00",
               "social relevance" = "#005f73",
               "broadcast sharing" = "#5F0F40",
               "narrowcast sharing" = "#D295BF")
palette_sharing = c("broadcast sharing" = "#5F0F40",
                    "narrowcast sharing" = "#D295BF")

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 & tidy data

climate_belief = read.csv("../data/study1_climate_cause.csv", stringsAsFactors = FALSE) %>%
  filter(scale_name == "climate_change_cause") %>%
  select(SID, value) %>%
  rename("climate_change_cause" = value)

merged = read.csv("../data/study1_data.csv", stringsAsFactors = FALSE) %>%
  left_join(., climate_belief) %>%
  gather(sharing_type, msg_share, contains("share")) %>%
  group_by(sharing_type) %>%
  mutate(msg_share_z = scale(msg_share, scale = TRUE, center = TRUE),
         msg_rel_self_z = scale(msg_rel_self, scale = TRUE, center = TRUE),
         msg_rel_social_z = scale(msg_rel_social, scale = TRUE, center = TRUE))

H3: sharing ~ intervention condition * climate cause

run models

fit_mod = function(data){
  mod = lmerTest::lmer(msg_share_z ~ 1 + article_cond * climate_change_cause +
                         (1 | SID) +
                         (1 | article_number), data = data,
                       control = lmerControl(optimizer = "bobyqa"))
  return(mod)
}

model_lmer = merged  %>%
  group_by(sharing_type) %>%
  nest() %>%
  mutate(test = map(data, fit_mod))

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

predicted_data_share = model_lmer %>% 
  mutate(predicted = map(test, modelbased::estimate_contrasts,
                         contrast = "article_cond",
                         by = c("climate_change_cause=seq(2,5,.2)"))) %>%
  select(-data, -test) %>%
  unnest(cols = predicted) %>%
  mutate(Difference = Difference * -1,
         CI_low = CI_low * -1,
         CI_high = CI_high * -1) %>%
  filter(Level1 == "control")

model summary table

table_model(model_data_share, sharing_type = TRUE, study = FALSE)

sharing_type	term	b [95% CI]	df	t	p
broadcast sharing	control	-0.62 [-0.93, -0.30]	1640.83	-3.81	< .001
broadcast sharing	other - control	0.81 [0.23, 1.38]	1632.62	2.74	.006
broadcast sharing	self - control	-0.13 [-0.69, 0.44]	1633.46	-0.44	.664
broadcast sharing	climate change cause	0.10 [0.02, 0.18]	1623.60	2.54	.011
broadcast sharing	other - control x climate change cause	-0.08 [-0.22, 0.06]	1633.13	-1.16	.247
broadcast sharing	self - control x climate change cause	0.13 [-0.01, 0.27]	1632.46	1.89	.059
narrowcast sharing	control	-0.81 [-1.12, -0.50]	1612.55	-5.16	< .001
narrowcast sharing	other - control	1.05 [0.50, 1.61]	1633.42	3.70	< .001
narrowcast sharing	self - control	0.31 [-0.24, 0.86]	1634.57	1.10	.271
narrowcast sharing	climate change cause	0.15 [0.08, 0.23]	1621.74	4.09	< .001
narrowcast sharing	other - control x climate change cause	-0.15 [-0.29, -0.02]	1634.09	-2.20	.028
narrowcast sharing	self - control x climate change cause	0.01 [-0.13, 0.14]	1633.28	0.07	.941

plot predicted

predicted_data_share %>%
  mutate(sharing_type = recode(sharing_type, "msg_share_broad" = "broadcast sharing",
                                   "msg_share_narrow" = "narrowcast sharing")) %>%
  ggplot(aes(x = climate_change_cause, y = Difference)) +
  geom_ribbon(aes(fill = Level2, ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(aes(colour = Level2), size = 2) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  facet_grid(~sharing_type) +
  scale_color_manual(name = "", values = palette_condition) + 
  scale_fill_manual(name = "", values = palette_condition) + 
  labs(x = "\nclimate change cause\n(2 = mostly natural, 5 = entirely human)",
       y = "predicted difference\n(intervention - control in SD)\n") +
  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>.
##   - Bolker B, Robinson D (2024). _broom.mixed: Tidying Methods for Mixed Models_. R package version 0.2.9.5, <https://CRAN.R-project.org/package=broom.mixed>.
##   - 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/>.
##   - Kassambara A (2023). _ggpubr: 'ggplot2' Based Publication Ready Plots_. R package version 0.6.0, <https://CRAN.R-project.org/package=ggpubr>.
##   - 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/>.
##   - 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>.
##   - Lenth R (2024). _emmeans: Estimated Marginal Means, aka Least-Squares Means_. R package version 1.10.4, <https://CRAN.R-project.org/package=emmeans>.
##   - 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, 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, D'Agostino McGowan L (2024). _emo: Easily Insert 'Emoji'_. R package version 0.0.0.9000, commit 3f03b11491ce3d6fc5601e210927eff73bf8e350, <https://github.com/hadley/emo>.
##   - 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>.

Study 1 exploratory climate cause analysis

Dani Cosme

2024-11-20