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
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.
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.
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
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)
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")
## 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
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
We describe our sample: their age, gender, and occupations with regard to the target occupations in the study.
## [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")
Below are visual representations of the perception of our target occupations (firefighters, NHS, police officers, military personnel, and Psychiatrists).
# 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),
)
# 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),
)
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),
)
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.
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
Occupations described as involving a Physical threat are perceived as significantly “braver” than occupations described as involving psychological pressures, and
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
Occupations described as involving a Physical threat are perceived as significantly more exposed to physical risks than occupations described as involving psychological pressures, and
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.
This tab contains:
The Risk type (physical vs psychological) should predict the perception of bravery.
## 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
==> Failed Manipulation Check. Our manipulation of Physical risks did not influence Bravery evaluations
The Motivation type (Altruistic vs Internal) should predict the perception of Altruism, defined as the average between “Caring” scores and reverse-coded “Selfless” scores.
## 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…)
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:
To what extent do you believe the target occupation is exposed to physical danger – Risk 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).
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.
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:
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)`*).*
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).
## 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
## Registered S3 method overwritten by 'clubSandwich':
## method from
## bread.mlm sandwich
## 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
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.
We registered that we would explore any higher-order interaction with occupation type.
However: No interaction to report here.
## 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
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?])
This tab contains:
We repeat the analyses using the attributes rating (Manipulation check #1) as predictors: ___
# 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) ___
## 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
## 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
## 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
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.
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:
## 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.
## [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
## 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].
## 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
## Warning: 1 is outside the observed range of Selfless
In firefighters: there is a large Bravery/heroism association — Less so of a Selflessness/heroism association The interaction is significant.
## [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
## 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].
## 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
## Warning: 0.999999999999998 is outside the observed range of Selfless
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%).
## [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
## 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].
## 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
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%).
## [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
## 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].
## 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
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%)
## [1] "Psy analysis"
##
## 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
## 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].
## 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
Similarly, psychiatrists heroism is derived from both Bravery (10%) and selflessness (9%). The interaction is quite weak (4%).
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?”)
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.
# 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
## 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
## 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
## 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
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.39 | [0.37, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.17 | [0.15, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.17 | [0.15, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 9.69e-04 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## 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).
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.
If an interaction between Risk and Motivation comes out as positive it will be decompose this interaction as follow:
## 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
## 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
## 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.
## [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
## 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].
## 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
## Warning: 1.00000000000001 is outside the observed range of Help
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.
## [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
## 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].
## 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
## Warning: 1.00000000000001 is outside the observed range of Help
In healthcare worker, it’s definitely helping others (18%) and less so exposure to risk (2%). No interaction.
## [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
## 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].
## 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
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.
## [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
## 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].
## 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
Police officer’s heroism is predicted by Help (43%) and to a lesser extent, exposure to risk (2%).
## [1] "Psy analysis"
##
## 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
## 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].
## 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
Here also, it is Helping others that explain the heroism level in the model with psychiatrists (20%). Exposure to risk definitely less so (3%). ___
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?]”).
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.
We should create more vivid manipulations (e.g., “a day in a life of a xxxx”).
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).
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.
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
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"
## 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
## [1] "Victims ~ manipulation"
## 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
## [1] "Villains ~ Brave * selfless"
## 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
## [1] "Victims ~ Brave * selfless"
## 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
## [1] "Villains ~ Risk * Helpful"
## 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
## [1] "Victims ~ Risk * Helpful"
## 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
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
## 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
## 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
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)”)
## [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
## [1] "Heroes ~ Personality Attributes"
## 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
## [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
## [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
## [1] "Villains ~ Personality Attributes"
## 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
## [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
## [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
## [1] "Victims ~ Personality Attributes"
## 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
## [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
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
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:
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")
## [1] "Brave evaluation ~ Risk manip"
##
## 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
## [1] "Selflessness evaluation ~ Motivation manip"
##
## 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
## [1] "Exposure to risk evaluation ~ Risk manip"
##
## 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
## [1] "Helping people evaluation ~ Motivation manip"
##
## 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
## [1] "Brave evaluation ~ Risk manip"
##
## 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
## [1] "Selflessness evaluation ~ Motivation manip"
##
## 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
## [1] "Exposure to risk evaluation ~ Risk manip"
##
## 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
## [1] "Helping people evaluation ~ Motivation manip"
##
## 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
## [1] "Brave evaluation ~ Risk manip"
##
## 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
## [1] "Selflessness evaluation ~ Motivation manip"
##
## 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
## [1] "Exposure to risk evaluation ~ Risk manip"
##
## 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
## [1] "Helping people evaluation ~ Motivation manip"
##
## 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
## [1] "Brave evaluation ~ Risk manip"
##
## 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
## [1] "Selflessness evaluation ~ Motivation manip"
##
## 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
## [1] "Exposure to risk evaluation ~ Risk manip"
##
## 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
## [1] "Helping people evaluation ~ Motivation manip"
##
## 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
## [1] "Brave evaluation ~ Risk manip"
##
## 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
## [1] "Selflessness evaluation ~ Motivation manip"
##
## 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
## [1] "Exposure to risk evaluation ~ Risk manip"
##
## 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
## [1] "Helping people evaluation ~ Motivation manip"
##
## 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
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?
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
)
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"
## 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
## [1] "additive model"
## 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
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.18 | [0.16, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.16 | [0.14, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## [1] "Interactive model"
## 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
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.19 | [0.17, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.16 | [0.14, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## 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.
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"
## 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
## [1] "Additive model"
## 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
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.17 | [0.15, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.39 | [0.37, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## [1] "Interactive model"
## 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
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.17 | [0.15, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## Eta2 (partial) | 95% CI
## -----------------------------
## 0.39 | [0.37, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].
## 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.
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.
##
## 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
##
## 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
## 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
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
## 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.
##
## 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
##
## 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
## 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
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
## 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.
##
## 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
##
## 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
## 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
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
## 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).
##
## 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
##
## 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
## 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."
## 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)
##
## 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
##
## 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
## 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
## [1] "The interactive model (smaller RSS, significant F-statistic) is the best fit."
## 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.
##
## 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
##
## 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
## 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"
## 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.
##
## 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
##
## 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
## 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"
## 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.
##
## 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
##
## 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
## 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"
## 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).
##
## 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
##
## 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
## 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"
## 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)
##
## 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
##
## 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
## 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"
## 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.
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).