COVID-19 Pilots 1 & 2

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 these pilot studies, 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 reports). 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_pilot/covid19_study1_pilot_clean_long.csv", stringsAsFactors = FALSE) %>%
  bind_rows(read.csv("../../covid19_study1_pilot2/covid19_study1_pilot2_clean_long.csv", stringsAsFactors = FALSE)) %>%
  mutate(SID = sprintf("%s_%s", study, SID))


## 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", 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
         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))) %>% 
  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", 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))

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", 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", measure)),
         scale = ifelse(grepl("IAF", survey_name), "1 = not at all true, 5 = completely", scale),
         citation = ifelse(grepl("IAF", survey_name), " Weinstein, Przybylski, & Ryan, 2012", citation)) %>%
  filter(!grepl("hygiene", measure))

dvs_covs_controls = data_person %>%
  select(-c(scale, measure, citation)) %>%
  filter(grepl("intentions|agency|IAF|norms|beliefs", 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)

primary analyses

---

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

hypothesis 1

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

✅ These data are consistent with this hypothesis.

run model

rel_self_1 = lmer(msg_rel_self ~ condition + (1 | SID) + (1 | message) + (1 | study), 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) + (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 1008.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.3031 -0.4032  0.1286  0.4424  2.8415 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.50094  0.7078  
##  message  (Intercept) 0.01646  0.1283  
##  study    (Intercept) 0.08569  0.2927  
##  Residual             0.42705  0.6535  
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                     Estimate Std. Error      df t value Pr(>|t|)  
## (Intercept)          -0.1807     0.2386  1.2781  -0.758   0.5635  
## conditionautonomous   0.3206     0.1688 80.9467   1.899   0.0611 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## conditntnms -0.316
## convergence code: 0
## Model failed to converge with max|grad| = 0.00222765 (tol = 0.002, component 1)

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(-.8, 1)) +
  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 consistent with this hypothesis.

run model

motiv_self_1 = lmer(msg_motiv_self ~ condition + (1 | SID) + (1 | message) + (1 | study), 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) + (1 |  
##     study)
##    Data: data_mod
## 
## REML criterion at convergence: 1055.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.4777 -0.4088  0.1823  0.5470  2.6834 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.441832 0.66470 
##  message  (Intercept) 0.004608 0.06789 
##  study    (Intercept) 0.033595 0.18329 
##  Residual             0.511938 0.71550 
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                     Estimate Std. Error      df t value Pr(>|t|)  
## (Intercept)          -0.1960     0.1705  1.4941  -1.150   0.4016  
## conditionautonomous   0.3906     0.1625 80.7376   2.403   0.0185 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## conditntnms -0.425

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(-.8, 1)) +
  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.

run model

share_1 = lmer(msg_share ~ condition + (1 | SID) + (1 | message) + (1 | study), 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) + (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 925.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7077 -0.4755  0.0384  0.5017  2.6604 
## 
## Random effects:
##  Groups   Name        Variance  Std.Dev.
##  SID      (Intercept) 0.6251805 0.79068 
##  message  (Intercept) 0.0164372 0.12821 
##  study    (Intercept) 0.0001283 0.01133 
##  Residual             0.3207012 0.56630 
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                     Estimate Std. Error      df t value Pr(>|t|)  
## (Intercept)          -0.1906     0.1259 58.1196  -1.514   0.1353  
## conditionautonomous   0.4430     0.1826 81.7414   2.426   0.0175 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## conditntnms -0.639
## convergence code: 0
## Model failed to converge with max|grad| = 0.118834 (tol = 0.002, component 1)

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(-.8, 1)) +
  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.

self-relevance

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

✅ These data are also consistent with the moderation hypothesis.

run model

share_mod_rel = lmer(msg_share ~ condition*msg_rel_self + (1 | SID) + (1 | message) + (1 | study), 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) +  
##     (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 854.7
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -3.09399 -0.51062  0.05151  0.51298  2.86151 
## 
## Random effects:
##  Groups   Name        Variance   Std.Dev.
##  SID      (Intercept) 0.60396317 0.777151
##  message  (Intercept) 0.00911714 0.095484
##  study    (Intercept) 0.00006515 0.008072
##  Residual             0.26030882 0.510205
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                                   Estimate Std. Error        df t value
## (Intercept)                       -0.15590    0.12105  65.56157  -1.288
## conditionautonomous                0.32242    0.17855  81.95499   1.806
## msg_rel_self                       0.27664    0.04868 397.87684   5.682
## conditionautonomous:msg_rel_self   0.23726    0.08395 403.14066   2.826
##                                      Pr(>|t|)    
## (Intercept)                           0.20230    
## conditionautonomous                   0.07463 .  
## msg_rel_self                     0.0000000257 ***
## conditionautonomous:msg_rel_self      0.00495 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt msg_r_
## conditntnms -0.648              
## msg_rel_slf  0.052 -0.036       
## cndtntnm:__ -0.031 -0.030 -0.574
## convergence code: 0
## Model failed to converge with max|grad| = 0.0814884 (tol = 0.002, component 1)

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(-.8, 1)) +
  labs(x = "", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

self motivation

✅ These data are consistent with the hypothesis that motivation is associated with higher sharing intentions.

❌ These data are not consistent with the moderation hypothesis.

run model

share_mod_motiv = lmer(msg_share ~ condition*msg_motiv_self + (1 | SID) + (1 | message) + (1 | study), 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) +  
##     (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 794.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.9930 -0.4864  0.0459  0.5242  3.8068 
## 
## Random effects:
##  Groups   Name        Variance   Std.Dev.
##  SID      (Intercept) 0.51577913 0.718178
##  message  (Intercept) 0.00697976 0.083545
##  study    (Intercept) 0.00001382 0.003717
##  Residual             0.22585095 0.475238
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                                     Estimate Std. Error        df t value
## (Intercept)                         -0.12458    0.11168  78.60676  -1.116
## conditionautonomous                  0.26752    0.16525  82.81896   1.619
## msg_motiv_self                       0.40176    0.04460 389.33363   9.009
## conditionautonomous:msg_motiv_self   0.10868    0.07087 389.43882   1.533
##                                               Pr(>|t|)    
## (Intercept)                                      0.268    
## conditionautonomous                              0.109    
## msg_motiv_self                     <0.0000000000000002 ***
## conditionautonomous:msg_motiv_self               0.126    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt msg_m_
## conditntnms -0.650              
## msg_mtv_slf  0.066 -0.045       
## cndtntnm:__ -0.041 -0.027 -0.629
## convergence code: 0
## Model failed to converge with max|grad| = 0.0403143 (tol = 0.002, component 1)

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(-.8, 1)) +
  labs(x = "", y = "predicted standardized rating\n", title = "sharing intention\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.

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 
## -2.66462 -0.74546  0.08176  0.76707  1.37208 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                  -0.0320     0.1452  -0.220    0.826
## conditionautonomous           0.2787     0.2187   1.274    0.205
## conditionno message control  -0.1041     0.1968  -0.529    0.598
## 
## Residual standard error: 0.9951 on 137 degrees of freedom
## Multiple R-squared:  0.02401,    Adjusted R-squared:  0.009761 
## F-statistic: 1.685 on 2 and 137 DF,  p-value: 0.1893

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(-.7, .7)) +
  labs(x = "", y = "predicted standardized rating\n", title = "agency to mitigate the spread of COVID-19\n") +
  theme_minimal() +
  theme(legend.position = "none")

