Background

In previous studies, we found that presenting some occupations (i.e., firefighters, psychiatrists, and underwater welders) as exposed to risk (vs bored) or helpful (vs unhelpful) had a significant effect on perceived heroism. In this study, we try to use a similar approach, but adding heroism components (i.e., hero imagery and captions) in an attempt to validate a manipulation of heroism for nurses, soldiers, and underwater welders.

We are manipulating the framing of an occupation as either heroic (i.e., a drawing of the workers wearing a cape, captionned “Military heroes”, or “Healthcare heroes”, or “Underwater heroes”, associated with a text describing the daily life of the workers as exposed to risk and helpful - see project webpage).

Hypotheses

H1: Occupations framed as heroic will be perceived as more heroic
H2: Occupations framed as heroic will be perceived as more helpful
H3: Occupations framed as heroic will be perceived as more exposed to risk

In addition, we will explore - Hbonus: The effect of the manipulation on perceived heroism will be significantly larger than the effect of the manipulation on a) perceived victim status, b) perceived villain status, and c) attitude towards the group

Procedure

After reading the consent form and confirming participation, participants entered their Prolific ID and completed a commitment check (e.g., “I commit to answering honestly and paying attention throughout this study”). They were then randomly assigned to one of six experimental vignette conditions in a 2×3 between-participants design: Heroism (No heroism vs Heroism) × Occupation (Healthcare workers vs Soldiers vs Underwater welders).

Each participant viewed a vignette describing the target occupation. The text emphasised risk (vs boredom) and helpfulness (vs no helpfulness) of workers - next to the text, a drawing showed the workers in a neutral manner or an heroic manner (see Stanley & Kay, 2024 for the healthcare workers condition - we adapted their image to target welders and soldiers).

Participants then completed a comprehension check to ensure they had understood the vignette. They were given two chances to answer correctly. Those who failed both attempts were redirected to a page instructing them to return the survey, in line with Prolific’s policy. Participants who passed the comprehension check proceeded to the main measures.

Participants rated the extent to which the targeted workers were perceived as heroes, as victims, and as villains, each on a 7-point Likert scale (“Completely disagree” to “Completely agree”). They then completed two manipulation checks, rating the extent to which they perceived the target occupation as (1) exposed to risk and (2) helpful, both on 7-point Likert scales (“Completely disagree” to “Completely agree”).

To control for baseline occupational attitudes, participants rated their general attitude toward targeted workers on a 7-point scale (“Very negative” to “Very positive”). This variable was used as a covariate in the main analyses.

Finally, participants completed a short demographic questionnaire (i.e., age, gender, and whether they were, or used to be, one of the target workers) and a credibility check, indicating how believable they found the vignette (“1 – Very unbelievable” to “7 – Very believable”).

The survey concluded with a debrief outlining the purpose of the study and sharing some real figures regarding the target occupation. After reading the consent form and confirming participation, participants entered their Prolific ID and completed a commitment check (e.g., “I commit to answering honestly and paying attention throughout this study”). They were then randomly assigned to one of six experimental vignette conditions in a 2×3 between-participants design: Heroism (No heroism vs Heroism) × Occupation (Healthcare workers vs Soldiers vs Underwater welders).

They then completed two manipulation checks, rating the extent to which they perceived the target occupation as (1) exposed to risk and (2) helpful, both on 7-point Likert scales (“Completely disagree” to “Completely agree”).

The survey concluded with a debrief outlining the purpose of the study and sharing some real figures regarding the target occupation.

H1-H3 Analyses

Relevant Variables

Dependent variables: we used raw scores as predicted outcomes

Independent variables: Heroism manipulation was dummy coded (-0.5 for non-heroic condition, +0.5 for heroic condition).

Covariate: Occupation type (factor, 3 levels) was coded using sum-to-zero contrasts and used as a covariate. Attitude was standardised.

Statistical Technique

A model comparison approach was used to assess our main hypotheses and qualify the part of variance explained by general attitude (i.e., Halo effect). We performed independent OLS regression models predicting each of our target outcomes (i.e., hero status, perceived exposure to risk, perceived helpfulness) using Heroism framing manipulation and target occupation as predictors.

We established four models assessing the effect of our manipulations while accounting for possible interactions with occupation types and possible halo effects (see subsection Variable roles for details on each model).

Model 1 (Heroism effect across occupations): Target construct (hero status, perceived exposure to risk, perceived helpfulness): predicted variable Occupation: covariate Heroic framing manipulation: Main predictor > Model: Target outcome ~ Occupation + Heroic framing

Model 2 (Heroism within occupations): Target construct (hero status, perceived exposure to risk, perceived helpfulness): predicted variable Occupation: Main predictor and moderator Heroic framing manipulation: Main predictor > Model: Target outcome ~ Heroic Framing + Occupation + Heroic Framing:Occupation

Model 3 (Heroism effect across occupations and Halo effect): Target construct (hero status, perceived exposure to risk, perceived helpfulness): predicted variable Occupation: covariate Attitude: covariate Heroic framing manipulation: Main predictor > Model: Target outcome ~ Occupation + Attitude + Heroic framing

Model 4 (Heroism within occupations and Halo effect): Target construct (hero status, perceived exposure to risk, perceived helpfulness): predicted variable Occupation: Main predictor and moderator Attitude: covariate Heroic framing manipulation: Main predictor > Model: Target outcome ~ Heroic framing + Occupation + Attitude + Heroic framing:Occupation

Bonus hypotheses: divergent validity analyses

We wanted to evaluate to what extent the effect of the manipulation influenced heroism ratings vs victim, villain, and attitude ratings. To do so, we used mixed regression models using scale type as a within-participant predictor of scores.

Relevant Variables

To test these hypotheses, we reverse-coded the scores obtained on the villain single item. We then standardised all scores, before wrangling the data into a long-format with scores in one column, and the scale type into another column.

We used scale type as a four-level predictor (Heroism, Villain, Victim, Attitude) to assess its interaction with the Occupation framing condition on the score.

As such, Scale type was a within-participant variable, with the Heroism single item scale used as a reference level.

Unique participant identifier (generated by Qualtrics, and thus completely anonymised) was used as a random intercept in the mixed model to account for the nested structure of scale type.

Dependent variables: standardised scores

Independent variables: Heroism manipulation was dummy coded (-0.5 for non-heroic condition, +0.5 for heroic condition); Scale type used a treatment contrast with Heroism scale as a reference level.

Covariate: Occupation type (factor, 3 levels) was coded using sum-to-zero contrasts and used as a covariate.

Statistical Technique

We performed mixed regression models (using lmer) predicting scores using Heroism framing manipulation, scale type and target occupation as predictors, as well as their interaction. Unique anonymous participant ID was used as a random intercept in the model.

We tested planned contrasts:

1. the effect of heroic framing in the hero scale condition vs the effect of heroic framing in the victim scale condition;
1. the effect of heroic framing in the hero scale condition vs the effect of heroic framing in the villain scale condition,
1. the effect of heroic framing in the hero scale condition vs the effect of heroic framing in the attitude scale condition

As before, we established two models assessing the effect of our manipulations and its interactions with the scale types while accounting for possible interactions with occupation types (see subsection Variable roles for details on each model).

Variable Roles

Model 1 (Heroism effect vs other effects across all occupations): Participant: random intercept Average score: predicted variable Occupation: covariate Heroic framing manipulation: Main predictor and moderator Scale type (Heroism, villain, victim, and attitude): Main predictor and moderator > Model: Score ~ Occupation + Heroic framing x Scale type + (1|participant)

Model 2 (Heroism effect vs other effects within occupations): Participant: random intercept Average score: predicted variable Occupation: Main predictor and moderator Heroic framing manipulation: Main predictor and moderator Scale type (Heroism, villain, victim, and attitude): Main predictor and moderator > Model: Target outcome ~ Heroic Framing x Scale type x Occupation + (1|participant)

In Model 2: Regardless of the presence of any significant three-way interaction term in model 2, we decomposed the interaction to assess the comparison between the effect of framing on heroism vs the effect of framing on other measures (i.e., 3 pairwise comparisons: Hero scale vs Victim scale, Hero scale vs Villain scale, Hero scale vs Attitude scale) within each occupation for exploratory purposes (so a total of 3 x 3 = 9 effects were looked at).

Results

Overall, the results supported the main predictions: occupations framed as heroic were perceived as more heroic, more helpful, and more exposed to risk. The exploratory analyses further showed that the manipulation had a stronger effect on perceived heroism than on perceived victim status and villain status, but not significantly more than on attitudes toward the group. Decompositions by occupation qualified this pattern: the predicted effects were consistently supported among welders, partially supported among soldiers for perceived helpfulness, and not supported among nurses. Thus, the heroic framing manipulation was effective overall, but its effects were primarily driven by responses to welders rather than applying uniformly across occupations.

