COVID-19 Full Study 1

Autonomy analyses

Autonomy has been described as a fundamental human need and satisfying the need for autonomy is an important motivator of behavior (Deci & Ryan, 2000). Autonomy can be supported in various ways, and autonomy-supportive environments are associated with more successful behavior change (Ng et al., 2012). Framing information and decisions in autonomous ways, emphasizing choice and agency, may increase receptivity to health messages and promote behavior change.

In this preregistered study, we assess the degree to which framing health messages related to COVID-19 in ways that support autonomy improves message effectiveness and promotes social distancing behaviors.

Specifically, we tested the degree to which autonomously framed messages are rated as being more 1) self-relevant, and 2) motivating, and 3) are associated with greater self-reported intentions of sharing on social media, compared to control messages. We also tested whether increased self-relevance and motivation are associated with greater sharing intentions and whether these relationships are moderated by the framing condition. Finally, we tested the degree to which exposure to autonomously framed messages increases perceived agency in mitigating the spread of COVID-19.

In secondary analyses, we will explored the degree to which exposure to autonomously framed messages had downstream consequences on person-level variation in intentions, beliefs, and perceptions of social norms related to social distancing.

Participants were randomly assigned to one of three conditions: autonomous framing, message control, or no message control as part of a larger study with 5 total conditions (for full details, see the project overview report). In this study, participants were either exposed to 1) messages framed using autonomous language, 2) control messages (message control), or 3) no message (no treatment control).

Each participant saw a series of 5 messages about social distancing related to COVID-19 randomly sampled from a pool of 15 messages previously normed for argument strength (M = 4.16, SD = 0.18, possible range = 1-5; see the argument strength norming report for details). Each message was created to look like an instagram post that includes a visual message about COVID-19 accompanied by a “post” about the message. For each message, the post begins with the same stem (e.g., “Staying home protects our community by stopping the spread of #covid19.”). The message control condition contains this stem only, whereas the experimental condition contains additional text framed using autonomous language. For example:

Message stimuli from the autonomy framing condition can be viewed here. Message stimuli in the control condition can be viewed here.

prep and check data

---

Tidy the data and check the number of item responses per condition for each measure

## load packages

if (!require(tidyverse)) {
  install.packages('tidyverse')
}
if (!require(lmerTest)) {
  install.packages('lmerTest')
}
if (!require(knitr)) {
  install.packages('knitr')
}
if (!require(kableExtra)) {
  install.packages('kableExtra')
}
if (!require(ggeffects)) {
  install.packages('ggeffects')
}
if (!require(fastDummies)) {
  install.packages('fastDummies')
}
devtools::install_github("dcosme/specr", ref = "plotmods")
library(specr)

## define palette

palette_cond = wesanderson::wes_palette("Zissou1", n = 2, type = "continuous")
palette_rel_motiv = wesanderson::wes_palette("Zissou1", n = 8, "continuous")[c(3:5,7)]
palette = c(palette_cond[1:2], "grey50")


## load cleaned data
#* Data was cleaned using the `../data_cleaning.Rmd` script.

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


## tidy data for analysis
items = read.csv("item_text.csv", stringsAsFactors = FALSE)
items_surveys = items %>% 
  select(-item, -text) %>%
  unique()

messages = data %>%
  filter(condition %in% c("no message control", "message control", "autonomous")) %>%
  filter(grepl("msg", survey_name)) %>%
  filter(!grepl("time", survey_name)) %>%
  mutate(value = as.numeric(value)) %>%
  extract(item, "item", "msg_.*_(.*)") %>%
  spread(survey_name, value) %>%
  mutate(msg_favorability = msg_positive - msg_negative) %>%
  select(-msg_negative, -msg_positive) %>%
  gather(survey_name, value, contains("msg")) %>%
  mutate(item = sprintf("%s_%s", survey_name, item)) %>%
  group_by(survey_name) %>%
  mutate(mean = mean(value, na.rm = TRUE),
         sd3 = 3*sd(value, na.rm = TRUE),
         value = ifelse(!grepl("familiarity", item) & value > mean + sd3, mean + sd3, value), # winsorize outliers
         value = ifelse(!grepl("familiarity", item) & value < mean - sd3, mean - sd3, value)) %>%
  select(-c(mean, sd3))

data_tidy = data %>%
  filter(!grepl("time", survey_name)) %>%
  filter(condition %in% c("no message control", "message control", "autonomous")) %>%
  filter(grepl("agency|autonomy|intentions|norms_close|norms_town|beliefs_safe|purpose|selfconstrual", survey_name)) %>% 
  mutate(value = as.numeric(value),
         value = ifelse(item == "covid_studies" & as.numeric(value) > 100, NA, value), # remove 8 extreme outliers
         value = ifelse(item == "agency_2", abs(value - 8), value), # reverse-code agency item
         value = ifelse(item %in% c("purpose_2", "purpose_4", "purpose_5", "purpose_6"), abs(value - 6), value), # reverse-code purpose
         survey_name = ifelse(item %in% c("autonomy_1", "autonomy_2", "autonomy_3", "autonomy_4", "autonomy_5"),
                              "IAF_autonomous", 
                       ifelse(item %in% c("autonomy_6", "autonomy_7", "autonomy_8", "autonomy_9", "autonomy_10"),
                              "IAF_controlling", survey_name)),
         survey_name = ifelse(item %in% c("selfconstrual_1", "selfconstrual_2", "selfconstrual_3", "selfconstrual_4"),
                              "SC_independence", 
                       ifelse(item %in% c("selfconstrual_5", "selfconstrual_6", "selfconstrual_7", "selfconstrual_8"),
                              "SC_interdependence", survey_name))) %>% 
  bind_rows(messages) %>%
  left_join(., select(items, -survey_name),  by = "item") %>%
  mutate(text = ifelse(survey_name == "msg_familiarity", filter(items, item == "msg_familiarity")$text,
                ifelse(survey_name == "msg_rel_self", filter(items, item == "msg_rel_self")$text,
                ifelse(survey_name == "msg_rel_social", filter(items, item == "msg_rel_social")$text,
                ifelse(survey_name == "msg_motiv_self", filter(items, item == "msg_motiv_self")$text,
                ifelse(survey_name == "msg_motiv_other", filter(items, item == "msg_motiv_other")$text,
                ifelse(survey_name == "msg_positive", filter(items, item == "msg_positive")$text,
                ifelse(survey_name == "msg_negative", filter(items, item == "msg_negative")$text,
                ifelse(survey_name == "msg_share", filter(items, item == "msg_share")$text, text)))))))),
         measure = ifelse(survey_name == "msg_familiarity", filter(items, item == "msg_familiarity")$measure,
                   ifelse(survey_name == "msg_rel_self", filter(items, item == "msg_rel_self")$measure,
                   ifelse(survey_name == "msg_rel_social", filter(items, item == "msg_rel_social")$measure,
                   ifelse(survey_name == "msg_motiv_self", filter(items, item == "msg_motiv_self")$measure,
                   ifelse(survey_name == "msg_motiv_other", filter(items, item == "msg_motiv_other")$measure,
                   ifelse(survey_name == "msg_positive", filter(items, item == "msg_positive")$measure,
                   ifelse(survey_name == "msg_negative", filter(items, item == "msg_negative")$measure,
                   ifelse(survey_name == "msg_share", filter(items, item == "msg_share")$measure, measure)))))))))

control_vars = data %>%
  filter(grepl("state|gender|^age$|politics_party|politics_conserv|ses_income_household|ses_degree|covid_studies", survey_name)) %>%
  select(SID, survey_name, value) %>%
  unique() %>%
  spread(survey_name, value) %>%
  mutate(state = as.factor(state),
         gender = recode(gender, "1" = "male", "2" = "female", "3" = "other", "4" = "prefer not to say"),
         age = scale(as.integer(age), center = TRUE, scale = FALSE), # mean center age
         ses_degree = factor(ses_degree),
         ses_income_household = ifelse(ses_income_household %in% c("10", "11"), NA, ses_income_household),
         ses_income_household = factor(ses_income_household),
         politics_conserv = scale(as.integer(politics_conserv), center = TRUE, scale = FALSE),
         politics_party = scale(as.integer(politics_party), center = TRUE, scale = FALSE),
         covid_studies = ifelse(covid_studies == 1273, NA, as.numeric(covid_studies)),
         covid_studies = log(covid_studies),
         covid_studies = ifelse(covid_studies == -Inf, NA, covid_studies))

data_person = data_tidy %>%
  filter(grepl("msg|agency|autonomy|beliefs|intentions1_2|intentions1_4|intentions1_6|intentions1_10|norms_close1_2|norms_close1_4|norms_close1_6|norms_close1_10|norms_town1_2|norms_town1_4|norms_town1_6|norms_town1_10|purpose|selfconstrual", item)) %>%
  group_by(condition, SID, survey_name) %>%
  summarize(value = mean(value, na.rm = TRUE)) %>%
  group_by(survey_name) %>%
  mutate(mean = mean(value, na.rm = TRUE),
       sd3 = 3*sd(value, na.rm = TRUE),
       value = ifelse(!grepl("msg", survey_name) & value > mean + sd3, mean + sd3, value), # winsorize outliers
       value = ifelse(!grepl("msg", survey_name) & value < mean - sd3, mean - sd3, value)) %>%
  select(-c(mean, sd3)) %>%
  left_join(., items_surveys, by = "survey_name") %>%
  mutate(measure = ifelse(survey_name == "IAF_autonomous", "Index of Autonomous Functioning: self-congruence/authorship",
                 ifelse(survey_name == "IAF_controlling", "Index of Autonomous Functioning: susceptibility to control",
                 ifelse(survey_name == "SC_independence", "Self-Construal Scale: independence",
                 ifelse(survey_name == "SC_interdependence", "Self-Construal Scale: interdependence", measure)))),
         scale = ifelse(grepl("IAF", survey_name), "1 = not at all true, 5 = completely",
                 ifelse(grepl("SC", survey_name), "1 = strongly disagree, 7 = strongly agree", scale)),
         citation = ifelse(grepl("IAF", survey_name), " Weinstein, Przybylski, & Ryan, 2012",
                    ifelse(grepl("SC", survey_name), "Adapted from Singelis, 1994", citation))) %>%
  filter(!grepl("hygiene", measure))

dvs_covs_controls = data_person %>%
  select(-c(scale, measure, citation)) %>%
  filter(grepl("intentions|agency|IAF|norms|beliefs|SC", survey_name)) %>%
  group_by(survey_name) %>%
  mutate(value = scale(value)) %>% #scale within survey
  spread(survey_name, value) %>%
  left_join(., control_vars, by = "SID")

data_mod = messages %>%
  group_by(SID, survey_name) %>%
  extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
  mutate(trial = row_number()) %>%
  select(-item) %>%
  group_by(survey_name) %>%
  mutate(value = scale(value)) %>% #scale within survey
  spread(survey_name, value) %>%
  left_join(., dvs_covs_controls) %>%
  mutate(group = gsub(" ", "_", condition),
         SID = as.factor(SID),
         condition = factor(condition, levels = c("message control", "autonomous", "no message control"))) %>%
  ungroup() %>%
  select(-msg_familiarity) %>%
  fastDummies::dummy_cols(., select_columns = "group") %>%
  gather(var, val, contains("group_")) %>%
  mutate(var = gsub("group_", "", var)) %>%
  spread(var, val)

data_mod_person = messages %>%
  group_by(SID, survey_name) %>%
  extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
  mutate(trial = row_number()) %>%
  select(-item) %>%
  group_by(study, condition, SID, survey_name, survey_name) %>%
  summarize(value = mean(value, na.rm = TRUE)) %>% # take the mean across messages
  group_by(survey_name) %>%
  mutate(value = scale(value)) %>% # scale within survey
  spread(survey_name, value) %>%
  full_join(., dvs_covs_controls) %>%
  mutate(group = gsub(" ", "_", condition),
         SID = as.factor(SID),
         condition = factor(condition, levels = c("message control", "autonomous", "no message control"))) %>%
  fastDummies::dummy_cols(., select_columns = "group") %>%
  gather(var, val, contains("group_")) %>%
  mutate(var = gsub("group_", "", var)) %>%
  spread(var, val)


## define functions
## plotting
plot_cond = function(data, survey, item=TRUE, palette=palette) {
  if (item == FALSE) {
    data %>%
    filter(grepl(!!(survey), survey_name)) %>%
    mutate(value = as.numeric(value)) %>%
    ggplot(aes(survey_name, value, color = condition)) +
    stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", position = position_dodge(width = .5)) +
    scale_color_manual(values = palette) +
    labs(x = "", y = "value\n") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.position = "top")
  } else {
    data %>%
    filter(grepl(!!(survey), survey_name)) %>%
    mutate(value = as.numeric(value)) %>%
    ggplot(aes(item, value, color = condition)) +
    stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", position = position_dodge(width = .5)) +
    scale_color_manual(values = palette) +
    labs(x = "", y = "value\n") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.position = "top")
  }
}

