COVID19 Control Message Argument Strength Norming

The goal of this pilot study was to identify a set of health messages related to COVID-19 rated as making strong argumnets for use in future studies. We included COVID-19 health messages that were being shared on social media and framed them as Instagram posts. Specifically, each visual message (a static image or GIF) collected from social media was accompanied by a “post” about the message from a fictitious user, “j.smith.” Messages focused on social distancing, flattening the curve, hand washing, or combating misperceptions. Below is a list of all messages.

prep and check data

---

Check the number of ratings per message

# load packages

if (!require(tidyverse)) {
  install.packages('tidyverse')
}
if (!require(wesanderson)) {
  install.packages('wesanderson')
}
if (!require(knitr)) {
  install.packages('knitr')
}
if (!require(kableExtra)) {
  install.packages('kableExtra')
}
if (!require(DT)) {
  install.packages('DT')
}

# define palette

palette = wesanderson::wes_palette("Zissou1", n = 6, type = "continuous")[c(1,3:6)]

# load and tidy data
# load message info
message_info = read.csv("CNLAB COVID-19 Messages, DVs & Covariates - Humor, norm, autonomy appeals.csv", stringsAsFactors = FALSE) %>%
  rename("message_text" = Message..link.or.text.) %>%
  mutate(condition = gsub(" ", "", condition)) %>%
  filter(condition == "Control") %>%
  mutate(message = sprintf("message_%02d", as.numeric(image.number)),
         behavior = ifelse(message %in% c("message_33", "message_15", "message_17",
                                          "message_24", "message_30"), "social distancing", behavior)) %>%
  group_by(behavior) %>%
  mutate(behavior_n = n()) %>%
  select(message, behavior, behavior_n, message_text)

# load surveys
surveys = read.csv("COVID-19 Control Message Testing.csv", stringsAsFactors = FALSE) %>%
  slice(3:n()) %>%
  mutate(RecordedDate = lubridate::as_datetime(RecordedDate)) %>%
  filter(!DistributionChannel == "preview") %>%
  filter(!mturk_code == "") %>%
  filter(!MID == "") %>%
  mutate(SID = sprintf("s%03d", row_number())) %>%
  select(-MID) %>%
  gather(var, val, starts_with("X")) %>%
  extract(var, c("message", "question"), "X([0-9]+)_(.*)", remove = FALSE) %>%
  mutate(message = sprintf("message_%02d", as.numeric(message) - 3),
         val = as.numeric(val))

# filter out failed attention checks and failed English comprehension
failed = surveys %>%
  filter(!grepl("How do you feel about sharing information online?", attention_1) | !english == 6) %>%
  select(SID) %>%
  unique()

surveys_pass = surveys %>%
  filter(!SID %in% failed$SID) %>%
  left_join(., message_info)

# score the data
scored = surveys_pass %>%
  select(-var) %>%
  spread(question, val) %>%
  mutate(argument_favorability = ((argument_6 - argument_7) / 2) + 3) %>%
  select(-c(argument_6, argument_7)) %>%
  gather(question, val, contains("argument")) %>%
  mutate(val = as.numeric(val)) %>%
  select(SID, message, behavior, question, val) %>%
  left_join(., message_info)

surveys_pass %>%
  filter(!is.na(val)) %>%
  group_by(message, message_text) %>%
  summarize(n = n() / 9) %>%
  DT::datatable(rownames = FALSE, extensions = 'FixedColumns', 
                      options = list(scrollX = TRUE,
                                     scrollY = TRUE))

argument strength survey

---

We assessed perceived argument strength using the following scale from Zhao et al. (2011):

Instructions: Fill in the blanks with the target behavior for the persuasive argument.
Scale: 1 = strongly disagree, 5 = strongly agree

1. The statement is a reason for ___ that is believable.
2. The statement is a reason for ___ that is convincing.
3. The statement gives a reason for ___ that is important to me.
4. The statement helped me feel confident about how best to ___.
5. The statement would help my friends ___.
6. The statement put thoughts in my mind about wanting to ___.
7. The statement put thoughts in my mind about not wanting to ___.
8. Overall, how much do you agree or disagree with the statement?
9. Is the reason the statement gave for ____ a strong or weak reason? (1 = very weak, 5 = very strong)

Subtract item 7) from item 6) to create a single thought favorability item and then convert the new item to a 5-point scale by dividing it by 2 and then adding a constant of 3.

We customized the blanks so that the ratings were focused on the behavior targeted by the message. For each message type, the blanks were filled as follows:

hand washing = “practice/practicing hand washing”
social distancing = “practice/practicing social distancing”
flattening the curve = “flatten/flattening the curve”
combating misperceptions = “take/taking the virus seriously”
multiple = “stop/stopping the spread of coronavirus”

visualize

---

Average argument strength was calculated in the following way: First, we created the argument favorability item using the procedure listed above. Then, we averaged across argument favorability and the remaining 7 items to form an average score on argument strength for each message.

box and whisker plots

The box and whisker plots depicted below represent the following statistics: the vertical line in the middle is the median, the box encompasses the inter-quartile range (25th to 75th percentile), and the whiskers capture +/- 1.5 times the inter-quartile range from the box hinge. Points outside the whiskers are likely outliers. Colors represent the COVID-19 message types.

average argument strength rating for each message

order = scored %>%
  filter(!is.na(val)) %>%
  group_by(SID, message, behavior) %>%
  summarize(mean = round(mean(val, na.rm = TRUE), 2)) %>%
  group_by(message) %>%
  summarize(median = median(mean))