library(knitr)
library(kableExtra)

hypothesis_table <- data.frame(
  Hypothesis = c(
    "H1",
    "H2",
    "H3",
    "Exploratory H-a",
    "Exploratory H-b",
    "Exploratory H-c"
  ),
  
  Prediction = c(
    "Occupations framed as heroic will be perceived as more heroic.",
    "Occupations framed as heroic will be perceived as more helpful.",
    "Occupations framed as heroic will be perceived as more exposed to risk.",
    "The effect of the manipulation on perceived heroism will be larger than its effect on perceived victim status.",
    "The effect of the manipulation on perceived heroism will be larger than its effect on perceived villain status.",
    "The effect of the manipulation on perceived heroism will be larger than its effect on attitudes toward the group."
  ),
  
  Outcome = c(
    "Supported",
    "Supported",
    "Supported",
    "Supported",
    "Supported",
    "Not supported"
  ),
  
  stringsAsFactors = FALSE
)

hypothesis_table$Outcome_Formatted <- ifelse(
  hypothesis_table$Outcome == "Supported",
  cell_spec("Supported", color = "white", background = "#2E7D32", bold = TRUE),
  cell_spec("Not supported", color = "white", background = "#B71C1C", bold = TRUE)
)

hypothesis_table_final <- hypothesis_table[, c(
  "Hypothesis",
  "Prediction",
  "Outcome_Formatted"
)]

names(hypothesis_table_final) <- c(
  "Hypothesis",
  "Prediction",
  "Outcome"
)

table_object <- kable(
  hypothesis_table_final,
  format = "html",
  escape = FALSE,
  align = c("l", "l", "c"),
  caption = "Summary of hypotheses and support"
)

table_object <- kable_styling(
  table_object,
  full_width = FALSE,
  bootstrap_options = c("striped", "hover", "condensed", "responsive"),
  position = "center",
  font_size = 14
)

table_object <- column_spec(
  table_object,
  column = 1,
  bold = TRUE,
  width = "11em"
)

table_object <- column_spec(
  table_object,
  column = 2,
  width = "42em"
)

table_object <- column_spec(
  table_object,
  column = 3,
  width = "11em"
)

table_object

Summary of hypotheses and support
Hypothesis	Prediction	Outcome
H1	Occupations framed as heroic will be perceived as more heroic.	Supported
H2	Occupations framed as heroic will be perceived as more helpful.	Supported
H3	Occupations framed as heroic will be perceived as more exposed to risk.	Supported
Exploratory H-a	The effect of the manipulation on perceived heroism will be larger than its effect on perceived victim status.	Supported
Exploratory H-b	The effect of the manipulation on perceived heroism will be larger than its effect on perceived villain status.	Supported
Exploratory H-c	The effect of the manipulation on perceived heroism will be larger than its effect on attitudes toward the group.	Not supported

decomposition_table <- data.frame(
  Occupation = c(
    "Welders",
    "Soldiers",
    "Nurses"
  ),
  
  Heroism_H1 = c(
    "Supported",
    "Not supported",
    "Not supported"
  ),
  
  Helpfulness_H2 = c(
    "Supported",
    "Supported",
    "Not supported"
  ),
  
  Risk_Exposure_H3 = c(
    "Supported",
    "Not supported",
    "Not supported"
  ),
  
  stringsAsFactors = FALSE
)

format_result <- function(result) {
  
  if (result == "Supported") {
    formatted_result <- cell_spec(
      "Supported",
      color = "white",
      background = "#2E7D32",
      bold = TRUE
    )
  } else {
    formatted_result <- cell_spec(
      "Not supported",
      color = "white",
      background = "#B71C1C",
      bold = TRUE
    )
  }
  
  return(formatted_result)
}

decomposition_table$Heroism_H1_Formatted <- sapply(
  decomposition_table$Heroism_H1,
  format_result
)

decomposition_table$Helpfulness_H2_Formatted <- sapply(
  decomposition_table$Helpfulness_H2,
  format_result
)

decomposition_table$Risk_Exposure_H3_Formatted <- sapply(
  decomposition_table$Risk_Exposure_H3,
  format_result
)

decomposition_table_final <- decomposition_table[, c(
  "Occupation",
  "Heroism_H1_Formatted",
  "Helpfulness_H2_Formatted",
  "Risk_Exposure_H3_Formatted"
)]

names(decomposition_table_final) <- c(
  "Occupation",
  "Heroism",
  "Helpfulness",
  "Risk exposure"
)

table_object <- kable(
  decomposition_table_final,
  format = "html",
  escape = FALSE,
  align = c("l", "c", "c", "c"),
  caption = "Decomposition of manipulation effects within occupations"
)

table_object <- kable_styling(
  table_object,
  full_width = FALSE,
  bootstrap_options = c("striped", "hover", "condensed", "responsive"),
  position = "center",
  font_size = 14
)

table_object <- column_spec(
  table_object,
  column = 1,
  bold = TRUE,
  width = "10em"
)

table_object <- column_spec(
  table_object,
  column = 2:4,
  width = "11em"
)

table_object

Decomposition of manipulation effects within occupations
Occupation	Heroism	Helpfulness	Risk exposure
Welders	Supported	Supported	Supported
Soldiers	Not supported	Supported	Not supported
Nurses	Not supported	Not supported	Not supported

Data analysis details

R codes can be displayed by clicking Show.

Preparing environment

Loading packages: tidyverse is an obvious must load, then emmeans for decomposing interactions, lme4 for H7 which requires mixed modelling. I use lmerTest to get some p-values for lmer models.

if(!require("dplyr")) install.packages("dplyr")
if(!require("tidyr")) install.packages("tidyr")
if(!require("emmeans")) install.packages("emmeans")
if(!require("lme4")) install.packages("lme4")
if(!require("lmerTest")) install.packages("lmerTest")
if(!require("ggplot2")) install.packages("ggplot2")

My environment:

sessionInfo()

## R version 4.5.1 (2025-06-13)
## Platform: aarch64-apple-darwin20
## Running under: macOS Sonoma 14.7.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Europe/London
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] ggplot2_4.0.0    lmerTest_3.1-3   lme4_2.0-6       Matrix_1.7-3    
## [5] emmeans_2.0.4    tidyr_1.3.1      dplyr_1.2.1      kableExtra_1.4.0
## [9] knitr_1.50      
## 
## loaded via a namespace (and not attached):
##  [1] sandwich_3.1-1      sass_0.4.10         generics_0.1.4     
##  [4] xml2_1.6.0          stringi_1.8.9       lattice_0.22-7     
##  [7] digest_0.6.37       magrittr_2.0.5      evaluate_1.0.5     
## [10] grid_4.5.1          estimability_1.5.1  RColorBrewer_1.1-3 
## [13] mvtnorm_1.3-3       fastmap_1.2.0       jsonlite_2.0.0     
## [16] survival_3.8-3      multcomp_1.4-28     purrr_1.1.0        
## [19] viridisLite_0.4.2   scales_1.4.0        TH.data_1.1-4      
## [22] numDeriv_2016.8-1.1 codetools_0.2-20    textshaping_1.0.3  
## [25] jquerylib_0.1.4     reformulas_0.4.4    Rdpack_2.6.4       
## [28] cli_3.6.6           rlang_1.3.0         rbibutils_2.3      
## [31] splines_4.5.1       withr_3.0.3         cachem_1.1.0       
## [34] yaml_2.3.12         tools_4.5.1         nloptr_2.2.1       
## [37] coda_0.19-4.1       minqa_1.2.8         boot_1.3-31        
## [40] vctrs_0.7.3         R6_2.6.1            zoo_1.8-14         
## [43] lifecycle_1.0.5     stringr_1.5.2       MASS_7.3-65        
## [46] pkgconfig_2.0.3     gtable_0.3.6        pillar_1.11.1      
## [49] bslib_0.9.0         Rcpp_1.1.2          glue_1.8.1         
## [52] systemfonts_1.2.3   xfun_0.53           tibble_3.3.1       
## [55] tidyselect_1.2.1    rstudioapi_0.17.1   farver_2.1.2       
## [58] xtable_1.8-4        nlme_3.1-168        htmltools_0.5.8.1  
## [61] rmarkdown_2.29      svglite_2.2.1       compiler_4.5.1     
## [64] S7_0.2.0

Import data:

We anonymise the data:

DF <- read.csv("~/Downloads/Pilot+Study+September+2026_August+28,+2026_09.16.csv", comment.char="#")
DF <- subset(DF, DF$Age != "") # Remove all participants who did not complete survey
DF <- DF[-c(1:2), ] # remove useless sub-headers

# Anonymise:
DF$IPAddress <- "XXXXXXX"
DF$prolID <- "XXXXXXX"
DF$LocationLatitude <- "XXXXXXX"
DF$LocationLongitude <- "XXXXXXX"
DF$PROLIFIC_PID <- "XXXXXXX"

DF <- subset(DF, DF$Wave == "FullSample") # Exclude participants from 'crash test' (n = 30 testing the survey)

# Save the anonymous data:

write.csv(DF, "DATA_Anon_PilotSeptember2026.csv", row.names = F)

Data wrangling

We organise the data, and we display some sanity checks - and our contrasts.

DF <- read.csv("DATA_Anon_PilotSeptember2026.csv", comment.char="#") # Load anonymised data

Demographics <- DF[, c(37:44,70)]
DF <- DF[, c(9, 26:36, 45:55, 57:67, 70)]
#DF <- DF[, c(23, 25:60, 65:180, 207)]

Nurse <- subset(DF, startsWith(Condition, "N_"))
Nurse <- Nurse[, colSums(!is.na(Nurse) & Nurse != "") > 0, drop = FALSE]

Weld <- subset(DF, startsWith(Condition, "W_"))
Weld <- Weld[, colSums(!is.na(Weld) & Weld != "") > 0, drop = FALSE]

Soldier <- subset(DF, startsWith(Condition, "S_"))
Soldier <- Soldier[, colSums(!is.na(Soldier) & Soldier != "") > 0, drop = FALSE]

# 1) Use Nurse as the "template" for column names
template_names <- names(Nurse)  # 47 names

# 2) Helper that renames a data frame by POSITION to match Weld
rename_like_weld <- function(df, template = template_names) {
  # Sanity checks to avoid silent disasters
  if (ncol(df) != length(template)) {
    stop("Column count mismatch: this df has ", ncol(df),
         " columns but template has ", length(template), ".")
  }
  # Copy names by position
  names(df) <- template
  df
}

# 3) Put all your data frames into a named list
dfs <- list(
  Weld    = Weld,
  Nurse   = Nurse,
  Soldier = Soldier
)

# 4) Harmonise names, then stack vertically with a source column
stacked <- dfs %>%
  purrr::map(rename_like_weld) %>%          # harmonise titles to Weld's names
  bind_rows(.id = "dataset")         # adds the dataset name as the first column

# Result: 48 columns total (1 "dataset" + 47 harmonised vars)
# and nrow(stacked) == sum(nrow(.) for each df)


table(stacked$Manip_Check_Nu_H, stacked$Condition)

##    
##     N_H N_NH S_H S_NH W_H W_NH
##   1  99    0  94    0  98    0

table(stacked$Manip_Check_Nu_NH, stacked$Condition)

##    
##     N_H N_NH S_H S_NH W_H W_NH
##   1   0   97   0   95   0   98

stacked$Hero_Nu_H_1    <- as.numeric(stacked$Hero_Nu_H_1)
stacked$Hero_Nu_H_2    <- as.numeric(stacked$Hero_Nu_H_2)
stacked$Hero_Nu_H_3    <- as.numeric(stacked$Hero_Nu_H_3)
stacked$Hero_Nu_H_4    <- as.numeric(stacked$Hero_Nu_H_4)
stacked$Hero_Nu_H_5    <- as.numeric(stacked$Hero_Nu_H_5)
stacked$Att_N_1_1    <- as.numeric(stacked$Att_N_1_1)
stacked$Att_N_2_1   <- as.numeric(stacked$Att_N_2_1)
stacked$Att_N_2_2    <- as.numeric(stacked$Att_N_2_2)
stacked$Att_N_2_3    <- as.numeric(stacked$Att_N_2_3)

# One attitude item is reversed:

stacked$Att_N_2_3 <- 6 - stacked$Att_N_2_3

# Later, I'll also reverse the villain item because we need it in the same direction as the others for H7

# Compute mean attitude:
stacked$Attitude <- rowMeans(stacked[, c(10:13)])

stacked$Attitude_z <- scale(stacked$Attitude)

stacked$JobCond <- ifelse(startsWith(stacked$Condition, "S_"), "Soldier", 
                          ifelse(startsWith(stacked$Condition, "W_"), "Welder", "Nurse"))

stacked$FrameCond <- ifelse(endsWith(stacked$Condition, "_H"), "Hero", "NonHero")

table(stacked$FrameCond, stacked$Condition)

##          
##           N_H N_NH S_H S_NH W_H W_NH
##   Hero     99    0  94    0  98    0
##   NonHero   0   97   0   95   0   98

table(stacked$JobCond, stacked$Condition)

##          
##           N_H N_NH S_H S_NH W_H W_NH
##   Nurse    99   97   0    0   0    0
##   Soldier   0    0  94   95   0    0
##   Welder    0    0   0    0  98   98

stacked$JobCond <- as.factor(stacked$JobCond)
stacked$FrameCond <- as.factor(stacked$FrameCond)
# COntrasts:
contrasts(stacked$JobCond) <- contr.sum(nlevels(stacked$JobCond))
contrasts(stacked$JobCond)

##         [,1] [,2]
## Nurse      1    0
## Soldier    0    1
## Welder    -1   -1

stacked$Frame <- stacked$FrameCond
stacked$FrameCond <- ifelse(stacked$FrameCond == "Hero", -0.5, 0.5)

Demographics

paste0("A total of ", nrow(stacked), " participants were included in the survey")

## [1] "A total of 581 participants were included in the survey"

cat("Thet were distributed in 3 (occupation) x 2 (heroic vs non-heroic) conditions:")

## Thet were distributed in 3 (occupation) x 2 (heroic vs non-heroic) conditions:

table(stacked$JobCond, stacked$Frame)

##          
##           Hero NonHero
##   Nurse     99      97
##   Soldier   94      95
##   Welder    98      98

paste0("mean age = ", round(mean(Demographics$Age), digits = 2), "and a SD = ", round(sd(Demographics$Age), digits = 2))

## [1] "mean age = 45.77and a SD = 15.27"

## Gender

Demographics$Gender_b <- ifelse(Demographics$Gender == 1, "Male",
                              ifelse(Demographics$Gender == 2, "Female",
                                     ifelse(Demographics$Gender == 3, "Prefer not to say", "Other")))

Demographics %>% group_by(Gender_b) %>% summarise(N=n()) %>%
  ggplot(aes(x=Gender_b,y=N,fill=Gender_b))+
  geom_bar(stat = 'identity',color='black')+
  scale_y_continuous(labels = scales::comma_format(accuracy = 2))+
  geom_text(aes(label=N),vjust=-0.25,fontface='bold')+
  theme_bw()+
  theme(axis.text = element_text(color='black',face='bold'),
        axis.title = element_text(color='black',face='bold'),
        legend.text = element_text(color='black',face='bold'),
        legend.title = element_text(color='black',face='bold')) +
  ggtitle("Gender distribution")

#  ## Occupations
#  #colnames(Set)






Demographics$JOB <- ifelse(Demographics$Job_1 == 1 & is.na(Demographics$Job_2) & is.na(Demographics$Job_3)  , "Soldier",
                           ifelse(Demographics$Job_2 == 1 & is.na(Demographics$Job_1) & is.na(Demographics$Job_3)  , "Nurse", 
                                  ifelse(Demographics$Job_3 == 1 & is.na(Demographics$Job_2) & is.na(Demographics$Job_1)  , "Underwater welder",  "none")))

Demographics$JOB <- ifelse(is.na(Demographics$JOB), "none", Demographics$JOB)


  job_df <- as.data.frame(table(Demographics$JOB))
  colnames(job_df) <- c("Job", "Count")
#  
  ggplot(job_df, aes(x = Job, y = Count, fill = Job)) +
    geom_bar(stat = 'identity',color='black')+
    scale_y_continuous(labels = scales::comma_format(accuracy = 2))+
    geom_text(aes(label=Count),vjust=-0.25,fontface='bold')+
    theme_bw()+
    theme(axis.text = element_text(color='black',face='bold'),
          axis.title = element_text(color='black',face='bold'),
          legend.text = element_text(color='black',face='bold'),
          legend.title = element_text(color='black',face='bold')) +
    ggtitle("Job distribution ")

We asked participants to evaluate how believable our vignettes were. Importantly, none of them were deceptive: they described different activities included in the occupations.

hist(Demographics$Believe)

Overall, the vignettes were believable.

car::Anova(m<- lm(Believe ~ Condition, data = Demographics))