secondary analyses

---

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

For all analyses in this section, ratings were averaged across items in each scale for each person.

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.0701 -0.5220  0.3909  0.7526  0.9007 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                 -0.07228    0.18438  -0.392    0.696
## conditionautonomous          0.14810    0.28734   0.515    0.608
## conditionno message control  0.08743    0.24665   0.354    0.724
## 
## Residual standard error: 1.01 on 86 degrees of freedom
##   (51 observations deleted due to missingness)
## Multiple R-squared:  0.003252,   Adjusted R-squared:  -0.01993 
## F-statistic: 0.1403 on 2 and 86 DF,  p-value: 0.8693

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(-.7, .7)) +
  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 
## -2.8128 -0.4802  0.4253  0.7546  0.8494 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)
## (Intercept)                 -0.03222    0.18451  -0.175    0.862
## conditionautonomous         -0.01241    0.28754  -0.043    0.966
## conditionno message control  0.08232    0.24682   0.334    0.740
## 
## Residual standard error: 1.011 on 86 degrees of freedom
##   (51 observations deleted due to missingness)
## Multiple R-squared:  0.001913,   Adjusted R-squared:  -0.0213 
## F-statistic: 0.08243 on 2 and 86 DF,  p-value: 0.9209

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(-.7, .7)) +
  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 consistent with the hypothesis that exposure to autonomously framed messages increases intentions to practice social distancing. However, a similar effect size was observed for the no message control, indicating that the message control group may just have reported lower intentions.

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.3994 -0.2473  0.3606  0.6194  1.0470 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                  -0.3164     0.1430  -2.213   0.0285 *
## conditionautonomous           0.5499     0.2154   2.553   0.0118 *
## conditionno message control   0.4276     0.1939   2.206   0.0291 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.98 on 137 degrees of freedom
## Multiple R-squared:  0.05335,    Adjusted R-squared:  0.03953 
## F-statistic:  3.86 on 2 and 137 DF,  p-value: 0.02339

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(-.7, .7)) +
  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 
