Introduction

Recently, entire occupations have been granted the label of “Heroes”. For example, during the recent COVID-19 pandemic, as well as in previous health crises (such as the SARS and H1N1 pandemics), healthcare workers were applauded – sometimes literally – as ‘heroes’. Military personnel in the US, but also in the UK, are also often called ‘heroes’. So are police, firefighters, and other first responders. But how malleable is this perception of heroism in these occupations? Can we manipulate the public perception toward recognising “heroism” in occupations not typically perceived as such (e.g., psychiatrists)?

In this study, we tested how malleable the perception of heroism in an occupation is. Specifically, we hypothesised two core components of heroism perception:

Perception of physical threat contributes to the perception of heroism

Altruistic motivations of the group’s member contribute to the perception of heroism

Rationale

Franco et al. (2011) provided the general and, to their own admission, overly simplistic definition of heroism as “to act in a prosocial manner despite personal risk” (p.99). Altruism and exposure to danger are indeed two core elements that are consistently found in the lay people’s prototype of a hero (Kinsella et al., 2015). Regarding physical threat, Sternstorm & Curtis (2012) observed that altruistic actions were distinguished between being merely altruistic vs heroic as a direct function of the level of physical danger. The more dangerous the action, the more heroic rather than altruistic.

As emphasised by Sternstorm & Curtis (2012), altruism may not be a sufficient element to the perception of heroism, but it might be necessary element nonetheless. However, to our knowledge, there is a lack of experimental evidence for this influence of altruism on the perception of heroism.

Manipulations

We manipulated the description of the target occupations as exposed to physical risks (vs psychological pressures) and having altruistic motivations (vs individual motivations).

We assessed to what extent the target occupations are perceived as “Brave” and “Altruistic” as a direct consequence of our manipulation of physical threat and altruism respectively through two separate manipulation checks.

  • The first one (MC1) will use attributes ratings for each occupation regarding how much participants perceive them to be “brave” (physical threat manipulation check) and “Selfless” (motivation type manipulation check). [Personality attributes evaluation]

  • The second manipulation check (MC2) will use self-reported evaluation of how much participants perceive each occupation as being “exposed to physical risks” and “effectively helping people”. [Physical ‘objective’ evaluation]

MC1 will be successful if 1) Occupations described as involving a Physical threat are perceived as significantly “braver” than occupations described as involving psychological pressures, and 2) occupations described as involving an altruistic motivation are perceived as significantly less “selfish” than occupations not described as involving altruistic motivations.

MC2 will be successful if 1) Occupations described as involving a Physical threat are perceived as significantly more exposed to physical risks than occupations described as involving psychological pressures, and 2) occupations described as involving an altruistic motivation are perceived as significantly helping more people than occupations not described as involving altruistic motivations.

Hypotheses

H1a - Describing an occupation as exposed to physical threats (vs Psychological pressure) will increase perception of heroism across all types of occupations

H1b - Describing an occupation as having altruistic motivations (vs Internal motivation) will increase perception of heroism across all types of occupations


H2a: Perceived heroism will be positively predicted by perceived bravery across all types of occupations

H2b: Perceived heroism will be positively predicted by perceived altruism across all types of occupations


H3a: Perceived heroism will be positively predicted by perceived physical risk across all types of occupations

H3b: Perceived heroism will be positively predicted by perceived help provided to others across all types of occupations

Loading data

Please adjust the path if you are running this script in your local machine.

Set <- read.csv("~/Downloads/GW1+-+Corrigendum_February+5,+2025_01.18.csv")
ListProl <-read.csv("~/Downloads/prolific_export_679dfe14f0a53be9045b755b(1).csv")
Set <- subset(Set, Set$Q233 != "No, I won't")
Set <- Set[-c(1:2),]
#test <- subset(Set, !grepl("^[A-Za-z0-9]{24}$", Prol_ID))
Set <- subset(Set, grepl("^[A-Za-z0-9]{24}$", Prol_ID)) #Identify Prolific only
Set <- subset(Set, Set$Gen_attitude_1 != "") # Special case for R_8SAkgsnivXh76fg
# 62b22949a3d0a8d422573f97 reported they were an healthcare worker, but they're not (they're a teacher) - see private communication on Prolific
Set[which(Set$Prol_ID == "62b22949a3d0a8d422573f97"), "Job_match_3"] <- ""
# A participant was timed out despite completing the study (664e2c11cda6e01d54eebe24)
ListProl<-subset(ListProl, ListProl$Status =="AWAITING REVIEW")
# Extract unique IDs from each data frame
ids_prolific <- unique(ListProl$Participant.id)
ids_data     <- unique(Set$Prol_ID)
missing_in_prolific <- setdiff(ids_data, ids_prolific)

Set <- subset(Set, Set$Prol_ID != missing_in_prolific)

Loading Packages

if(!require("dplyr")) install.packages("dplyr")
if(!require("tidyr")) install.packages("tidyr")
if(!require("stringr")) install.packages("stringr")
if(!require("ggplot2")) install.packages("ggplot2")
if(!require("lmerTest")) install.packages("lmerTest")
if(!require("emmeans")) install.packages("emmeans")
if(!require("data.table")) install.packages("data.table")
if(!require("PerformanceAnalytics")) install.packages("PerformanceAnalytics")
if(!require("interactions")) install.packages("interactions")
if(!require("robustlmm")) install.packages("robustlmm")
if(!require("car")) install.packages("car")
if(!require("effectsize")) install.packages("effectsize")
if(!require("RColorBrewer")) install.packages("RColorBrewer")
if(!require("effectsize")) install.packages("effectsize")

My environment

sessionInfo()
## R version 4.2.2 (2022-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS 14.7.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] RColorBrewer_1.1-3         effectsize_0.8.9          
##  [3] car_3.1-2                  carData_3.0-5             
##  [5] robustlmm_3.3-1            interactions_1.1.5        
##  [7] PerformanceAnalytics_2.0.4 xts_0.13.2                
##  [9] zoo_1.8-12                 data.table_1.15.0         
## [11] emmeans_1.10.0             lmerTest_3.1-3            
## [13] lme4_1.1-35.1              Matrix_1.6-5              
## [15] ggplot2_3.5.1              stringr_1.5.1             
## [17] tidyr_1.3.1                dplyr_1.1.4               
## 
## loaded via a namespace (and not attached):
##  [1] sass_0.4.8          jsonlite_1.8.8      splines_4.2.2      
##  [4] bslib_0.6.1         datawizard_0.11.0   pander_0.6.5       
##  [7] yaml_2.3.8          robustbase_0.99-2   bayestestR_0.13.2  
## [10] numDeriv_2016.8-1.1 pillar_1.9.0        lattice_0.22-5     
## [13] glue_1.7.0          quadprog_1.5-8      jtools_2.2.2       
## [16] digest_0.6.34       minqa_1.2.6         colorspace_2.1-0   
## [19] sandwich_3.1-0      htmltools_0.5.7     pkgconfig_2.0.3    
## [22] purrr_1.0.2         xtable_1.8-4        mvtnorm_1.2-4      
## [25] scales_1.3.0        tibble_3.2.1        generics_0.1.3     
## [28] TH.data_1.1-2       cachem_1.1.0        withr_3.0.0        
## [31] cli_3.6.3           fastGHQuad_1.0.1    survival_3.5-8     
## [34] magrittr_2.0.3      crayon_1.5.2        estimability_1.4.1 
## [37] evaluate_0.23       fansi_1.0.6         nlme_3.1-164       
## [40] MASS_7.3-60.0.1     tools_4.2.2         lifecycle_1.0.4    
## [43] multcomp_1.4-25     munsell_0.5.1       compiler_4.2.2     
## [46] jquerylib_0.1.4     rlang_1.1.4         grid_4.2.2         
## [49] nloptr_2.0.3        parameters_0.22.0   rstudioapi_0.15.0  
## [52] rmarkdown_2.25      boot_1.3-30         gtable_0.3.5       
## [55] codetools_0.2-19    abind_1.4-5         R6_2.5.1           
## [58] knitr_1.45          fastmap_1.2.0       utf8_1.2.4         
## [61] insight_0.20.1      stringi_1.8.4       Rcpp_1.0.12        
## [64] vctrs_0.6.5         DEoptimR_1.1-3      tidyselect_1.2.1   
## [67] xfun_0.49           coda_0.19-4.1

Confirmatory analyses (as registered)

Data preparation & Preliminary Analyses

Data wrangling

The data is in a wide format. We need to pass it to a long format. This requires significant data wrangling that you can study by unfolding the code chunk below.

Details of our data wrangling are given in the code chunk below.

QualCheck <- Set[, c(6:28, 234)] # Quality evaluation is Good. There is one participant flagged as duplicatated, but I do not trust this opaque quality check
Set<- Set[, -c(1:8, 10:28, 233, 234, 235)] # Remove useless columns
#colnames(Set)

## An adjective Data set:

df_Adj <- Set %>%
  select(ResponseId, contains("_ad")) # Select all columns that contains "_ad"


df_Adj <- df_Adj %>%
  pivot_longer( # To put it in a long format: a col for the condition, and a col for the rating
    cols = -ResponseId,
    names_to = "FullColumnName",
    values_to = "Value"
  ) %>%
  mutate(
    Condition = case_when(
      # Healthcare workers
      str_detect(FullColumnName, "Health_Phys_Altr") ~ "Health_Phys_Altr",
      str_detect(FullColumnName, "Health_Phys_Ind")  ~ "Health_Phys_Ind",
      str_detect(FullColumnName, "Health_Psych_Alt") ~ "Health_Psych_Alt",
      str_detect(FullColumnName, "Health_Psych_Ind") ~ "Health_Psych_Ind", #Conditions are standardised in their name.

      # Police
      str_detect(FullColumnName, "Poli_Phys_alt") ~ "Poli_Phys_Altr",
      str_detect(FullColumnName, "Poli_Phys_ind")  ~ "Poli_Phys_Ind",
      str_detect(FullColumnName, "Poli_Psych_Alt") ~ "Poli_Psych_Alt",
      str_detect(FullColumnName, "Poli_Psych_indiv") ~ "Poli_Psych_Ind",

      # Milit
      str_detect(FullColumnName, "Mil_Phys_alt") ~ "Mil_Phys_Altr",
      str_detect(FullColumnName, "Mil_Phys_indiv")  ~ "Mil_Phys_Ind",
      str_detect(FullColumnName, "Mil_Psych_alt") ~ "Mil_Psych_Alt",
      str_detect(FullColumnName, "Mil_psych_ind") ~ "Mil_Psych_Ind",

      # Firefighters
      str_detect(FullColumnName, "Fire_phys_alt") ~ "Fire_Phys_Altr",
      str_detect(FullColumnName, "Fire_Phys_Ind")  ~ "Fire_Phys_Ind",
      str_detect(FullColumnName, "Fire_psych_alt") ~ "Fire_Psych_Alt",
      str_detect(FullColumnName, "Fire_psych_ind") ~ "Fire_Psych_Ind",

      # Psychiatrists
      str_detect(FullColumnName, "Psy_Phys_alt") ~ "Psy_Phys_Altr",
      str_detect(FullColumnName, "Psy_phys_ind")  ~ "Psy_Phys_Ind",
      str_detect(FullColumnName, "Psy_psych_alt") ~ "Psy_Psych_Alt",
      str_detect(FullColumnName, "Psy_psych_ind") ~ "Psy_Psych_Ind",

      TRUE ~ NA_character_
    ),
    # Extract digits that appear after "_ad" or "_adj" or "_rol" -- it will indicates the target adjective; 1 = Selfless, 2 = Brave, 3 = Caring, 4 = Cowardly (see Qualtrics survey)
    AdjectiveNumber = str_extract(FullColumnName, "(\\d)+") 
  ) %>%
  # Filter out empty strings if needed
  filter(Value != "") %>%
  pivot_wider( # Switch back to the wide format, each adj is a col now.
    id_cols      = c(ResponseId, Condition),
    names_from   = "AdjectiveNumber",
    values_from  = "Value",
    names_prefix = "Adj"
  )

adjective_names <- c(
  "Adj1" = "Selfless",
  "Adj2" = "Brave" # Rename adjectives for clarity (see Qualtrics survey)
)

colnames(df_Adj) <- ifelse(
    colnames(df_Adj) %in% names(adjective_names),
    adjective_names[colnames(df_Adj)],
    colnames(df_Adj)
  )
table(df_Adj$Selfless)
#df_Adj<- data.frame(lapply(df_Adj, function(x) {gsub("1 - Strongly disagree", 1, x)})) # Replace Character string responses by numbers.
#df_Adj<- data.frame(lapply(df_Adj, function(x) {gsub("7 - Strongly agree", 7, x)}))

df_Adj[,3:4] <- lapply(df_Adj[,3:4], as.numeric) # Transform to numeric.

df_Adj$Risk <- ifelse(grepl("Phys", df_Adj$Condition), "Physical", "Psychological") # Code for a new column: Risk condition ; if Condition contans Phys, it means "Physical", else it means "Psychological"
df_Adj$Motiv <- ifelse(grepl("Alt", df_Adj$Condition), "Altruistic", "Individual") # Same for motivation

df_Adj$Job <- ifelse(grepl("Fire", df_Adj$Condition), "Firefighter",
                     ifelse(grepl("Health", df_Adj$Condition), "HealthCare",
                            ifelse(grepl("Mil", df_Adj$Condition), "Military",
                                   ifelse(grepl("Poli", df_Adj$Condition), "Police", "Psychiatrist" )))) # Code, the same manner, nested ifelse, the target occupation.

# Relevel and dummy code
df_Adj$Risk_dummy <- ifelse(df_Adj$Risk == "Physical", 0.5, -0.5) # Dummy coding factors for regression centered around 0.
df_Adj$Motiv_dummy <- ifelse(df_Adj$Motiv == "Altruistic", 0.5, -0.5)
df_Adj$Job <- as.factor(df_Adj$Job)
df_Adj$Job <- relevel(df_Adj$Job, ref = "Psychiatrist") # Psychiatrist, non heroic level, will be used as a reference level for our models including higher order Job interaction.


# I create a Resp_Cond variable which will be unique per row.
df_Adj$Resp_Cond <-paste(df_Adj$ResponseId, df_Adj$Condition, sep = "_") 


### ROLES data frame; we do the same things.


df_Roles <- Set %>%
  select(ResponseId, contains("_r"), -contains("Risk"))


df_Roles <- df_Roles %>%
  pivot_longer(
    cols = -ResponseId,
    names_to = "FullColumnName",
    values_to = "Value"
  ) %>%
  mutate(
    Condition = case_when(
      # Healthcare workers
      str_detect(FullColumnName, "Health_Phys_alt") ~ "Health_Phys_Altr",
      str_detect(FullColumnName, "Health_Phys_Ind")  ~ "Health_Phys_Ind",
      str_detect(FullColumnName, "Health_Psych_Alt") ~ "Health_Psych_Alt",
      str_detect(FullColumnName, "Health_Psych_Indiv") ~ "Health_Psych_Ind",

      # Police
      str_detect(FullColumnName, "Poli_Phys_Alt") ~ "Poli_Phys_Altr",
      str_detect(FullColumnName, "Poli_Phys_Indi")  ~ "Poli_Phys_Ind",
      str_detect(FullColumnName, "Poli_Psych_Alt") ~ "Poli_Psych_Alt",
      str_detect(FullColumnName, "Poli_Psych_Indiv") ~ "Poli_Psych_Ind",

      # Milit
      str_detect(FullColumnName, "Mil_Phys_alt") ~ "Mil_Phys_Altr",
      str_detect(FullColumnName, "Mil_Phys_Indiv")  ~ "Mil_Phys_Ind",
      str_detect(FullColumnName, "Mil_Psych_alt") ~ "Mil_Psych_Alt",
      str_detect(FullColumnName, "Mil_psych_ind") ~ "Mil_Psych_Ind",

      # Firefighters
      str_detect(FullColumnName, "Fire_phys_alt") ~ "Fire_Phys_Altr",
      str_detect(FullColumnName, "Fire_phys_ind")  ~ "Fire_Phys_Ind",
      str_detect(FullColumnName, "Fire_psych_alt") ~ "Fire_Psych_Alt",
      str_detect(FullColumnName, "Fire_psych_ind") ~ "Fire_Psych_Ind",

      # Psychiatrists
      str_detect(FullColumnName, "Psy_phys_alt") ~ "Psy_Phys_Altr",
      str_detect(FullColumnName, "Psy_phys_ind")  ~ "Psy_Phys_Ind",
      str_detect(FullColumnName, "Psy_psych_alt") ~ "Psy_Psych_Alt",
      str_detect(FullColumnName, "Psy_psych_ind") ~ "Psy_Psych_Ind",

      TRUE ~ NA_character_
    ),
    # Extract digits that appear after "_ad" or "_adj" or "_rol"
    RoleNumber = str_extract(FullColumnName, "(\\d)+")
  ) %>%
  # Filter out empty strings if needed
  filter(Value != "") %>%
  pivot_wider(
    id_cols      = c(ResponseId, Condition),
    names_from   = "RoleNumber",
    values_from  = "Value",
    names_prefix = "Role"
  )



df_Roles<- data.frame(lapply(df_Roles, function(x) {gsub("1 - Strongly disagree", 1, x)}))
df_Roles<- data.frame(lapply(df_Roles, function(x) {gsub("7 - Strongly agree", 7, x)}))



df_Roles[,3:5] <- lapply(df_Roles[,3:5], as.numeric)
colnames(df_Roles)[which(names(df_Roles) == "Role1")] <- "Heroes"
colnames(df_Roles)[which(names(df_Roles) == "Role2")] <- "Victims"
colnames(df_Roles)[which(names(df_Roles) == "Role3")] <- "Villains"

df_Roles$Risk <- ifelse(grepl("Phys", df_Roles$Condition), "Physical", "Psychological")
df_Roles$Motiv <- ifelse(grepl("Alt", df_Roles$Condition), "Altruistic", "Individual")

df_Roles$Job <- ifelse(grepl("Fire", df_Roles$Condition), "Firefighter",
                     ifelse(grepl("Health", df_Roles$Condition), "HealthCare",
                            ifelse(grepl("Mil", df_Roles$Condition), "Military",
                                   ifelse(grepl("Poli", df_Roles$Condition), "Police", "Psychiatrist" ))))

# Setting reference levels
df_Roles$Risk_dummy <- ifelse(df_Roles$Risk == "Physical", 0.5, -0.5)
df_Roles$Motiv_dummy <- ifelse(df_Roles$Motiv == "Altruistic", 0.5, -0.5)
df_Roles$Job <- as.factor(df_Roles$Job)
df_Roles$Job <- relevel(df_Roles$Job, ref = "Psychiatrist")