## Registered S3 method overwritten by 'car':
##   method           from
##   na.action.merMod lme4

paste0("Condition influenced the believability of our vignettes. Let's display the marginal means per condition:")

## [1] "Condition influenced the believability of our vignettes. Let's display the marginal means per condition:"

cont<-emmeans::emmeans(m, "Condition")

cont

##  Condition emmean    SE  df lower.CL upper.CL
##  N_H         5.81 0.143 575     5.53     6.09
##  N_NH        4.53 0.144 575     4.24     4.81
##  S_H         5.63 0.147 575     5.34     5.92
##  S_NH        5.07 0.146 575     4.79     5.36
##  W_H         5.66 0.144 575     5.38     5.95
##  W_NH        5.24 0.144 575     4.96     5.53
## 
## Confidence level used: 0.95

It seems the Non-heroic Nurse and Soldiers condition is the least believed. It is consistent with the idea that these workers are viewed as heroic and information running against this stereotype is not received as as credible as information consistent with the stereotype.

paste0("And now, let's dive into pairwise comparisons:")

## [1] "And now, let's dive into pairwise comparisons:"

pairs(cont)

##  contrast    estimate    SE  df t.ratio p.value
##  N_H - N_NH    1.2823 0.203 575   6.308 <0.0001
##  N_H - S_H     0.1804 0.205 575   0.881  0.9511
##  N_H - S_NH    0.7344 0.204 575   3.594  0.0047
##  N_H - W_H     0.1448 0.203 575   0.714  0.9802
##  N_H - W_NH    0.5632 0.203 575   2.778  0.0625
##  N_NH - S_H   -1.1019 0.206 575  -5.351 <0.0001
##  N_NH - S_NH  -0.5479 0.205 575  -2.668  0.0834
##  N_NH - W_H   -1.1375 0.204 575  -5.582 <0.0001
##  N_NH - W_NH  -0.7191 0.204 575  -3.529  0.0060
##  S_H - S_NH    0.5540 0.207 575   2.676  0.0816
##  S_H - W_H    -0.0356 0.205 575  -0.173  1.0000
##  S_H - W_NH    0.3828 0.205 575   1.863  0.4260
##  S_NH - W_H   -0.5896 0.205 575  -2.878  0.0475
##  S_NH - W_NH  -0.1712 0.205 575  -0.836  0.9608
##  W_H - W_NH    0.4184 0.203 575   2.058  0.3109
## 
## P value adjustment: tukey method for comparing a family of 6 estimates

Yep, the Non-heroic nurse is the ‘problematic’ one - it is significantly less believed than: Heroic nurse, Non heroic Soldiers, Heroic soldiers, Heroic welders, and non heroic welders.

Aside from this, only the Non heroic soldier vs Nonheroic welder reached significance (p = .048).

Descriptive statistics

Heroism

paste0("Mean score of heroism is M = ", round(mean(stacked$Hero_Nu_H_1), digits = 2), ", and SD = ", round(sd(stacked$Hero_Nu_H_1), digits = 2))

## [1] "Mean score of heroism is M = 5.3, and SD = 1.51"

stacked$FrameCond_Label <- ifelse(
  stacked$FrameCond == -0.5,
  "Heroic frame",
  "Non-heroic frame"
)

facet_stats <- unique(stacked[, c("FrameCond_Label", "JobCond")])
facet_stats$Mean <- NA
facet_stats$SD <- NA
facet_stats$N <- NA

for (row_number in 1:nrow(facet_stats)) {
  
  current_frame <- facet_stats$FrameCond_Label[row_number]
  current_job <- facet_stats$JobCond[row_number]
  
  current_values <- stacked$Hero_Nu_H_1[
    stacked$FrameCond_Label == current_frame &
      stacked$JobCond == current_job
  ]
  
  facet_stats$Mean[row_number] <- mean(current_values, na.rm = TRUE)
  facet_stats$SD[row_number] <- sd(current_values, na.rm = TRUE)
  facet_stats$N[row_number] <- sum(!is.na(current_values))
}

facet_stats$Label <- paste0(
  "M = ", round(facet_stats$Mean, 2),
  "\nSD = ", round(facet_stats$SD, 2),
  "\nn = ", facet_stats$N
)


ggplot(
  stacked,
  aes(x = Hero_Nu_H_1)
) +
  geom_histogram(
    binwidth = 1,
    boundary = 0.5,
    color = "black",
    fill = "orange"
  ) +
  geom_label(
    data = facet_stats,
    aes(
      x = 4,
      y = Inf,
      label = Label
    ),
    inherit.aes = FALSE,
    hjust = 1.05,
    vjust = 1.10,
    size = 3.5
  ) +
  facet_grid(
    FrameCond_Label ~ JobCond
  ) +
  scale_x_continuous(
    breaks = 1:7
  ) +
  labs(
    x = "Perceived Heroism",
    y = "Count"
  ) +
  theme_classic(base_size = 14)

for (row_number in 1:nrow(facet_stats)) {
  
  current_frame <- facet_stats$FrameCond_Label[row_number]
  current_job <- facet_stats$JobCond[row_number]
  
  current_values <- stacked$Hero_Nu_H_2[
    stacked$FrameCond_Label == current_frame &
      stacked$JobCond == current_job
  ]
  
  facet_stats$Mean[row_number] <- mean(current_values, na.rm = TRUE)
  facet_stats$SD[row_number] <- sd(current_values, na.rm = TRUE)
  facet_stats$N[row_number] <- sum(!is.na(current_values))
}

facet_stats$Label <- paste0(
  "M = ", round(facet_stats$Mean, 2),
  "\nSD = ", round(facet_stats$SD, 2),
  "\nn = ", facet_stats$N
)




ggplot(
  stacked,
  aes(x = Hero_Nu_H_2)
) +
  geom_histogram(
    binwidth = 1,
    boundary = 0.5,
    color = "black",
    fill = "orange"
  ) +
    geom_label(
    data = facet_stats,
    aes(
      x = 4,
      y = Inf,
      label = Label
    ),
    inherit.aes = FALSE,
    hjust = 1.05,
    vjust = 1.10,
    size = 3.5
  ) +
  facet_grid(
    FrameCond_Label ~ JobCond
  ) +
  scale_x_continuous(
    breaks = 1:7
  ) +
  labs(
    x = "Perceived Victim",
    y = "Count"
  ) +
  theme_classic(base_size = 14)

for (row_number in 1:nrow(facet_stats)) {
  
  current_frame <- facet_stats$FrameCond_Label[row_number]
  current_job <- facet_stats$JobCond[row_number]
  
  current_values <- stacked$Hero_Nu_H_3[
    stacked$FrameCond_Label == current_frame &
      stacked$JobCond == current_job
  ]
  
  facet_stats$Mean[row_number] <- mean(current_values, na.rm = TRUE)
  facet_stats$SD[row_number] <- sd(current_values, na.rm = TRUE)
  facet_stats$N[row_number] <- sum(!is.na(current_values))
}

facet_stats$Label <- paste0(
  "M = ", round(facet_stats$Mean, 2),
  "\nSD = ", round(facet_stats$SD, 2),
  "\nn = ", facet_stats$N
)

ggplot(
  stacked,
  aes(x = Hero_Nu_H_3)
) +
  geom_histogram(
    binwidth = 1,
    boundary = 0.5,
    color = "black",
    fill = "orange"
  ) +
    geom_label(
    data = facet_stats,
    aes(
      x = 4,
      y = Inf,
      label = Label
    ),
    inherit.aes = FALSE,
    hjust = 1.05,
    vjust = 1.10,
    size = 3.5
  ) +
  facet_grid(
    FrameCond_Label ~ JobCond
  ) +
  scale_x_continuous(
    breaks = 1:7
  ) +
  labs(
    x = "Perceived Villains",
    y = "Count"
  ) +
  theme_classic(base_size = 14)

for (row_number in 1:nrow(facet_stats)) {
  
  current_frame <- facet_stats$FrameCond_Label[row_number]
  current_job <- facet_stats$JobCond[row_number]
  
  current_values <- stacked$Hero_Nu_H_4[
    stacked$FrameCond_Label == current_frame &
      stacked$JobCond == current_job
  ]
  
  facet_stats$Mean[row_number] <- mean(current_values, na.rm = TRUE)
  facet_stats$SD[row_number] <- sd(current_values, na.rm = TRUE)
  facet_stats$N[row_number] <- sum(!is.na(current_values))
}

facet_stats$Label <- paste0(
  "M = ", round(facet_stats$Mean, 2),
  "\nSD = ", round(facet_stats$SD, 2),
  "\nn = ", facet_stats$N
)