## -2.5598 -0.6082  0.2694  0.7450  1.4418 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                  -0.1977     0.1453  -1.361   0.1758  
## conditionautonomous           0.3638     0.2189   1.662   0.0989 .
## conditionno message control   0.2540     0.1971   1.289   0.1997  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9962 on 137 degrees of freedom
## Multiple R-squared:  0.02184,    Adjusted R-squared:  0.007559 
## F-statistic: 1.529 on 2 and 137 DF,  p-value: 0.2204

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(-.7, .7)) +
  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 consistent with the hypothesis that exposure to autonously 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 
## -2.43404 -0.68861  0.07872  0.71297  1.92576 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                  -0.2179     0.1439  -1.514   0.1322  
## conditionautonomous           0.5251     0.2168   2.422   0.0167 *
## conditionno message control   0.1977     0.1951   1.013   0.3126  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9862 on 137 degrees of freedom
## Multiple R-squared:  0.04134,    Adjusted R-squared:  0.02734 
## F-statistic: 2.954 on 2 and 137 DF,  p-value: 0.05548

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(-.7, .7)) +
  labs(x = "", y = "predicted standardized rating\n", title = "social distancing norms: community\n") +
  theme_minimal() +
  theme(legend.position = "none")

exploratory analyses

---

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.

sharing

These data are consistent with main effects of condition and autonomy, 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) + (1 | study), 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) +  
##     (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 924.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7183 -0.4668  0.0411  0.5124  2.7151 
## 
## Random effects:
##  Groups   Name        Variance     Std.Dev. 
##  SID      (Intercept) 0.5935446016 0.7704185
##  message  (Intercept) 0.0165222577 0.1285389
##  study    (Intercept) 0.0000002295 0.0004791
##  Residual             0.3206724576 0.5662795
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                                    Estimate Std. Error      df t value
## (Intercept)                         -0.1249     0.1260 84.2947  -0.992
## conditionautonomous                  0.3728     0.1807 79.8135   2.063
## IAF_autonomous                       0.2728     0.1143 79.9725   2.387
## conditionautonomous:IAF_autonomous  -0.2074     0.1780 79.9066  -1.165
##                                    Pr(>|t|)  
## (Intercept)                          0.3241  
## conditionautonomous                  0.0423 *
## IAF_autonomous                       0.0194 *
## conditionautonomous:IAF_autonomous   0.2473  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt IAF_tn
## conditntnms -0.649              
## IAF_autonms  0.218 -0.153       
## cndtnt:IAF_ -0.140  0.059 -0.642
## convergence code: 0
## Model failed to converge with max|grad| = 0.00496631 (tol = 0.002, component 1)

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(-1.2, 1.1)) +
  labs(x = "\nautonomous functioning", y = "predicted standardized rating\n", title = "sharing intention\n") +
  theme_minimal() +
  theme(legend.position = "top")