# Unique Block identifier
df_Roles$Resp_Cond <-paste(df_Roles$ResponseId, df_Roles$Condition, sep = "_")


## Attitudes data frame:

df_Attitude <- Set[, c(1, 192:196)] # Also should add experimental condition to this - just in case

table(df_Attitude$Gen_attitude_1)
str(df_Attitude)

df_Attitude<- data.frame(lapply(df_Attitude, function(x) {gsub("1 - Very negative", 1, x)}))
df_Attitude<- data.frame(lapply(df_Attitude, function(x) {gsub("7 - Very positive", 7, x)}))


long_df_Attitude <- melt(setDT(df_Attitude), id.vars = "ResponseId", variable.name = "Occupation")
table(long_df_Attitude$Occupation)
long_df_Attitude<- data.frame(lapply(long_df_Attitude, function(x) {gsub("Gen_attitude_1", "Healthcare", x)}))
long_df_Attitude<- data.frame(lapply(long_df_Attitude, function(x) {gsub("Gen_attitude_2", "Police", x)}))
long_df_Attitude<- data.frame(lapply(long_df_Attitude, function(x) {gsub("Gen_attitude_3", "Military", x)}))
long_df_Attitude<- data.frame(lapply(long_df_Attitude, function(x) {gsub("Gen_attitude_4", "Firefighters", x)}))
long_df_Attitude<- data.frame(lapply(long_df_Attitude, function(x) {gsub("Gen_attitude_5", "Psychiatrists", x)}))


long_df_Attitude$value <- as.numeric(long_df_Attitude$value)
# anova(lmer(value ~ Occupation + (1|ResponseId), data = long_df_Attitude)) Here, we can check if attitudes change for occupations
#No difference between occupations in this simulated data

#Add conditions (just in case for explorations)
long_df_Attitude <- long_df_Attitude[order(long_df_Attitude$ResponseId),]
df_Adj <- df_Adj[order(df_Adj$ResponseId),]
df_Roles <- df_Roles[order(df_Roles$ResponseId),]
long_df_Attitude <- subset(long_df_Attitude, !is.na(value)) # This line is in case someone did not consent to participation -- this would result in some recorded qualtrics form without any response.
long_df_Attitude$Risk <- df_Adj$Risk
long_df_Attitude$Motiv <- df_Adj$Motiv
long_df_Attitude$Job <- df_Adj$Job


# MC 2 : "objective" Manip Check.

df_MC_Risk <- Set[, c(1, 182:186)] # Also should add experimental condition to this - just in case
df_MC_Help <- Set[, c(1, 187:191)] # Also should add experimental condition to this - just in case

df_MC_Risk<- data.frame(lapply(df_MC_Risk, function(x) {gsub("1 - Not at all", 1, x)}))
df_MC_Risk<- data.frame(lapply(df_MC_Risk, function(x) {gsub("7 - Extremely", 7, x)}))

df_MC_Help<- data.frame(lapply(df_MC_Help, function(x) {gsub("1 - Not at all", 1, x)}))
df_MC_Help<- data.frame(lapply(df_MC_Help, function(x) {gsub("7 - Extremely", 7, x)}))


long_df_MC_Risk <- melt(setDT(df_MC_Risk), id.vars = "ResponseId", variable.name = "Occupation")
table(long_df_MC_Risk$Occupation)
long_df_MC_Risk<- data.frame(lapply(long_df_MC_Risk, function(x) {gsub("MC2_Risk_1", "Healthcare", x)}))
long_df_MC_Risk<- data.frame(lapply(long_df_MC_Risk, function(x) {gsub("MC2_Risk_2", "Police", x)}))
long_df_MC_Risk<- data.frame(lapply(long_df_MC_Risk, function(x) {gsub("MC2_Risk_3", "Military", x)}))
long_df_MC_Risk<- data.frame(lapply(long_df_MC_Risk, function(x) {gsub("MC2_Risk_4", "Firefighters", x)}))
long_df_MC_Risk<- data.frame(lapply(long_df_MC_Risk, function(x) {gsub("MC2_Risk_5", "Psychiatrists", x)}))

long_df_MC_Risk$value <- as.numeric(long_df_MC_Risk$value)
# anova(lmer(value ~ Occupation + (1|ResponseId), data = long_df_Attitude)) Here, we can check if attitudes change for occupations
#No difference between occupations in this simulated data

#Add conditions (just in case for explorations)
long_df_MC_Risk <- long_df_MC_Risk[order(long_df_MC_Risk$ResponseId),]
df_Adj <- df_Adj[order(df_Adj$ResponseId),]
df_Roles <- df_Roles[order(df_Roles$ResponseId),]
long_df_MC_Risk <- subset(long_df_MC_Risk, !is.na(value)) # This line is in case someone did not consent to participation -- this would result in some recorded qualtrics form without any response.
long_df_MC_Risk$Risk <- df_Adj$Risk
long_df_MC_Risk$Motiv <- df_Adj$Motiv
long_df_MC_Risk$Job <- df_Adj$Job


###

long_df_MC_Help <- melt(setDT(df_MC_Help), id.vars = "ResponseId", variable.name = "Occupation")
table(long_df_MC_Help$Occupation)
long_df_MC_Help<- data.frame(lapply(long_df_MC_Help, function(x) {gsub("MC2_ALtruism_1", "Healthcare", x)}))
long_df_MC_Help<- data.frame(lapply(long_df_MC_Help, function(x) {gsub("MC2_ALtruism_2", "Police", x)}))
long_df_MC_Help<- data.frame(lapply(long_df_MC_Help, function(x) {gsub("MC2_ALtruism_3", "Military", x)}))
long_df_MC_Help<- data.frame(lapply(long_df_MC_Help, function(x) {gsub("MC2_ALtruism_4", "Firefighters", x)}))
long_df_MC_Help<- data.frame(lapply(long_df_MC_Help, function(x) {gsub("MC2_ALtruism_5", "Psychiatrists", x)}))

long_df_MC_Help$value <- as.numeric(long_df_MC_Help$value)
# anova(lmer(value ~ Occupation + (1|ResponseId), data = long_df_Attitude)) Here, we can check if attitudes change for occupations
#No difference between occupations in this simulated data

#Add conditions (just in case for explorations)
long_df_MC_Help <- long_df_MC_Help[order(long_df_MC_Help$ResponseId),]
df_Adj <- df_Adj[order(df_Adj$ResponseId),]
df_Roles <- df_Roles[order(df_Roles$ResponseId),]
long_df_MC_Help <- subset(long_df_MC_Help, !is.na(value)) # This line is in case someone did not consent to participation -- this would result in some recorded qualtrics form without any response.
long_df_MC_Help$Risk <- df_Adj$Risk
long_df_MC_Help$Motiv <- df_Adj$Motiv
long_df_MC_Help$Job <- df_Adj$Job

Descriptives

We describe our sample: their age, gender, and occupations with regard to the target occupations in the study.

paste0("Mean age in the sample is ", mean(as.numeric(Set$Age)), ", SD = ", sd(as.numeric(Set$Age)))
## [1] "Mean age in the sample is 46.2033333333333, SD = 15.547503454306"
## Gender

Set %>% group_by(Gender) %>% summarise(N=n()) %>%
  ggplot(aes(x=Gender,y=N,fill=Gender))+
  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)

jobs <- unlist(Set[, 200:205])           # Make a long list of all jobs that were named

jobs <- jobs[jobs != ""]     # Remove empty strings

job_df <- as.data.frame(table(jobs))
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")

# Here, I just flag participants that do have a job (or had a job) relating to the targeted occupations

# table(Set$Job_match_1) # Fire
# table(Set$Job_match_2)# Milit
# table(Set$Job_match_3) # Health
# table(Set$Job_match_4) # Psychi
# table(Set$Job_match_5) # Police
# table(Set$Job_match_6) # None

flagged_list <- Set$ResponseId[Set$Job_match_1 == "Firefighter"]
df_Roles$None_job<- ifelse(df_Roles$ResponseId %in% flagged_list, "Firefighter", "Keep")

flagged_list <- Set$ResponseId[Set$Job_match_2 == "Military Personnel"]
df_Roles$None_job<- ifelse(df_Roles$ResponseId %in% flagged_list, "Military", "Keep")

flagged_list <- Set$ResponseId[Set$Job_match_3 == "Healthcare Worker"]
df_Roles$None_job<- ifelse(df_Roles$ResponseId %in% flagged_list, "Healthcare", "Keep")

flagged_list <- Set$ResponseId[Set$Job_match_4 == "Psychiatrist"]
df_Roles$None_job<- ifelse(df_Roles$ResponseId %in% flagged_list, "Psychiatrist", "Keep")

flagged_list <- Set$ResponseId[Set$Job_match_5 == "Police officer"]
df_Roles$None_job<- ifelse(df_Roles$ResponseId %in% flagged_list, "Police", "Keep")


flagged_list <- Set$ResponseId[Set$Job_match_6 == "None of the above"]
df_Roles$None_job<- ifelse(df_Roles$ResponseId %in% flagged_list, "None", "Flagged_Job")

Plots

Below are visual representations of the perception of our target occupations (firefighters, NHS, police officers, military personnel, and Psychiatrists).

Heroes, Victims, and Villains

# Reshape from wide to long format:
df_long <- df_Roles %>%
  pivot_longer(
    cols = c(Heroes, Victims, Villains),
    names_to = "Role",
    values_to = "Score"
  )
df_summary <- df_long %>%
  group_by(Role, Job) %>%
  summarize(
    mean_score = mean(Score, na.rm = TRUE),
    sd_score   = sd(Score, na.rm = TRUE),
    .groups    = "drop"
  )




ggplot(df_long, aes(x = Score)) +
  geom_histogram(aes(fill = after_stat(count)),
                 binwidth = 1,
                 color = "black", show.legend = FALSE) +
  facet_grid(Role ~ Job, scales = "free") +
  scale_fill_gradientn(
    colours = brewer.pal(9, "YlOrBr"),  
    name = "Count"
  ) +
  labs(
    title = "Histograms of Heroes, Victims, and Villains by Job",
    x = "Score",
    y = "Count"
  ) +
  geom_text(data = df_summary,
            aes(x = 7, y = Inf,
                label = paste0("Mean = ", round(mean_score, 2),
                               "\nSD = ", round(sd_score, 2))),
            vjust = 1.5, hjust = 1.1, size = 3) +
  theme_classic() + 
  theme(panel.grid.major.y = element_line(linewidth = 0.5),
        panel.grid.minor.y = element_line(linewidth = 0.5),
        )


Bravery and Selflessness

# Reshape from wide to long format:
df_long <- df_Adj %>%
  pivot_longer(
    cols = c(Selfless, Brave),
    names_to = "Adjective",
    values_to = "Score"
  )

df_summary <- df_long %>%
  group_by(Adjective, Job) %>%
  summarize(
    mean_score = mean(Score, na.rm = TRUE),
    sd_score   = sd(Score, na.rm = TRUE),
    .groups    = "drop"
  )


ggplot(df_long, aes(x = Score)) +
  geom_histogram(aes(fill = after_stat(count)),
                 binwidth = 1,
                 color = "black", show.legend = FALSE) +
  facet_grid(Adjective ~ Job, scales = "free") +
  scale_fill_gradientn(
    colours = brewer.pal(9, "YlOrBr"),  # Earthy yellow-orange-brown palette
    name = "Count"
  ) +
  labs(
    title = "Histograms of Bravery and Selflessness by Job",
    x = "Score",
    y = "Count"
  ) +
  # Add text annotation in the top-right corner of each facet
  geom_text(data = df_summary,
            aes(x = 7, y = Inf,
                label = paste0("Mean = ", round(mean_score, 2),
                               "\nSD = ", round(sd_score, 2))),
            vjust = 1.5, hjust = 1.1, size = 3) +
  theme_classic() + 
  theme(panel.grid.major.y = element_line(linewidth = 0.5),
        panel.grid.minor.y = element_line(linewidth = 0.5),
        )


Physical Risk exposure and Helping People

df_summary <- long_df_MC_Help %>%
  group_by(Job) %>%
  summarize(
    mean_score = mean(value, na.rm = TRUE),
    sd_score   = sd(value, na.rm = TRUE),
    .groups    = "drop"
  )


ggplot(long_df_MC_Help, aes(x = value)) +
  geom_histogram(aes(fill = after_stat(count)),
                 binwidth = 1,
                 color = "black", show.legend = FALSE) +
  facet_grid( ~ Job, scales = "free") +
  scale_fill_gradientn(
    colours = brewer.pal(9, "YlOrBr"),  # Earthy yellow-orange-brown palette
    name = "Count"
  ) +
  labs(
    title = "Histograms of Helping by Job",
    x = "Score",
    y = "Count"
  ) +
  # Add text annotation in the top-right corner of each facet
  geom_text(data = df_summary,
            aes(x = 7, y = Inf,
                label = paste0("Mean = ", round(mean_score, 2),
                               "\nSD = ", round(sd_score, 2))),
            vjust = 1.5, hjust = 1.1, size = 3) +
  theme_classic() + 
  theme(panel.grid.major.y = element_line(linewidth = 0.5),
        panel.grid.minor.y = element_line(linewidth = 0.5),
        )

df_summary <- long_df_MC_Risk %>%
  group_by(Job) %>%
  summarize(
    mean_score = mean(value, na.rm = TRUE),
    sd_score   = sd(value, na.rm = TRUE),
    .groups    = "drop"
  )


ggplot(long_df_MC_Risk, aes(x = value)) +
  geom_histogram(aes(fill = after_stat(count)),
                 binwidth = 1,
                 color = "black", show.legend = FALSE) +
  facet_grid( ~ Job, scales = "free") +
  scale_fill_gradientn(
    colours = brewer.pal(9, "YlOrBr"),  # Earthy yellow-orange-brown palette
    name = "Count"
  ) +
  labs(
    title = "Histograms of Risk exposure by Job",
    x = "Score",
    y = "Count"
  ) +
  # Add text annotation in the top-right corner of each facet
  geom_text(data = df_summary,
            aes(x = 7, y = Inf,
                label = paste0("Mean = ", round(mean_score, 2),
                               "\nSD = ", round(sd_score, 2))),
            vjust = 1.5, hjust = 1.1, size = 3) +
  theme_classic() + 
  theme(panel.grid.major.y = element_line(linewidth = 0.5),
        panel.grid.minor.y = element_line(linewidth = 0.5),
        )


Attitude

df_summary <- long_df_Attitude %>%
  group_by(Job) %>%
  summarize(
    mean_score = mean(value, na.rm = TRUE),
    sd_score   = sd(value, na.rm = TRUE),
    .groups    = "drop"
  )


ggplot(long_df_Attitude, aes(x = value)) +
  geom_histogram(aes(fill = stat(count)),
                 binwidth = 1,
                 color = "black", show.legend = FALSE) +
  facet_grid( ~ Job, scales = "free") +
  scale_fill_gradientn(
    colours = brewer.pal(9, "YlOrBr"),  # Earthy yellow-orange-brown palette
    name = "Count"
  ) +
  labs(
    title = " Attitudes by Job",
    x = "Score",
    y = "Count"
  ) +
  # Add text annotation in the top-right corner of each facet
  geom_text(data = df_summary,
            aes(x = 7, y = Inf,
                label = paste0("Mean = ", round(mean_score, 2),
                               "\nSD = ", round(sd_score, 2))),
            vjust = 1.5, hjust = 1.1, size = 3) +
  theme_classic() + 
  theme(panel.grid.major.y = element_line(linewidth = 0.5),
        panel.grid.minor.y = element_line(linewidth = 0.5),
        )
## Warning: `stat(count)` was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Manipulation checks {.tabset}

Because the main aim of this study was to assess the ability of an experimental manipulation to influence heroism perceptions in a range occupations, it is necessary to evaluate whether our manipulation acts as predicted.

MC1 will be successful if

  1. Occupations described as involving a Physical threat are perceived as significantly “braver” than occupations described as involving psychological pressures, and

  2. occupations described as involving an altruistic motivation are perceived as significantly less “selfish” than occupations not described as involving altruistic motivations.

MC2 will be successful if

  1. Occupations described as involving a Physical threat are perceived as significantly more exposed to physical risks than occupations described as involving psychological pressures, and

  2. occupations described as involving an altruistic motivation are perceived as significantly helping more people than occupations not described as involving altruistic motivations.

We performed mixed models to account for the repeated measures design and possible imbalance in conditions.

Manipulation check 1 (Personality Attributes)

This tab contains:

Perception of bravery

The Risk type (physical vs psychological) should predict the perception of bravery.

anova(lmer(Brave ~ Risk_dummy + (1|ResponseId),
           data = df_Adj))
## Type III Analysis of Variance Table with Satterthwaite's method
##            Sum Sq Mean Sq NumDF  DenDF F value Pr(>F)
## Risk_dummy 1.7203  1.7203     1 2773.4  1.3653 0.2427
# confint(lmer(Brave ~ Risk_dummy + (1|ResponseId), data = df_Adj))

==> Failed Manipulation Check. Our manipulation of Physical risks did not influence Bravery evaluations

Perception of selflessness

The Motivation type (Altruistic vs Internal) should predict the perception of Altruism, defined as the average between “Caring” scores and reverse-coded “Selfless” scores.

anova(lmer(Selfless ~ Motiv_dummy + (1|ResponseId),
           data = df_Adj))
## Type III Analysis of Variance Table with Satterthwaite's method
##             Sum Sq Mean Sq NumDF  DenDF F value Pr(>F)  
## Motiv_dummy 5.8841  5.8841     1 2740.6  4.7028 0.0302 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# confint(lmer(Selfless ~ Motiv_dummy + (1|ResponseId), data = df_Adj))
# library(effectsize)
#  F_to_eta2(4.7028, 1, 2740.6) # to get effect size appoximationss

==> Relative success. Yes, motivation types did predict perception of selflessness, but it’s very large (for the record, an approximation of eta squared using the effectsize package shows that our manipulation explains 0.17% of the variance of the selfless motivation…)


Manipulation check 2 (Objective Situational characteristics)

In addition to this subjective or personnality assessment manipulation check (that is, altruism and bravery perception are abstract evaluations of the character of the targets, that do not rely on objective measurement), we have more objective manipulation checks (i.e., things that we could theoretically really measure, evaluations of objective features of reality) : evaluation of physical danger and how much do they help people. Let’s do the same analyses here:

This tab contains:

Perceived Risk