ggplot(
  stacked,
  aes(x = Hero_Nu_H_4)
) +
  geom_histogram(
    binwidth = 1,
    boundary = 0.5,
    color = "black",
    fill = "orange"
  ) +
    geom_label(
    data = facet_stats,
    aes(
      x = 4,
      y = Inf,
      label = Label
    ),
    inherit.aes = FALSE,
    hjust = 1.05,
    vjust = 1.10,
    size = 3.5
  ) +
  facet_grid(
    FrameCond_Label ~ JobCond
  ) +
  scale_x_continuous(
    breaks = 1:7
  ) +
  labs(
    x = "Perceived Exposure to danger",
    y = "Count"
  ) +
  theme_classic(base_size = 14)

for (row_number in 1:nrow(facet_stats)) {
  
  current_frame <- facet_stats$FrameCond_Label[row_number]
  current_job <- facet_stats$JobCond[row_number]
  
  current_values <- stacked$Hero_Nu_H_5[
    stacked$FrameCond_Label == current_frame &
      stacked$JobCond == current_job
  ]
  
  facet_stats$Mean[row_number] <- mean(current_values, na.rm = TRUE)
  facet_stats$SD[row_number] <- sd(current_values, na.rm = TRUE)
  facet_stats$N[row_number] <- sum(!is.na(current_values))
}

facet_stats$Label <- paste0(
  "M = ", round(facet_stats$Mean, 2),
  "\nSD = ", round(facet_stats$SD, 2),
  "\nn = ", facet_stats$N
)

ggplot(
  stacked,
  aes(x = Hero_Nu_H_5)
) +
  geom_histogram(
    binwidth = 1,
    boundary = 0.5,
    color = "black",
    fill = "orange"
  ) +
    geom_label(
    data = facet_stats,
    aes(
      x = 4,
      y = Inf,
      label = Label
    ),
    inherit.aes = FALSE,
    hjust = 1.05,
    vjust = 1.10,
    size = 3.5
  ) +
  facet_grid(
    FrameCond_Label ~ JobCond
  ) +
  scale_x_continuous(
    breaks = 1:7
  ) +
  labs(
    x = "Perceived Helpfulness",
    y = "Count"
  ) +
  theme_classic(base_size = 14)

for (row_number in 1:nrow(facet_stats)) {
  
  current_frame <- facet_stats$FrameCond_Label[row_number]
  current_job <- facet_stats$JobCond[row_number]
  
  current_values <- stacked$Attitude[
    stacked$FrameCond_Label == current_frame &
      stacked$JobCond == current_job
  ]
  
  facet_stats$Mean[row_number] <- mean(current_values, na.rm = TRUE)
  facet_stats$SD[row_number] <- sd(current_values, na.rm = TRUE)
  facet_stats$N[row_number] <- sum(!is.na(current_values))
}

facet_stats$Label <- paste0(
  "M = ", round(facet_stats$Mean, 2),
  "\nSD = ", round(facet_stats$SD, 2),
  "\nn = ", facet_stats$N
)

ggplot(
  stacked,
  aes(x = Attitude)
) +
  geom_histogram(
    binwidth = 1,
    boundary = 0.5,
    color = "black",
    fill = "orange"
  ) +
    geom_label(
    data = facet_stats,
    aes(
      x = 4,
      y = Inf,
      label = Label
    ),
    inherit.aes = FALSE,
    hjust = 1.05,
    vjust = 1.10,
    size = 3.5
  ) +
  facet_grid(
    FrameCond_Label ~ JobCond
  ) +
  scale_x_continuous(
    breaks = 1:7
  ) +
  labs(
    x = "Attitude",
    y = "Count"
  ) +
  theme_classic(base_size = 14)

Testing H1 - H3

Model 1 | Model: Target outcome ~ Occupation + Heroic framing

HEROISM

cat("HEROISM:")

## HEROISM:

car::Anova(m1<-lm(stacked$Hero_Nu_H_1 ~ stacked$JobCond + stacked$FrameCond))

effectsize::eta_squared(m1, partial = T, alternative = "two.sided")

There is an effect of framing on perceived heroism across conditions - t = -2.98, p = .003, eta2p = .01 —- it is a small effect.

DANGER

cat("DANGER:")

## DANGER:

car::Anova(m1b<-lm(stacked$Hero_Nu_H_4 ~ stacked$JobCond + stacked$FrameCond))

effectsize::eta_squared(m1b, partial = T, alternative = "two.sided")

There is an effect of framing on perceived heroism across conditions - t = -5.17, p < .001, eta2p = .044 —- it is a small-to-medium effect.

HELPFULNESS

cat("HELP:")

## HELP:

car::Anova(m1c<-lm(stacked$Hero_Nu_H_5 ~ stacked$JobCond + stacked$FrameCond))

effectsize::eta_squared(m1c, partial = T, alternative = "two.sided")

There is an effect of framing on perceived heroism across conditions - t = -4.85, p < .001, eta2p = .04 —- it is a small-to-medium effect.

Conclusions: H1 to H3 are verified - albeit with a smal effect for H1.

Model 2 | Model: Target outcome ~ Heroic Framing + Occupation + Heroic Framing:Occupation

HEROISM

cat("HEROISM:")

## HEROISM:

car::Anova(m2 <- lm(Hero_Nu_H_1 ~ JobCond*FrameCond, data = stacked))

effectsize::eta_squared(m2, partial = T, alternative = "two.sided")

DANGER

car::Anova(m2b <- lm(Hero_Nu_H_4 ~ JobCond*FrameCond, data = stacked))

effectsize::eta_squared(m2b, partial = T, alternative = "two.sided")

HELP

cat("HELP:")

## HELP:

car::Anova(m2c <- lm(Hero_Nu_H_5 ~ JobCond*FrameCond, data = stacked))

effectsize::eta_squared(m2c, partial = T, alternative = "two.sided")

Conclusion: conclusions from Model 1 hold true when adding occupation type as a moderator. Occupation does not moderate the effect of framing on heroism, nor the effect of framing on exposure to risk.

However, there is a significant, though small, interaction between occupation type and framing on helpfulness. Let’s get into this.

We decompose the interaction to assess the effect of heroic framing within each occupation:

NSet<-subset(stacked, stacked$JobCond == "Nurse")
SSet<-subset(stacked, stacked$JobCond == "Soldier")
WSet<-subset(stacked, stacked$JobCond == "Welder")

cat("HELP:")

## HELP:

cont<-emmeans::emmeans(m2c, "FrameCond", by = "JobCond")
pairs(cont)

## JobCond = Nurse:
##  contrast                       estimate    SE  df t.ratio p.value
##  (FrameCond-0.5) - FrameCond0.5    0.142 0.149 575   0.953  0.3408
## 
## JobCond = Soldier:
##  contrast                       estimate    SE  df t.ratio p.value
##  (FrameCond-0.5) - FrameCond0.5    0.305 0.152 575   2.013  0.0446
## 
## JobCond = Welder:
##  contrast                       estimate    SE  df t.ratio p.value
##  (FrameCond-0.5) - FrameCond0.5    0.816 0.149 575   5.484 <0.0001

cat("Cohen's d: Help in Nurses")

## Cohen's d: Help in Nurses

effectsize::cohens_d(NSet$Hero_Nu_H_5 ~ NSet$FrameCond)

cat("Cohen's d: Help in Soldiers")

## Cohen's d: Help in Soldiers

effectsize::cohens_d(SSet$Hero_Nu_H_5 ~ SSet$FrameCond)

cat("Cohen's d: Help in Welders")

## Cohen's d: Help in Welders

effectsize::cohens_d(WSet$Hero_Nu_H_5 ~ WSet$FrameCond)

The effect of framing is barely significant in the Soldier condition, t = 2.013, p = .044, d = 0.26.

The effect of framing is significant and large in the Welder condition, t = 5.48, p < .001, d = 0.70

Model 3 | Model: Target outcome ~ Occupation + Attitude + Heroic framing

HEROISM

cat("HEROISM:")

## HEROISM:

car::Anova(m3<-lm(stacked$Hero_Nu_H_1 ~ stacked$JobCond + stacked$FrameCond + stacked$Attitude_z))

effectsize::eta_squared(m3, partial = T, alternative = "two.sided")

Framing condition resists to the addition of attitude as a covariate. Both attitudes and occupations are obvious predictors of perceived heroism.

DANGER

cat("DANGER:")

## DANGER:

car::Anova(m3b<-lm(stacked$Hero_Nu_H_4 ~ stacked$JobCond + stacked$FrameCond + stacked$Attitude_z))

effectsize::eta_squared(m3b, partial = T, alternative = "two.sided")