self-relevance

These data are not consistent with either the main effect or moderating effect of autonomy on self-relevance.

run model

rel_mod_auto = lmer(msg_rel_self ~ condition*IAF_autonomous + (1 | SID) + (1 | message) + (1 | study), 
                       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) + (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 1007.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.2505 -0.3850  0.1244  0.4753  2.8353 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.48057  0.6932  
##  message  (Intercept) 0.01636  0.1279  
##  study    (Intercept) 0.05337  0.2310  
##  Residual             0.42710  0.6535  
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                                    Estimate Std. Error       df t value
## (Intercept)                        -0.12060    0.20282  1.43393  -0.595
## conditionautonomous                 0.25409    0.16841 79.26097   1.509
## IAF_autonomous                      0.19632    0.10766 80.04869   1.823
## conditionautonomous:IAF_autonomous -0.01093    0.16533 79.13996  -0.066
##                                    Pr(>|t|)  
## (Intercept)                           0.632  
## conditionautonomous                   0.135  
## IAF_autonomous                        0.072 .
## conditionautonomous:IAF_autonomous    0.947  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt IAF_tn
## conditntnms -0.384              
## IAF_autonms  0.145 -0.166       
## cndtnt:IAF_ -0.087  0.063 -0.640

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(-1.2, 1.1)) +
  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 main effects of condition and autonomy, but not with the hypothesis that autonomy moderates the relationship between condition and sharing.

run model

motiv_mod_auto = lmer(msg_motiv_self ~ condition*IAF_autonomous + (1 | SID) + (1 | message) + (1 | study), 
                       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) + (1 | study)
##    Data: data_mod
## 
## REML criterion at convergence: 1044.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.4643 -0.3877  0.1446  0.5356  2.8737 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.358199 0.59850 
##  message  (Intercept) 0.004806 0.06933 
##  study    (Intercept) 0.002721 0.05216 
##  Residual             0.511514 0.71520 
## Number of obs: 419, groups:  SID, 84; message, 15; study, 2
## 
## Fixed effects:
##                                    Estimate Std. Error       df t value
## (Intercept)                        -0.07730    0.11021  2.31522  -0.701
## conditionautonomous                 0.27113    0.15135 79.23614   1.791
## IAF_autonomous                      0.38609    0.09596 77.37779   4.023
## conditionautonomous:IAF_autonomous -0.18718    0.14892 78.73110  -1.257
##                                    Pr(>|t|)    
## (Intercept)                        0.546908    
## conditionautonomous                0.077050 .  
## IAF_autonomous                     0.000133 ***
## conditionautonomous:IAF_autonomous 0.212490    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndtnt IAF_tn
## conditntnms -0.625              
## IAF_autonms  0.216 -0.155       
## cndtnt:IAF_ -0.136  0.060 -0.642
## convergence code: 0
## Model failed to converge with max|grad| = 0.0197676 (tol = 0.002, component 1)

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(-1.2, 1.1)) +
  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 not consistent with either the main effect or moderating effect of autonomy on 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 