To what extent do you believe the target occupation is exposed to physical dangerRisk type should increase evaluation of physical risks

long_df_MC_Risk$Risk_dummy <- ifelse(long_df_MC_Risk$Risk == "Physical", 0.5, -0.5) # 
anova(lmer(value ~ Risk_dummy + (1|ResponseId),
           data = long_df_MC_Risk))
## boundary (singular) fit: see help('isSingular')
## Type III Analysis of Variance Table with Satterthwaite's method
##            Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Risk_dummy 2.7852  2.7852     1  2998  1.1878 0.2759
#summary(lmer(value ~ Risk_dummy + (1|ResponseId),
#           data = long_df_MC_Risk))
#confint(lmer(value ~ Risk_dummy + (1|ResponseId),
#           data = long_df_MC_Risk))

==> Failed Manipulation Check.

Note that the model is singular. Because it cannot be further simplified without omitting the nested structure (which would mean performing analyses omitting the problem of dependence of observations, and an analysis omitting the true structure of our data).


Perceived helpfulness

To what extent do you believe the target occupation helps people?Motivation type should increase evaluation of help provided

long_df_MC_Help$Motiv_dummy <- ifelse(long_df_MC_Help$Motiv == "Altruistic", 0.5, -0.5) # 
anova(lmer(value ~ Motiv_dummy + (1|ResponseId),
           data = long_df_MC_Help))
## Type III Analysis of Variance Table with Satterthwaite's method
##             Sum Sq Mean Sq NumDF  DenDF F value Pr(>F)
## Motiv_dummy 1.8771  1.8771     1 2835.9  1.3716 0.2416
# summary(lmer(value ~ Motiv_dummy + (1|ResponseId),
#            data = long_df_MC_Help))
# confint(lmer(value ~ Motiv_dummy + (1|ResponseId),
#            data = long_df_MC_Help))

==> Failed Manipulation Check.


Principal analyses

On the basis of our manipulation checks, it can be stated that our manipulations (both physical risks and motivation type) did not behave as expected.. We still proceed with our main registered hypotheses. This section contains analyses regarding:

  • H1: the effect of our manipulations on heroism
  • H2: the effect of perceived selflessness and perceived bravery on heroism
  • H3: the effect of perceived risk and perceived helpfulness on heroism

H1a, b, and c: Manipulation as predictors

This tab contains:

Because of the repeated measures structure of the model, it is necessary to account for dependence of the observations across participants by conducting a mixed model with Participant as a random intercept.

From registration:

***Statistical Technique***

*We will use a mixed regression model to assess:*
*- The effect of the Risk type on the attribution of Heroism to target occupations (H1a)*
*- The effect of the Motivation type on the attribution of Heroism to target occupations (H1b)*
*- Their interaction (exploratory analysis)*
*- A higher order interaction when considering Job type (to control for potential higher order interaction - should occupation interacts with any variable, we would further explore the interactions when decomposing by job types in independent OLS regression models, see Registered R script, section "Further explorations")*

***Variable Roles***

*IVs: Risk type; Motivation type*
*DV: Heroism attribution*

*Job type  will be used as a covariate, participant level will be used as a random intercept (e.g.,* `Heroes ~ Risk*Motivation*Job type + (1|Participant)`*).*

H1 Model comparison

mod <-lmer(Heroes ~ Risk_dummy * Motiv_dummy + (1|ResponseId), data = df_Roles)

mod_cov<-lmer(Heroes ~ Risk_dummy * Motiv_dummy * Job + (1|ResponseId), data = df_Roles)

anova(mod, mod_cov)
## refitting model(s) with ML (instead of REML)
## Data: df_Roles
## Models:
## mod: Heroes ~ Risk_dummy * Motiv_dummy + (1 | ResponseId)
## mod_cov: Heroes ~ Risk_dummy * Motiv_dummy * Job + (1 | ResponseId)
##         npar     AIC     BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mod        6 10426.5 10462.5 -5207.2  10414.5                         
## mod_cov   22  9476.7  9608.9 -4716.4   9432.7 981.78 16  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Model comparison indicates that Heroism rate are significantly driven by normative ratings: model using Job as a covariate is associated to a significantly better fit (BIC = 9608.9) than the model not using a covariate (BIC = 10462.5, chi^2 = 981.78, p < .000001).


H1 Main registered model

summary(mod)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Heroes ~ Risk_dummy * Motiv_dummy + (1 | ResponseId)
##    Data: df_Roles
## 
## REML criterion at convergence: 10430.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5727 -0.5806  0.1443  0.6771  2.9806 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.5763   0.7591  
##  Residual               1.5263   1.2354  
## Number of obs: 3000, groups:  ResponseId, 600
## 
## Fixed effects:
##                          Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)               5.43133    0.03833  598.10319 141.697   <2e-16 ***
## Risk_dummy                0.02005    0.04822 2731.46650   0.416    0.678    
## Motiv_dummy               0.03307    0.04855 2763.62538   0.681    0.496    
## Risk_dummy:Motiv_dummy   -0.04601    0.09748 2780.75720  -0.472    0.637    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) Rsk_dm Mtv_dm
## Risk_dummy  0.001               
## Motiv_dummy 0.000  0.010        
## Rsk_dmmy:M_ 0.000  0.007  0.000
qqnorm(resid(mod))
qqline(resid(mod))

plot(fitted(mod),residuals(mod))
abline(h = 0)

library(clubSandwich)
## Registered S3 method overwritten by 'clubSandwich':
##   method    from    
##   bread.mlm sandwich
robust_results <- coef_test(mod, vcov = "CR2")
print(robust_results)
##                   Coef. Estimate     SE  t-stat d.f. (Satt) p-val (Satt) Sig.
##             (Intercept)   5.4313 0.0383 141.705         599       <0.001  ***
##              Risk_dummy   0.0200 0.0495   0.405         580        0.685     
##             Motiv_dummy   0.0331 0.0470   0.703         576        0.482     
##  Risk_dummy:Motiv_dummy  -0.0460 0.0969  -0.475         575        0.635

Model Linearity

# Fitted values from your model
fitted_vals <- fitted(mod)

# Plot observed values against fitted values
plot(fitted_vals, df_Roles$Heroes,
     xlab = "Fitted Values",
     ylab = "Observed Heroes",
     main = "Observed vs Fitted Values")
abline(0, 1, col = "blue", lty = 2)

==> Our manipulation did not influence heroism in any way


H1 Outliers analyses

Note on Outlier management: As registered, We compared the outputs from our mixed models to the outputs of a robust mixed model using a smoothed Huber function to down-weight extreme residuals of both the fixed effect and random intercept (see Koller, 2016). Robust mixed models used the default parameters from the rlmer command in the robustlmm package – that is a set of parameters resulting in a 95% efficiency (assuming normal residual distribution and no contamination). This model is robust to the presence of extreme values and less sensitive to deviations from normality assumption

Non_robust_model<-lmer(Heroes ~ Risk_dummy * Motiv_dummy + (1|ResponseId), data = df_Roles)

#Robust_model<-rlmer(Heroes ~ Risk_dummy * Motiv_dummy + (1|ResponseId), data = df_Roles, method = "DASvar")
#compare(Non_robust_model, Robust_model)

No large discrepancy.


H1 No Job interaction

We registered that we would explore any higher-order interaction with occupation type.

However: No interaction to report here.

anova(mod_cov)
## Type III Analysis of Variance Table with Satterthwaite's method
##                             Sum Sq Mean Sq NumDF  DenDF  F value Pr(>F)    
## Risk_dummy                    0.59   0.586     1 2618.5   0.5738 0.4488    
## Motiv_dummy                   0.63   0.633     1 2643.5   0.6205 0.4309    
## Job                        1214.14 303.535     4 2380.7 297.4535 <2e-16 ***
## Risk_dummy:Motiv_dummy        0.19   0.188     1 2659.5   0.1842 0.6678    
## Risk_dummy:Job                6.29   1.572     4 2634.4   1.5403 0.1878    
## Motiv_dummy:Job               5.79   1.447     4 2628.0   1.4176 0.2255    
## Risk_dummy:Motiv_dummy:Job    2.22   0.555     4 2624.9   0.5443 0.7032    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

H1 Conclusion

Hypothesis 1 does not receive any support.. None of our manipulation succeeded in moving heroism scores. This could be due to a very engrained vision of heroism in our target occupation (but psychiatrists though…). This could be due to a weak contrast between the levels of our manipulation (i.e., psychological vs. physical risks both contribute to heroism perception; individualstic motives are socially desirable and thus might contribute to a positive attitude consistent with heroism motivation).

(*Note - effects in job were explored in additional analyses, see [Job Analysis : Brave and Selfless make heroes?])


H2a, b, and c: MC1 as predictors

This tab contains:

We repeat the analyses using the attributes rating (Manipulation check #1) as predictors: ___

H2 Model comparison

# Add the General attitudes to the target df
df_Roles <- df_Roles[order(df_Roles$ResponseId),]

df_Adj <- df_Adj[order(df_Adj$ResponseId),]

df_Roles$Selfless <- scale(df_Adj$Selfless)
df_Roles$Brave <- scale(df_Adj$Brave)
df_Roles$Selfless_unscaled <- (df_Adj$Selfless)
df_Roles$Brave_unscaled <- (df_Adj$Brave)

(mod<-lmer(Heroes ~ Brave * Selfless + (1|ResponseId), data = df_Roles))
## Linear mixed model fit by REML ['lmerModLmerTest']
## Formula: Heroes ~ Brave * Selfless + (1 | ResponseId)
##    Data: df_Roles
## REML criterion at convergence: 8057.684
## Random effects:
##  Groups     Name        Std.Dev.
##  ResponseId (Intercept) 0.4928  
##  Residual               0.8351  
## Number of obs: 3000, groups:  ResponseId, 600
## Fixed Effects:
##    (Intercept)           Brave        Selfless  Brave:Selfless  
##         5.3650          0.6424          0.5903          0.0921
mod_cov<-lmer(Heroes ~ Brave * Selfless * Job + (1|ResponseId), data = df_Roles)
anova(mod, mod_cov)
## refitting model(s) with ML (instead of REML)
## Data: df_Roles
## Models:
## mod: Heroes ~ Brave * Selfless + (1 | ResponseId)
## mod_cov: Heroes ~ Brave * Selfless * Job + (1 | ResponseId)
##         npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mod        6 8045.5 8081.5 -4016.8   8033.5                         
## mod_cov   22 7770.9 7903.0 -3863.4   7726.9 306.63 16  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Here also, the heroism rate is driven by normative evaluations of the job – including jobs as covariate leads to a better fit (BIC = 7903.0, vs BIC = 8081.5, chi 2 = 306.63, p < .000001) ___

H2 Main registered model

summary(mod)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Heroes ~ Brave * Selfless + (1 | ResponseId)
##    Data: df_Roles
## 
## REML criterion at convergence: 8057.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.4957 -0.5068  0.1185  0.4976  5.0666 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.2429   0.4928  
##  Residual               0.6974   0.8351  
## Number of obs: 3000, groups:  ResponseId, 600
## 
## Fixed effects:
##                 Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)    5.365e+00  2.698e-02 7.065e+02 198.867  < 2e-16 ***
## Brave          6.424e-01  2.497e-02 2.797e+03  25.724  < 2e-16 ***
## Selfless       5.903e-01  2.459e-02 2.933e+03  24.007  < 2e-16 ***
## Brave:Selfless 9.210e-02  1.322e-02 2.918e+03   6.967 3.97e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) Brave  Slflss
## Brave       -0.106              
## Selfless    -0.042 -0.606       
## Brav:Slflss -0.353  0.300  0.119
qqnorm(resid(mod))
qqline(resid(mod))

plot(fitted(mod),residuals(mod))
abline(h = 0)

confint(mod)
## Computing profile confidence intervals ...
##                     2.5 %    97.5 %
## .sig01         0.44775374 0.5384580
## .sigma         0.81154602 0.8589473
## (Intercept)    5.31217056 5.4181235
## Brave          0.59337998 0.6916328
## Selfless       0.54204528 0.6384468
## Brave:Selfless 0.06586576 0.1184157
# Robust variances
robust_results <- coef_test(mod, vcov = "CR2")
print(robust_results)
##           Coef. Estimate     SE t-stat d.f. (Satt) p-val (Satt) Sig.
##     (Intercept)   5.3650 0.0320 167.88       569.8       <0.001  ***
##           Brave   0.6424 0.0366  17.57       226.9       <0.001  ***
##        Selfless   0.5903 0.0392  15.06       198.8       <0.001  ***
##  Brave:Selfless   0.0921 0.0359   2.56        70.6       0.0125    *

Consistent with our predictions, Heroes are significantly selfless and Brave. An interaction can be observed, seemingly synergetic: the two variables encourage themselves. However, we note that the effectsize associated to the interaction is quite modest

#sim_slopes(mod, pred = Brave, modx = Selfless)

interact_plot(mod, pred = Brave, modx = Selfless)


H2 Outliers analyses

Outlier analyses through model comparison with a robust model:

Non_robust_model<-lmer(Heroes ~ Brave * Selfless + (1|ResponseId), data = df_Roles)

#Robust_model<-rlmer(Heroes ~ Brave * Selfless + (1|ResponseId), data = df_Roles, method = "DASvar")
#compare(Non_robust_model, Robust_model)

==> No outliers.


H2 Decomposition of the effects within job

We registered an exploration of the effects within each occupation if there was any higher order interaction involving type of occupation.

Let’s see if there is an higher-order job interaction:

anova(mod_cov)
## Type III Analysis of Variance Table with Satterthwaite's method
##                     Sum Sq Mean Sq NumDF  DenDF  F value    Pr(>F)    
## Brave              231.581 231.581     1 2900.8 373.0340 < 2.2e-16 ***
## Selfless           198.013 198.013     1 2918.8 318.9615 < 2.2e-16 ***
## Job                 77.430  19.358     4 2551.2  31.1814 < 2.2e-16 ***
## Brave:Selfless      34.689  34.689     1 2898.6  55.8768 1.016e-13 ***
## Brave:Job           24.985   6.246     4 2662.9  10.0615 4.412e-08 ***
## Selfless:Job        19.802   4.951     4 2660.6   7.9744 2.183e-06 ***
## Brave:Selfless:Job  16.537   4.134     4 2584.2   6.6594 2.495e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

…So many stars, it looks like a Van Gogh. Job does have a (somewhat small) influence on our predictions.

As registered: Decomposition of the effects in each job.

To do this, we conduct Ordinary Least Squares Regression (as there is no need for random intercept anymore).

For each analysis, I report the shape of the interaction and compare the partial eta^2 of each predictors.

Firefighters
paste0("Firefighter analysis")
## [1] "Firefighter analysis"
FireRole<- subset(df_Roles, df_Roles$Job == "Firefighter")
FireRole$Brave<-scale(FireRole$Brave)
FireRole$Selfless<-scale(FireRole$Selfless)

summary(FireMod<-lm(Heroes ~ Brave * Selfless, data = FireRole))
## 
## Call:
## lm(formula = Heroes ~ Brave * Selfless, data = FireRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.3754 -0.3754  0.2918  0.2918  2.8552 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     6.24159    0.03474 179.646  < 2e-16 ***
## Brave           0.57193    0.06196   9.231  < 2e-16 ***
## Selfless        0.30061    0.04543   6.616 8.21e-11 ***
## Brave:Selfless  0.13566    0.01658   8.181 1.71e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8038 on 596 degrees of freedom
## Multiple R-squared:  0.3095, Adjusted R-squared:  0.306 
## F-statistic: 89.06 on 3 and 596 DF,  p-value: < 2.2e-16
FfMod_typeIII <- car::Anova(FireMod, type = "III")
eta_squared(FfMod_typeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter      | Eta2 (partial) |       95% CI
## ----------------------------------------------
## Brave          |           0.13 | [0.09, 1.00]
## Selfless       |           0.07 | [0.04, 1.00]
## Brave:Selfless |           0.10 | [0.07, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(FireMod, pred = Brave, modx = Selfless)
## Warning: 1 is outside the observed range of Selfless
## JOHNSON-NEYMAN INTERVAL 
## 
## When Selfless is OUTSIDE the interval [-5.12, -3.52], the slope of Brave is
## p < .05.
## 
## Note: The range of observed values of Selfless is [-4.95, 0.63]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of Brave when Selfless = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.44   0.05     8.37   0.00
## 
## Slope of Brave when Selfless =  4.204045e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.57   0.06     9.23   0.00
## 
## Slope of Brave when Selfless =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.71   0.07     9.53   0.00
interact_plot(FireMod, pred = Brave, modx = Selfless)
## Warning: 1 is outside the observed range of Selfless

# etc.

In firefighters: there is a large Bravery/heroism association — Less so of a Selflessness/heroism association The interaction is significant.

NHS
paste0("HC analysis")
## [1] "HC analysis"
HCrole<- subset(df_Roles, df_Roles$Job == "HealthCare")
HCrole$Brave <- scale(HCrole$Brave)
HCrole$Selfless <- scale(HCrole$Selfless)

summary(HCMod<-lm(Heroes ~ Brave * Selfless, data = HCrole))
## 
## Call:
## lm(formula = Heroes ~ Brave * Selfless, data = HCrole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.4655 -0.3735  0.1640  0.2544  3.8351 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.75848    0.04103 140.338  < 2e-16 ***
## Brave           0.44846    0.04935   9.088  < 2e-16 ***
## Selfless        0.56379    0.05252  10.735  < 2e-16 ***
## Brave:Selfless  0.11931    0.02555   4.669 3.74e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9214 on 596 degrees of freedom
## Multiple R-squared:  0.4539, Adjusted R-squared:  0.4512 
## F-statistic: 165.1 on 3 and 596 DF,  p-value: < 2.2e-16
HCMod_typeIII <- car::Anova(HCMod, type = "III")
eta_squared(HCMod_typeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter      | Eta2 (partial) |       95% CI
## ----------------------------------------------
## Brave          |           0.12 | [0.08, 1.00]
## Selfless       |           0.16 | [0.12, 1.00]
## Brave:Selfless |           0.04 | [0.01, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(HCMod, pred = Brave, modx = Selfless)
## Warning: 0.999999999999998 is outside the observed range of Selfless
## JOHNSON-NEYMAN INTERVAL 
## 
## When Selfless is OUTSIDE the interval [-6.56, -2.49], the slope of Brave is
## p < .05.
## 
## Note: The range of observed values of Selfless is [-4.45, 0.87]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of Brave when Selfless = -1.00000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.33   0.05     6.16   0.00
## 
## Slope of Brave when Selfless =  1.32135e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.45   0.05     9.09   0.00
## 
## Slope of Brave when Selfless =  1.00000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.57   0.06     9.84   0.00
interact_plot(HCMod, pred = Brave, modx = Selfless)
## Warning: 0.999999999999998 is outside the observed range of Selfless

# etc.

In Healthcare workers, Heroism is largely associated to selflessness (16%), less so to bravery (12%), but is it significant though? To be explored.). The interaction is there, albeit small (4%).

Army
paste0("Soldier analysis")
## [1] "Soldier analysis"
MilitaryRole<- subset(df_Roles, df_Roles$Job == "Military")
MilitaryRole$Brave <- scale(MilitaryRole$Brave)
MilitaryRole$Selfless <- scale(MilitaryRole$Selfless)

summary(MilitaryMod<-lm(Heroes ~ Brave * Selfless, data = MilitaryRole))
## 
## Call:
## lm(formula = Heroes ~ Brave * Selfless, data = MilitaryRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.7806 -0.6400  0.3086  0.6503  4.5124 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.35942    0.04714 113.690  < 2e-16 ***
## Brave           0.93690    0.07667  12.221  < 2e-16 ***
## Selfless        0.47064    0.05970   7.883 1.53e-14 ***
## Brave:Selfless  0.19737    0.03082   6.404 3.06e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.025 on 596 degrees of freedom
## Multiple R-squared:  0.5346, Adjusted R-squared:  0.5323 
## F-statistic: 228.2 on 3 and 596 DF,  p-value: < 2.2e-16
HCMil_typeIII <- car::Anova(MilitaryMod, type = "III")
eta_squared(HCMil_typeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter      | Eta2 (partial) |       95% CI
## ----------------------------------------------
## Brave          |           0.20 | [0.16, 1.00]
## Selfless       |           0.09 | [0.06, 1.00]
## Brave:Selfless |           0.06 | [0.04, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(MilitaryMod, pred = Brave, modx = Selfless)
## JOHNSON-NEYMAN INTERVAL 
## 
## When Selfless is OUTSIDE the interval [-6.31, -3.84], the slope of Brave is
## p < .05.
## 
## Note: The range of observed values of Selfless is [-3.20, 1.05]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of Brave when Selfless = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.74   0.06    11.97   0.00
## 
## Slope of Brave when Selfless =  1.079692e-16 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.94   0.08    12.22   0.00
## 
## Slope of Brave when Selfless =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   1.13   0.10    11.43   0.00
interact_plot(MilitaryMod, pred = Brave, modx = Selfless)

# etc.

In armed forces, heroism levels are largely predicted by Bravery estimates (eta2 = 20%), less so by selflessness (eta2 = 9%). Once again, the interaction is relatively modest when considering the estimate (eta2 = 6%).

Police
paste0("Police analysis")
## [1] "Police analysis"
PoliceRole<- subset(df_Roles, df_Roles$Job == "Police")
PoliceRole$Brave <- scale(PoliceRole$Brave)
PoliceRole$Selfless <- scale(PoliceRole$Selfless)

summary(PolMod<-lm(Heroes ~ Brave * Selfless, data = PoliceRole))
## 
## Call:
## lm(formula = Heroes ~ Brave * Selfless, data = PoliceRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8209 -0.5933  0.1791  0.4234  5.3517 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     4.91862    0.04146 118.649   <2e-16 ***
## Brave           0.65220    0.06012  10.848   <2e-16 ***
## Selfless        0.53889    0.05587   9.646   <2e-16 ***
## Brave:Selfless  0.05675    0.02680   2.117   0.0347 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8849 on 596 degrees of freedom
## Multiple R-squared:  0.6018, Adjusted R-squared:  0.5998 
## F-statistic: 300.3 on 3 and 596 DF,  p-value: < 2.2e-16
PoltypeIII <- car::Anova(PolMod, type = "III")
eta_squared(PoltypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter      | Eta2 (partial) |       95% CI
## ----------------------------------------------
## Brave          |           0.16 | [0.12, 1.00]
## Selfless       |           0.14 | [0.10, 1.00]
## Brave:Selfless |       7.46e-03 | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(PolMod, pred = Brave, modx = Selfless)
## JOHNSON-NEYMAN INTERVAL 
## 
## When Selfless is OUTSIDE the interval [-148.12, -6.18], the slope of Brave
## is p < .05.
## 
## Note: The range of observed values of Selfless is [-2.96, 1.48]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of Brave when Selfless = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.60   0.06    10.68   0.00
## 
## Slope of Brave when Selfless =  1.072475e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.65   0.06    10.85   0.00
## 
## Slope of Brave when Selfless =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.71   0.07     9.51   0.00
interact_plot(PolMod, pred = Brave, modx = Selfless)

# etc.

In police, Bravery (16%) and selflessness (14%) appear to have - at the naked eye- a relatively similar contribution to heroism. The interaction is null (0.01%)

Psychiatrists
paste0("Psy analysis")
## [1] "Psy analysis"
table(df_Roles$Job)
## 
## Psychiatrist  Firefighter   HealthCare     Military       Police 
##          600          600          600          600          600
PsyRole<- subset(df_Roles, df_Roles$Job == "Psychiatrist")
PsyRole$Brave <- scale(PsyRole$Brave)
PsyRole$Selfless <- scale(PsyRole$Selfless)


summary(PsyMod<-lm(Heroes ~ Brave * Selfless, data = PsyRole))
## 
## Call:
## lm(formula = Heroes ~ Brave * Selfless, data = PsyRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.6267 -0.4522  0.1837  0.6026  2.6026 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     4.42254    0.04529  97.649  < 2e-16 ***
## Brave           0.49200    0.06158   7.990 7.01e-15 ***
## Selfless        0.49152    0.06275   7.833 2.19e-14 ***
## Brave:Selfless  0.13942    0.02657   5.247 2.16e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9972 on 596 degrees of freedom
## Multiple R-squared:  0.453,  Adjusted R-squared:  0.4503 
## F-statistic: 164.6 on 3 and 596 DF,  p-value: < 2.2e-16
PsyTypeIII <- car::Anova(PsyMod, type = "III")
eta_squared(PsyTypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter      | Eta2 (partial) |       95% CI
## ----------------------------------------------
## Brave          |           0.10 | [0.06, 1.00]
## Selfless       |           0.09 | [0.06, 1.00]
## Brave:Selfless |           0.04 | [0.02, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(PsyMod, pred = Brave, modx = Selfless)
## JOHNSON-NEYMAN INTERVAL 
## 
## When Selfless is OUTSIDE the interval [-6.00, -2.27], the slope of Brave is
## p < .05.
## 
## Note: The range of observed values of Selfless is [-3.46, 1.59]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of Brave when Selfless = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.35   0.07     5.12   0.00
## 
## Slope of Brave when Selfless =  1.397401e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.49   0.06     7.99   0.00
## 
## Slope of Brave when Selfless =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.63   0.07     9.69   0.00
interact_plot(PsyMod, pred = Brave, modx = Selfless)

# etc.

Similarly, psychiatrists heroism is derived from both Bravery (10%) and selflessness (9%). The interaction is quite weak (4%).


H2 Conclusion

Support for Hypotheses 2. Perception of heroism is linked to perception of bravery and selflessness. The effect sizes are quite large for our main effects. We can note that interactions between the two attributes is quite small. Both contribute to heroism, but they appear to describe heroism in different manners for each occupation (see “Job Analysis : Bravery and Selfless make heroes?”)


H3a, b, and c: MC2 as predictors

This tab contains:

Similar analyses were conducted but using the second Manipulation check as predictors: the evaluation of exposure to physical risks and of helpfulness of each occupation.


H3 Model comparison

# Add the General attitudes to the target df
df_Roles <- df_Roles[order(df_Roles$ResponseId),]

long_df_MC_Help <- long_df_MC_Help[order(long_df_MC_Help$ResponseId),]
long_df_MC_Risk <- long_df_MC_Risk[order(long_df_MC_Risk$ResponseId),]
df_Roles$Help <-long_df_MC_Help$value
df_Roles$ExposureRisk <-long_df_MC_Risk$value


### PLEASE VERIFY ID (done)
#df_Roles$ID2 <-long_df_MC_Help$ResponseId
#df_Roles$ID3 <-long_df_MC_Risk$ResponseId

df_Roles$Help_unscaled <- (df_Roles$Help)
df_Roles$ExposureRisk_unscaled <- (df_Roles$ExposureRisk)
df_Roles$Help <- scale(df_Roles$Help)
df_Roles$ExposureRisk <- scale(df_Roles$ExposureRisk)


mod<-lmer(Heroes ~ Help * ExposureRisk + (1|ResponseId), data = df_Roles)
mod_cov<-lmer(Heroes ~ Help * ExposureRisk * Job + (1|ResponseId), data = df_Roles)
anova(mod, mod_cov)
## refitting model(s) with ML (instead of REML)
## Data: df_Roles
## Models:
## mod: Heroes ~ Help * ExposureRisk + (1 | ResponseId)
## mod_cov: Heroes ~ Help * ExposureRisk * Job + (1 | ResponseId)
##         npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mod        6 8512.3 8548.4 -4250.2   8500.3                         
## mod_cov   22 8191.6 8323.7 -4073.8   8147.6 352.77 16  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

H3 Main registered model

anova(mod)
## Type III Analysis of Variance Table with Satterthwaite's method
##                    Sum Sq Mean Sq NumDF  DenDF   F value  Pr(>F)    
## Help              1500.98 1500.98     1 2945.2 1883.2688 < 2e-16 ***
## ExposureRisk       448.28  448.28     1 2678.7  562.4521 < 2e-16 ***
## Help:ExposureRisk    2.16    2.16     1 2797.5    2.7131 0.09964 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mod)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Heroes ~ Help * ExposureRisk + (1 | ResponseId)
##    Data: df_Roles
## 
## REML criterion at convergence: 8524.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.5094 -0.5339  0.0920  0.5767  3.3410 
## 
## Random effects:
##  Groups     Name        Variance Std.Dev.
##  ResponseId (Intercept) 0.3286   0.5733  
##  Residual               0.7970   0.8928  
## Number of obs: 3000, groups:  ResponseId, 600
## 
## Fixed effects:
##                    Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)       5.427e+00  2.865e-02 6.066e+02 189.411   <2e-16 ***
## Help              8.185e-01  1.886e-02 2.945e+03  43.397   <2e-16 ***
## ExposureRisk      4.207e-01  1.774e-02 2.679e+03  23.716   <2e-16 ***
## Help:ExposureRisk 2.715e-02  1.648e-02 2.797e+03   1.647   0.0996 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) Help   ExpsrR
## Help        -0.005              
## ExposureRsk -0.015 -0.091       
## Hlp:ExpsrRs -0.095  0.047  0.155
confint(mod)
## Computing profile confidence intervals ...
##                          2.5 %    97.5 %
## .sig01             0.524958902 0.6229194
## .sigma             0.867582496 0.9181146
## (Intercept)        5.370638065 5.4830032
## Help               0.781480639 0.8554898
## ExposureRisk       0.385888795 0.4554729
## Help:ExposureRisk -0.005172662 0.0594414
F_to_eta2(1883.2688, 1, 2945.2)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.39           | [0.37, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(562.4521, 1, 2678.7)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.17           | [0.15, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(562.4521, 1, 2678.7)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.17           | [0.15, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(2.7131, 1, 2797.5)
## Eta2 (partial) |       95% CI
## -----------------------------
## 9.69e-04       | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
qqnorm(resid(mod))
qqline(resid(mod))

plot(fitted(mod),residuals(mod))
abline(h = 0)

# Robust variances
robust_results <- coef_test(mod, vcov = "CR2")
print(robust_results)
##              Coef. Estimate     SE t-stat d.f. (Satt) p-val (Satt) Sig.
##        (Intercept)   5.4268 0.0292 185.98         597       <0.001  ***
##               Help   0.8185 0.0282  29.06         265       <0.001  ***
##       ExposureRisk   0.4207 0.0213  19.73         393       <0.001  ***
##  Help:ExposureRisk   0.0271 0.0229   1.18         121        0.239

Both variables contribute to Heroism with helpfulness’ effect being definitely larger (partial eta^2 = 39%) as Risk (17%). The barely significant interaction should be discarded as negligeable (< .0001).


H3 Outliers analyses

Non_robust_model<-lmer(Heroes ~ Help * ExposureRisk + (1|ResponseId), data = df_Roles)

#Robust_model<-rlmer(Heroes ~ Help * ExposureRisk + (1|ResponseId), data = df_Roles, method = "DASvar")
#compare(Non_robust_model, Robust_model)

There is no reason to use a robust model here, as the betas do not seem very discrepant.


H3 Decomposition of the effects within job

If an interaction between Risk and Motivation comes out as positive it will be decompose this interaction as follow:

anova(mod_cov)
## Type III Analysis of Variance Table with Satterthwaite's method
##                       Sum Sq Mean Sq NumDF  DenDF  F value    Pr(>F)    
## Help                  373.66  373.66     1 2901.5 542.4300 < 2.2e-16 ***
## ExposureRisk           16.73   16.73     1 2854.7  24.2852 8.782e-07 ***
## Job                   129.48   32.37     4 2600.0  46.9908 < 2.2e-16 ***
## Help:ExposureRisk       3.66    3.66     1 2838.4   5.3069   0.02131 *  
## Help:Job                7.94    1.98     4 2628.4   2.8806   0.02147 *  
## ExposureRisk:Job        6.89    1.72     4 2633.9   2.5008   0.04063 *  
## Help:ExposureRisk:Job  12.52    3.13     4 2624.5   4.5433   0.00117 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
sim_slopes(mod, pred = ExposureRisk, modx = Help)
## Warning: 1.00000000000002 is outside the observed range of Help
## JOHNSON-NEYMAN INTERVAL 
## 
## When Help is INSIDE the interval [-7.12, 80.31], the slope of ExposureRisk
## is p < .05.
## 
## Note: The range of observed values of Help is [-3.70, 0.88]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of ExposureRisk when Help = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.39   0.02    17.67   0.00
## 
## Slope of ExposureRisk when Help = -2.155313e-16 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.42   0.02    23.72   0.00
## 
## Slope of ExposureRisk when Help =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.45   0.03    17.22   0.00
interact_plot(mod, pred = ExposureRisk, modx = Help)
## Warning: 1.00000000000002 is outside the observed range of Help

There are significant moderation of job types on our main predictors. We should therefore explore how Risk and Helpfulness influence heroism within each job.

Performing models for each job delete the repeated-measure component of the design. Consequently, we can perform classic OLS regression analyses.

Firefighters
paste0("Firefighter analysis")
## [1] "Firefighter analysis"
FireRole<- subset(df_Roles, df_Roles$Job == "Firefighter")
FireRole$Help <- scale(FireRole$Help)
FireRole$ExposureRisk <- scale(FireRole$ExposureRisk)



summary(FireMod<-lm(Heroes ~ Help * ExposureRisk, data = FireRole))
## 
## Call:
## lm(formula = Heroes ~ Help * ExposureRisk, data = FireRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.6229 -0.4384  0.3771  0.3771  2.0670 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        6.34375    0.03529 179.769  < 2e-16 ***
## Help               0.35998    0.04601   7.824 2.34e-14 ***
## ExposureRisk       0.14117    0.04143   3.407   0.0007 ***
## Help:ExposureRisk -0.01668    0.01632  -1.022   0.3071    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8386 on 596 degrees of freedom
## Multiple R-squared:  0.2485, Adjusted R-squared:  0.2447 
## F-statistic: 65.68 on 3 and 596 DF,  p-value: < 2.2e-16
FFTypeIII <- car::Anova(FireMod, type = "III")
eta_squared(FFTypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter         | Eta2 (partial) |       95% CI
## -------------------------------------------------
## Help              |           0.09 | [0.06, 1.00]
## ExposureRisk      |           0.02 | [0.01, 1.00]
## Help:ExposureRisk |       1.75e-03 | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(FireMod, pred = ExposureRisk, modx = Help)
## Warning: 1.00000000000001 is outside the observed range of Help
## JOHNSON-NEYMAN INTERVAL 
## 
## When Help is INSIDE the interval [-9.75, 1.82], the slope of ExposureRisk
## is p < .05.
## 
## Note: The range of observed values of Help is [-7.50, 0.56]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of ExposureRisk when Help = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.16   0.04     3.87   0.00
## 
## Slope of ExposureRisk when Help =  5.910827e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.14   0.04     3.41   0.00
## 
## Slope of ExposureRisk when Help =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.12   0.05     2.60   0.01
interact_plot(FireMod, pred = ExposureRisk, modx = Help)
## Warning: 1.00000000000001 is outside the observed range of Help

# etc.

Heroism in firefighters is mainly explained by the fact that they help others (9%), less so about their exposure to risky situation (2%). No interaction.

NHS
paste0("HC analysis")
## [1] "HC analysis"
HCrole<- subset(df_Roles, df_Roles$Job == "HealthCare")
HCrole$Help <- scale(HCrole$Help)
HCrole$ExposureRisk <- scale(HCrole$ExposureRisk)

summary(HCMod<-lm(Heroes ~ Help * ExposureRisk, data = HCrole))
## 
## Call:
## lm(formula = Heroes ~ Help * ExposureRisk, data = HCrole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.3212 -0.5134  0.2788  0.7869  3.1156 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        5.84781    0.04443 131.623  < 2e-16 ***
## Help               0.56615    0.05011  11.297  < 2e-16 ***
## ExposureRisk       0.16738    0.04521   3.703 0.000233 ***
## Help:ExposureRisk -0.04241    0.03640  -1.165 0.244433    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.054 on 596 degrees of freedom
## Multiple R-squared:  0.2849, Adjusted R-squared:  0.2813 
## F-statistic: 79.15 on 3 and 596 DF,  p-value: < 2.2e-16
HCTypeIII <- car::Anova(HCMod, type = "III")
eta_squared(HCTypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter         | Eta2 (partial) |       95% CI
## -------------------------------------------------
## Help              |           0.18 | [0.13, 1.00]
## ExposureRisk      |           0.02 | [0.01, 1.00]
## Help:ExposureRisk |       2.27e-03 | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(HCMod, pred = ExposureRisk, modx = Help)
## Warning: 1.00000000000001 is outside the observed range of Help
## JOHNSON-NEYMAN INTERVAL 
## 
## When Help is INSIDE the interval [-5.46, 1.11], the slope of ExposureRisk
## is p < .05.
## 
## Note: The range of observed values of Help is [-5.61, 0.62]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of ExposureRisk when Help = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.21   0.06     3.64   0.00
## 
## Slope of ExposureRisk when Help =  4.117817e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.17   0.05     3.70   0.00
## 
## Slope of ExposureRisk when Help =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.12   0.06     2.14   0.03
interact_plot(HCMod, pred = ExposureRisk, modx = Help)
## Warning: 1.00000000000001 is outside the observed range of Help

# etc.

In healthcare worker, it’s definitely helping others (18%) and less so exposure to risk (2%). No interaction.

Army
paste0("Soldier analysis")
## [1] "Soldier analysis"
MilitaryRole<- subset(df_Roles, df_Roles$Job == "Military")

MilitaryRole$Help <- scale(MilitaryRole$Help)
MilitaryRole$ExposureRisk <- scale(MilitaryRole$ExposureRisk)



summary(MilMod<-lm(Heroes ~ Help * ExposureRisk, data = MilitaryRole))
## 
## Call:
## lm(formula = Heroes ~ Help * ExposureRisk, data = MilitaryRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0650 -0.6715  0.2582  0.5966  3.4368 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        5.5176686  0.0460107 119.922   <2e-16 ***
## Help               1.0223736  0.0464516  22.009   <2e-16 ***
## ExposureRisk       0.0008265  0.0566386   0.015    0.988    
## Help:ExposureRisk -0.0653752  0.0422592  -1.547    0.122    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.085 on 596 degrees of freedom
## Multiple R-squared:  0.4791, Adjusted R-squared:  0.4764 
## F-statistic: 182.7 on 3 and 596 DF,  p-value: < 2.2e-16
MilTypeIII <- car::Anova(MilMod, type = "III")
eta_squared(MilTypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter         | Eta2 (partial) |       95% CI
## -------------------------------------------------
## Help              |           0.45 | [0.40, 1.00]
## ExposureRisk      |       3.57e-07 | [0.00, 1.00]
## Help:ExposureRisk |       4.00e-03 | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(MilMod, pred = ExposureRisk, modx = Help)
## JOHNSON-NEYMAN INTERVAL 
## 
## The Johnson-Neyman interval could not be found. Is the p value for your
## interaction term below the specified alpha?
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of ExposureRisk when Help = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.07   0.05     1.40   0.16
## 
## Slope of ExposureRisk when Help =  6.988854e-16 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.00   0.06     0.01   0.99
## 
## Slope of ExposureRisk when Help =  1.000000e+00 (+ 1 SD): 
## 
##    Est.   S.E.   t val.      p
## ------- ------ -------- ------
##   -0.06   0.09    -0.73   0.46
interact_plot(MilMod, pred = ExposureRisk, modx = Help)

# etc.

In military – HELPING OTHERS contribute greatly to their heroism level (45%). Exposure to risk: not at all. It might be due to the fact that everyone score 7 for exposure to risk here, so there is no variance because of this ceiling effect.

Police
paste0("Police analysis")
## [1] "Police analysis"
PoliceRole<- subset(df_Roles, df_Roles$Job == "Police")

PoliceRole$Help <- scale(PoliceRole$Help)
PoliceRole$ExposureRisk <- scale(PoliceRole$ExposureRisk)



summary(PolMod<-lm(Heroes ~ Help * ExposureRisk, data = PoliceRole))
## 
## Call:
## lm(formula = Heroes ~ Help * ExposureRisk, data = PoliceRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8889 -0.5466  0.1111  0.6547  2.7688 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       4.959062   0.042361 117.068  < 2e-16 ***
## Help              0.926397   0.043779  21.161  < 2e-16 ***
## ExposureRisk      0.167888   0.045810   3.665  0.00027 ***
## Help:ExposureRisk 0.006352   0.035295   0.180  0.85724    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9752 on 596 degrees of freedom
## Multiple R-squared:  0.5164, Adjusted R-squared:  0.514 
## F-statistic: 212.2 on 3 and 596 DF,  p-value: < 2.2e-16
PolTypeIII <- car::Anova(PolMod, type = "III")
eta_squared(PolTypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter         | Eta2 (partial) |       95% CI
## -------------------------------------------------
## Help              |           0.43 | [0.38, 1.00]
## ExposureRisk      |           0.02 | [0.01, 1.00]
## Help:ExposureRisk |       5.43e-05 | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(PolMod, pred = ExposureRisk, modx = Help)
## JOHNSON-NEYMAN INTERVAL 
## 
## When Help is INSIDE the interval [-2.23, 1.89], the slope of ExposureRisk
## is p < .05.
## 
## Note: The range of observed values of Help is [-3.08, 1.15]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of ExposureRisk when Help = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.16   0.05     3.32   0.00
## 
## Slope of ExposureRisk when Help = -1.218747e-15 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.17   0.05     3.66   0.00
## 
## Slope of ExposureRisk when Help =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.17   0.07     2.65   0.01
interact_plot(PolMod, pred = ExposureRisk, modx = Help)

# etc.

Police officer’s heroism is predicted by Help (43%) and to a lesser extent, exposure to risk (2%).

Psychiatrists
paste0("Psy analysis")
## [1] "Psy analysis"
table(df_Roles$Job)
## 
## Psychiatrist  Firefighter   HealthCare     Military       Police 
##          600          600          600          600          600
PsyRole<- subset(df_Roles, df_Roles$Job == "Psychiatrist")
PsyRole$Help <- scale(PsyRole$Help)
PsyRole$ExposureRisk <- scale(PsyRole$ExposureRisk)


summary(PsyMod<-lm(Heroes ~ Help * ExposureRisk, data = PsyRole))
## 
## Call:
## lm(formula = Heroes ~ Help * ExposureRisk, data = PsyRole)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.5950 -0.6870  0.0729  0.7849  2.6410 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        4.52133    0.04868  92.869  < 2e-16 ***
## Help               0.63203    0.05200  12.155  < 2e-16 ***
## ExposureRisk       0.21630    0.04990   4.334 1.72e-05 ***
## Help:ExposureRisk  0.01555    0.04475   0.348    0.728    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.132 on 596 degrees of freedom
## Multiple R-squared:  0.2956, Adjusted R-squared:  0.2921 
## F-statistic: 83.38 on 3 and 596 DF,  p-value: < 2.2e-16
PsyTypeIII <- car::Anova(PsyMod, type = "III")
eta_squared(PsyTypeIII, partial = TRUE)
## Type 3 ANOVAs only give sensible and informative results when covariates
##   are mean-centered and factors are coded with orthogonal contrasts (such
##   as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but
##   *not* by the default `contr.treatment`).
## # Effect Size for ANOVA (Type III)
## 
## Parameter         | Eta2 (partial) |       95% CI
## -------------------------------------------------
## Help              |           0.20 | [0.15, 1.00]
## ExposureRisk      |           0.03 | [0.01, 1.00]
## Help:ExposureRisk |       2.03e-04 | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
sim_slopes(PsyMod, pred = ExposureRisk, modx = Help)
## JOHNSON-NEYMAN INTERVAL 
## 
## When Help is INSIDE the interval [-1.68, 2.96], the slope of ExposureRisk
## is p < .05.
## 
## Note: The range of observed values of Help is [-3.86, 1.13]
## 
## SIMPLE SLOPES ANALYSIS 
## 
## Slope of ExposureRisk when Help = -1.000000e+00 (- 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.20   0.07     2.78   0.01
## 
## Slope of ExposureRisk when Help =  2.361074e-16 (Mean): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.22   0.05     4.33   0.00
## 
## Slope of ExposureRisk when Help =  1.000000e+00 (+ 1 SD): 
## 
##   Est.   S.E.   t val.      p
## ------ ------ -------- ------
##   0.23   0.06     3.78   0.00
interact_plot(PsyMod, pred = ExposureRisk, modx = Help)

# etc.

Here also, it is Helping others that explain the heroism level in the model with psychiatrists (20%). Exposure to risk definitely less so (3%). ___

H3 Conclusion

Support for Hypotheses 3. Perception of heroism is linked to perception of Risk and Helpfulness The effect sizes are quite large for our main effects, with a definite advantage of Helpfulness. This effect can be due to the fact that soldiers and police officers can be villainized despite everyone agreeing that they are objectively in risky situations. In a nutshell, people can disagree on bravery and heroism, but it would be counterfactual to disagree on the risk involved in occupations. This can make this dimension less predictive of heroism (but note that the contribution of risk perception to heroism remains quite significant).

We can note that interactions between the two attributes is small and negligeable (a comparison between additive and interactive model further emphasise this point, see Is the model additive or interactive). Both helpfulness and risk contribute to heroism, but Helpfulness is consistently a better predictor of heroism (see “[Job Analysis : Risky environments and Helpfulness make heroes?]”).


Conclusion

We aimed to assess the effect of our manipulation of risk exposure and altruism on heroism. Our two manipulation checks indicated a general failure: although the manipulation of altruism had a small effect on the perceived selflessness of the targets, it was too weak to be of interest. Our manipulation had null effects on perceived bravery. It also had null effects on ‘objective’ physical appraisals of the occupations: bein exposed to physical risks, and Helping others (Note that our manipulation was about wanting to help others, not helping others).

These results are thus a strong signal that we should revise our protocol accordingly.

  1. We should create more vivid manipulations (e.g., “a day in a life of a xxxx”).

  2. We could think in term of greater contrasts: some individualistic motivation manipulations could be framed as altruistic (catching suspects, for police officers; having correct diagnoses for HC).

  3. Target jobs (with the exception of psychiatrists and, to some extent, police officers) are stereotypically heroes. It might be hard to have movement in these representations given their typicality.

==> Our next text will use vignettes really emphasising physical risks (vs stress) and altruism (vs. individualistic) via a typical day of the occupation (perhaps an illustration?). We will focus on HC workers, psychiatrists, and police officers.

However, when testing the foundations of our study, we found strong support that perceiving heroism is strongly related to the perception of bravery and selflessness and to the perception of Risk and helpfulness. This is encouraging.

Decomposing the effects of H2 and H3 revealed that Altruism and Risk taking might be attributes of heroism that work with a relative independence (i.e., their interaction appear to be weak [in the case of H2] if not inexistant [in the case of H3]).

Another element that catches our attention is that, depending on the specific occupation, the Altruism component and the Risk component of heroism could provide different contributions. A nurse is heroic to the extent that they’s altruistic – and to a lesser extent exposed to risk ; A military is heroic to the extent that they’s brave – and to a lesser extent altruistic.

In the next sections, we explore further those two aspects: the additive vs interactive nature of altruism and risk taking, and the relative contribution of each component in each occupation.


Exploratory analyses

Some exploratory analyses were registered (see ‘Additional comments’ section on OSF registration)

The following exploratory analyses were conducted:

Further not-registered analyses:

long_df_Attitude$Risk_dummy <- ifelse(df_Adj$Risk == "Physical", 0.5, -0.5) # 
long_df_Attitude$Motiv_dummy <- ifelse(df_Adj$Motiv == "Altruistic", 0.5, -0.5)
long_df_Attitude <- long_df_Attitude[order(long_df_Attitude$ResponseId), ]
df_Roles <- df_Roles[order(df_Roles$ResponseId), ]
long_df_Attitude$Heroism <- df_Roles$Heroes
long_df_Attitude$Victims <- df_Roles$Victims
long_df_Attitude$Villains <- df_Roles$Villains



df_Adj <- df_Adj[order(df_Adj$ResponseId), ]
long_df_Attitude$Brave <- scale(df_Adj$Brave)
long_df_Attitude$Selfless <- scale(df_Adj$Selfless)
long_df_Attitude$Brave_unscaled <- (df_Adj$Brave)
long_df_Attitude$Selfless_unscaled <- (df_Adj$Selfless)
  

MetaDF <- long_df_Attitude

MetaDF$Attitude <- MetaDF$value

MetaDF$ExposureRisk <- df_Roles$ExposureRisk_unscaled
MetaDF$Help <- df_Roles$Help_unscaled

Villains and victims

Exploratory analyses using similar models as the ones described in Predicted Analyses 1 and Predicted analyses 2 will be used to regress Villain and Victim perceptions (individually) on the manipulated variables.

# e.g.,

# Add the General attitudes to the target df
df_Roles <- df_Roles[order(df_Roles$ResponseId),]

paste0("Villains ~ manipulation")
## [1] "Villains ~ manipulation"
anova(mod<-lmer(Villains ~ Risk_dummy * Motiv_dummy + (1|ResponseId), data = MetaDF))
## Type III Analysis of Variance Table with Satterthwaite's method
##                         Sum Sq Mean Sq NumDF  DenDF F value  Pr(>F)  
## Risk_dummy             0.19740 0.19740     1 2710.4  0.2162 0.64202  
## Motiv_dummy            0.55422 0.55422     1 2741.3  0.6069 0.43602  
## Risk_dummy:Motiv_dummy 2.48038 2.48038     1 2757.9  2.7162 0.09945 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("Victims ~ manipulation")
## [1] "Victims ~ manipulation"
anova(mod<-lmer(Victims ~ Risk_dummy * Motiv_dummy + (1|ResponseId), data = MetaDF))
## Type III Analysis of Variance Table with Satterthwaite's method
##                          Sum Sq  Mean Sq NumDF  DenDF F value Pr(>F)
## Risk_dummy             0.098293 0.098293     1 2599.0  0.0792 0.7784
## Motiv_dummy            0.007137 0.007137     1 2621.2  0.0058 0.9396
## Risk_dummy:Motiv_dummy 0.033268 0.033268     1 2633.4  0.0268 0.8700
paste0("Villains ~ Brave * selfless")
## [1] "Villains ~ Brave * selfless"
anova(mod<-lmer(Villains ~ Brave * Selfless + (1|ResponseId), data = MetaDF))
## Type III Analysis of Variance Table with Satterthwaite's method
##                 Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## Brave            7.829   7.829     1 2730.3  11.980 0.0005459 ***
## Selfless       250.367 250.367     1 2868.8 383.151 < 2.2e-16 ***
## Brave:Selfless  20.880  20.880     1 2988.1  31.953 1.728e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("Victims ~ Brave * selfless")
## [1] "Victims ~ Brave * selfless"
anova(mod<-lmer(Victims ~ Brave * Selfless + (1|ResponseId), data = MetaDF))
## Type III Analysis of Variance Table with Satterthwaite's method
##                 Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## Brave          21.4034 21.4034     1 2629.6 17.7109 2.658e-05 ***
## Selfless        0.8441  0.8441     1 2748.7  0.6985 0.4033626    
## Brave:Selfless 13.5146 13.5146     1 2961.3 11.1830 0.0008358 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("Villains ~ Risk * Helpful")
## [1] "Villains ~ Risk * Helpful"
anova(mod<-lmer(Villains ~  ExposureRisk * Help + (1|ResponseId), data = MetaDF))
## Type III Analysis of Variance Table with Satterthwaite's method
##                   Sum Sq Mean Sq NumDF  DenDF  F value    Pr(>F)    
## ExposureRisk       5.684   5.684     1 2778.5   9.4882  0.002088 ** 
## Help              60.036  60.036     1 2816.6 100.2166 < 2.2e-16 ***
## ExposureRisk:Help  2.348   2.348     1 2782.8   3.9188  0.047847 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("Victims ~ Risk * Helpful")
## [1] "Victims ~ Risk * Helpful"
anova(mod<-lmer(Victims ~  ExposureRisk * Help + (1|ResponseId), data = MetaDF))
## Type III Analysis of Variance Table with Satterthwaite's method
##                   Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## ExposureRisk      26.704  26.704     1 2650.1  22.030 2.821e-06 ***
## Help              13.361  13.361     1 2680.9  11.022 0.0009124 ***
## ExposureRisk:Help 12.579  12.579     1 2652.8  10.377 0.0012915 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Without Relevant Job participants

Additional sensitivity analyses will be conducted when excluding participants whose occupations are directly relevant or similar to the target occupations of the study.

# e.g., 

# Add the General attitudes to the target df
df_Roles_Excl <- subset(df_Roles, df_Roles$None_job=="None")

anova(mod<-lmer(Heroes ~ Risk_dummy * Motiv_dummy * Job + (1|ResponseId), data = df_Roles_Excl))
## Type III Analysis of Variance Table with Satterthwaite's method
##                             Sum Sq Mean Sq NumDF  DenDF  F value Pr(>F)    
## Risk_dummy                    0.76   0.763     1 2264.2   0.7510 0.3862    
## Motiv_dummy                   0.09   0.092     1 2280.2   0.0902 0.7639    
## Job                        1051.22 262.804     4 2052.7 258.5525 <2e-16 ***
## Risk_dummy:Motiv_dummy        1.07   1.072     1 2305.2   1.0547 0.3045    
## Risk_dummy:Job                6.89   1.722     4 2270.7   1.6943 0.1485    
## Motiv_dummy:Job               3.42   0.856     4 2266.5   0.8418 0.4985    
## Risk_dummy:Motiv_dummy:Job    2.21   0.553     4 2261.0   0.5443 0.7033    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
anova(mod<-lmer(Heroes ~ Brave * Motiv_dummy * Job + (1|ResponseId), data = df_Roles_Excl))
## Type III Analysis of Variance Table with Satterthwaite's method
##                       Sum Sq Mean Sq NumDF  DenDF   F value    Pr(>F)    
## Brave                 774.20  774.20     1 2561.0 1091.4417 < 2.2e-16 ***
## Motiv_dummy             0.37    0.37     1 2371.6    0.5278    0.4676    
## Job                   256.38   64.10     4 2133.2   90.3594 < 2.2e-16 ***
## Brave:Motiv_dummy       0.04    0.04     1 2422.9    0.0512    0.8209    
## Brave:Job              42.64   10.66     4 2221.2   15.0295 3.981e-12 ***
## Motiv_dummy:Job         1.94    0.48     4 2311.8    0.6835    0.6034    
## Brave:Motiv_dummy:Job   2.20    0.55     4 2303.2    0.7736    0.5423    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
anova(mod<-lmer(Heroes ~ Risk_dummy * Motiv_dummy * Job + (1|ResponseId), data = df_Roles_Excl))
## Type III Analysis of Variance Table with Satterthwaite's method
##                             Sum Sq Mean Sq NumDF  DenDF  F value Pr(>F)    
## Risk_dummy                    0.76   0.763     1 2264.2   0.7510 0.3862    
## Motiv_dummy                   0.09   0.092     1 2280.2   0.0902 0.7639    
## Job                        1051.22 262.804     4 2052.7 258.5525 <2e-16 ***
## Risk_dummy:Motiv_dummy        1.07   1.072     1 2305.2   1.0547 0.3045    
## Risk_dummy:Job                6.89   1.722     4 2270.7   1.6943 0.1485    
## Motiv_dummy:Job               3.42   0.856     4 2266.5   0.8418 0.4985    
## Risk_dummy:Motiv_dummy:Job    2.21   0.553     4 2261.0   0.5443 0.7033    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#summary(mod)

Attitudes

We assessed general attitudes toward each occupations to see if heroism can be predicted by our manipulations above and beyond heroism (i.e., “Attitude ~ Threat * Motivation + Heroism score + (1| participant)”)

Heroes

paste0("Heroes ~ Manip")
## [1] "Heroes ~ Manip"
summary(lmer( Heroism ~ Risk_dummy * Motiv_dummy + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                            Estimate Std. Error       df     t value
## (Intercept)            1.4898318745 0.07747647 2900.070 19.22947438
## Risk_dummy             0.0254343582 0.03416025 2724.607  0.74456011
## Motiv_dummy            0.0005451832 0.03440797 2756.370  0.01584468
## Attitude               0.7050177690 0.01296160 2975.966 54.39281827
## Risk_dummy:Motiv_dummy 0.0066423376 0.06907917 2773.107  0.09615544
##                            Pr(>|t|)
## (Intercept)            1.173158e-77
## Risk_dummy             4.566019e-01
## Motiv_dummy            9.873595e-01
## Attitude               0.000000e+00
## Risk_dummy:Motiv_dummy 9.234041e-01
paste0("Heroes ~ Personality Attributes")
## [1] "Heroes ~ Personality Attributes"
summary(lmer( Heroism ~ Brave * Selfless + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                  Estimate Std. Error       df   t value      Pr(>|t|)
## (Intercept)    3.18798639 0.08770005 2919.268 36.351021 5.344657e-239
## Brave          0.50508772 0.02321807 2792.961 21.754075  4.650245e-97
## Selfless       0.30108281 0.02489989 2985.752 12.091733  6.771124e-33
## Attitude       0.39132713 0.01514741 2994.895 25.834594 4.937586e-133
## Brave:Selfless 0.07720198 0.01196621 2922.689  6.451663  1.290230e-10
paste0("Heroes ~ Physical attributed")
## [1] "Heroes ~ Physical attributed"
summary(lmer( Heroism ~ ExposureRisk * Help + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                     Estimate  Std. Error       df   t value      Pr(>|t|)
## (Intercept)       0.52251201 0.247391316 2863.586  2.112087  3.476535e-02
## ExposureRisk      0.15179899 0.043145754 2781.618  3.518283  4.413083e-04
## Help              0.16057570 0.045602727 2847.417  3.521186  4.363657e-04
## Attitude          0.49348483 0.019305602 2977.510 25.561743 1.827094e-130
## ExposureRisk:Help 0.01085958 0.007428484 2784.361  1.461884  1.438858e-01

Our manipulation fails to predict heroism, even when controlling for attitude

After controlling for attitude, the main predictors (Brave/Selfless; Risk/Helpfulness) remain significant predictor of heroism

Villains

paste0("Villains ~ Manip")
## [1] "Villains ~ Manip"
summary(lmer( Villains ~ Risk_dummy * Motiv_dummy + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                            Estimate Std. Error       df     t value
## (Intercept)             4.399219054 0.06806359 2915.602  64.6339573
## Risk_dummy              0.012694801 0.02931612 2667.075   0.4330315
## Motiv_dummy            -0.007689907 0.02955451 2694.960  -0.2601941
## Attitude               -0.474098458 0.01123501 2924.875 -42.1983044
## Risk_dummy:Motiv_dummy  0.089473855 0.05936350 2709.927   1.5072200
##                             Pr(>|t|)
## (Intercept)             0.000000e+00
## Risk_dummy              6.650269e-01
## Motiv_dummy             7.947340e-01
## Attitude               2.392244e-304
## Risk_dummy:Motiv_dummy  1.318708e-01
paste0("Villains ~ Personality Attributes")
## [1] "Villains ~ Personality Attributes"
summary(lmer( Villains ~ Brave * Selfless + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                   Estimate Std. Error       df    t value      Pr(>|t|)
## (Intercept)     3.84174549 0.08777039 2971.447  43.770402 1.976263e-323
## Brave           0.04869955 0.02261704 2707.180   2.153224  3.138912e-02
## Selfless       -0.18440588 0.02455570 2924.473  -7.509697  7.825087e-14
## Attitude       -0.38562441 0.01498985 2960.183 -25.725703 6.844985e-132
## Brave:Selfless  0.08727653 0.01194750 2994.125   7.305005  3.537820e-13
paste0("Villains ~ Physical Attributes")
## [1] "Villains ~ Physical Attributes"
summary(lmer( Villains ~ ExposureRisk * Help + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                      Estimate  Std. Error       df    t value     Pr(>|t|)
## (Intercept)        4.01631532 0.221858852 2827.053  18.103020 2.160854e-69
## ExposureRisk       0.16013252 0.038619566 2737.339   4.146409 3.479989e-05
## Help              -0.13537038 0.040876458 2802.006  -3.311695 9.390892e-04
## Attitude          -0.35054559 0.017379430 2946.897 -20.170143 7.420061e-85
## ExposureRisk:Help -0.01246022 0.006649545 2739.664  -1.873845 6.105813e-02

Victims

paste0("Victims ~ Manip")
## [1] "Victims ~ Manip"
summary(lmer( Victims ~ Risk_dummy * Motiv_dummy + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                            Estimate Std. Error       df     t value
## (Intercept)             2.299599686 0.10632492 2897.697 21.62803968
## Risk_dummy             -0.012378745 0.04413830 2595.869 -0.28045356
## Motiv_dummy             0.001241838 0.04454155 2617.795  0.02788043
## Attitude                0.048066369 0.01711305 2826.279  2.80875474
## Risk_dummy:Motiv_dummy -0.011590269 0.08951574 2629.762 -0.12947744
##                            Pr(>|t|)
## (Intercept)            2.716285e-96
## Risk_dummy             7.791519e-01
## Motiv_dummy            9.777596e-01
## Attitude               5.007523e-03
## Risk_dummy:Motiv_dummy 8.969898e-01
paste0("Victims ~ Personality Attributes")
## [1] "Victims ~ Personality Attributes"
summary(lmer( Victims ~ Brave * Selfless + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                   Estimate Std. Error       df    t value     Pr(>|t|)
## (Intercept)     2.75254636 0.13824786 2986.641 19.9102283 6.319358e-83
## Brave           0.15012840 0.03456874 2623.661  4.3428955 1.459538e-05
## Selfless       -0.00904664 0.03793834 2824.877 -0.2384564 8.115444e-01
## Attitude       -0.02498704 0.02322629 2867.358 -1.0758083 2.821035e-01
## Brave:Selfless -0.06185177 0.01866173 2957.994 -3.3143642 9.295871e-04
paste0("Victims ~ Physical attributes")
## [1] "Victims ~ Physical attributes"
summary(lmer( Victims ~ ExposureRisk * Help + Attitude + (1|ResponseId), data = MetaDF))$coefficients
##                      Estimate Std. Error       df   t value     Pr(>|t|)
## (Intercept)        0.91644466 0.34640185 2756.861  2.645611 8.200658e-03
## ExposureRisk       0.27809215 0.06001964 2649.826  4.633352 3.771864e-06
## Help               0.16893044 0.06370430 2704.832  2.651790 8.053365e-03
## Attitude           0.03853132 0.02731311 2847.087  1.410726 1.584346e-01
## ExposureRisk:Help -0.03351841 0.01033508 2651.251 -3.243169 1.196750e-03

Correlations

PerformanceAnalytics::chart.Correlation(MetaDF[, c("Heroism", "Victims", "Villains", "Selfless", "Brave", "ExposureRisk", "Help", "Attitude")], method = "spearman")

# install.packages("ggcorrplot")
# library(ggcorrplot)
# 
# cor_matrix <- cor(MetaDF[, c("Heroism", "Victims", "Villains", "Selfless", 
#                              "Brave", "ExposureRisk", "Help", "Attitude")],
#                   use = "pairwise.complete.obs")
# 
# ggcorrplot(cor_matrix, 
#            lab = TRUE,            # show correlation coefficients
#            lab_size = 3,          # adjust label size as needed
#            type = "upper",        # display only the upper triangle
#            tl.cex = 10,           # adjust text label size
#            ggtheme = theme_minimal())  # use a minimal theme for a clean look
# 
# install.packages("corrplot")
# library(corrplot)
# corrplot(cor_matrix, 
#          method = "color",        # display as colored squares
#          type = "upper",          # show only the upper triangle
#          #order = "hclust",        # order by hierarchical clustering
#          addCoef.col = "black",   # add correlation coefficients in black
#          tl.col = "black",        # color text labels in black
#          tl.srt = 45)             # rotate text labels by 45 degrees
# 
# library(GGally)
# ggpairs(MetaDF[, c("Heroism", "Victims", "Villains", "Selfless", 
#                              "Brave", "ExposureRisk", "Help", "Attitude")])
# 
# library(sjPlot)
# tab_corr(cor_matrix, triangle = "lower", show.p = T)
# trace(tab_corr, edit = T)
# ??tab_corr

Manipulation check in each job?

I am curious about how manip checks of our manip works in each job. In this section, I explore whether at least, our manipulation worked for specific occupations.

This tab contains:

  • MC Firefighters Is our Manipulation check validated for firefighters?
  • MC Healthcare Is our Manipulation check validated for Healthcare workers?
  • MC Military Is our Manipulation check validated for UK armed forces?
  • MC Police Is our Manipulation check validated for Police officers?
  • MC Psychiatrists Is our Manipulation check validated for Psychiatrists?
Firefighters <- subset(MetaDF, MetaDF$Occupation == "Firefighters")

Healthcare <- subset(MetaDF, MetaDF$Occupation == "Healthcare")

Military <- subset(MetaDF, MetaDF$Occupation == "Military")

Police <- subset(MetaDF, MetaDF$Occupation == "Police")

Psychiatrists <- subset(MetaDF, MetaDF$Occupation == "Psychiatrists")

MC Firefighters

paste0("Brave evaluation ~ Risk manip")
## [1] "Brave evaluation ~ Risk manip"
summary(lm(Brave ~ Risk_dummy, data = Firefighters))
## 
## Call:
## lm(formula = Brave ~ Risk_dummy, data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.4183  0.2709  0.2709  0.2735  0.2735 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.659613   0.026231   25.15   <2e-16 ***
## Risk_dummy  0.002605   0.052462    0.05     0.96    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6425 on 598 degrees of freedom
## Multiple R-squared:  4.123e-06,  Adjusted R-squared:  -0.001668 
## F-statistic: 0.002466 on 1 and 598 DF,  p-value: 0.9604
paste0("Selflessness evaluation ~ Motivation manip")
## [1] "Selflessness evaluation ~ Motivation manip"
summary(lm(Selfless ~ Motiv_dummy, data = Firefighters))
## 
## Call:
## lm(formula = Selfless ~ Motiv_dummy, data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.0129 -0.2780  0.4690  0.5371  0.5371 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.54594    0.03282  16.633   <2e-16 ***
## Motiv_dummy  0.06809    0.06565   1.037      0.3    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.804 on 598 degrees of freedom
## Multiple R-squared:  0.001796,   Adjusted R-squared:  0.0001268 
## F-statistic: 1.076 on 1 and 598 DF,  p-value: 0.3
paste0("Exposure to risk evaluation ~ Risk manip")
## [1] "Exposure to risk evaluation ~ Risk manip"
summary(lm(ExposureRisk ~ Risk_dummy, data = Firefighters))
## 
## Call:
## lm(formula = ExposureRisk ~ Risk_dummy, data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.6233 -0.5433  0.3767  0.4567  0.4567 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.58333    0.02915 225.846   <2e-16 ***
## Risk_dummy  -0.08000    0.05830  -1.372    0.171    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.714 on 598 degrees of freedom
## Multiple R-squared:  0.003139,   Adjusted R-squared:  0.001472 
## F-statistic: 1.883 on 1 and 598 DF,  p-value: 0.1705
paste0("Helping people evaluation ~ Motivation manip")
## [1] "Helping people evaluation ~ Motivation manip"
summary(lm(Help ~ Motiv_dummy, data = Firefighters))
## 
## Call:
## lm(formula = Help ~ Motiv_dummy, data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.5518 -0.5518  0.3887  0.4482  0.4482 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.58157    0.03039 216.537   <2e-16 ***
## Motiv_dummy  0.05946    0.06079   0.978    0.328    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7445 on 598 degrees of freedom
## Multiple R-squared:  0.001597,   Adjusted R-squared:  -7.242e-05 
## F-statistic: 0.9566 on 1 and 598 DF,  p-value: 0.3284

MC Healthcare

paste0("Brave evaluation ~ Risk manip")
## [1] "Brave evaluation ~ Risk manip"
summary(lm(Brave ~ Risk_dummy, data = Healthcare))
## 
## Call:
## lm(formula = Brave ~ Risk_dummy, data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7576 -0.5455  0.1501  0.9316  1.0176 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.04275    0.03781  -1.131    0.259
## Risk_dummy  -0.08594    0.07562  -1.136    0.256
## 
## Residual standard error: 0.9261 on 598 degrees of freedom
## Multiple R-squared:  0.002155,   Adjusted R-squared:  0.0004866 
## F-statistic: 1.292 on 1 and 598 DF,  p-value: 0.2562
paste0("Selflessness evaluation ~ Motivation manip")
## [1] "Selflessness evaluation ~ Motivation manip"
summary(lm(Selfless ~ Motiv_dummy, data = Healthcare))
## 
## Call:
## lm(formula = Selfless ~ Motiv_dummy, data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7574 -0.7520 -0.0050  0.7246  0.7420 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.31573    0.03444   9.167   <2e-16 ***
## Motiv_dummy  0.01743    0.06888   0.253      0.8    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8436 on 598 degrees of freedom
## Multiple R-squared:  0.0001071,  Adjusted R-squared:  -0.001565 
## F-statistic: 0.06403 on 1 and 598 DF,  p-value: 0.8003
paste0("Exposure to risk evaluation ~ Risk manip")
## [1] "Exposure to risk evaluation ~ Risk manip"
summary(lm(ExposureRisk ~ Risk_dummy, data = Healthcare))
## 
## Call:
## lm(formula = ExposureRisk ~ Risk_dummy, data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9094 -0.8146  0.1380  1.0906  2.1854 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.86198    0.05327   91.27   <2e-16 ***
## Risk_dummy   0.09483    0.10654    0.89    0.374    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.305 on 598 degrees of freedom
## Multiple R-squared:  0.001323,   Adjusted R-squared:  -0.0003471 
## F-statistic: 0.7922 on 1 and 598 DF,  p-value: 0.3738
paste0("Helping people evaluation ~ Motivation manip")
## [1] "Helping people evaluation ~ Motivation manip"
summary(lm(Help ~ Motiv_dummy, data = Healthcare))
## 
## Call:
## lm(formula = Help ~ Motiv_dummy, data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.5233 -0.4833  0.4767  0.5167  0.5167 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.50333    0.03279  198.34   <2e-16 ***
## Motiv_dummy -0.04000    0.06558   -0.61    0.542    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8032 on 598 degrees of freedom
## Multiple R-squared:  0.0006218,  Adjusted R-squared:  -0.001049 
## F-statistic: 0.3721 on 1 and 598 DF,  p-value: 0.5421

MC Military

paste0("Brave evaluation ~ Risk manip")
## [1] "Brave evaluation ~ Risk manip"
summary(lm(Brave ~ Risk_dummy, data = Military))
## 
## Call:
## lm(formula = Brave ~ Risk_dummy, data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.0671 -0.1594  0.6221  0.6283  0.6283 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.306631   0.037087   8.268 8.85e-16 ***
## Risk_dummy  0.006252   0.074175   0.084    0.933    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9084 on 598 degrees of freedom
## Multiple R-squared:  1.188e-05,  Adjusted R-squared:  -0.00166 
## F-statistic: 0.007105 on 1 and 598 DF,  p-value: 0.9329
paste0("Selflessness evaluation ~ Motivation manip")
## [1] "Selflessness evaluation ~ Motivation manip"
summary(lm(Selfless ~ Motiv_dummy, data = Military))
## 
## Call:
## lm(formula = Selfless ~ Motiv_dummy, data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.4177 -0.4297  0.3173  1.0643  1.1441 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.05514    0.04306  -1.281    0.201
## Motiv_dummy  0.07979    0.08611   0.927    0.355
## 
## Residual standard error: 1.055 on 598 degrees of freedom
## Multiple R-squared:  0.001434,   Adjusted R-squared:  -0.0002362 
## F-statistic: 0.8585 on 1 and 598 DF,  p-value: 0.3545
paste0("Exposure to risk evaluation ~ Risk manip")
## [1] "Exposure to risk evaluation ~ Risk manip"
summary(lm(ExposureRisk ~ Risk_dummy, data = Military))
## 
## Call:
## lm(formula = ExposureRisk ~ Risk_dummy, data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.6478 -0.6254  0.3522  0.3746  0.3746 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.63663    0.03027  219.26   <2e-16 ***
## Risk_dummy  -0.02242    0.06054   -0.37    0.711    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7414 on 598 degrees of freedom
## Multiple R-squared:  0.0002294,  Adjusted R-squared:  -0.001442 
## F-statistic: 0.1372 on 1 and 598 DF,  p-value: 0.7112
paste0("Helping people evaluation ~ Motivation manip")
## [1] "Helping people evaluation ~ Motivation manip"
summary(lm(Help ~ Motiv_dummy, data = Military))
## 
## Call:
## lm(formula = Help ~ Motiv_dummy, data = Military)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -4.244 -1.103 -0.103  0.897  1.897 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.17357    0.06109  84.689   <2e-16 ***
## Motiv_dummy  0.14116    0.12218   1.155    0.248    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.496 on 598 degrees of freedom
## Multiple R-squared:  0.002227,   Adjusted R-squared:  0.0005586 
## F-statistic: 1.335 on 1 and 598 DF,  p-value: 0.2484

MC Police

paste0("Brave evaluation ~ Risk manip")
## [1] "Brave evaluation ~ Risk manip"
summary(lm(Brave ~ Risk_dummy, data = Police))
## 
## Call:
## lm(formula = Brave ~ Risk_dummy, data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.6169 -0.4907  0.2908  0.5175  1.2991 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.25385    0.04112  -6.174 1.23e-09 ***
## Risk_dummy   0.22673    0.08224   2.757  0.00601 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.007 on 598 degrees of freedom
## Multiple R-squared:  0.01255,    Adjusted R-squared:  0.0109 
## F-statistic: 7.601 on 1 and 598 DF,  p-value: 0.006011
paste0("Selflessness evaluation ~ Motivation manip")
## [1] "Selflessness evaluation ~ Motivation manip"
summary(lm(Selfless ~ Motiv_dummy, data = Police))
## 
## Call:
## lm(formula = Selfless ~ Motiv_dummy, data = Police)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -3.01039 -0.72707  0.01992  0.72458  1.51391 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.44371    0.04126 -10.755   <2e-16 ***
## Motiv_dummy  0.04233    0.08251   0.513    0.608    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.011 on 598 degrees of freedom
## Multiple R-squared:  0.0004399,  Adjusted R-squared:  -0.001232 
## F-statistic: 0.2632 on 1 and 598 DF,  p-value: 0.6081
paste0("Exposure to risk evaluation ~ Risk manip")
## [1] "Exposure to risk evaluation ~ Risk manip"
summary(lm(ExposureRisk ~ Risk_dummy, data = Police))
## 
## Call:
## lm(formula = ExposureRisk ~ Risk_dummy, data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.1096 -0.1739 -0.1096  0.8261  0.8904 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.14177    0.03463 177.342   <2e-16 ***
## Risk_dummy  -0.06428    0.06926  -0.928    0.354    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8483 on 598 degrees of freedom
## Multiple R-squared:  0.001438,   Adjusted R-squared:  -0.0002318 
## F-statistic: 0.8612 on 1 and 598 DF,  p-value: 0.3538
paste0("Helping people evaluation ~ Motivation manip")
## [1] "Helping people evaluation ~ Motivation manip"
summary(lm(Help ~ Motiv_dummy, data = Police))
## 
## Call:
## lm(formula = Help ~ Motiv_dummy, data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.3967 -0.3967  0.6033  0.6667  1.6667 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.36500    0.05794  92.597   <2e-16 ***
## Motiv_dummy  0.06333    0.11588   0.547    0.585    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.419 on 598 degrees of freedom
## Multiple R-squared:  0.0004993,  Adjusted R-squared:  -0.001172 
## F-statistic: 0.2987 on 1 and 598 DF,  p-value: 0.5849

MC Psychiatrists

paste0("Brave evaluation ~ Risk manip")
## [1] "Brave evaluation ~ Risk manip"
summary(lm(Brave ~ Risk_dummy, data = Psychiatrists))
## 
## Call:
## lm(formula = Brave ~ Risk_dummy, data = Psychiatrists)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -3.09486 -0.73464  0.03126  0.81279  1.60995 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.67029    0.03746 -17.892   <2e-16 ***
## Risk_dummy   0.01563    0.07493   0.209    0.835    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9176 on 598 degrees of freedom
## Multiple R-squared:  7.277e-05,  Adjusted R-squared:  -0.001599 
## F-statistic: 0.04352 on 1 and 598 DF,  p-value: 0.8348
paste0("Selflessness evaluation ~ Motivation manip")
## [1] "Selflessness evaluation ~ Motivation manip"
summary(lm(Selfless ~ Motiv_dummy, data = Psychiatrists))
## 
## Call:
## lm(formula = Selfless ~ Motiv_dummy, data = Psychiatrists)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -3.13192 -0.76698 -0.01999  0.72701  1.47400 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.36300    0.03616 -10.040   <2e-16 ***
## Motiv_dummy  0.12395    0.07231   1.714    0.087 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8857 on 598 degrees of freedom
## Multiple R-squared:  0.004889,   Adjusted R-squared:  0.003225 
## F-statistic: 2.938 on 1 and 598 DF,  p-value: 0.08703
paste0("Exposure to risk evaluation ~ Risk manip")
## [1] "Exposure to risk evaluation ~ Risk manip"
summary(lm(ExposureRisk ~ Risk_dummy, data = Psychiatrists))
## 
## Call:
## lm(formula = ExposureRisk ~ Risk_dummy, data = Psychiatrists)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.9733 -0.9733  0.0267  1.0267  3.3967 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.78833    0.05854   64.71  < 2e-16 ***
## Risk_dummy   0.37000    0.11708    3.16  0.00166 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.434 on 598 degrees of freedom
## Multiple R-squared:  0.01643,    Adjusted R-squared:  0.01478 
## F-statistic: 9.987 on 1 and 598 DF,  p-value: 0.001656
paste0("Helping people evaluation ~ Motivation manip")
## [1] "Helping people evaluation ~ Motivation manip"
summary(lm(Help ~ Motiv_dummy, data = Psychiatrists))
## 
## Call:
## lm(formula = Help ~ Motiv_dummy, data = Psychiatrists)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.6545 -0.6545  0.3455  1.3455  1.3746 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.63995    0.04908 114.925   <2e-16 ***
## Motiv_dummy  0.02907    0.09815   0.296    0.767    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.202 on 598 degrees of freedom
## Multiple R-squared:  0.0001466,  Adjusted R-squared:  -0.001525 
## F-statistic: 0.0877 on 1 and 598 DF,  p-value: 0.7672

Conclusion

The only manipulations that worked were the Risk manipulation of police officers (“confronted to armed criminals” vs “burnout”) on Bravey rating (but not physical exposure to danger…) and of Psychiatrists (“Confronted to dangerous patients” vs “burnout”) on exposure to risk — but not bravery ratings……

You need to be brave to be exposed to armed criminals but not dangerous patients? Police officers have a ceiling effects on exposure to physical risks?


Is the model additive or interactive

It appears that all interactions are weak. Perhaps Altruism and Risk work independently on heroism and not that synergetically. In the following section, I compare additive and interactive solutions to see which model result in the best fit.

In this section we will compare an additive model (Outcome ~ IV1 + IV2) and an interactive model (Outcome ~ IV1 * IV2)

H2 - Bravery and Selflessness

modInt<-lmer(Heroism ~ Brave * Selfless + (1|ResponseId), data = MetaDF)
modAdd<-lmer(Heroism ~ Brave + Selfless + (1|ResponseId), data = MetaDF)
paste0("Comparison between additive vs interactive models")
## [1] "Comparison between additive vs interactive models"
anova(modInt, modAdd)
## refitting model(s) with ML (instead of REML)
## Data: MetaDF
## Models:
## modAdd: Heroism ~ Brave + Selfless + (1 | ResponseId)
## modInt: Heroism ~ Brave * Selfless + (1 | ResponseId)
##        npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## modAdd    5 8090.3 8120.3 -4040.1   8080.3                         
## modInt    6 8045.5 8081.5 -4016.8   8033.5 46.745  1  8.083e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("additive model")
## [1] "additive model"
anova(modAdd)
## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## Brave    423.86  423.86     1 2804.0  608.17 < 2.2e-16 ***
## Selfless 377.93  377.93     1 2910.8  542.26 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
F_to_eta2(608.17, df = 1, df_error = 2804.0)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.18           | [0.16, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(542.26, df = 1, df_error = 2910.8)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.16           | [0.14, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
paste0("Interactive model")
## [1] "Interactive model"
anova(modInt)
## Type III Analysis of Variance Table with Satterthwaite's method
##                Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## Brave          461.48  461.48     1 2796.6 661.715 < 2.2e-16 ***
## Selfless       401.94  401.94     1 2933.3 576.343 < 2.2e-16 ***
## Brave:Selfless  33.86   33.86     1 2917.5  48.546 3.973e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
F_to_eta2(661.715, df = 1, df_error = 2796.6)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.19           | [0.17, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(576.343, df = 1, df_error = 2933.3)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.16           | [0.14, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(48.546, df = 1, df_error = 2917.5)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.02           | [0.01, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].

Additive Model: Main Bravery effect (eta^2 = 18%), Main Selflessness effect (eta^2 = 16%) Interactive Model: Main Bravery effect (eta^2 = 19%), Main Selflessness effect (eta^2 = 16%), Interaction (eta^2 = 2%).

The interactive model provides a better fit.

H2 - Risk and Helpfulness

modAdd<-lmer(Heroism ~ scale(ExposureRisk) + scale(Help) + (1|ResponseId), data = MetaDF)
modInt<-lmer(Heroism ~ scale(ExposureRisk) * scale(Help) + (1|ResponseId), data = MetaDF)
paste0("Comparison between additive vs interactive models")
## [1] "Comparison between additive vs interactive models"
anova(modInt, modAdd)
## refitting model(s) with ML (instead of REML)
## Data: MetaDF
## Models:
## modAdd: Heroism ~ scale(ExposureRisk) + scale(Help) + (1 | ResponseId)
## modInt: Heroism ~ scale(ExposureRisk) * scale(Help) + (1 | ResponseId)
##        npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)  
## modAdd    5 8513.0 8543.1 -4251.5   8503.0                       
## modInt    6 8512.3 8548.4 -4250.2   8500.3 2.7107  1    0.09968 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("Additive model")
## [1] "Additive model"
anova(modAdd)
## Type III Analysis of Variance Table with Satterthwaite's method
##                      Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## scale(ExposureRisk)  449.46  449.46     1 2679.0  563.23 < 2.2e-16 ***
## scale(Help)         1499.88 1499.88     1 2948.8 1879.57 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
F_to_eta2(563.23, df = 1, df_error = 2679.0)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.17           | [0.15, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(1879.57, df = 1, df_error = 2948.8)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.39           | [0.37, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
paste0("Interactive model")
## [1] "Interactive model"
anova(modInt)
## Type III Analysis of Variance Table with Satterthwaite's method
##                                  Sum Sq Mean Sq NumDF  DenDF   F value  Pr(>F)
## scale(ExposureRisk)              448.28  448.28     1 2678.7  562.4521 < 2e-16
## scale(Help)                     1500.98 1500.98     1 2945.2 1883.2688 < 2e-16
## scale(ExposureRisk):scale(Help)    2.16    2.16     1 2797.5    2.7131 0.09964
##                                    
## scale(ExposureRisk)             ***
## scale(Help)                     ***
## scale(ExposureRisk):scale(Help) .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
F_to_eta2(562.4521, df = 1, df_error = 2678.7)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.17           | [0.15, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(1883.2688, df = 1, df_error = 2945.2)
## Eta2 (partial) |       95% CI
## -----------------------------
## 0.39           | [0.37, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].
F_to_eta2(2.7131, df = 1, df_error = 2797.5)
## Eta2 (partial) |       95% CI
## -----------------------------
## 9.69e-04       | [0.00, 1.00]
## 
## - One-sided CIs: upper bound fixed at [1.00].

Additive Model: Main Risk effect (eta^2 = 17%), Main Helpfulness effect (eta^2 = 39%) Interactive Model: Main Risk effect (eta^2 = 19%), Main Helpfulness effect (eta^2 = 16%), Interaction (eta^2 < 0.01%).

Here it is clearly additive. Interaction is associated to a worst fit.


Job Analysis : Bravery and Selfless make heroes?

Having established that the Personality attributes (Bravery/Selflessness) are vaguely interactive and the model of Situational evaluation (Risk/Helpfulness) is clearly additive, we now want to assess the relative contribution of each Heroism elements (Risk vs Altruism) in predicting heroism.

In the next section, for each occupation, I systematically compare the betas of the two predictors in the best model.

We observed that within each occupation, Attributes relating to danger and Attributes relating to Altruism appears to provide diverse contribution. For instance, it appears that Healthcare workers heroism is correlated with altruism, but not danger; whereas Soldiers heroism is correlated with danger but not altruism.

However, it would be interesting to know if those discrepancy in contribution for each aspect is significant in each job. To test this, I use car::linearHypothesis: I force the model betas of the two predictors to be equivalent (e.g., Brave = Selfless) and see if this constrained model provides a better fit than the model where the betas are let loose. If the non-constrained model provides a better fit, it points to the relative superiority of one beta over the other in explaining the outcome.

Firefighters

summary(modAdd<-lm(Heroism ~ Brave + Selfless, data = Firefighters))
## 
## Call:
## lm(formula = Heroism ~ Brave + Selfless, data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.3465 -0.3465  0.3947  0.3947  3.6023 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.91303    0.04962 119.170  < 2e-16 ***
## Brave        0.35293    0.07444   4.741 2.66e-06 ***
## Selfless     0.34643    0.05944   5.828 9.18e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.847 on 597 degrees of freedom
## Multiple R-squared:  0.232,  Adjusted R-squared:  0.2294 
## F-statistic: 90.17 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ Brave * Selfless, data = Firefighters))
## 
## Call:
## lm(formula = Heroism ~ Brave * Selfless, data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.3754 -0.3754  0.2918  0.2918  2.8552 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.54447    0.06517  85.081  < 2e-16 ***
## Brave           0.74736    0.08553   8.738  < 2e-16 ***
## Selfless        0.20052    0.05916   3.389 0.000747 ***
## Brave:Selfless  0.26281    0.03213   8.181 1.71e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8038 on 596 degrees of freedom
## Multiple R-squared:  0.3095, Adjusted R-squared:  0.306 
## F-statistic: 89.06 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ Brave + Selfless
## Model 2: Heroism ~ Brave * Selfless
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    597 428.29                                  
## 2    596 385.05  1    43.239 66.927 1.707e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("The interactive model (smaller RSS, significant F-statistic) is the best fit.")
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
car::linearHypothesis(modInt, "Brave = Selfless") 
## Linear hypothesis test
## 
## Hypothesis:
## Brave - Selfless = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ Brave * Selfless
## 
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    597 395.77                                  
## 2    596 385.05  1    10.714 16.584 5.284e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

In firefighters, in the interactive model (note: but not in the additive one), Bravery contributes a great deal more than Selflessness to Heroism.

Healthcare workers

summary(modAdd<-lm(Heroism ~ Brave + Selfless, data = Healthcare))
## 
## Call:
## lm(formula = Heroism ~ Brave + Selfless, data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.5560 -0.3861  0.1153  0.3011  4.9980 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.67586    0.04330 131.074   <2e-16 ***
## Brave        0.46068    0.05395   8.539   <2e-16 ***
## Selfless     0.56598    0.05929   9.546   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9374 on 597 degrees of freedom
## Multiple R-squared:  0.4339, Adjusted R-squared:  0.4321 
## F-statistic: 228.8 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ Brave * Selfless, data = Healthcare))
## 
## Call:
## lm(formula = Heroism ~ Brave * Selfless, data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.4655 -0.3735  0.1640  0.2544  3.8351 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.56582    0.04866 114.388  < 2e-16 ***
## Brave           0.43589    0.05330   8.178 1.75e-15 ***
## Selfless        0.67531    0.06281  10.752  < 2e-16 ***
## Brave:Selfless  0.15280    0.03273   4.669 3.74e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9214 on 596 degrees of freedom
## Multiple R-squared:  0.4539, Adjusted R-squared:  0.4512 
## F-statistic: 165.1 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ Brave + Selfless
## Model 2: Heroism ~ Brave * Selfless
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    597 524.54                                  
## 2    596 506.03  1    18.508 21.799 3.744e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("The interactive model (smaller RSS, significant F-statistic) is the best fit.")
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
car::linearHypothesis(modInt, "Brave = Selfless") 
## Linear hypothesis test
## 
## Hypothesis:
## Brave - Selfless = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ Brave * Selfless
## 
##   Res.Df    RSS Df Sum of Sq     F  Pr(>F)  
## 1    597 510.46                             
## 2    596 506.03  1    4.4219 5.208 0.02283 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

No real difference here. It is sig., but barely.

Military

summary(modAdd<-lm(Heroism ~ Brave + Selfless, data = Military))
## 
## Call:
## lm(formula = Heroism ~ Brave + Selfless, data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.7336 -0.4793  0.2664  0.5207  5.9809 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.31517    0.04896 108.560   <2e-16 ***
## Brave        0.68733    0.06722  10.225   <2e-16 ***
## Selfless     0.49914    0.05786   8.627   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.059 on 597 degrees of freedom
## Multiple R-squared:  0.5026, Adjusted R-squared:  0.5009 
## F-statistic: 301.6 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ Brave * Selfless, data = Military))
## 
## Call:
## lm(formula = Heroism ~ Brave * Selfless, data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.7806 -0.6400  0.3086  0.6503  4.5124 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.06410    0.06151  82.330  < 2e-16 ***
## Brave           1.04358    0.08561  12.190  < 2e-16 ***
## Selfless        0.38308    0.05887   6.507 1.63e-10 ***
## Brave:Selfless  0.20620    0.03220   6.404 3.06e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.025 on 596 degrees of freedom
## Multiple R-squared:  0.5346, Adjusted R-squared:  0.5323 
## F-statistic: 228.2 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ Brave + Selfless
## Model 2: Heroism ~ Brave * Selfless
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    597 669.54                                  
## 2    596 626.43  1     43.11 41.016 3.065e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("The interactive model (smaller RSS, significant F-statistic) is the best fit.")
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
car::linearHypothesis(modInt, "Brave = Selfless") 
## Linear hypothesis test
## 
## Hypothesis:
## Brave - Selfless = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ Brave * Selfless
## 
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    597 651.97                                  
## 2    596 626.43  1    25.545 24.304 1.068e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

In Armed forces, there is a significantly greater contribution of Bravery than Selflessness (Interactive model).

Police

summary(modAdd<-lm(Heroism ~ Brave + Selfless, data = Police))
## 
## Call:
## lm(formula = Heroism ~ Brave + Selfless, data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8630 -0.6085  0.1370  0.5187  5.7553 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.35442    0.03985 134.358   <2e-16 ***
## Brave        0.59628    0.05508  10.825   <2e-16 ***
## Selfless     0.54451    0.05523   9.858   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8875 on 597 degrees of freedom
## Multiple R-squared:  0.5989, Adjusted R-squared:  0.5975 
## F-statistic: 445.6 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ Brave * Selfless, data = Police))
## 
## Call:
## lm(formula = Heroism ~ Brave * Selfless, data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8209 -0.5933  0.1791  0.4234  5.3517 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.32485    0.04212 126.422   <2e-16 ***
## Brave           0.66861    0.06468  10.337   <2e-16 ***
## Selfless        0.54763    0.05509   9.940   <2e-16 ***
## Brave:Selfless  0.05548    0.02621   2.117   0.0347 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8849 on 596 degrees of freedom
## Multiple R-squared:  0.6018, Adjusted R-squared:  0.5998 
## F-statistic: 300.3 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ Brave + Selfless
## Model 2: Heroism ~ Brave * Selfless
##   Res.Df    RSS Df Sum of Sq      F  Pr(>F)  
## 1    597 470.19                              
## 2    596 466.68  1    3.5097 4.4822 0.03466 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("The interactive model (smaller RSS, significant F-statistic) is the best fit. But not from a lot.")
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit. But not from a lot."
car::linearHypothesis(modInt, "Brave = Selfless") 
## Linear hypothesis test
## 
## Hypothesis:
## Brave - Selfless = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ Brave * Selfless
## 
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 467.66                           
## 2    596 466.68  1   0.97828 1.2494 0.2641

No significantly greater contribution from one or the other predictor. (Interactive)

Psychiatrists

summary(modAdd<-lm(Heroism ~ Brave + Selfless, data = Psychiatrists))
## 
## Call:
## lm(formula = Heroism ~ Brave + Selfless, data = Psychiatrists)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7823 -0.5095  0.1339  0.6935  3.6789 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.07763    0.05227  97.137  < 2e-16 ***
## Brave        0.56357    0.06843   8.236 1.13e-15 ***
## Selfless     0.47743    0.07073   6.750 3.51e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.019 on 597 degrees of freedom
## Multiple R-squared:  0.4278, Adjusted R-squared:  0.4259 
## F-statistic: 223.1 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ Brave * Selfless, data = Psychiatrists))
## 
## Call:
## lm(formula = Heroism ~ Brave * Selfless, data = Psychiatrists)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.6267 -0.4522  0.1837  0.6026  2.6026 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     5.02491    0.05213  96.398  < 2e-16 ***
## Brave           0.59877    0.06730   8.898  < 2e-16 ***
## Selfless        0.66897    0.07825   8.549  < 2e-16 ***
## Brave:Selfless  0.17141    0.03267   5.247 2.16e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9972 on 596 degrees of freedom
## Multiple R-squared:  0.453,  Adjusted R-squared:  0.4503 
## F-statistic: 164.6 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ Brave + Selfless
## Model 2: Heroism ~ Brave * Selfless
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    597 620.05                                  
## 2    596 592.67  1    27.374 27.528 2.155e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
paste0("The interactive model (smaller RSS, significant F-statistic) is the best fit.")
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
car::linearHypothesis(modInt, "Brave = Selfless") 
## Linear hypothesis test
## 
## Hypothesis:
## Brave - Selfless = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ Brave * Selfless
## 
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 592.96                           
## 2    596 592.67  1   0.28668 0.2883 0.5915

No significantly larger contribution from one or the other.

Job Analyses: Risky environments and Helpfulness make heroes?

Firefighters

summary(modAdd<-lm(Heroism ~ scale(ExposureRisk) + scale(Help), data = Firefighters))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) + scale(Help), data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.6382 -0.4267  0.3618  0.3618  2.1156 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          6.33500    0.03424 185.042  < 2e-16 ***
## scale(ExposureRisk)  0.15112    0.04027   3.753 0.000192 ***
## scale(Help)          0.38273    0.04027   9.504  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8386 on 597 degrees of freedom
## Multiple R-squared:  0.2472, Adjusted R-squared:  0.2446 
## F-statistic:    98 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ scale(ExposureRisk) * scale(Help), data = Firefighters))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) * scale(Help), data = Firefighters)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.6229 -0.4384  0.3771  0.3771  2.0670 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      6.34375    0.03529 179.769  < 2e-16 ***
## scale(ExposureRisk)              0.14117    0.04143   3.407   0.0007 ***
## scale(Help)                      0.35998    0.04601   7.824 2.34e-14 ***
## scale(ExposureRisk):scale(Help) -0.01668    0.01632  -1.022   0.3071    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8386 on 596 degrees of freedom
## Multiple R-squared:  0.2485, Adjusted R-squared:  0.2447 
## F-statistic: 65.68 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ scale(ExposureRisk) + scale(Help)
## Model 2: Heroism ~ scale(ExposureRisk) * scale(Help)
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 419.84                           
## 2    596 419.10  1   0.73474 1.0449 0.3071
paste0("Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive")
## [1] "Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive"
car::linearHypothesis(modAdd, "scale(ExposureRisk) = scale(Help)") 
## Linear hypothesis test
## 
## Hypothesis:
## scale(ExposureRisk) - scale(Help) = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ scale(ExposureRisk) + scale(Help)
## 
##   Res.Df    RSS Df Sum of Sq      F   Pr(>F)   
## 1    598 427.46                                
## 2    597 419.84  1    7.6248 10.842 0.001051 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

In firefighters, in the interactive model (note: but not in the additive one), Bravery contributes a great deal more than Selflessness to Heroism.

Healthcare workers

summary(modAdd<-lm(Heroism ~ scale(ExposureRisk) + scale(Help), data = Healthcare))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) + scale(Help), data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.3477 -0.4820  0.3377  0.7813  3.1203 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          5.83500    0.04306 135.508  < 2e-16 ***
## scale(ExposureRisk)  0.16827    0.04521   3.722 0.000217 ***
## scale(Help)          0.59136    0.04521  13.079  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.055 on 597 degrees of freedom
## Multiple R-squared:  0.2833, Adjusted R-squared:  0.2809 
## F-statistic:   118 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ scale(ExposureRisk) * scale(Help), data = Healthcare))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) * scale(Help), data = Healthcare)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.3212 -0.5134  0.2788  0.7869  3.1156 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      5.84781    0.04443 131.623  < 2e-16 ***
## scale(ExposureRisk)              0.16738    0.04521   3.703 0.000233 ***
## scale(Help)                      0.56615    0.05011  11.297  < 2e-16 ***
## scale(ExposureRisk):scale(Help) -0.04241    0.03640  -1.165 0.244433    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.054 on 596 degrees of freedom
## Multiple R-squared:  0.2849, Adjusted R-squared:  0.2813 
## F-statistic: 79.15 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ scale(ExposureRisk) + scale(Help)
## Model 2: Heroism ~ scale(ExposureRisk) * scale(Help)
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 664.16                           
## 2    596 662.65  1    1.5093 1.3575 0.2444
paste0("Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive")
## [1] "Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive"
car::linearHypothesis(modAdd, "scale(ExposureRisk) = scale(Help)") 
## Linear hypothesis test
## 
## Hypothesis:
## scale(ExposureRisk) - scale(Help) = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ scale(ExposureRisk) + scale(Help)
## 
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    598 701.56                                  
## 2    597 664.16  1    37.393 33.611 1.091e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

No real difference here. It is sig., but barely.

Military

summary(modAdd<-lm(Heroism ~ scale(ExposureRisk) + scale(Help), data = Military))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) + scale(Help), data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0862 -0.6556  0.2330  0.6052  3.2320 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          5.49833    0.04433 124.026   <2e-16 ***
## scale(ExposureRisk)  0.05107    0.04645   1.099    0.272    
## scale(Help)          1.01900    0.04645  21.935   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.086 on 597 degrees of freedom
## Multiple R-squared:  0.477,  Adjusted R-squared:  0.4752 
## F-statistic: 272.2 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ scale(ExposureRisk) * scale(Help), data = Military))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) * scale(Help), data = Military)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0650 -0.6715  0.2582  0.5966  3.4368 
## 
## Coefficients:
##                                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      5.5176686  0.0460107 119.922   <2e-16 ***
## scale(ExposureRisk)              0.0008265  0.0566386   0.015    0.988    
## scale(Help)                      1.0223736  0.0464516  22.009   <2e-16 ***
## scale(ExposureRisk):scale(Help) -0.0653752  0.0422592  -1.547    0.122    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.085 on 596 degrees of freedom
## Multiple R-squared:  0.4791, Adjusted R-squared:  0.4764 
## F-statistic: 182.7 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ scale(ExposureRisk) + scale(Help)
## Model 2: Heroism ~ scale(ExposureRisk) * scale(Help)
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 703.99                           
## 2    596 701.17  1    2.8155 2.3932 0.1224
paste0("Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive")
## [1] "Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive"
car::linearHypothesis(modAdd, "scale(ExposureRisk) = scale(Help)") 
## Linear hypothesis test
## 
## Hypothesis:
## scale(ExposureRisk) - scale(Help) = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ scale(ExposureRisk) + scale(Help)
## 
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    598 901.46                                  
## 2    597 703.99  1    197.47 167.46 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

In Armed forces, there is a significantly greater contribution of Bravery than Selflessness (Interactive model).

Police

summary(modAdd<-lm(Heroism ~ scale(ExposureRisk) + scale(Help), data = Police))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) + scale(Help), data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8908 -0.5436  0.1092  0.6517  2.7620 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          4.96167    0.03978 124.729  < 2e-16 ***
## scale(ExposureRisk)  0.16541    0.04367   3.788 0.000167 ***
## scale(Help)          0.92593    0.04367  21.205  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9744 on 597 degrees of freedom
## Multiple R-squared:  0.5164, Adjusted R-squared:  0.5148 
## F-statistic: 318.8 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ scale(ExposureRisk) * scale(Help), data = Police))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) * scale(Help), data = Police)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8889 -0.5466  0.1111  0.6547  2.7688 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     4.959062   0.042361 117.068  < 2e-16 ***
## scale(ExposureRisk)             0.167888   0.045810   3.665  0.00027 ***
## scale(Help)                     0.926397   0.043779  21.161  < 2e-16 ***
## scale(ExposureRisk):scale(Help) 0.006352   0.035295   0.180  0.85724    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9752 on 596 degrees of freedom
## Multiple R-squared:  0.5164, Adjusted R-squared:  0.514 
## F-statistic: 212.2 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ scale(ExposureRisk) + scale(Help)
## Model 2: Heroism ~ scale(ExposureRisk) * scale(Help)
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 566.82                           
## 2    596 566.79  1  0.030801 0.0324 0.8572
paste0("Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive")
## [1] "Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive"
car::linearHypothesis(modAdd, "scale(ExposureRisk) = scale(Help)") 
## Linear hypothesis test
## 
## Hypothesis:
## scale(ExposureRisk) - scale(Help) = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ scale(ExposureRisk) + scale(Help)
## 
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    598 668.90                                  
## 2    597 566.82  1    102.08 107.51 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

No significantly greater contribution from one or the other predictor. (Interactive)

Psychiatrists

summary(modAdd<-lm(Heroism ~ scale(ExposureRisk) + scale(Help), data = Psychiatrists))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) + scale(Help), data = Psychiatrists)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.5712 -0.7038  0.0783  0.7749  2.6232 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          4.52667    0.04617  98.054  < 2e-16 ***
## scale(ExposureRisk)  0.21913    0.04920   4.454 1.01e-05 ***
## scale(Help)          0.62622    0.04920  12.728  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.131 on 597 degrees of freedom
## Multiple R-squared:  0.2955, Adjusted R-squared:  0.2931 
## F-statistic: 125.2 on 2 and 597 DF,  p-value: < 2.2e-16
summary(modInt<-lm(Heroism ~ scale(ExposureRisk) * scale(Help), data = Psychiatrists))
## 
## Call:
## lm(formula = Heroism ~ scale(ExposureRisk) * scale(Help), data = Psychiatrists)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.5950 -0.6870  0.0729  0.7849  2.6410 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      4.52133    0.04868  92.869  < 2e-16 ***
## scale(ExposureRisk)              0.21630    0.04990   4.334 1.72e-05 ***
## scale(Help)                      0.63203    0.05200  12.155  < 2e-16 ***
## scale(ExposureRisk):scale(Help)  0.01555    0.04475   0.348    0.728    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.132 on 596 degrees of freedom
## Multiple R-squared:  0.2956, Adjusted R-squared:  0.2921 
## F-statistic: 83.38 on 3 and 596 DF,  p-value: < 2.2e-16
anova(modAdd, modInt)
## Analysis of Variance Table
## 
## Model 1: Heroism ~ scale(ExposureRisk) + scale(Help)
## Model 2: Heroism ~ scale(ExposureRisk) * scale(Help)
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1    597 763.40                           
## 2    596 763.25  1   0.15469 0.1208 0.7283
paste0("Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive")
## [1] "Model do not significantly differ. Consistency motive: we keep interaction; or Parsimony motive: we go with additive"
car::linearHypothesis(modAdd, "scale(ExposureRisk) = scale(Help)") 
## Linear hypothesis test
## 
## Hypothesis:
## scale(ExposureRisk) - scale(Help) = 0
## 
## Model 1: restricted model
## Model 2: Heroism ~ scale(ExposureRisk) + scale(Help)
## 
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1    598 795.98                                  
## 2    597 763.40  1    32.574 25.474 5.962e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

No significantly larger contribution from one or the other.


Final Conclusion

This study failed its main objective: successfully piloting an experimental manipulation that could increase or decrease the perception of heroism by acting though the two main components of heroism: Exposing oneself to danger, and Altruism.

However, the correlations between perceived heroism and Bravery/Risk exposure and Selflessness/Helpfulness indicates that the core theory behind our research project is legit: Altruism and Risk are two main components of heroism. These conclusions hold when controlling for general attitude, which might reduce the chance that our results are solely explained by a halo effect, or a mere tendency to evaluate positively groups that whe appreciate.

Our initial data suggests that these two components are weakly interacting - if interacting. In contrast, those elements appear to be additive. They both contribute to heroism, but in the absence of one, the other is sufficient.

In addition, our results indicate that these two components of heroism might not contribute in a similar way to building heroism perception in each group. Nurses’ heroism is mostly driven by their Altruism, whereas Soldiers’ heroism is mostly driven by their Bravery.

There are two possibilities here:

  • Descriptive observation. We took a snapshot of heroism perception in different occupations. Heroism is predicted by both Risk and Altruism (probably in an additive rather than interactive fashion) ceteris paribus. HC are less perceived as risk - but it is compensated by their altruism. Soldiers are not perceived as altruistic, but it is compensated by their exposure to risk.

  • Non-unitary heroism construct. Heroism in healtcare workers is qualitatively different from Heroism in soldiers.

Suppose we design a manipulation Risk producing d = 0.7 on Risk exposure and a manipulation Motivation producing d = 0.7 on Altruism. If the Snapshot interpretation is correct, both occupation would benefit in the same manner from these manipulations. If the non-unitary heroism interpretation is correct, we shoult expect the risk manipulation to have a larger effect in soldiers than healtcare workers; and the motivation manipulation to result in a larger effect on the heroism measure for healthcare workers than for soldiers.

# Right, so we're going to plot the betas difference for each occupation
# We create a list of df
datasets <- list(
  Firefighters   = Firefighters,
  Healthcare     = Healthcare,
  Military       = Military,
  Police         = Police,
  Psychiatrists  = Psychiatrists
)

# Storing the results of the models
results <- list()

# for loop: in each dataset, fit the model, and extract the betas to substract them
for(model_name in names(datasets)) {
  data_ <- datasets[[model_name]]
  
  # Fitting mod
  mod <- lm(Heroism ~ Brave * Selfless, data = data_)
  
  # Extract coefficients and the variance-covariance matrix (used for 95%CI)
  coefs <- coef(mod)
  vc   <- vcov(mod)
  
  # Compute the difference between coefficients "Brave" and "Selfless"
  diff_coef <- coefs["Brave"] - coefs["Selfless"]
  
  # Compute standard error of the difference:
  # Var(Brave - Selfless) = Var(Brave) + Var(Selfless) - 2*Cov(Brave,Selfless)
  se_diff <- sqrt(vc["Brave", "Brave"] + vc["Selfless", "Selfless"] - 2 * vc["Brave", "Selfless"])
  
  # Compute the 95% confidence interval using a normal approximation (z = 1.96)
  crit <- qnorm(0.975)
  lower <- diff_coef - crit * se_diff
  upper <- diff_coef + crit * se_diff
  
  # Store the results in a data frame
  results[[model_name]] <- data.frame(
    Model  = model_name,
    diff   = diff_coef,
    lower  = lower,
    upper  = upper
  )
}

# Combine the list of data frames into one
df_results <- do.call(rbind, results)
df_results$Model <- factor(df_results$Model, levels = names(datasets))

ggplot(df_results, aes(x = Model, y = diff)) +
  geom_point(size = 3) +
  geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(
    title = "Relative contribution of Bravery vs Selflessness in predicting Heroism",
    y = "Coefficient Difference (Brave - Selfless)",
    x = "Occupation"
  ) +
  theme_minimal()

# Right, so we're going to plot the betas difference for each occupation
# We create a list of df
datasets <- list(
  Firefighters   = Firefighters,
  Healthcare     = Healthcare,
  Military       = Military,
  Police         = Police,
  Psychiatrists  = Psychiatrists
)

# Storing the results of the models
results <- list()
Firefighters$ExposureRisk <- scale(Firefighters$ExposureRisk)
Firefighters$Help <- scale(Firefighters$Help)

Healthcare$ExposureRisk <- scale(Healthcare$ExposureRisk)
Healthcare$Help <- scale(Healthcare$Help)

Military$ExposureRisk <- scale(Military$ExposureRisk)
Military$Help <- scale(Military$Help)

Police$ExposureRisk <- scale(Police$ExposureRisk)
Police$Help <- scale(Police$Help)

Psychiatrists$ExposureRisk <- scale(Psychiatrists$ExposureRisk)
Psychiatrists$Help <- scale(Psychiatrists$Help)


# for loop: in each dataset, fit the model, and extract the betas to substract them
for(model_name in names(datasets)) {
  data_ <- datasets[[model_name]]
  
  # Fitting mod
  mod <- lm(Heroism ~ ExposureRisk + Help, data = data_)
  
  # Extract coefficients and the variance-covariance matrix (used for 95%CI)
  coefs <- coef(mod)
  vc   <- vcov(mod)
  
  # Compute the difference between coefficients "Brave" and "Selfless"
  diff_coef <- coefs["ExposureRisk"] - coefs["Help"]
  
  # Compute standard error of the difference:
  se_diff <- sqrt(vc["ExposureRisk", "ExposureRisk"] + vc["Help", "Help"] - 2 * vc["ExposureRisk", "Help"])
  
  # Compute the 95% confidence interval using a normal approximation (z = 1.96)
  crit <- qnorm(0.975)
  lower <- diff_coef - crit * se_diff
  upper <- diff_coef + crit * se_diff
  
  # Store the results in a data frame
  results[[model_name]] <- data.frame(
    Model  = model_name,
    diff   = diff_coef,
    lower  = lower,
    upper  = upper
  )
}

# Combine the list of data frames into one
df_results <- do.call(rbind, results)
df_results$Model <- factor(df_results$Model, levels = names(datasets))

ggplot(df_results, aes(x = Model, y = diff)) +
  geom_point(size = 3) +
  geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(
    title = "Relative contribution of Risk vs Helpfulness in predicting Heroism",
    y = "Coefficient Difference (Risk - Helpfulness)",
    x = "Occupation"
  ) +
  theme_minimal()

Any question can be addressed to Jean Monéger (My contact can be easily found using Google).