scored %>%
  filter(!is.na(val)) %>%
  group_by(SID, message, behavior) %>%
  summarize(mean = round(mean(val, na.rm = TRUE), 2)) %>%
  left_join(., order) %>%
  filter(!is.nan(mean)) %>%
  ggplot(aes(reorder(message, median), mean, fill = behavior)) +
  geom_boxplot() +
  coord_flip() +
  scale_fill_manual(values = palette) +
  labs(y = "\nrating", x = "message\n") +
  theme_minimal() +
  theme(legend.position = "top")

average argument strength rating by behavior

n = number of messages in the behavior type

annot = message_info %>%
  select(-message) %>%
  unique()

scored %>%
  extract(message, "message_num", "message_(.*)", remove = FALSE) %>%
  group_by(SID, message, message_num, behavior) %>%
  summarize(mean = round(mean(val, na.rm = TRUE), 2)) %>%
  filter(!is.nan(mean)) %>%
  ggplot(aes(behavior, mean, fill = behavior, label = message_num)) +
  geom_boxplot() +
  geom_text(data = annot, aes(x = behavior, y = 5.25, label = sprintf("n = %d", behavior_n))) +
  coord_flip() +
  scale_fill_manual(values = palette) +
  labs(y = "\nrating", x = "message\n") +
  theme_minimal() +
  theme(legend.position = "top")

mean and 95% confidence intervals

Colors represent the COVID-19 message types.

average argument strength rating for each message

order = scored %>%
  filter(!is.na(val)) %>%
  group_by(SID, message, behavior) %>%
  summarize(mean = round(mean(val, na.rm = TRUE), 2)) %>%
  group_by(message) %>%
  summarize(median = median(mean))

scored %>%
  filter(!is.na(val)) %>%
  group_by(SID, message, behavior) %>%
  summarize(mean = round(mean(val, na.rm = TRUE), 2)) %>%
  left_join(., order) %>%
  filter(!is.nan(mean)) %>%
  ggplot(aes(reorder(message, median), mean, color = behavior)) +
  stat_summary(fun.data = "mean_cl_boot") +
  coord_flip() +
  scale_color_manual(values = palette) +
  labs(y = "\nrating", x = "message\n") +
  theme_minimal() +
  theme(legend.position = "top")

average argument strength rating by behavior

n = number of messages in the behavior type

annot = message_info %>%
  select(-message) %>%
  unique()

scored %>%
  extract(message, "message_num", "message_(.*)", remove = FALSE) %>%
  group_by(SID, message, message_num, behavior) %>%
  summarize(mean = round(mean(val, na.rm = TRUE), 2)) %>%
  filter(!is.nan(mean)) %>%
  ggplot(aes(behavior, mean, color = behavior, label = message_num)) +
  stat_summary(fun.data = "mean_cl_boot") +
  geom_text(data = annot, aes(x = behavior, y = 4.25, label = sprintf("n = %d", behavior_n)), color = "black") +
  coord_flip() +
  scale_color_manual(values = palette) +
  labs(y = "\nrating", x = "message\n") +
  theme_minimal() +
  theme(legend.position = "top")

descriptives

---

Below are descriptives for the average agrument strength by message. n = number of ratings.

scored %>%
  filter(!is.na(val)) %>%
  group_by(SID, message, behavior) %>%
  summarize(mean_sub = round(mean(val, na.rm = TRUE), 2)) %>%
  group_by(message, behavior) %>%
  summarize(n = n(),
            mean = round(mean(mean_sub, na.rm = TRUE), 2),
            sd = round(sd(mean_sub, na.rm = TRUE), 2)) %>%
  arrange(desc(mean)) %>%
  DT::datatable(filter = "top", rownames = FALSE)

select the top 15 social distancing messages

---

For a series of studies focused on social distancing, we down-selected messages from the information above, as follows:

• INCLUDE ONLY social distancing items
• EXCLUDE messages with the highest variability (top 20%) / INCLUDE messages rated most consistently as strong arguments by raters
• Rank messages by mean argument strength rating
• Select the top 15 messages from the remaining set

These 15 messages are presented below.

high_var = scored %>%
  filter(!is.na(val)) %>%
  group_by(SID, message) %>%
  summarize(mean_sub = round(mean(val, na.rm = TRUE), 2)) %>%
  group_by(message) %>%
  summarize(n = n(),
            mean = round(mean(mean_sub, na.rm = TRUE), 2),
            sd = round(sd(mean_sub, na.rm = TRUE), 2)) %>%
  arrange(desc(sd)) %>%
  slice(1:7)
  
final_messages = scored %>%
  filter(behavior %in% c("social distancing")) %>%
  filter(!is.na(val)) %>%
  group_by(SID, message, behavior, message_text) %>%
  summarize(mean_sub = round(mean(val, na.rm = TRUE), 2)) %>%
  group_by(message, message_text) %>%
  summarize(n = n(),
            mean = round(mean(mean_sub, na.rm = TRUE), 2),
            sd = round(sd(mean_sub, na.rm = TRUE), 2)) %>%
  ungroup() %>%
  arrange(desc(mean)) %>%
  filter(!message %in% high_var$message) %>%
  slice(1:15)

final_messages %>%
  DT::datatable(filter = "top", rownames = FALSE)

summarize mean and SD across messages

final_messages %>%
  summarize(SD = sd(mean),
            mean = mean(mean)) %>%
  select(mean, SD) %>%
  kable(digits = 2) %>%
  kable_styling()

mean	SD
4.16	0.18