## -2.6629 -0.5328  0.2196  0.6814  2.1700 
## 
## Coefficients:
##                                            Estimate Std. Error t value
## (Intercept)                                 0.01122    0.13816   0.081
## conditionautonomous                         0.21043    0.20543   1.024
## conditionno message control                -0.23490    0.18634  -1.261
## IAF_autonomous                              0.17949    0.12990   1.382
## conditionautonomous:IAF_autonomous          0.19354    0.20227   0.957
## conditionno message control:IAF_autonomous  0.37553    0.18519   2.028
##                                            Pr(>|t|)  
## (Intercept)                                  0.9354  
## conditionautonomous                          0.3075  
## conditionno message control                  0.2096  
## IAF_autonomous                               0.1693  
## conditionautonomous:IAF_autonomous           0.3404  
## conditionno message control:IAF_autonomous   0.0446 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9226 on 134 degrees of freedom
## Multiple R-squared:  0.1794, Adjusted R-squared:  0.1488 
## F-statistic: 5.861 on 5 and 134 DF,  p-value: 0.00006265

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(-1.2, 1.1)) +
  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.

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: 858.5
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -3.09281 -0.48588  0.03878  0.49957  2.97141 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.600567 0.77496 
##  message  (Intercept) 0.008578 0.09262 
##  Residual             0.260539 0.51043 
## Number of obs: 419, groups:  SID, 84; message, 15
## 
## Fixed effects:
##                                       Estimate Std. Error        df
## (Intercept)                           -0.18278    0.12164  83.20634
## msg_rel_self_gmc                       0.05661    0.11314  79.90289
## conditionautonomous                    0.35497    0.18110  79.86780
## msg_rel_self_cwc                       0.18177    0.03091 331.95037
## msg_rel_self_gmc:conditionautonomous   0.32636    0.18751  79.96669
## conditionautonomous:msg_rel_self_cwc   0.12798    0.05368 332.78518
##                                      t value      Pr(>|t|)    
## (Intercept)                           -1.503        0.1367    
## msg_rel_self_gmc                       0.500        0.6182    
## conditionautonomous                    1.960        0.0535 .  
## msg_rel_self_cwc                       5.881 0.00000000995 ***
## msg_rel_self_gmc:conditionautonomous   1.741        0.0856 .  
## conditionautonomous:msg_rel_self_cwc   2.384        0.0177 *  
## ---
## 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.148                                        
## conditntnms  -0.646 -0.099                                 
## msg_rl_slf_c  0.000  0.001       -0.001                    
## msg_rl_sl_:  -0.089 -0.604       -0.074  0.000             
## cndtntn:___  -0.001  0.003        0.001 -0.571       -0.003

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.3, 1.5)) +
  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: 855
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -2.95657 -0.48588  0.01208  0.51842  2.67248 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.550468 0.74194 
##  message  (Intercept) 0.008304 0.09113 
##  Residual             0.263005 0.51284 
## Number of obs: 419, groups:  SID, 84; message, 15
## 
## Fixed effects:
##                                         Estimate Std. Error        df
## (Intercept)                             -0.16681    0.11873  83.02841
## msg_rel_social_gmc                       0.10644    0.10922  79.90353
## conditionautonomous                      0.24873    0.17906  79.89142
## msg_rel_social_cwc                       0.20896    0.03312 332.65869
## msg_rel_social_gmc:conditionautonomous   0.43807    0.18728  79.96902
## conditionautonomous:msg_rel_social_cwc   0.04261    0.05171 332.73473
##                                        t value       Pr(>|t|)    
## (Intercept)                             -1.405         0.1638    
## msg_rel_social_gmc                       0.975         0.3327    
## conditionautonomous                      1.389         0.1687    
## msg_rel_social_cwc                       6.309 0.000000000893 ***
## msg_rel_social_gmc:conditionautonomous   2.339         0.0218 *  
## conditionautonomous:msg_rel_social_cwc   0.824         0.4105    
## ---
## 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.223                                        
## conditntnms  -0.637 -0.148                                 
## msg_rl_scl_c  0.000  0.002       -0.001                    
## msg_rl_sc_:  -0.130 -0.583       -0.127 -0.002             
## cndtntn:___  -0.001  0.000        0.002 -0.641        0.001

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.3, 1.5)) +
  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: 800
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.9949 -0.4837  0.0395  0.5230  3.8044 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.525954 0.72523 
##  message  (Intercept) 0.007043 0.08392 
##  Residual             0.225919 0.47531 
## Number of obs: 419, groups:  SID, 84; message, 15
## 
## Fixed effects:
##                                         Estimate Std. Error        df
## (Intercept)                             -0.11197    0.11467  82.13931
## msg_motiv_self_gmc                       0.37201    0.10637  79.99006
## conditionautonomous                      0.25357    0.17225  79.92115
## msg_motiv_self_cwc                       0.25205    0.03035 328.57684
## msg_motiv_self_gmc:conditionautonomous   0.02183    0.17904  79.92458
## conditionautonomous:msg_motiv_self_cwc   0.07618    0.04796 332.58476
##                                        t value            Pr(>|t|)    
## (Intercept)                             -0.976             0.33169    
## msg_motiv_self_gmc                       3.497             0.00077 ***
## conditionautonomous                      1.472             0.14491    
## msg_motiv_self_cwc                       8.305 0.00000000000000265 ***
## msg_motiv_self_gmc:conditionautonomous   0.122             0.90326    
## conditionautonomous:msg_motiv_self_cwc   1.588             0.11316    
## ---
## 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.198                                          
## conditntnms   -0.642 -0.133                                   
## msg_mtv_slf_c -0.001 -0.002         0.001                     
## msg_mtv_s_:   -0.118 -0.594        -0.105  0.001              
## cndtntn:___    0.001  0.004        -0.002 -0.634        -0.002

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.3, 1.5)) +
  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: 815.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.9523 -0.5262  0.0180  0.5457  4.1401 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 0.508256 0.71292 