Same conclusions for perceived exposure to danger -our effect remains sig. after controlling for attitude.

HELPFULNESS

cat("HELP:")

## HELP:

car::Anova(m3c<-lm(stacked$Hero_Nu_H_5 ~ stacked$JobCond + stacked$FrameCond + stacked$Attitude_z))

effectsize::eta_squared(m3c, partial = T, alternative = "two.sided")

Idem - effect of framing on perceived helpfulness remain significant after controlling for attitude.

Model 4 | Model: Target outcome ~ Heroic framing + Occupation + Attitude + Heroic framing:Occupation

HEROISM

cat("HEROISM:")

## HEROISM:

car::Anova(m4<-lm(Hero_Nu_H_1 ~ JobCond*FrameCond + Attitude_z, data = stacked))

No job interaction.

DANGER

cat("DANGER:")

## DANGER:

car::Anova(m4b<-lm(Hero_Nu_H_4 ~ JobCond*FrameCond + Attitude_z, data = stacked))

No job interaction.

HELPFULNESS

cat("HELP:")

## HELP:

car::Anova(m4c<-lm(Hero_Nu_H_5 ~ JobCond*FrameCond + Attitude_z, data = stacked))

Here, as in Model 2 - job target interacts with heroic framing in predicting perceived helpfulness (p = .001).

We decompose interactions:

cat("HELP:")

## HELP:

contc<-emmeans::emmeans(m4c, "FrameCond", by = "JobCond")
pairs(contc)

## JobCond = Nurse:
##  contrast                       estimate    SE  df t.ratio p.value
##  (FrameCond-0.5) - FrameCond0.5   0.0117 0.114 574   0.102  0.9185
## 
## JobCond = Soldier:
##  contrast                       estimate    SE  df t.ratio p.value
##  (FrameCond-0.5) - FrameCond0.5   0.3694 0.116 574   3.173  0.0016
## 
## JobCond = Welder:
##  contrast                       estimate    SE  df t.ratio p.value
##  (FrameCond-0.5) - FrameCond0.5   0.5930 0.115 574   5.165 <0.0001

The effect of framing did not work for nurses -but it significantly drove perceived helpfulness for soldiers and welders.

Summary tables

eta_heroism <- effectsize::eta_squared(
  m2,
  partial = TRUE,
  alternative = "two.sided"
)

eta_danger <- effectsize::eta_squared(
  m2b,
  partial = TRUE,
  alternative = "two.sided"
)

eta_help <- effectsize::eta_squared(
  m2c,
  partial = TRUE,
  alternative = "two.sided"
)

eta_table <- rbind(
  data.frame(Outcome = "Heroism", eta_heroism),
  data.frame(Outcome = "Danger", eta_danger),
  data.frame(Outcome = "Help", eta_help)
)

#eta_table


eta_display <- data.frame(
  Outcome = eta_table$Outcome,
  Effect = eta_table$Parameter,
  `Partial eta-squared` = sprintf(
    "%.3f",
    eta_table$Eta2_partial
  ),
  `95% CI` = sprintf(
    "[%.3f, %.3f]",
    eta_table$CI_low,
    eta_table$CI_high
  )
)

eta_display$Effect <- factor(
  eta_display$Effect,
  levels = c(
    "JobCond",
    "FrameCond",
    "JobCond:FrameCond"
  ),
  labels = c(
    "Job condition",
    "Frame condition",
    "Job × Frame"
  )
)

knitr::kable(
  eta_display,
  format = "html",
  escape = FALSE,
  align = c("l", "l", "c", "c"),
  col.names = c(
    "Outcome",
    "Effect",
    "Partial η²",
    "95% CI"
  ),
  caption = "Effect sizes for omnibus effects"
) |>
  kableExtra::kable_styling(
    bootstrap_options = c(
      "striped",
      "hover",
      "condensed"
    ),
    full_width = FALSE,
    position = "center"
  )

Effect sizes for omnibus effects
Outcome	Effect	Partial η²	95% CI
Heroism	Job condition	0.010	[0.000, 0.030]
Heroism	Frame condition	0.015	[0.002, 0.041]
Heroism	Job × Frame	0.006	[0.000, 0.022]
Danger	Job condition	0.108	[0.064, 0.156]
Danger	Frame condition	0.044	[0.017, 0.081]
Danger	Job × Frame	0.002	[0.000, 0.011]
Help	Job condition	0.100	[0.057, 0.147]
Help	Frame condition	0.040	[0.014, 0.076]
Help	Job × Frame	0.019	[0.002, 0.045]

d_heroism_nurse <- effectsize::cohens_d(
  Hero_Nu_H_1 ~ FrameCond,
  data = NSet
)

d_heroism_soldier <- effectsize::cohens_d(
  Hero_Nu_H_1 ~ FrameCond,
  data = SSet
)

d_heroism_welder <- effectsize::cohens_d(
  Hero_Nu_H_1 ~ FrameCond,
  data = WSet
)


d_danger_nurse <- effectsize::cohens_d(
  Hero_Nu_H_4 ~ FrameCond,
  data = NSet
)

d_danger_soldier <- effectsize::cohens_d(
  Hero_Nu_H_4 ~ FrameCond,
  data = SSet
)

d_danger_welder <- effectsize::cohens_d(
  Hero_Nu_H_4 ~ FrameCond,
  data = WSet
)


d_help_nurse <- effectsize::cohens_d(
  Hero_Nu_H_5 ~ FrameCond,
  data = NSet
)

d_help_soldier <- effectsize::cohens_d(
  Hero_Nu_H_5 ~ FrameCond,
  data = SSet
)

d_help_welder <- effectsize::cohens_d(
  Hero_Nu_H_5 ~ FrameCond,
  data = WSet
)


d_table <- rbind(
  data.frame(
    Outcome = "Heroism",
    Job = "Nurse",
    d_heroism_nurse
  ),
  data.frame(
    Outcome = "Heroism",
    Job = "Soldier",
    d_heroism_soldier
  ),
  data.frame(
    Outcome = "Heroism",
    Job = "Welder",
    d_heroism_welder
  ),

  data.frame(
    Outcome = "Danger",
    Job = "Nurse",
    d_danger_nurse
  ),
  data.frame(
    Outcome = "Danger",
    Job = "Soldier",
    d_danger_soldier
  ),
  data.frame(
    Outcome = "Danger",
    Job = "Welder",
    d_danger_welder
  ),

  data.frame(
    Outcome = "Help",
    Job = "Nurse",
    d_help_nurse
  ),
  data.frame(
    Outcome = "Help",
    Job = "Soldier",
    d_help_soldier
  ),
  data.frame(
    Outcome = "Help",
    Job = "Welder",
    d_help_welder
  )
)


d_display <- data.frame(
  Outcome = d_table$Outcome,
  Job = d_table$Job,
  `Cohen's d` = sprintf(
    "%.2f",
    d_table$Cohens_d
  ),
  `95% CI` = sprintf(
    "[%.2f, %.2f]",
    d_table$CI_low,
    d_table$CI_high
  )
)


knitr::kable(
  d_display,
  format = "html",
  align = c("l", "l", "c", "c"),
  col.names = c(
    "Outcome",
    "Job condition",
    "Cohen's d",
    "95% CI"
  ),
  caption = "Effect sizes for simple effects of frame condition"
) |>
  kableExtra::kable_styling(
    bootstrap_options = c(
      "striped",
      "hover",
      "condensed"
    ),
    full_width = FALSE,
    position = "center"
  )

Effect sizes for simple effects of frame condition
Outcome	Job condition	Cohen’s d	95% CI
Heroism	Nurse	0.18	[-0.10, 0.46]
Heroism	Soldier	0.10	[-0.19, 0.38]
Heroism	Welder	0.49	[0.20, 0.77]
Danger	Nurse	0.26	[-0.02, 0.54]
Danger	Soldier	0.49	[0.20, 0.77]
Danger	Welder	0.69	[0.40, 0.98]
Help	Nurse	0.20	[-0.08, 0.48]
Help	Soldier	0.26	[-0.03, 0.54]
Help	Welder	0.70	[0.41, 0.99]

Testing exploratory Divergent validity of manipulation

Now moving on to exploratory mixed models!

We need to pass the df into a long format: 1) reverse villain item (item 3) 2) scale all variables so they can be comparable 3) pass it to a long format

#1
stacked$Hero_Nu_H_3 <- 8 - stacked$Hero_Nu_H_3
#2
stacked$Hero_Nu_H_1    <- scale(stacked$Hero_Nu_H_1)
stacked$Hero_Nu_H_2    <- scale(stacked$Hero_Nu_H_2)
stacked$Hero_Nu_H_3    <- scale(stacked$Hero_Nu_H_3)