plot_compare = function(data, survey = ".*", palette, condition = FALSE) {

  rating_means = data %>%
    filter(grepl(!!(survey), survey_name)) %>%
    group_by(survey_name) %>%
    summarize(mean = mean(value))
  
  if (condition == TRUE) {
    data %>%
      filter(grepl(!!(survey), survey_name)) %>%
      ggplot(aes(message, value, color = condition)) +
      stat_summary(fun.data = "mean_cl_boot") +
      coord_flip() +
      geom_hline(data = rating_means, aes(yintercept = mean), linetype = "dotted") +
      facet_grid(~survey_name) +
      labs(x = "message\n", y = "\nvalue") +
      scale_color_manual(values = palette_cond) +
      theme_minimal() +
      theme(legend.position = "top")
    
  } else {
    data %>%
      filter(grepl(!!(survey), survey_name)) %>%
      ggplot(aes(message, value)) +
      stat_summary(fun.data = "mean_cl_boot") +
      coord_flip() +
      geom_hline(data = rating_means, aes(yintercept = mean), linetype = "dotted") +
      facet_grid(~survey_name) +
      labs(x = "message\n", y = "\nvalue") +
      scale_color_manual(values = palette_cond) +
      theme_minimal() +
      theme(legend.position = "top")
  }
}

plot_desc = function(data, survey, condition=FALSE,
                     palette=palette, min=1, max=7,
                     text_size=3, alpha=.5) {

    source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")
    
    labels = data %>%
      filter(grepl(!!(survey), survey_name)) %>%
      group_by(survey_name, measure) %>%
      summarize(y = (max + min) / 2) %>%
      mutate(condition = "autonomous")
    
    if (condition == FALSE) {
      data %>%
        filter(grepl(!!(survey), survey_name)) %>%
        ggplot(aes(survey_name, value)) +
        geom_flat_violin(position = position_nudge(x = .1, y = 0), color = FALSE, fill = palette[1]) +
        geom_point(position = position_jitter(width = .05, height = .05), size = .5, alpha = alpha, color = palette[1]) +
        geom_boxplot(width = .1, outlier.shape = NA, alpha = .25) +
        geom_text(data = labels, aes(x = survey_name, y = y, label = measure), nudge_x = .55, size = text_size) +
        coord_flip() +
        scale_x_discrete(expand = expansion(add = c(0, .75))) +
        scale_y_continuous(limits = c(min, max), breaks = seq(min, max, 1)) +
        labs(x = "", y = "rating") +
        theme_minimal() +
        theme(axis.text.y = element_blank(),
              legend.position = "top")

    } else {
      
      data %>%
        filter(grepl(!!(survey), survey_name)) %>%
        ggplot(aes(survey_name, value, fill = condition)) +
        geom_flat_violin(position = position_nudge(x = .1, y = 0), alpha = .3, color = FALSE) +
        geom_point(aes(color = condition), position = position_jitter(width = .05, height = .05), size = .5, alpha = alpha) +
        geom_boxplot(width = .1, outlier.shape = NA, alpha = .25) +
        geom_text(data = labels, aes(x = survey_name, y = y, label = measure), nudge_x = .55, size = text_size) +
        coord_flip() +
        scale_x_discrete(expand = expansion(add = c(0, .75))) +
        scale_y_continuous(limits = c(min, max), breaks = seq(min, max, 1)) +
        scale_fill_manual(values = palette) +
        scale_color_manual(values = palette) +
        labs(x = "", y = "rating") +
        theme_minimal() +
        theme(axis.text.y = element_blank(),
              legend.position = "top")
    }
}

table_desc = function(data, survey, condition=FALSE, item=TRUE, message=FALSE) {
  
  if (item == FALSE) {
    
    if (condition == TRUE) {
      
      data %>%
        filter(grepl(!!(survey), survey_name)) %>%
        filter(!is.na(value)) %>%
        group_by(survey_name, measure, condition) %>%
        summarize(n = n(),
                  min = min(value, na.rm = TRUE),
                  max = max(value, na.rm = TRUE),
                  mean = mean(value, na.rm = TRUE),
                  median = median(value, na.rm = TRUE),
                  sd = sd(value, na.rm = TRUE)) %>%
        mutate_if(is.numeric, round, 2) %>%
        DT::datatable(rownames = FALSE, extensions = 'FixedColumns', 
                      options = list(scrollX = TRUE,
                                     scrollY = TRUE,
                                     fixedColumns = list(leftColumns = 2)))
      
    } else {
    
      data %>%
        filter(grepl(!!(survey), survey_name)) %>%
        filter(!is.na(value)) %>%
        group_by(survey_name, measure) %>%
        summarize(n = n(),
                  min = min(value, na.rm = TRUE),
                  max = max(value, na.rm = TRUE),
                  mean = mean(value, na.rm = TRUE),
                  median = median(value, na.rm = TRUE),
                  sd = sd(value, na.rm = TRUE)) %>%
        mutate_if(is.numeric, round, 2) %>%
        DT::datatable(rownames = FALSE, extensions = 'FixedColumns', 
                      options = list(scrollX = TRUE,
                                     scrollY = TRUE,
                                     fixedColumns = list(leftColumns = 2)))
    }
    
  } else {
  
    data %>%
      filter(grepl(!!(survey), survey_name)) %>%
      filter(!is.na(value)) %>%
      group_by(text) %>%
      summarize(n = n(),
                min = min(value, na.rm = TRUE),
                max = max(value, na.rm = TRUE),
                mean = mean(value, na.rm = TRUE),
                median = median(value, na.rm = TRUE),
                sd = sd(value, na.rm = TRUE)) %>%
      mutate_if(is.numeric, round, 2) %>%
      DT::datatable(rownames = FALSE, extensions = 'FixedColumns', 
                    options = list(scrollX = TRUE,
                                   scrollY = TRUE,
                                   fixedColumns = list(leftColumns = 2)))
  }
}

data_tidy %>%
  mutate(value = as.numeric(value)) %>%
  group_by(condition, survey_name) %>%
  summarize(n = n()) %>%
  spread(condition, n)

Check the number of participants per condition for each measure

data_person %>%
  mutate(value = as.numeric(value)) %>%
  group_by(condition, survey_name) %>%
  summarize(n = n()) %>%
  spread(condition, n)

visualize variables

distributions and descriptives

Below are tables and density plots for the distribution of average responses for each measure as a function of condition.

message-level items

scale
1 = strongly disagree, 7 = strongly agree

For each person and item, ratings were averaged across messages.