##  message  (Intercept) 0.004672 0.06835 
##  Residual             0.239793 0.48969 
## Number of obs: 419, groups:  SID, 84; message, 15
## 
## Fixed effects:
##                                          Estimate Std. Error        df
## (Intercept)                              -0.10991    0.11283  81.41874
## msg_motiv_other_gmc                       0.36794    0.10682  80.18010
## conditionautonomous                       0.22897    0.17042  79.98402
## msg_motiv_other_cwc                       0.25883    0.03280 330.85427
## msg_motiv_other_gmc:conditionautonomous   0.08069    0.17537  80.01379
## conditionautonomous:msg_motiv_other_cwc   0.02553    0.04861 333.01587
##                                         t value           Pr(>|t|)    
## (Intercept)                              -0.974           0.332853    
## msg_motiv_other_gmc                       3.444           0.000913 ***
## conditionautonomous                       1.344           0.182883    
## msg_motiv_other_cwc                       7.892 0.0000000000000439 ***
## msg_motiv_other_gmc:conditionautonomous   0.460           0.646685    
## conditionautonomous:msg_motiv_other_cwc   0.525           0.599854    
## ---
## 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.213                                          
## conditntnms   -0.646 -0.141                                   
## msg_mtv_thr_c -0.001 -0.001         0.000                     
## msg_mtv_t_:   -0.129 -0.609        -0.099  0.001              
## cndtntn:___    0.001  0.002        -0.001 -0.673        -0.001

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.3, 1.5)) +
  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")

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")

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

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")

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

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) + (1 | study)",
            model = c("lmer"))

condition SCA

Let’s run a SCA looking at the effect of condition (autonomous v. message control or each condition v. the average of the other two) 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 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.

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 large (B = 0.39). The largest effect is for sharing (B = 0.44), and most of these relationships are positive and 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) + (1 | study)"
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", "subsets"), palette = palette_cond[1])

compare SCA curves

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

person-level outcomes

Compared to the message and no message controls, the autonomous condition had a median effect of B = 0.19. This is largely driven by perceived social distancing norms in the community (B = 0.41) and these relationships are the only statistically significant effects for the autonomous condition.

# 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) + (1 | study)"
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 across 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, this was the most effective message:

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, condition = TRUE)

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)) %>%
  kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = T)

message	mean_diff
07	1.53
15	1.22
20	0.81
32	0.74
06	0.69
24	0.69
10	0.66
12	0.61
31	0.47
23	0.46
25	0.45
18	0.38
09	0.33
17	0.28
08	0.00