#3
stacked_long <- tidyr::pivot_longer(
  stacked,
  cols = c(Hero_Nu_H_1, Hero_Nu_H_2, Hero_Nu_H_3, Attitude_z),
  names_to = "ScaleType",
  values_to = "Score"
)


stacked_long$ScaleType <- as.factor(stacked_long$ScaleType)

stacked_long$ScaleType <- relevel(
  stacked_long$ScaleType,
  ref = "Hero_Nu_H_1"
)

cat("these are our contrasts for scale type -- Heroism (H_1) is our reference level")

## these are our contrasts for scale type -- Heroism (H_1) is our reference level

contrasts(stacked_long$ScaleType)

##             Attitude_z Hero_Nu_H_2 Hero_Nu_H_3
## Hero_Nu_H_1          0           0           0
## Attitude_z           1           0           0
## Hero_Nu_H_2          0           1           0
## Hero_Nu_H_3          0           0           1

Model1 | Model: Score ~ Occupation + Heroic framing*Scale type + (1|participant)

# Model1 | Model: Score ~ Occupation + Heroic framing*Scale type + (1|participant)
summary(m1 <- lmer(Score ~ JobCond + FrameCond*ScaleType + (1|ResponseId), data = stacked_long))

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Score ~ JobCond + FrameCond * ScaleType + (1 | ResponseId)
##    Data: stacked_long
## 
## REML criterion at convergence: 6441.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.1649 -0.5543  0.1355  0.6414  3.8053 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.2031   0.4507  
##  Residual               0.7717   0.8784  
## Number of obs: 2324, groups:  ResponseId, 581
## 
## Fixed effects:
##                                  Estimate Std. Error         df t value
## (Intercept)                    -1.337e-03  4.096e-02  2.045e+03  -0.033
## JobCond1                        2.133e-01  3.682e-02  5.770e+02   5.793
## JobCond2                       -9.353e-02  3.715e-02  5.770e+02  -2.518
## FrameCond                      -2.436e-01  8.192e-02  2.045e+03  -2.974
## ScaleTypeAttitude_z             8.514e-05  5.154e-02  1.737e+03   0.002
## ScaleTypeHero_Nu_H_2            2.145e-04  5.154e-02  1.737e+03   0.004
## ScaleTypeHero_Nu_H_3            1.810e-04  5.154e-02  1.737e+03   0.004
## FrameCond:ScaleTypeAttitude_z   9.894e-02  1.031e-01  1.737e+03   0.960
## FrameCond:ScaleTypeHero_Nu_H_2  2.492e-01  1.031e-01  1.737e+03   2.417
## FrameCond:ScaleTypeHero_Nu_H_3  2.103e-01  1.031e-01  1.737e+03   2.040
##                                Pr(>|t|)    
## (Intercept)                     0.97397    
## JobCond1                       1.14e-08 ***
## JobCond2                        0.01209 *  
## FrameCond                       0.00298 ** 
## ScaleTypeAttitude_z             0.99868    
## ScaleTypeHero_Nu_H_2            0.99668    
## ScaleTypeHero_Nu_H_3            0.99720    
## FrameCond:ScaleTypeAttitude_z   0.33729    
## FrameCond:ScaleTypeHero_Nu_H_2  0.01573 *  
## FrameCond:ScaleTypeHero_Nu_H_3  0.04152 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##              (Intr) JbCnd1 JbCnd2 FrmCnd SclTA_ STH_N_H_2 STH_N_H_3 FC:STA
## JobCond1     -0.006                                                       
## JobCond2      0.011 -0.505                                                
## FrameCond     0.002  0.004 -0.003                                         
## SclTypAttt_  -0.629  0.000  0.000 -0.001                                  
## SclTH_N_H_2  -0.629  0.000  0.000 -0.001  0.500                           
## SclTH_N_H_3  -0.629  0.000  0.000 -0.001  0.500  0.500                    
## FrmCnd:STA_  -0.001  0.000  0.000 -0.629  0.002  0.001     0.001          
## FC:STH_N_H_2 -0.001  0.000  0.000 -0.629  0.001  0.002     0.001     0.500
## FC:STH_N_H_3 -0.001  0.000  0.000 -0.629  0.001  0.001     0.002     0.500
##              FC:STH_N_H_2
## JobCond1                 
## JobCond2                 
## FrameCond                
## SclTypAttt_              
## SclTH_N_H_2              
## SclTH_N_H_3              
## FrmCnd:STA_              
## FC:STH_N_H_2             
## FC:STH_N_H_3  0.500

The three lines of interest here are:

FrameCond1:ScaleTypeAttitude_z    # Is the effect in heroism different than the effect in Attitude?
FrameCond1:ScaleTypeHero_Nu_H_2    # Is the effect in heroism different than the effect in Victim?
FrameCond1:ScaleTypeHero_Nu_H_3  # Is the effect in heroism different than the effect in Villain?

Which gives us the the effect of framing on Attitude vs Heroism, Victim vs Heroism, and Villain vs Heroism.

==> The effect of our framing on heroism does not differ from the effect of our framing on Attitude.

==> However, it does differ from the effect of heroism on perceived victimhood and perceived villain-hood.

Model2 | Model: Target outcome ~ Heroic Framing*Scale type + Occupation + Heroic Framing:Scale type:Occupation + (1|participant)

summary(m2 <- lmer(Score ~ JobCond + FrameCond*ScaleType*JobCond + (1|ResponseId), data = stacked_long))

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Score ~ JobCond + FrameCond * ScaleType * JobCond + (1 | ResponseId)
##    Data: stacked_long
## 
## REML criterion at convergence: 6338.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.2300 -0.5217  0.1001  0.6513  3.5663 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.2129   0.4614  
##  Residual               0.7166   0.8465  
## Number of obs: 2324, groups:  ResponseId, 581
## 
## Fixed effects:
##                                           Estimate Std. Error         df
## (Intercept)                             -3.307e-04  4.000e-02  1.987e+03
## JobCond1                                 1.254e-01  5.640e-02  1.987e+03
## JobCond2                                -8.519e-03  5.692e-02  1.987e+03
## FrameCond                               -2.428e-01  8.001e-02  1.987e+03
## ScaleTypeAttitude_z                     -2.867e-03  4.967e-02  1.725e+03
## ScaleTypeHero_Nu_H_2                     2.830e-03  4.967e-02  1.725e+03
## ScaleTypeHero_Nu_H_3                    -4.544e-03  4.967e-02  1.725e+03
## FrameCond:ScaleTypeAttitude_z            1.016e-01  9.935e-02  1.725e+03
## FrameCond:ScaleTypeHero_Nu_H_2           2.501e-01  9.935e-02  1.725e+03
## FrameCond:ScaleTypeHero_Nu_H_3           2.130e-01  9.935e-02  1.725e+03
## JobCond1:FrameCond                       6.027e-02  1.128e-01  1.987e+03
## JobCond2:FrameCond                       1.427e-01  1.138e-01  1.987e+03
## JobCond1:ScaleTypeAttitude_z             1.172e-01  7.004e-02  1.725e+03
## JobCond2:ScaleTypeAttitude_z            -2.229e-01  7.068e-02  1.725e+03
## JobCond1:ScaleTypeHero_Nu_H_2            1.884e-01  7.004e-02  1.725e+03
## JobCond2:ScaleTypeHero_Nu_H_2            2.443e-01  7.068e-02  1.725e+03
## JobCond1:ScaleTypeHero_Nu_H_3            4.610e-02  7.004e-02  1.725e+03
## JobCond2:ScaleTypeHero_Nu_H_3           -3.625e-01  7.068e-02  1.725e+03
## JobCond1:FrameCond:ScaleTypeAttitude_z  -1.097e-01  1.401e-01  1.725e+03
## JobCond2:FrameCond:ScaleTypeAttitude_z   9.253e-02  1.414e-01  1.725e+03
## JobCond1:FrameCond:ScaleTypeHero_Nu_H_2 -1.738e-01  1.401e-01  1.725e+03
## JobCond2:FrameCond:ScaleTypeHero_Nu_H_2  3.347e-02  1.414e-01  1.725e+03
## JobCond1:FrameCond:ScaleTypeHero_Nu_H_3 -1.586e-01  1.401e-01  1.725e+03
## JobCond2:FrameCond:ScaleTypeHero_Nu_H_3  1.015e-01  1.414e-01  1.725e+03
##                                         t value Pr(>|t|)    
## (Intercept)                              -0.008 0.993406    
## JobCond1                                  2.223 0.026346 *  
## JobCond2                                 -0.150 0.881045    
## FrameCond                                -3.034 0.002441 ** 
## ScaleTypeAttitude_z                      -0.058 0.953986    
## ScaleTypeHero_Nu_H_2                      0.057 0.954574    
## ScaleTypeHero_Nu_H_3                     -0.091 0.927118    
## FrameCond:ScaleTypeAttitude_z             1.023 0.306542    
## FrameCond:ScaleTypeHero_Nu_H_2            2.517 0.011926 *  
## FrameCond:ScaleTypeHero_Nu_H_3            2.144 0.032150 *  
## JobCond1:FrameCond                        0.534 0.593227    
## JobCond2:FrameCond                        1.254 0.210086    
## JobCond1:ScaleTypeAttitude_z              1.673 0.094472 .  
## JobCond2:ScaleTypeAttitude_z             -3.154 0.001638 ** 
## JobCond1:ScaleTypeHero_Nu_H_2             2.690 0.007205 ** 
## JobCond2:ScaleTypeHero_Nu_H_2             3.456 0.000562 ***
## JobCond1:ScaleTypeHero_Nu_H_3             0.658 0.510505    
## JobCond2:ScaleTypeHero_Nu_H_3            -5.129 3.24e-07 ***
## JobCond1:FrameCond:ScaleTypeAttitude_z   -0.783 0.433505    
## JobCond2:FrameCond:ScaleTypeAttitude_z    0.655 0.512813    
## JobCond1:FrameCond:ScaleTypeHero_Nu_H_2  -1.241 0.214757    
## JobCond2:FrameCond:ScaleTypeHero_Nu_H_2   0.237 0.812861    
## JobCond1:FrameCond:ScaleTypeHero_Nu_H_3  -1.132 0.257793    
## JobCond2:FrameCond:ScaleTypeHero_Nu_H_3   0.718 0.472960    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