items %>%
  filter(grepl("msg_.*_self|share", item)) %>%
  select(item, text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

item	text
msg_rel_self	This message is relevant to me
msg_share	I would share this message on social media.
msg_motiv_self	This message motivates me to avoid physical contact with others.

table

table_desc(data_person, "msg_.*_self|share", item = FALSE, condition = TRUE)

figure

plot_desc(data_person, "msg_.*_self|share", condition = TRUE, palette = palette_cond)

person-level items

measure
Agency in mitigating the spread of COVID-19

question text
To what extent do you agree or disagree with the following statements?

scale
1 = strongly disagree, 7 = strongly agree

In all analyses, average agency for each person was computed by reverse scoring agency_2 and taking the mean across all items.

items %>%
  filter(grepl("^agency_[1-3]{1}", item)) %>%
  select(item, text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

item	text
agency_1	I, personally, have the ability to reduce further outbreak of COVID-19
agency_2	I am powerless to reduce further outbreak of COVID-19
agency_3	My actions matter for reducing further outbreak of COVID-19

table

table_desc(data_person, "agency", item = FALSE, condition = TRUE)

figure

plot_desc(data_person, "agency", condition = TRUE, palette = palette)

average condition effects

In these plots, we averaged across message responses for each item (or across items in the agency scale) within person and plot the difference between conditions.

plot_cond(data_person, "msg_.*_self|share|agency", item = FALSE, palette = palette)

preregistered analyses

---

For all analyses, the data are grand-mean centered and scaled in standard units.

primary

hypothesis 1

Hypothesis: Compared to the message control condition, autonomously framed messages will be rated as more self-relevant

❌ These data are not consistent with this hypothesis. Based on the Bayes factor, there is very strong evidence for the null.

run model

rel_self_1 = lmer(msg_rel_self ~ condition + (1 | SID) + (1 | message), data = data_mod)

summary(rel_self_1)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self ~ condition + (1 | SID) + (1 | message)
##    Data: data_mod
## 
## REML criterion at convergence: 4099.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.8594 -0.3704  0.1055  0.4633  4.4901 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.57905  0.7610  
##  message  (Intercept) 0.01299  0.1140  
##  Residual             0.41078  0.6409  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                      Estimate Std. Error        df t value Pr(>|t|)
## (Intercept)          -0.01365    0.06753 157.06873  -0.202    0.840
## conditionautonomous   0.02825    0.08764 342.99682   0.322    0.747
## 
## Correlation of Fixed Effects:
##             (Intr)
## conditntnms -0.624

bayes factor using BIC

Evidence for H0 (no condition effect)

rel_self_null = lmer(msg_rel_self ~ 1 + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(rel_self_null, rel_self_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1 + (1 | SID) + (1 | message)	179.4431
condition + (1 | SID) + (1 | message)	1.0000

plot predicted effects

ggeffects::ggpredict(rel_self_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous")) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "self-relevance\n") +
  theme_minimal() +
  theme(legend.position = "none")

hypothesis 2

Hypothesis: Compared to the message control condition, autonomously framed messages will be associated with greater motivation to practice social distancing

❌ These data are not consistent with this hypothesis. Based on the Bayes factor, there is very strong evidence for the null.

run model

motiv_self_1 = lmer(msg_motiv_self ~ condition + (1 | SID) + (1 | message), data = data_mod)
summary(motiv_self_1)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_motiv_self ~ condition + (1 | SID) + (1 | message)
##    Data: data_mod
## 
## REML criterion at convergence: 4183.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.8075 -0.3348  0.1088  0.4553  4.1460 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.54730  0.7398  
##  message  (Intercept) 0.02018  0.1421  
##  Residual             0.43986  0.6632  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                      Estimate Std. Error        df t value Pr(>|t|)
## (Intercept)          -0.00183    0.06997 104.18226  -0.026    0.979
## conditionautonomous   0.00180    0.08590 342.92424   0.021    0.983
## 
## Correlation of Fixed Effects:
##             (Intr)
## conditntnms -0.591

bayes factor using BIC

Evidence for H0 (no condition effect)

motiv_self_null = lmer(msg_motiv_self ~ 1 + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(motiv_self_null, motiv_self_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1 + (1 | SID) + (1 | message)	192.8092
condition + (1 | SID) + (1 | message)	1.0000

plot predicted effects

ggeffects::ggpredict(motiv_self_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous")) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "motivation to practice social distancing\n") +
  theme_minimal() +
  theme(legend.position = "none")

hypothesis 3

Hypothesis: Compared to the message control condition, autonomously framed messages will be rated as being more likely to be shared.

❌ These data are consistent with this hypothesis, but the uncertainty around these estimates is large. Based on the Bayes factor, there is strong evidence for the null.

run model

share_1 = lmer(msg_share ~ condition + (1 | SID) + (1 | message), data = data_mod)
summary(share_1)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share ~ condition + (1 | SID) + (1 | message)
##    Data: data_mod
## 
## REML criterion at convergence: 3782.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8240 -0.4247  0.0630  0.5035  2.9405 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.66350  0.8146  
##  message  (Intercept) 0.01584  0.1258  
##  Residual             0.31764  0.5636  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                      Estimate Std. Error        df t value Pr(>|t|)  
## (Intercept)          -0.07461    0.07154 160.57403  -1.043   0.2986  
## conditionautonomous   0.15426    0.09189 342.87889   1.679   0.0941 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## conditntnms -0.618

bayes factor using BIC

Evidence for H0 (no condition effect)

share_null = lmer(msg_share ~ 1 + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(share_null, share_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1 + (1 | SID) + (1 | message)	44.13225
condition + (1 | SID) + (1 | message)	1.00000

plot predicted effects

ggeffects::ggpredict(share_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous")) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "none")

hypothesis 4

Hypothesis: Self-relevance and motivation will be associated with higher sharing intentions, and these relationships will be stronger in the autonomous framing condition.

✅ These data are consistent with the hypothesis that self-relevance and motivation are associated with higher sharing intentions.

❌ However, not with the moderation hypothesis. Based on the Bayes factors, there is very strong evidence for the null (i.e., no moderation).

self-relevance

run model

share_mod_rel = lmer(msg_share ~ condition*msg_rel_self + (1 | SID) + (1 | message), data = data_mod)
summary(share_mod_rel)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share ~ condition * msg_rel_self + (1 | SID) + (1 | message)
##    Data: data_mod
## 
## REML criterion at convergence: 3399.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0982 -0.4434  0.0356  0.4711  3.5965 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.51044  0.7144  
##  message  (Intercept) 0.01019  0.1010  
##  Residual             0.25534  0.5053  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                    Estimate Std. Error         df t value
## (Intercept)                        -0.06899    0.06178  181.88563  -1.117
## conditionautonomous                 0.14290    0.08076  341.26985   1.769
## msg_rel_self                        0.41559    0.02742 1660.95319  15.156
## conditionautonomous:msg_rel_self   -0.00862    0.03868 1684.13218  -0.223
##                                             Pr(>|t|)    
## (Intercept)                                   0.2656    
## conditionautonomous                           0.0777 .  
## msg_rel_self                     <0.0000000000000002 ***
## conditionautonomous:msg_rel_self              0.8237    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt msg_r_
## conditntnms -0.629              
## msg_rel_slf  0.006 -0.004       
## cndtntnm:__ -0.004 -0.001 -0.701

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_rel_null = lmer(msg_share ~ msg_rel_self + condition + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(share_mod_rel_null, share_mod_rel, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
msg_rel_self + condition + (1 | SID) + (1 | message)	417.5942
condition * msg_rel_self + (1 | SID) + (1 | message)	1.0000

plot predicted effects

ggeffects::ggpredict(share_mod_rel, c("condition", "msg_rel_self [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean", 
                 ifelse(group == "1", sprintf("+%s SD", group), sprintf("%s SD", group))),
         group = factor(group, levels = c("-1 SD", "mean", "+1 SD"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.7, .8)) +
  labs(x = "", y = "predicted standardized rating\n", title = "self-relevance\n") +
  theme_minimal() +
  theme(legend.position = "top")

self motivation

run model

share_mod_motiv = lmer(msg_share ~ condition*msg_motiv_self + (1 | SID) + (1 | message), data = data_mod)
summary(share_mod_motiv)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share ~ condition * msg_motiv_self + (1 | SID) + (1 | message)
##    Data: data_mod
## 
## REML criterion at convergence: 3071.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1775 -0.4304  0.0575  0.4788  4.9881 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.417078 0.64582 
##  message  (Intercept) 0.003333 0.05773 
##  Residual             0.212853 0.46136 
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                      Estimate Std. Error         df
## (Intercept)                          -0.07388    0.05283  266.90390
## conditionautonomous                   0.15405    0.07306  340.07855
## msg_motiv_self                        0.49946    0.02392 1657.78752
## conditionautonomous:msg_motiv_self    0.04164    0.03415 1673.42483
##                                    t value            Pr(>|t|)    
## (Intercept)                         -1.399              0.1631    
## conditionautonomous                  2.108              0.0357 *  
## msg_motiv_self                      20.879 <0.0000000000000002 ***
## conditionautonomous:msg_motiv_self   1.219              0.2230    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt msg_m_
## conditntnms -0.665              
## msg_mtv_slf  0.001  0.000       
## cndtntnm:__ -0.001  0.000 -0.692

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_motiv_null = lmer(msg_share ~ msg_motiv_self + condition + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(share_mod_motiv_null, share_mod_motiv, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
msg_motiv_self + condition + (1 | SID) + (1 | message)	230.5835
condition * msg_motiv_self + (1 | SID) + (1 | message)	1.0000

plot predicted effects

ggeffects::ggpredict(share_mod_motiv, c("condition", "msg_motiv_self [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean", 
                 ifelse(group == "1", sprintf("+%s SD", group), sprintf("%s SD", group))),
         group = factor(group, levels = c("-1 SD", "mean", "+1 SD"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.7, .8)) +
  labs(x = "", y = "predicted standardized rating\n", title = "motivation to practice social distancing\n") +
  theme_minimal() +
  theme(legend.position = "top")

hypothesis 5

Hypothesis: Compared to both control conditions, exposure to autonomously framed messages will be associated with greater perceived personal agency for mitigating the spread of COVID19.

❌ These data are not consistent with this hypothesis. Based on the Bayes factor, there is very strong evidence for the null.

run model

agency_1 = lm(agency ~ condition, data = data_mod_person)
summary(agency_1)

## 
## Call:
## lm(formula = agency ~ condition, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.1354 -0.6101  0.2270  0.8743  1.2224 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                  0.01049    0.07473   0.140    0.888
## conditionautonomous          0.06614    0.10773   0.614    0.540
## conditionno message control -0.09206    0.10568  -0.871    0.384
## 
## Residual standard error: 0.9998 on 521 degrees of freedom
## Multiple R-squared:  0.004178,   Adjusted R-squared:  0.0003556 
## F-statistic: 1.093 on 2 and 521 DF,  p-value: 0.336

bayes factor using BIC

Evidence for H0 (no condition effect)

agency_null = lm(agency ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(agency_null, agency_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	174.9462
condition	1.0000

plot predicted effects

ggeffects::ggpredict(agency_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "agency in mitigating the spread of COVID-19\n") +
  theme_minimal() +
  theme(legend.position = "none")

secondary

Here, we test whether exposure to autonomously framed messages has downstream effects on beliefs, intentions, and perceived social norms about social distancing.

beliefs protecting oneself

question text
If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick:

scale
1 = strongly disagree, 7 = strongly agree

items %>%
  filter(grepl("beliefs_safe_self", item)) %>%
  select(text) %>%
  rename("items" = text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

items
I will avoid coming in contact with coronavirus.
I will be less likely to get COVID-19.
I will be less likely to get sick.
I will keep myself safe.
I will be able to take care of myself.

run model

❌ These data are not consistent with the hypothesis that message exposure affects beliefs about protecting oneself.

beliefs_self_1 = lm(beliefs_safe_self ~ condition, data = data_mod_person)
summary(beliefs_self_1)

## 
## Call:
## lm(formula = beliefs_safe_self ~ condition, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.1804 -0.3931  0.3567  0.8170  0.8400 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                 -0.01096    0.07484  -0.146    0.884
## conditionautonomous          0.05941    0.10790   0.551    0.582
## conditionno message control -0.02300    0.10584  -0.217    0.828
## 
## Residual standard error: 1.001 on 521 degrees of freedom
## Multiple R-squared:  0.001181,   Adjusted R-squared:  -0.002653 
## F-statistic: 0.308 on 2 and 521 DF,  p-value: 0.7351

bayes factor using BIC

Evidence for H0 (no condition effect)

beliefs_self_null = lm(beliefs_safe_self ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(beliefs_self_null, beliefs_self_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	384.4934
condition	1.0000

plot predicted effects

ggeffects::ggpredict(beliefs_self_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "beliefs: protecting oneself\n") +
  theme_minimal() +
  theme(legend.position = "none")

beliefs protecting others

question text
If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick:

scale
1 = strongly disagree, 7 = strongly agree

items %>%
  filter(grepl("beliefs_safe_others", item)) %>%
  select(text) %>%
  rename("items" = text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

items
I will keep my family safe.
I will keep people in my community safe.
I will prevent others from getting COVID-19.
I will protect more vulnerable people in our society.
I will slow the spread of COVID-19.
It will be good for society.
It will help stop the spread of COVID-19.
It will help the healthcare system from being over flooded and enable people who need urgent medical care to receive it.

run model

❌ These data are not consistent with the hypothesis that message exposure affects beliefs about protecting others

beliefs_others_1 = lm(beliefs_safe_others ~ condition, data = data_mod_person)
summary(beliefs_others_1)

## 
## Call:
## lm(formula = beliefs_safe_others ~ condition, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3557 -0.4923  0.4239  0.7906  0.8026 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                 -0.02916    0.07479  -0.390    0.697
## conditionautonomous          0.10495    0.10781   0.973    0.331
## conditionno message control -0.01197    0.10576  -0.113    0.910
## 
## Residual standard error: 1.001 on 521 degrees of freedom
## Multiple R-squared:  0.002693,   Adjusted R-squared:  -0.001136 
## F-statistic: 0.7034 on 2 and 521 DF,  p-value: 0.4954

bayes factor using BIC

Evidence for H0 (no condition effect)

beliefs_others_null = lm(beliefs_safe_others ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(beliefs_others_null, beliefs_others_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	258.5267
condition	1.0000

plot predicted effects

ggeffects::ggpredict(beliefs_others_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "beliefs: protecting others\n") +
  theme_minimal() +
  theme(legend.position = "none")

intentions to practice social distancing

question text
Please rate how much you intend to do the following things over the next two weeks.

scale
1 = definitely will not, 7 = definitely will

items %>%
  filter(item %in% paste0("intentions1_", c(2, 4, 6, 10))) %>%
  select(text) %>%
  rename("items" = text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

items
Stay home and avoid all social contact, even if I’m not sick
Limit my grocery shopping to once a week or less
Stay at least 6 feet apart from others when I’m in public
Avoid all public gatherings, even if I’m not sick

run model

❌ These data are not consistent with the hypothesis that message exposure affects intentions to self distance.

intentions_1 = lm(intentions1 ~ condition, data = data_mod_person)
summary(intentions_1)

## 
## Call:
## lm(formula = intentions1 ~ condition, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3248 -0.4745  0.4300  0.7346  0.7440 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)
## (Intercept)                 -0.012293   0.074863  -0.164    0.870
## conditionautonomous          0.048907   0.107925   0.453    0.651
## conditionno message control -0.009369   0.105872  -0.088    0.930
## 
## Residual standard error: 1.002 on 521 degrees of freedom
## Multiple R-squared:  0.0006378,  Adjusted R-squared:  -0.003198 
## F-statistic: 0.1663 on 2 and 521 DF,  p-value: 0.8469

bayes factor using BIC

Evidence for H0 (no condition effect)

intentions_null = lm(intentions1 ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(intentions_null, intentions_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	443.3362
condition	1.0000

plot predicted effects

ggeffects::ggpredict(intentions_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "intentions to practice social distancing\n") +
  theme_minimal() +
  theme(legend.position = "none")

social distancing norms, close others

question text
For these questions, think about your closest friends and family. What proportion of them will do the following things in the next two weeks?

scale
0-100%

items %>%
  filter(item %in% paste0("norms_close1_", c(2, 4, 6, 10))) %>%
  select(text) %>%
  rename("items" = text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

items
Stay home and avoid all social contact, even if they aren’t sick
Limit their grocery shopping to once a week or less
Stay at least 6 feet apart from others when they’re in public
Avoid all public gatherings, even if they aren’t sick

run model

❌ These data are not consistent with the hypothesis that exposure to autonomously framed messages increases perceived norms about social distancing when thinking about close others.

norms_close_1 = lm(norms_close1 ~ condition, data = data_mod_person)
summary(norms_close_1)

## 
## Call:
## lm(formula = norms_close1 ~ condition, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.0989 -0.5118  0.2555  0.7551  1.2434 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                 -0.02688    0.07485  -0.359    0.720
## conditionautonomous          0.01141    0.10808   0.106    0.916
## conditionno message control  0.06802    0.10586   0.643    0.521
## 
## Residual standard error: 1.001 on 520 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.0009038,  Adjusted R-squared:  -0.002939 
## F-statistic: 0.2352 on 2 and 520 DF,  p-value: 0.7905

bayes factor using BIC

Evidence for H0 (no condition effect)

norms_close_null = lm(norms_close1 ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(norms_close_null, norms_close_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	412.8741
condition	1.0000

plot predicted effects

ggeffects::ggpredict(norms_close_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "social distancing norms: close others\n") +
  theme_minimal() +
  theme(legend.position = "none")

social distancing norms, community

question text
For these questions, think about the people in your city or town. What proportion of them will do the following things in the next two weeks?

scale
0-100%

items %>%
  filter(item %in% paste0("norms_town1_", c(2, 4, 6, 10))) %>%
  select(text) %>%
  rename("items" = text) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

items
Stay home and avoid all social contact, even if they aren’t sick
Limit their grocery shopping to once a week or less
Stay at least 6 feet apart from others when they’re in public
Avoid all public gatherings, even if they aren’t sick

run model

❌ These data are not consistent with the hypothesis that exposure to autonomously framed messages increases perceived norms about social distancing when thinking about one’s community.

norms_town_1 = lm(norms_town1 ~ condition, data = data_mod_person)
summary(norms_town_1)

## 
## Call:
## lm(formula = norms_town1 ~ condition, data = data_mod_person)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -3.04101 -0.60852  0.05971  0.74902  1.86392 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                  0.02063    0.07487   0.276    0.783
## conditionautonomous         -0.04573    0.10811  -0.423    0.672
## conditionno message control -0.01813    0.10589  -0.171    0.864
## 
## Residual standard error: 1.002 on 520 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.0003473,  Adjusted R-squared:  -0.003498 
## F-statistic: 0.09033 on 2 and 520 DF,  p-value: 0.9136

bayes factor using BIC

Evidence for H0 (no condition effect)

norms_town_null = lm(norms_town1 ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(norms_town_null, norms_town_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	477.5879
condition	1.0000

plot predicted effects

ggeffects::ggpredict(norms_town_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "social distancing norms: community\n") +
  theme_minimal() +
  theme(legend.position = "none")

exploratory analyses

---

autonomy

The autonomy manipulation is increasing self-reported autonomous functioning compared to the controls. However, based on the Bayes factor, there is actually positive evidence for the null (no effect of condition).

run model

autonomy_1 = lm(IAF_autonomous ~ 1 + condition, data = data_mod_person)
summary(autonomy_1)

## 
## Call:
## lm(formula = IAF_autonomous ~ 1 + condition, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.2123 -0.7195  0.0683  0.7272  1.6117 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                 -0.03913    0.07442  -0.526   0.5993  
## conditionautonomous          0.19811    0.10728   1.847   0.0654 .
## conditionno message control -0.06918    0.10524  -0.657   0.5112  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9956 on 521 degrees of freedom
## Multiple R-squared:  0.01256,    Adjusted R-squared:  0.00877 
## F-statistic: 3.314 on 2 and 521 DF,  p-value: 0.03715

bayes factor using BIC

Evidence for H0 (no condition effect)

autonomy_null = lm(IAF_autonomous ~ 1, data = data_mod_person)
bayestestR::bayesfactor_models(autonomy_null, autonomy_1, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
1	19.10014
1 + condition	1.00000

plot predicted effects

ggeffects::ggpredict(autonomy_1, c("condition")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control"))) %>%
  ggplot(aes(x = x, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.3, .4)) +
  labs(x = "", y = "predicted standardized rating\n", title = "autonomous functioning\n") +
  theme_minimal() +
  theme(legend.position = "none")

autonomy moderation analyses

Here, we test whether individual differences in autonomous functioning measused using the self-congruence/authorship subscale of the Index of Autonomous Functioning scale (Weinstein, Przybylski, & Ryan, 2012) moderate the relationship between message condition and the outcomes of interest.

Summary: Individual differences in autonomous functioning were positively associated with sharing intentions, self-relevance, motivation, and agency, and this relationship did not differ as a function of the message framing condition.

sharing

These data are consistent with a main effect autonomy on sharing, but not with the hypothesis that autonomy moderates the relationship between condition and sharing.

run model

share_mod_auto = lmer(msg_share ~ condition*IAF_autonomous + (1 | SID) + (1 | message), data = data_mod)
summary(share_mod_auto)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share ~ condition * IAF_autonomous + (1 | SID) + (1 | message)
##    Data: data_mod
## 
## REML criterion at convergence: 3769.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8613 -0.4304  0.0592  0.5049  2.9716 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.62626  0.7914  
##  message  (Intercept) 0.01588  0.1260  
##  Residual             0.31763  0.5636  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                      Estimate Std. Error         df
## (Intercept)                         -0.066556   0.070137 151.994455
## conditionautonomous                  0.114681   0.090096 340.877964
## IAF_autonomous                       0.205298   0.063247 341.036812
## conditionautonomous:IAF_autonomous  -0.006967   0.089118 341.095496
##                                    t value Pr(>|t|)   
## (Intercept)                         -0.949  0.34416   
## conditionautonomous                  1.273  0.20393   
## IAF_autonomous                       3.246  0.00129 **
## conditionautonomous:IAF_autonomous  -0.078  0.93773   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt IAF_tn
## conditntnms -0.611              
## IAF_autonms  0.035 -0.028       
## cndtnt:IAF_ -0.025 -0.058 -0.710

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_auto_null = lmer(msg_share ~ condition + IAF_autonomous + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(share_mod_auto_null, share_mod_auto, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
condition + IAF_autonomous + (1 | SID) + (1 | message)	185.332
condition * IAF_autonomous + (1 | SID) + (1 | message)	1.000

plot predicted effects

ggeffects::ggpredict(share_mod_auto, c("condition", "IAF_autonomous [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean", 
                 ifelse(group == "1", sprintf("+%s SD", group), sprintf("%s SD", group))),
         group = factor(group, levels = c("-1 SD", "mean", "+1 SD"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.7, .8)) +
  labs(x = "\nautonomous functioning", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

self-relevance

These data are consistent with a main effect of autonomy on self-relevance, but probably not with the hypothesis that autonomy moderates the relationship between condition and self-relevance.

run model

rel_mod_auto = lmer(msg_rel_self ~ condition*IAF_autonomous + (1 | SID) + (1 | message), data = data_mod)
summary(rel_mod_auto)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self ~ condition * IAF_autonomous + (1 | SID) + (1 |  
##     message)
##    Data: data_mod
## 
## REML criterion at convergence: 4054.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.9705 -0.3704  0.0988  0.4676  4.4382 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.48908  0.6993  
##  message  (Intercept) 0.01303  0.1141  
##  Residual             0.41076  0.6409  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                      Estimate Std. Error         df
## (Intercept)                         -0.005054   0.063764 134.504148
## conditionautonomous                 -0.038767   0.081995 340.946577
## IAF_autonomous                       0.219307   0.057562 341.166663
## conditionautonomous:IAF_autonomous   0.148582   0.081110 341.249412
##                                    t value Pr(>|t|)    
## (Intercept)                         -0.079 0.936938    
## conditionautonomous                 -0.473 0.636658    
## IAF_autonomous                       3.810 0.000165 ***
## conditionautonomous:IAF_autonomous   1.832 0.067843 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt IAF_tn
## conditntnms -0.612              
## IAF_autonms  0.035 -0.028       
## cndtnt:IAF_ -0.025 -0.058 -0.710

bayes factor using BIC

Evidence for H0 (no moderation)

rel_mod_auto_null = lmer(msg_rel_self ~ condition + IAF_autonomous + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(rel_mod_auto_null, rel_mod_auto, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
condition + IAF_autonomous + (1 | SID) + (1 | message)	38.29242
condition * IAF_autonomous + (1 | SID) + (1 | message)	1.00000

plot predicted effects

ggeffects::ggpredict(rel_mod_auto, c("condition", "IAF_autonomous [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean", 
                 ifelse(group == "1", sprintf("+%s SD", group), sprintf("%s SD", group))),
         group = factor(group, levels = c("-1 SD", "mean", "+1 SD"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.7, .8)) +
  labs(x = "\nautonomous functioning", y = "predicted standardized rating\n", title = "self-relevance\n") +
  theme_minimal() +
  theme(legend.position = "top")

self motivation

These data are consistent with a main effect of autonomy on motivation, but not with the hypothesis that autonomy moderates the relationship between condition and motivation.

run model

motiv_mod_auto = lmer(msg_motiv_self ~ condition*IAF_autonomous + (1 | SID) + (1 | message), data = data_mod)
summary(motiv_mod_auto)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_motiv_self ~ condition * IAF_autonomous + (1 | SID) + (1 |  
##     message)
##    Data: data_mod
## 
## REML criterion at convergence: 4152.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.7933 -0.3388  0.1010  0.4613  4.1055 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.48219  0.6944  
##  message  (Intercept) 0.02006  0.1417  
##  Residual             0.43988  0.6632  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                      Estimate Std. Error         df
## (Intercept)                          0.006114   0.067297  92.715904
## conditionautonomous                 -0.054788   0.081920 340.885649
## IAF_autonomous                       0.202006   0.057512 341.140568
## conditionautonomous:IAF_autonomous   0.104258   0.081039 341.232723
##                                    t value Pr(>|t|)    
## (Intercept)                          0.091 0.927810    
## conditionautonomous                 -0.669 0.504075    
## IAF_autonomous                       3.512 0.000504 ***
## conditionautonomous:IAF_autonomous   1.287 0.199136    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt IAF_tn
## conditntnms -0.579              
## IAF_autonms  0.034 -0.028       
## cndtnt:IAF_ -0.024 -0.058 -0.710

bayes factor using BIC

Evidence for H0 (no moderation)

motiv_mod_auto_null = lmer(msg_motiv_self ~ condition + IAF_autonomous + (1 | SID) + (1 | message), data = data_mod)
bayestestR::bayesfactor_models(motiv_mod_auto_null, motiv_mod_auto, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
condition + IAF_autonomous + (1 | SID) + (1 | message)	89.33239
condition * IAF_autonomous + (1 | SID) + (1 | message)	1.00000

plot predicted effects

ggeffects::ggpredict(motiv_mod_auto, c("condition", "IAF_autonomous [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean", 
                 ifelse(group == "1", sprintf("+%s SD", group), sprintf("%s SD", group))),
         group = factor(group, levels = c("-1 SD", "mean", "+1 SD"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-.7, .8)) +
  labs(x = "\nautonomous functioning", y = "predicted standardized rating\n", title = "motivation to practice social distancing\n") +
  theme_minimal() +
  theme(legend.position = "top")

agency

These data are consistent with a main effect autonomy on agency, but not with the hypothesis that autonomy moderates the relationship between condition and agency.

run model

agency_mod_auto = lm(agency ~ condition*IAF_autonomous, data = data_mod_person)
summary(agency_mod_auto)

## 
## Call:
## lm(formula = agency ~ condition * IAF_autonomous, data = data_mod_person)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.5738 -0.6225  0.1900  0.7671  1.8021 
## 
## Coefficients:
##                                             Estimate Std. Error t value
## (Intercept)                                 0.018951   0.072302   0.262
## conditionautonomous                         0.004205   0.104836   0.040
## conditionno message control                -0.075507   0.102527  -0.736
## IAF_autonomous                              0.216133   0.073585   2.937
## conditionautonomous:IAF_autonomous          0.120233   0.103681   1.160
## conditionno message control:IAF_autonomous  0.014735   0.104644   0.141
##                                            Pr(>|t|)   
## (Intercept)                                 0.79334   
## conditionautonomous                         0.96802   
## conditionno message control                 0.46179   
## IAF_autonomous                              0.00346 **
## conditionautonomous:IAF_autonomous          0.24673   
## conditionno message control:IAF_autonomous  0.88808   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9666 on 518 degrees of freedom
## Multiple R-squared:  0.07467,    Adjusted R-squared:  0.06574 
## F-statistic:  8.36 on 5 and 518 DF,  p-value: 0.0000001289

bayes factor using BIC

Evidence for H0 (no moderation)

agency_mod_auto_null = lm(agency ~ condition + IAF_autonomous, data = data_mod_person)
bayestestR::bayesfactor_models(agency_mod_auto_null, agency_mod_auto, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
condition + IAF_autonomous	233.547
condition * IAF_autonomous	1.000

plot predicted effects

ggeffects::ggpredict(agency_mod_auto, c("condition", "IAF_autonomous [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "message control", 
             ifelse(x == 2, "autonomous", "no message control")),
         group = as.character(group),
         group = ifelse(group == "0", "mean", 
                 ifelse(group == "1", sprintf("+%s SD", group), sprintf("%s SD", group))),
         group = factor(group, levels = c("-1 SD", "mean", "+1 SD"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  scale_color_manual(name = "", values = palette) +
  scale_y_continuous(limits = c(-.7, .8)) +
  labs(x = "\nautonomous functioning", y = "predicted standardized rating\n", title = "agency to mitigate the spread of COVID-19\n") +
  theme_minimal() +
  theme(legend.position = "top")

disaggregated effects

The preregistered analyses just looked at the grand-mean centered effects of message-level predictors, reflecting deviations from the mean across people. However, this effect reflect both within and between-person effects. Here, we disaggregate these effects by including two message predictors in each model, reflecting within person variation (centered within context) and between-person variation (grand-mean centered). The within-person effect is a level-1 predictor reflecting deviations from an individual’s mean, whereas the between-person effect is a level-2 predictor (an average for each individual), reflecting deveiations from the mean across people.

cwc = centered within context
gmc = grand-mean centered

In the figures, between-person effects are represented on the x-axis; “mean gmc” reflects the predicted value when ratings are at the average across people, whereas “+/- 1 SD gmc” reflects the predicted values when the ratings are at +/- 1 SD from the average across people. The within-person effects are represented by the facet; “mean cwc” reflects the predicted value when ratings are at the average within-person, whereas “+/- 1 SD cwc” reflects the predicted values when the ratings are at +/- 1 SD from the average within-person.

Summary: Across all models, there were significant positive within- and between-person effects of relevance and motivation on sharing intentions. The effects were strongest for the between-person effects. Together these results suggest that individuals who rate the messages as more relevant and motivating on average also have higher sharing intentions, but that messages that are perceived as more relevant and motivating are associated with even stronger sharing intentions. We also observed main effects of the message framing condition in the models testing the associations between sharing intentions and self-relevance and motivation, but message framing condition did not moderate these relationships.

gmc_subs = messages %>%
  group_by(SID, survey_name) %>%
  extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
  group_by(survey_name, SID) %>%
  summarize(value_gmc = mean(value, na.rm = TRUE)) %>%
  group_by(survey_name) %>%
  mutate(value_gmc = scale(value_gmc),
         survey_name_gmc = sprintf("%s_gmc", survey_name)) %>%
  ungroup() %>%
  select(-survey_name) %>%
  spread(survey_name_gmc, value_gmc)

cwc_subs = messages %>%
  group_by(SID, survey_name) %>%
  extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
  mutate(trial = row_number()) %>%
  select(-item) %>%
  group_by(survey_name, SID) %>%
  mutate(value_cwc = scale(value, scale = FALSE),
         survey_name_cwc = sprintf("%s_cwc", survey_name)) %>%
  group_by(survey_name) %>%
  mutate(value_cwc = scale(value_cwc, scale = TRUE, center = FALSE)) %>%
  ungroup() %>%
  select(-value, -survey_name) %>%
  spread(survey_name_cwc, value_cwc)

data_mod_diss = messages %>%
  group_by(SID, survey_name) %>%
  extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
  mutate(trial = row_number()) %>%
  group_by(survey_name) %>%
  mutate(value = scale(value)) %>%
  select(-item) %>%
  spread(survey_name, value) %>%
  left_join(., gmc_subs) %>%
  left_join(., cwc_subs) %>%
  left_join(., dvs_covs_controls) %>%
  ungroup() %>%
  mutate(SID = as.factor(SID)) %>%
  ungroup() %>%
  select(-contains("msg_familiarity")) %>%
  mutate(condition = factor(condition, levels = c("message control", "autonomous"))) %>%
  unique()

self-relevance

run model

share_mod_rel_self = lmer(msg_share ~ msg_rel_self_gmc*condition + msg_rel_self_cwc*condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
summary(share_mod_rel_self)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share ~ msg_rel_self_gmc * condition + msg_rel_self_cwc *  
##     condition + (1 | SID) + (1 | message)
##    Data: data_mod_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 3403.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0426 -0.4409  0.0284  0.4659  3.5625 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.5049   0.7106  
##  message  (Intercept) 0.0104   0.1020  
##  Residual             0.2552   0.5052  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                         Estimate  Std. Error          df
## (Intercept)                            -0.066214    0.061651  178.093174
## msg_rel_self_gmc                        0.470803    0.062140  340.771195
## conditionautonomous                     0.139763    0.080369  340.700226
## msg_rel_self_cwc                        0.227987    0.017087 1372.924409
## msg_rel_self_gmc:conditionautonomous   -0.099061    0.081512  340.754976
## conditionautonomous:msg_rel_self_cwc    0.002382    0.024458 1366.817629
##                                      t value             Pr(>|t|)    
## (Intercept)                           -1.074               0.2843    
## msg_rel_self_gmc                       7.576    0.000000000000338 ***
## conditionautonomous                    1.739               0.0829 .  
## msg_rel_self_cwc                      13.343 < 0.0000000000000002 ***
## msg_rel_self_gmc:conditionautonomous  -1.215               0.2251    
## conditionautonomous:msg_rel_self_cwc   0.097               0.9224    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##              (Intr) msg_rl_slf_g cndtnt msg_rl_slf_c ms___:
## msg_rl_slf_g  0.018                                        
## conditntnms  -0.627 -0.014                                 
## msg_rl_slf_c  0.000  0.000        0.000                    
## msg_rl_sl_:  -0.013 -0.762        0.002  0.001             
## cndtntn:___   0.000  0.000        0.000 -0.690        0.000

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_rel_self_null = lmer(msg_share ~ msg_rel_self_gmc + msg_rel_self_cwc + condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
bayestestR::bayesfactor_models(share_mod_rel_self_null, share_mod_rel_self, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
msg_rel_self_gmc + msg_rel_self_cwc + condition + (1 | SID) + (1 | message)	65403.78
msg_rel_self_gmc * condition + msg_rel_self_cwc * condition + (1 | SID) + (1 | message)	1.00

plot predicted effects

ggeffects::ggpredict(share_mod_rel_self, c("condition", "msg_rel_self_gmc [-1, 0, 1]", "msg_rel_self_cwc [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean gmc", 
                 ifelse(group == "1", sprintf("+%s SD gmc", group), sprintf("%s SD gmc", group))),
         group = factor(group, levels = c("-1 SD gmc", "mean gmc", "+1 SD gmc")),
         facet = as.character(facet),
         facet = ifelse(facet == "0", "mean cwc", 
                 ifelse(facet == "1", sprintf("+%s SD cwc", facet), sprintf("%s SD cwc", facet))),
         facet = factor(facet, levels = c("-1 SD cwc", "mean cwc", "+1 SD cwc"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  facet_grid(~facet) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-1.1, 1.2)) +
  labs(x = "\nself-relevance", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

social relevance

run model

share_mod_rel_social = lmer(msg_share ~ msg_rel_social_gmc*condition + msg_rel_social_cwc*condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
summary(share_mod_rel_social)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share ~ msg_rel_social_gmc * condition + msg_rel_social_cwc *  
##     condition + (1 | SID) + (1 | message)
##    Data: data_mod_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 3480.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.2171 -0.4434  0.0475  0.4875  3.2100 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.517573 0.71943 
##  message  (Intercept) 0.009803 0.09901 
##  Residual             0.268407 0.51808 
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                          Estimate Std. Error         df
## (Intercept)                              -0.05973    0.06205  186.16825
## msg_rel_social_gmc                        0.47021    0.06415  340.79882
## conditionautonomous                       0.12904    0.08150  340.70772
## msg_rel_social_cwc                        0.21851    0.01775 1370.20614
## msg_rel_social_gmc:conditionautonomous   -0.12767    0.08311  340.76407
## conditionautonomous:msg_rel_social_cwc   -0.03190    0.02511 1368.43682
##                                        t value             Pr(>|t|)    
## (Intercept)                             -0.963                0.337    
## msg_rel_social_gmc                       7.329     0.00000000000169 ***
## conditionautonomous                      1.583                0.114    
## msg_rel_social_cwc                      12.311 < 0.0000000000000002 ***
## msg_rel_social_gmc:conditionautonomous  -1.536                0.125    
## conditionautonomous:msg_rel_social_cwc  -1.270                0.204    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##              (Intr) msg_rl_scl_g cndtnt msg_rl_scl_c ms___:
## msg_rl_scl_g  0.033                                        
## conditntnms  -0.632 -0.025                                 
## msg_rl_scl_c  0.000  0.000        0.001                    
## msg_rl_sc_:  -0.026 -0.772        0.005  0.000             
## cndtntn:___   0.000  0.000        0.000 -0.703        0.000

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_rel_social_null = lmer(msg_share ~ msg_rel_social_gmc + msg_rel_social_cwc + condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
bayestestR::bayesfactor_models(share_mod_rel_social_null, share_mod_rel_social, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
msg_rel_social_gmc + msg_rel_social_cwc + condition + (1 | SID) + (1 | message)	18044.53
msg_rel_social_gmc * condition + msg_rel_social_cwc * condition + (1 | SID) + (1 | message)	1.00

plot predicted effects

ggeffects::ggpredict(share_mod_rel_social, c("condition", "msg_rel_social_gmc [-1, 0, 1]", "msg_rel_social_cwc [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean gmc", 
                 ifelse(group == "1", sprintf("+%s SD gmc", group), sprintf("%s SD gmc", group))),
         group = factor(group, levels = c("-1 SD gmc", "mean gmc", "+1 SD gmc")),
         facet = as.character(facet),
         facet = ifelse(facet == "0", "mean cwc", 
                 ifelse(facet == "1", sprintf("+%s SD cwc", facet), sprintf("%s SD cwc", facet))),
         facet = factor(facet, levels = c("-1 SD cwc", "mean cwc", "+1 SD cwc"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  facet_grid(~facet) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-1.1, 1.2)) +
  labs(x = "\nsocial relevance", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

self motivation

run model

share_mod_motiv_self = lmer(msg_share ~ msg_motiv_self_gmc*condition + msg_motiv_self_cwc*condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
summary(share_mod_motiv_self)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share ~ msg_motiv_self_gmc * condition + msg_motiv_self_cwc *  
##     condition + (1 | SID) + (1 | message)
##    Data: data_mod_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 3069.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1423 -0.4350  0.0571  0.4762  4.8413 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.40574  0.6370  
##  message  (Intercept) 0.00366  0.0605  
##  Residual             0.21251  0.4610  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                          Estimate Std. Error         df
## (Intercept)                              -0.07283    0.05243  259.59494
## msg_motiv_self_gmc                        0.51279    0.05361  340.90880
## conditionautonomous                       0.15301    0.07215  340.93371
## msg_motiv_self_cwc                        0.29038    0.01550 1375.58355
## msg_motiv_self_gmc:conditionautonomous    0.03446    0.07253  341.03614
## conditionautonomous:msg_motiv_self_cwc    0.02102    0.02232 1370.38884
##                                        t value            Pr(>|t|)    
## (Intercept)                             -1.389              0.1660    
## msg_motiv_self_gmc                       9.566 <0.0000000000000002 ***
## conditionautonomous                      2.121              0.0347 *  
## msg_motiv_self_cwc                      18.734 <0.0000000000000002 ***
## msg_motiv_self_gmc:conditionautonomous   0.475              0.6350    
## conditionautonomous:msg_motiv_self_cwc   0.942              0.3465    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##               (Intr) msg_mtv_slf_g cndtnt msg_mtv_slf_c ms___:
## msg_mtv_slf_g  0.004                                          
## conditntnms   -0.662 -0.003                                   
## msg_mtv_slf_c  0.000 -0.001         0.001                     
## msg_mtv_s_:   -0.003 -0.739         0.000  0.001              
## cndtntn:___    0.000  0.000         0.000 -0.684         0.000

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_motiv_self_null = lmer(msg_share ~ msg_motiv_self_gmc + msg_motiv_self_cwc + condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
bayestestR::bayesfactor_models(share_mod_motiv_self_null, share_mod_motiv_self, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
msg_motiv_self_gmc + msg_motiv_self_cwc + condition + (1 | SID) + (1 | message)	97127.48
msg_motiv_self_gmc * condition + msg_motiv_self_cwc * condition + (1 | SID) + (1 | message)	1.00

plot predicted effects

ggeffects::ggpredict(share_mod_motiv_self, c("condition", "msg_motiv_self_gmc [-1, 0, 1]", "msg_motiv_self_cwc [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean gmc", 
                 ifelse(group == "1", sprintf("+%s SD gmc", group), sprintf("%s SD gmc", group))),
         group = factor(group, levels = c("-1 SD gmc", "mean gmc", "+1 SD gmc")),
         facet = as.character(facet),
         facet = ifelse(facet == "0", "mean cwc", 
                 ifelse(facet == "1", sprintf("+%s SD cwc", facet), sprintf("%s SD cwc", facet))),
         facet = factor(facet, levels = c("-1 SD cwc", "mean cwc", "+1 SD cwc"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  facet_grid(~facet) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-1.1, 1.2)) +
  labs(x = "\nmotivation to practice social distancing: self", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

other motivation

run model

share_mod_motiv_other = lmer(msg_share ~ msg_motiv_other_gmc*condition + msg_motiv_other_cwc*condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
summary(share_mod_motiv_other)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share ~ msg_motiv_other_gmc * condition + msg_motiv_other_cwc *  
##     condition + (1 | SID) + (1 | message)
##    Data: data_mod_diss
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 3145.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.1254 -0.4356  0.0428  0.4641  3.6530 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.385249 0.6207  
##  message  (Intercept) 0.002746 0.0524  
##  Residual             0.227365 0.4768  
## Number of obs: 1722, groups:  SID, 345; message, 15
## 
## Fixed effects:
##                                            Estimate  Std. Error
## (Intercept)                               -0.053996    0.050929
## msg_motiv_other_gmc                        0.545750    0.052085
## conditionautonomous                        0.114089    0.070786
## msg_motiv_other_cwc                        0.288288    0.016174
## msg_motiv_other_gmc:conditionautonomous    0.006273    0.071041
## conditionautonomous:msg_motiv_other_cwc   -0.014013    0.023067
##                                                  df t value
## (Intercept)                              266.250492  -1.060
## msg_motiv_other_gmc                      341.122454  10.478
## conditionautonomous                      341.008803   1.612
## msg_motiv_other_cwc                     1366.154499  17.824
## msg_motiv_other_gmc:conditionautonomous  341.064893   0.088
## conditionautonomous:msg_motiv_other_cwc 1371.517390  -0.607
##                                                    Pr(>|t|)    
## (Intercept)                                           0.290    
## msg_motiv_other_gmc                     <0.0000000000000002 ***
## conditionautonomous                                   0.108    
## msg_motiv_other_cwc                     <0.0000000000000002 ***
## msg_motiv_other_gmc:conditionautonomous               0.930    
## conditionautonomous:msg_motiv_other_cwc               0.544    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##               (Intr) msg_mtv_thr_g cndtnt msg_mtv_thr_c ms___:
## msg_mtv_thr_g  0.040                                          
## conditntnms   -0.669 -0.028                                   
## msg_mtv_thr_c  0.000  0.000         0.001                     
## msg_mtv_t_:   -0.029 -0.733         0.002  0.000              
## cndtntn:___    0.000  0.000         0.000 -0.691         0.000

bayes factor using BIC

Evidence for H0 (no moderation)

share_mod_motiv_other_null = lmer(msg_share ~ msg_motiv_other_gmc + msg_motiv_other_cwc + condition + (1 | SID) + (1 | message), 
                       data = data_mod_diss, control = lmerControl(optimizer = "bobyqa"))
bayestestR::bayesfactor_models(share_mod_motiv_other_null, share_mod_motiv_other, denominator = 2) %>%
  kable(format = "pandoc", row.names = FALSE)

Model	BF
msg_motiv_other_gmc + msg_motiv_other_cwc + condition + (1 | SID) + (1 | message)	138632.3
msg_motiv_other_gmc * condition + msg_motiv_other_cwc * condition + (1 | SID) + (1 | message)	1.0

plot predicted effects

ggeffects::ggpredict(share_mod_motiv_other, c("condition", "msg_motiv_other_gmc [-1, 0, 1]", "msg_motiv_other_cwc [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(x = ifelse(x == 1, "control", "autonomous"),
         group = as.character(group),
         group = ifelse(group == "0", "mean gmc", 
                 ifelse(group == "1", sprintf("+%s SD gmc", group), sprintf("%s SD gmc", group))),
         group = factor(group, levels = c("-1 SD gmc", "mean gmc", "+1 SD gmc")),
         facet = as.character(facet),
         facet = ifelse(facet == "0", "mean cwc", 
                 ifelse(facet == "1", sprintf("+%s SD cwc", facet), sprintf("%s SD cwc", facet))),
         facet = factor(facet, levels = c("-1 SD cwc", "mean cwc", "+1 SD cwc"))) %>%
  ggplot(aes(x = group, y = predicted, color = x)) +
  geom_line(aes(group = x), position = position_dodge(width = .1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(width = .1)) +
  facet_grid(~facet) +
  scale_color_manual(name = "", values = palette_cond) +
  scale_y_continuous(limits = c(-1.1, 1.2)) +
  labs(x = "\nmotivation to practice social distancing: others", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

scatterplots

Here, we visualize the relationships between several individual difference measures and the variables of interest in this study. Each individual plot shows the association between the ratings for a single measure (x-axis) and the ratings for another measures (y-axis). For measures that included multiple items, the average across items was taken so that each dot represents a single participant.

autonomous motivation

measure
Index of Autonomous Functioning: self-congruence/authorship

citation
Weinstein, Przybylski, & Ryan, 2012

question text
Please indicate how true each statement is of your experiences on the whole. Remember that there are no right or wrong answers. Please answer according to what really reflects your experience rather than what you think your experience should be.

scale
1 = not at all true, 5 = completely true

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  gather(var, val, -condition, -SID, -IAF_autonomous) %>%
  ggplot(aes(IAF_autonomous, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

controlling motivation

measure
Index of Autonomous Functioning: susceptibility to control

citation
Weinstein, Przybylski, & Ryan, 2012

question text
Please indicate how true each statement is of your experiences on the whole. Remember that there are no right or wrong answers. Please answer according to what really reflects your experience rather than what you think your experience should be.

scale
1 = not at all true, 5 = completely true

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  gather(var, val, -condition, -SID, -IAF_controlling) %>%
  ggplot(aes(IAF_controlling, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

purpose in life (7-item)

measure
Purpose in life

citation
Adapted from Ryff, 1989

question text
Please indicate the extent to which you agree with the following statements.

scale
1 = strongly disagree, 6 = strongly agree

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  gather(var, val, -condition, -SID, -purpose) %>%
  ggplot(aes(purpose, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

self-construal: independence

measure
Self-Construal Scale: independence

citation
Adapted from Singelis, 1994

question text
This is a questionnaire that measures a variety of feelings and behaviors in various situations. Listed below are a number of statements. Read each one as if it referred to you.

scale
1 = strongly disagree, 7 = strongly agree

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  gather(var, val, -condition, -SID, -SC_independence) %>%
  ggplot(aes(SC_independence, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

self-construal: interdependence

measure
Self-Construal Scale: interdependence

citation
Adapted from Singelis, 1994

question text
This is a questionnaire that measures a variety of feelings and behaviors in various situations. Listed below are a number of statements. Read each one as if it referred to you.

scale
1 = strongly disagree, 7 = strongly agree

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  gather(var, val, -condition, -SID, -SC_interdependence) %>%
  ggplot(aes(SC_interdependence, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

age

measure
Age

question text
How old are you?

scale
free response

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  left_join(., select(control_vars, SID, age)) %>%
  gather(var, val, -condition, -SID, -age) %>%
  ggplot(aes(age, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

political ideology

measure
Political ideology

question text
We hear a lot of talk these days about liberals and conservatives. Here is a seven-point scale on which the political views that people might hold are arranged from extremely liberal to extremely conservative. Where would you place yourself on this scale?

scale
1 = extremely liberal, 7 = extremely conservative

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  left_join(., select(control_vars, SID, politics_conserv)) %>%
  gather(var, val, -condition, -SID, -politics_conserv) %>%
  ggplot(aes(politics_conserv, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

political party

measure
Political party

question text
In politics today, would you consider yourself a:

scale
1 = Strong Democrat, 2 = Weak Democrate, 3 = Independent leaning Democrat, 4 = Independent, 5 = Independent leaning Republican, 6 = Weak Repebulican, 7 = Strong Republican

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  left_join(., select(control_vars, SID, politics_party)) %>%
  gather(var, val, -condition, -SID, -politics_party) %>%
  ggplot(aes(politics_party, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

log-transformed number of covid studies

measure
Number of COVID-19 studies

question text
How many COVID-related studies have you participated prior to this one? Please enter a number.

scale
free response

data_person %>%
  select(-c(scale, measure, citation)) %>%
  spread(survey_name, value) %>%
  left_join(., select(control_vars, SID, covid_studies)) %>%
  gather(var, val, -condition, -SID, -covid_studies) %>%
  ggplot(aes(covid_studies, val, color = condition)) +
  geom_point(alpha = .2) +
  geom_smooth(method = "lm", alpha = .2, fullrange = TRUE) +
  facet_wrap(~var, scales = "free") +
  scale_color_manual(values = palette) +
  theme_minimal() +
  theme(legend.position = "top")

specification curve analysis

Here, let’s run some Specification Curve Analyses (SCA) help get an overview of the relationships between the autonmous framing condition and the outcomes of interest, and assess how robust the condition effects are to the inclusion of control variables.

The goal is to identify robust effects across various model specifications.

There’s a great package that makes thise easy to do: specr

Summary: Across model specifications, the autonomous message framing condition is not strongly associated with either message- or person-level outcomes. However, perceived relevance and motivation of messages are consistently positively associated with sharing intentions and person-level outcomes across model specifications.

setup

Define functions and control variables

run_sca = function(data, var, outcome, controls=NULL, subsets=NULL, 
                   random_effects = NULL, model = "lm") {
  
    # define median bootstrapping function
    median_cl_boot = function(estimate, conf = 0.95) {
  
      lconf = (1 - conf)/2
      uconf = 1 - lconf
      require(boot)
      bmedian = function(estimate, ind) median(estimate[ind])
      bt = boot(estimate, bmedian, 1000)
      bb = boot.ci(bt, type = "perc")
      data.frame(obs_median = median(estimate), 
                 obs_conf_low = quantile(bt$t, lconf), 
                 obs_conf_high = quantile(bt$t, uconf))
    
    }
    
    # run scas
    results = run_specs(df = data,
                        y = outcome, 
                        x = var,
                        controls = controls,
                        random_effects = random_effects,
                        model = model,
                        subsets = subsets,
                        keep.results = FALSE)
    
    median_ci = results %>%
      group_by(x, y) %>%
      do({
        median_cl_boot(.$estimate)
      })
        
    summary = results %>%
      mutate(pos = ifelse(estimate > 0, 1, 0),
             neg = ifelse(estimate < 0, 1, 0),
             sig = ifelse(p.value < .05, 1, 0),
             pos_sig = ifelse(pos == 1 & sig == 1, 1, 0),
             neg_sig = ifelse(neg == 1 & sig == 1, 1, 0)) %>%
      group_by(x, y) %>%
      summarize(obs_n = n(),
                obs_n_positive = sum(pos),
                obs_n_negative = sum(neg),
                obs_n_significant = sum(sig),
                obs_n_positive_sig = sum(pos_sig),
                obs_n_negative_sig = sum(neg_sig)) %>%
      left_join(., median_ci, by = c("x", "y")) %>%
      select(x, y, obs_median, obs_conf_low, obs_conf_high, everything())
      
    return(list(results = results, summary = summary))
}

plot_sca = function(data, combined = TRUE, labels = c("A", "B"), title = FALSE, limits = NULL,
                    point_size = 1, point_alpha = 1, ci_alpha = .5, ci_size = .5, palette = palette,
                    text_size = 12, title_size = 6, line_alpha = 1, line_size = 6,
                    choices  = c("x", "y"), color_vars = FALSE,
                    remove_y = FALSE, remove_facet = FALSE) {
  
  medians = data %>%
    group_by(x) %>%
    summarize(median = median(estimate)) %>%
    ungroup() %>%
    mutate(color = sprintf("%s", palette))
  
  if (combined == TRUE) {
      p1 = plot_curve(data, point_size = point_size, point_alpha = point_alpha,
                      ci_alpha = ci_alpha, ci_size = ci_size,
                      limits = limits) +
        geom_hline(data = medians, aes(yintercept = median, color = color, linetype = x), alpha = line_alpha, size = .75, show_guide = TRUE) +
        scale_linetype_manual(name = "median effect", values = rep(1, nrow(medians)), 
                              guide = guide_legend(override.aes = list(color = palette))) +
        labs(x = "", y = "standarized\nregression coefficient\n")  +
        theme(legend.position = "top",
              text = element_text(size = text_size))
      
      if (title == TRUE) {
        if (is.null(limits)) {
          p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$x), fontface = 2, size = title_size,
                       x = 0.5*(1 + nrow(data)), 
                       y = max(data$conf.high))
        } else {
          p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$x), fontface = 2, size = title_size,
                       x = 0.5*(1 + nrow(data)), 
                       y = limits[2])
        }
      }
      
      if (color_vars == TRUE) {
        p2 = plot_choices(data, choices = choices, rename_controls = "covariates", size = line_size, color_vars = TRUE, palette = palette) +
          labs(x = "\nspecifications (ranked)")  +
          theme(strip.text.x = element_blank(),
                text = element_text(size = text_size))
      } else {
        p2 = plot_choices(data, choices = choices, rename_controls = "covariates", size = line_size) +
          labs(x = "\nspecifications (ranked)")  +
          theme(strip.text.x = element_blank(),
                text = element_text(size = text_size))
      }
        
  }
  else {
      p1 = plot_curve(data, point_size = point_size, point_alpha = point_alpha,
                      ci_alpha = ci_alpha, ci_size = ci_size) +
        geom_hline(yintercept = 0, linetype = "solid", color = "grey", size = .5) +
        geom_hline(data = medians, aes(yintercept = median, color = color, linetype = x), alpha = line_alpha, size = .75, show_guide = TRUE) +
        scale_linetype_manual(name = "median effect", values = rep(1, nrow(medians)), 
                              guide = guide_legend(override.aes = list(color = palette))) +
        labs(x = "", y = "standarized\nregression coefficient\n")  +
        theme(text = element_text(size = text_size))
      
      if (title == TRUE) {
        if (is.null(limits)) {
          p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$y), fontface = 2, size = title_size,
                       x = 0.5*(1 + nrow(data)), 
                       y = max(data$conf.high))
        } else {
          p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$y), fontface = 2, size = title_size,
                       x = 0.5*(1 + nrow(data)), 
                       y = limits[2])
        }
      }
      
      if (color_vars == TRUE) {
        p2 = plot_choices(data, choices = choices, rename_controls = "covariates", size = line_size, color_vars = TRUE, palette = palette) +
          labs(x = "\nspecifications (ranked)")  +
          theme(strip.text.x = element_blank(),
                text = element_text(size = text_size))
      } else {
        p2 = plot_choices(data, choices = choices, rename_controls = "covariates", size = line_size) +
          labs(x = "\nspecifications (ranked)")  +
          theme(strip.text.x = element_blank(),
                text = element_text(size = text_size))
      }
      
  }
  
  if (remove_y == TRUE) {
    p1 = p1 + labs(y = "")
    
    p2 = p2 + theme(axis.text.y = element_blank(),
                    axis.ticks.y = element_blank()) +
      labs(y = "")
  }

  if (remove_facet == TRUE) {
    p2 = p2 + theme(strip.text.y = element_blank())
    }
  
  plot_specs(plot_a = p1,
             plot_b = p2,
             labels = labels,
             rel_height = c(1, 2))
}

plot_sca_compare = function(data, pointrange = TRUE, labels = c("A", "B"), 
                            rel_heights = c(.75, .25), rel_widths = c(.75, .25), palette = palette,
                            title = FALSE, text_size = 14, title_size = 6, n_rows = 1,
                            remove_x = FALSE, remove_y = FALSE, sig = NULL) {
  
  # define median bootstrapping function
  median_cl_boot = function(x, conf = 0.95, df = TRUE, ci = "low") {
  
    lconf = (1 - conf)/2
    uconf = 1 - lconf
    require(boot)
    bmedian = function(x, ind) median(x[ind])
    bt = boot(x, bmedian, 1000)
    bb = boot.ci(bt, type = "perc")
    
    if (df == TRUE){
      data.frame(y = median(x),
                 ymin = quantile(bt$t, lconf), 
                 ymax = quantile(bt$t, uconf))
      
    } else {
      if (ci == "low") {
        quantile(bt$t, lconf)
      } else {
        quantile(bt$t, uconf)
      }
    }
  }
    
  # merge and tidy for plotting
  plot.data = data %>%
    group_by(x) %>%
    arrange(estimate) %>%
    mutate(specification = row_number()) %>%
    ungroup() %>%
    unique()
  
  # labels
  labs = plot.data %>%
    group_by(x) %>%
    summarize(med = median(estimate),
              low = median_cl_boot(estimate, df = FALSE, ci = "low"),
              high = median_cl_boot(estimate, df = FALSE, ci = "high")) %>%
    mutate(range = max(high) - min(low),
           estimate = ifelse(med > 0, high + (range / 10), low - (range / 10)),
           label = ifelse(x %in% sig, "*", ""))
  
  # plot curves
  if (pointrange == TRUE) {
    a = plot.data %>%
    ggplot(aes(specification, estimate, color = x)) +
      geom_linerange(aes(ymin = conf.low, ymax = conf.high), size = .1) +
      geom_point() +
      geom_hline(yintercept = 0, linetype = "solid", color = "grey", size = .5) +
      scale_color_manual(name = "", values = palette) +
      labs(x = "\nspecification number (ranked)", y = "standarized\negression coefficient\n") + 
      theme_minimal() + 
      theme(strip.text = element_blank(), 
            axis.line = element_line("black", size = 0.5), 
            legend.position = c(.5, .1), 
            legend.direction = "horizontal",
            panel.spacing = unit(0.75, "lines"), 
            axis.text = element_text(colour = "black"),
            text = element_text(size = text_size))
    if (title == TRUE) {
      a = a + annotate("text", -Inf, Inf, label = unique(plot.data$y), fontface = 2, size = title_size,
                       x = 0.5*(min(plot.data$specification) + max(plot.data$specification)), 
                       y = max(plot.data$conf.high))
    }
    
  } else {
    a = plot.data %>%
      ggplot(aes(specification, estimate, color = x)) +
      geom_point() +
      geom_hline(yintercept = 0, linetype = "solid", color = "grey", size = .5) +
      scale_color_manual(name = "", values = palette) +
      labs(x = "\nspecification number (ranked)", y = "standarized\nregression coefficient\n") + 
      theme_minimal() + 
      theme(strip.text = element_blank(), 
            axis.line = element_line("black", size = 0.5), 
            legend.position = "none", 
            legend.direction = "horizontal",
            panel.spacing = unit(0.75, "lines"), 
            axis.text = element_text(colour = "black"),
            text = element_text(size = text_size))
    if (title == TRUE) {
      a = a + annotate("text", -Inf, Inf, label = unique(plot.data$y), fontface = 2, size = title_size,
                       x = 0.5*(min(plot.data$specification) + max(plot.data$specification)), 
                       y = max(plot.data$estimate))    
      }
  }
  
    b = plot.data %>%
      group_by(x) %>%
      mutate(order = median(estimate)) %>%
      ggplot(aes(reorder(x, order), estimate, fill = x)) +
      stat_summary(fun.y = "median", geom = "bar") +
      stat_summary(fun.data = median_cl_boot, geom = "errorbar", width = 0) +
      geom_text(data = labs, aes(label = label, x = x, y = estimate), size = 6) +
      scale_fill_manual(name = "", values = palette) +
      scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) + 
      labs(x = "\n", y = "median effect\n") + 
      theme_minimal() + 
      theme(strip.text = element_blank(), 
            axis.line = element_line("black", size = 0.5), 
            legend.position = "none", 
            panel.spacing = unit(0.75, "lines"), 
            axis.text = element_text(colour = "black"),
            text = element_text(size = text_size),
            axis.text.x = element_text(angle = 45, hjust = 1))
    
  if (n_rows == 1) {
    a = a + theme(legend.position = c(.5, .1))
    b = b + coord_flip() +
      labs(x = "\n", y = "\nmedian effect") + 
      theme(axis.text.x = element_text(angle = 0, hjust = 1),
            axis.text.y = element_blank())
  }     
    

  if (remove_x == TRUE) {
    a = a + labs(x = "")
    
    if (n_rows == 1) {
      b = b + labs(y = "")
    } else {
      b = b + labs(x = "")
    }
  }    
  
  if (remove_y == TRUE) {
    a = a + labs(y = "")
    
    if (n_rows == 1) {
      b = b + labs(x = "")
    } else {
      b = b + labs(y = "")
    }
  }  
    
  cowplot::plot_grid(a, b, labels = labels, rel_heights = rel_heights, rel_widths = rel_widths, nrow = n_rows)
}

controls = c("politics_conserv", "politics_party", "age", "gender", "age", "ses_degree", "ses_income_household", "covid_studies")

To help illustrate how model specifications are selected, here are the models that will be included in the message-level SCA evaluating the effect of condition on the outcomes. Across these specifications, we examine the effect of the autonomous framing condition relative to the control condition on each outcome, with or without the following control variables:

politics_conserv = political ideology
politics_party = political party
age = age
gender = gender
state = US state residence
ses_degree = highest degree completed
ses_income_household = household income
covid_studies = log-transformed number of COVID-19 studies

setup_specs(y = names(data_mod)[grepl("share|msg.*self|social|msg.*other", names(data_mod))],
            x = c("autonomous v. message control"),
            control = controls,
            random_effects = "(1 | SID) + (1 | message)",
            model = c("lmer"))

condition SCA

Let’s run a SCA looking at the effect of condition (autonomous or control) on all dependent variables, and covariates we’re interested in. We’ll also visualize the median effect for each condition an whether the relationships tend to be positive, negative, or zero.

The top panels shows the IV-DV regression coefficients, ordered by effect size. Black points are statistically significant at p < .05; grey are p > .05. The color lines represent the median effect size for each condition.

The bottom panels show which variables were included for each model specification and they’re grouped into y (DV) and covariates categories.

The comparison plots show each condition curve separately, as well as the median effect size. The confidence intervals around the median effects are bootstrapped from the median effects in the curve.

message-level outcomes

These plots show us that the median effect size for the autonomous condition relative to the control condition across model specifications and outcomes is quite small (B = 0.06). The largest effect is for sharing (B = .16), but none of these relationships are statistically significant.

# define variables
outcome = names(data_mod)[grepl("share|msg.*self|social|msg.*other", names(data_mod))]
var = "autonomous"
random_effects = "(1 | SID) + (1 | message)"
model = "lmer"

# run SCA
output = run_sca(data = data_mod, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("y", "controls"),
         palette = palette_cond[1])

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_cond[1])

person-level outcomes

The order of effects (autonomous > message control > no message control) is relatively consistent across autonomy, agency, beliefs, and intentions, but these effects are small and only statistically significant for autonomy (IAF_autonomous).

# define variables
outcome = names(data_mod_person)[grepl("IAF_autonomous|agency|beliefs|intentions|norms", names(data_mod_person))]
var = unique(data_mod_person$group)
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "y", "controls"), palette = palette, 
         color_vars = TRUE, line_size = 4)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette)

motivation and relevance SCA

Here, we look at the self and social relevance, and self and other motivation variables are predictors of sharing.

The top panels shows the IV-DV regression coefficients, ordered by effect size. Black points are statistically significant at p < .05; grey are p > .05. The color lines represent the median effect size for each condition.

The bottom panels show which variables were included for each model specification and they’re grouped into x (IV), y (DV), and covariates categories.

The comparison plots show each condition curve separately, as well as the median effect size. The confidence intervals around the median effects are bootstrapped from the median effects in the curve.

combined message outcomes

For all predictors, the relationship with sharing is positive and statistically significant across model specifications. Overall, the motivation variables are more strongly related to sharing than the relevance variables. Reporting that the messages were personally motivating is the strongest predictor of sharing intentions.

# define variables
outcome = c("msg_share")
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = "(1 | SID) + (1 | message)"
model = "lmer"

# run SCA
output = run_sca(data = data_mod, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "y", "controls"), 
         palette = palette_rel_motiv, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

combined person-level outcomes

Again, all relationships are positive and statistically significant. Overall, social relevance has the strongest effect across all DVs, but there is variability in terms of rank order across DVs.

# define variables
outcome = names(data_mod_person)[grepl("IAF_autonomous|agency|beliefs|intentions|norms", names(data_mod_person))]
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "y", "controls"), palette = palette_rel_motiv, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

individual person-level outcomes

agency

The self-oriented measures are showing stronger relationships with agency, social relevance is only slightly weaker.

# define variables
outcome = "agency"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

autonomy

Interestingly, other-oriented motivation and relevance show stronger effects on autonomy than self-focused measures.

# define variables
outcome = "IAF_autonomous"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

intentions

Social relevance and self motivation are showing stronger effects on COVID-19 agency than self-relevance or other motivation.

# define variables
outcome = "intentions1"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

beliefs - protecting self

Interestingly, the other-focused measures are showing stronger relationships with beliefs about protecting the self than the self-focused measures.

# define variables
outcome = "beliefs_safe_self"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

beliefs - protecting others

All measures are showing strong relationships with beliefs about protecting others, but other motivation is weaker in comparison.

# define variables
outcome = "beliefs_safe_others"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

norms - close family and friends

# define variables
outcome = "norms_close1"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

norms - people in your community

These effects are relatively weaker compared the other DVs. The motivation measures are stronger, with other motivtion shows the strongest relationship.

# define variables
outcome = "norms_town1"
var = c("msg_motiv_self", "msg_rel_self", "msg_motiv_other", "msg_rel_social")
random_effects = NULL
model = "lm"

# run SCA
output = run_sca(data = data_mod_person, var = var, outcome = outcome, controls = controls,
                 random_effects = random_effects, model = model)

combined SCA curve

plot_sca(data = output$results, combined = TRUE, title = FALSE, choices = c("x", "controls"), palette = palette_rel_motiv, line_alpha = .5, color_vars = TRUE)

compare SCA curves

plot_sca_compare(data = output$results, palette = palette_rel_motiv)

message effects

Here we look at variability in ratings for individual message, either collapsed across conditions, or as a function of condition. The dotted line is the mean rating across all conditions and messages.

Message stimuli from the autonomy framing condition can be viewed here. Message stimuli in the control condition can be viewed here.

Overall, averaged across relevance, motivation, and sharing, these were the most effective messages:

message_info = read.csv("../message_info.csv", stringsAsFactors = FALSE) %>%
  rename("message_text" = text) %>%
  mutate(condition = tolower(condition),
         condition = gsub("control", "message control", condition)) %>%
  filter(condition %in% c("autonomous", "message control")) %>%
  mutate(message = sprintf("%02d", as.numeric(image_number))) %>%
  filter(message %in% c("06", "07", "08", "09", "10", 
                        "12", "15", "17", "18", "20", 
                        "23", "24", "25", "31", "32")) %>%
  mutate(behavior = "social_distancing") %>%
  select(condition, message, message_text, behavior)

data_comp = messages %>%
  filter(!survey_name == "msg_familiarity") %>%
  extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE)

data_comp %>%
  filter(grepl("self|social|other|share", survey_name)) %>%
  group_by(message, condition) %>%
  summarize(`mean rating` = round(mean(value), 2)) %>%
  arrange(desc(`mean rating`)) %>% 
  left_join(., message_info) %>%
  select(message, condition, `mean rating`, message_text) %>%
  DT::datatable(rownames = FALSE, extensions = 'FixedColumns', 
                    options = list(scrollX = TRUE,
                                   scrollY = TRUE),
                caption = htmltools::tags$caption(style = 'caption-side: top; text-align: left;',
                                                  "Message text by condition"))

collapsed across condition

all ratings

plot_compare(data_comp, "self|social|other|share", palette = palette_cond)

self motivation

plot_compare(data_comp, "msg_motiv_self", palette = palette_cond)

self-relevance

plot_compare(data_comp, "msg_rel_self", palette = palette_cond)

sharing

plot_compare(data_comp, "msg_share", palette = palette_cond)

by condition

all ratings

plot_compare(data_comp, "self|social|other|share", palette = palette_cond)

self motivation

plot_compare(data_comp, "msg_motiv_self", palette = palette_cond, condition = TRUE)

self-relevance

plot_compare(data_comp, "msg_rel_self", palette = palette_cond, condition = TRUE)

sharing

plot_compare(data_comp, "msg_share", palette = palette_cond, condition = TRUE)

condition differentiation

Below is a summary of the degree to which each message differed as a function of condition on average. Positive values reflect higher average ratings for the autonomous messages; negative values reflect higher average ratings for the control condition.

data_comp %>%
  group_by(condition, message, survey_name) %>%
  summarize(mean = mean(value, na.rm = TRUE)) %>%
  spread(condition, mean) %>%
  mutate(diff = autonomous - `message control`) %>%
  filter(grepl("self|share", survey_name)) %>%
  group_by(message) %>%
  summarize(mean_diff = round(mean(diff), 2)) %>%
  arrange(desc(mean_diff))