## 
## Correlation matrix not shown by default, as p = 24 > 12.
## Use print(x, correlation=TRUE)  or
##     vcov(x)        if you need it

We decompose the interactions within each jobs:

# Estimated means for FrameCond, separately by ScaleType and JobCond
emm <- emmeans(
  m2,
  ~ FrameCond | ScaleType * JobCond
)

# Hero - NonHero within each ScaleType and JobCond
frame_diff <- contrast(
  emm,
  method = "revpairwise"
)

# Compare each FrameCond effect against the effect for Hero_Nu_H_1
h7 <- contrast(
  frame_diff,
  method = "trt.vs.ctrl",
  ref = 1,
  by = "JobCond",
  adjust = "none"
)

h7

## JobCond = Nurse:
##  contrast                                                                                   
##  (FrameCond0.5 - (FrameCond-0.5) Attitude_z) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1) 
##  (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_2) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1)
##  (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_3) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1)
##  estimate    SE   df t.ratio p.value
##  -0.00812 0.171 1725  -0.047  0.9621
##   0.07622 0.171 1725   0.446  0.6559
##   0.05447 0.171 1725   0.318  0.7502
## 
## JobCond = Soldier:
##  contrast                                                                                   
##  (FrameCond0.5 - (FrameCond-0.5) Attitude_z) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1) 
##  (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_2) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1)
##  (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_3) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1)
##  estimate    SE   df t.ratio p.value
##   0.19414 0.174 1725   1.115  0.2651
##   0.28353 0.174 1725   1.628  0.1037
##   0.31450 0.174 1725   1.806  0.0711
## 
## JobCond = Welder:
##  contrast                                                                                   
##  (FrameCond0.5 - (FrameCond-0.5) Attitude_z) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1) 
##  (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_2) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1)
##  (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_3) - (FrameCond0.5 - (FrameCond-0.5) Hero_Nu_H_1)
##  estimate    SE   df t.ratio p.value
##   0.11882 0.171 1725   0.695  0.4873
##   0.39043 0.171 1725   2.283  0.0226
##   0.27013 0.171 1725   1.579  0.1144
## 
## Degrees-of-freedom method: kenward-roger

Not much to see here - the effect of framing on heroism is significantly different than the effect of framing on victim-hood for welders.

Very exploratory things: did framing influenced attitude, villain and victimhood at all?

Nurses Victimhood ~ Framing

t.test(NSet$Hero_Nu_H_2 ~ NSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  NSet$Hero_Nu_H_2 by NSet$FrameCond
## t = 0.74051, df = 193.97, p-value = 0.4599
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.2934303  0.6462368
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##           3.444444           3.268041

Welders Victimhood ~ Framing

t.test(WSet$Hero_Nu_H_2 ~ WSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  WSet$Hero_Nu_H_2 by WSet$FrameCond
## t = 0.54549, df = 189.74, p-value = 0.5861
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.2402551  0.4239286
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##           1.969388           1.877551

Soldiers Victimhood ~ Framing

t.test(SSet$Hero_Nu_H_2 ~ SSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  SSet$Hero_Nu_H_2 by SSet$FrameCond
## t = -1.2358, df = 186, p-value = 0.2181
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.7905447  0.1815861
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##           3.074468           3.378947

Nurses Villainhood ~ Framing

t.test(NSet$Hero_Nu_H_3 ~ NSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  NSet$Hero_Nu_H_3 by NSet$FrameCond
## t = -1.1429, df = 187.85, p-value = 0.2545
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.32446529  0.08641468
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##           1.272727           1.391753

Welders Villainhood ~ Framing

t.test(WSet$Hero_Nu_H_3 ~ WSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  WSet$Hero_Nu_H_3 by WSet$FrameCond
## t = -1.3838, df = 184.39, p-value = 0.1681
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.3960382  0.0695076
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##           1.224490           1.387755

Soldiers Villainhood ~ Framing

t.test(SSet$Hero_Nu_H_3 ~ SSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  SSet$Hero_Nu_H_3 by SSet$FrameCond
## t = 1.241, df = 186.9, p-value = 0.2162
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.1175415  0.5161977
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##           1.936170           1.736842

Nurses Attitude ~ Framing

t.test(NSet$Attitude_z ~ NSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  NSet$Attitude_z by NSet$FrameCond
## t = 1.6306, df = 186.43, p-value = 0.1047
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.04000369  0.42126935
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##          0.3346691          0.1440362

Welders Attitude ~ Framing

t.test(WSet$Attitude_z ~ WSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  WSet$Attitude_z by WSet$FrameCond
## t = 2.8405, df = 190.93, p-value = 0.004992
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  0.09991586 0.55398099
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##          0.1491570         -0.1777915

Soldiers Attitude ~ Framing

t.test(SSet$Attitude_z ~ SSet$FrameCond)

## 
##  Welch Two Sample t-test
## 
## data:  SSet$Attitude_z by SSet$FrameCond
## t = -0.51512, df = 178.32, p-value = 0.6071
## alternative hypothesis: true difference in means between group -0.5 and group 0.5 is not equal to 0
## 95 percent confidence interval:
##  -0.4544940  0.2663304
## sample estimates:
## mean in group -0.5  mean in group 0.5 
##         -0.2816685         -0.1875867

Any Question? Find me online by googling me.

REPORT - Pilot Manipulation 0826

ANONYMISED

2026-09-02

Background

Hypotheses

Procedure

H1-H3 Analyses

Relevant Variables

Statistical Technique

Bonus hypotheses: divergent validity analyses

Relevant Variables

Statistical Technique

Variable Roles

Results

Data analysis details

Preparing environment

Data wrangling

Demographics

Descriptive statistics

Heroism

Testing H1 - H3

Model 1 | Model: Target outcome ~ Occupation + Heroic framing

HEROISM

DANGER

HELPFULNESS

Model 2 | Model: Target outcome ~ Heroic Framing + Occupation + Heroic Framing:Occupation

HEROISM

DANGER

HELP

Model 3 | Model: Target outcome ~ Occupation + Attitude + Heroic framing

HEROISM

DANGER

HELPFULNESS

Model 4 | Model: Target outcome ~ Heroic framing + Occupation + Attitude + Heroic framing:Occupation

HEROISM

DANGER

HELPFULNESS

Summary tables

Testing exploratory Divergent validity of manipulation

Model1 | Model: Score ~ Occupation + Heroic framing*Scale type + (1|participant)

Model2 | Model: Target outcome ~ Heroic Framing*Scale type + Occupation + Heroic Framing:Scale type:Occupation + (1|participant)

Nurses Victimhood ~ Framing

Welders Victimhood ~ Framing

Soldiers Victimhood ~ Framing

Nurses Villainhood ~ Framing

Welders Villainhood ~ Framing

Soldiers Villainhood ~ Framing

Nurses Attitude ~ Framing

Welders Attitude ~ Framing

Soldiers Attitude ~ Framing