Registered_Psychometrics
Jean Monéger
2025-05-19
In my reports, you can unfold code chunks by clicking “Show”.
Environment
if(!require("dplyr")) install.packages("dplyr")
if(!require("psych")) install.packages("tidyr")
if(!require("GPArotation")) install.packages("stringr")
if(!require("semTools")) install.packages("ggplot2")
if(!require("tibble")) install.packages("knitr")
if(!require("gt")) install.packages("kableExtra")
if(!require("DT")) install.packages("DT")
if(!require("PerformanceAnalytics")) install.packages("PerformanceAnalytics")
if(!require("ggplot2")) install.packages("ggplot2")
if(!require("kableExtra")) install.packages("ggplot2")## 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] kableExtra_1.4.0 ggplot2_3.5.2
## [3] PerformanceAnalytics_2.0.8 xts_0.14.1
## [5] zoo_1.8-14 DT_0.33
## [7] gt_1.0.0 tibble_3.2.1
## [9] semTools_0.5-7 lavaan_0.6-19
## [11] GPArotation_2025.3-1 psych_2.5.3
## [13] dplyr_1.1.4
##
## loaded via a namespace (and not attached):
## [1] tidyselect_1.2.1 xfun_0.52 bslib_0.9.0 splines_4.2.2
## [5] lattice_0.22-7 vctrs_0.6.5 generics_0.1.3 viridisLite_0.4.2
## [9] htmltools_0.5.8.1 stats4_4.2.2 yaml_2.3.10 survival_3.8-3
## [13] rlang_1.1.6 jquerylib_0.1.4 pillar_1.10.2 withr_3.0.2
## [17] glue_1.8.0 RColorBrewer_1.1-3 emmeans_1.11.1 multcomp_1.4-28
## [21] lifecycle_1.0.4 stringr_1.5.1 gtable_0.3.6 htmlwidgets_1.6.4
## [25] mvtnorm_1.2-4 codetools_0.2-20 coda_0.19-4.1 evaluate_1.0.3
## [29] knitr_1.50 fastmap_1.2.0 parallel_4.2.2 TH.data_1.1-3
## [33] xtable_1.8-4 scales_1.4.0 cachem_1.1.0 jsonlite_2.0.0
## [37] systemfonts_1.0.5 farver_2.1.2 mnormt_2.1.1 digest_0.6.37
## [41] stringi_1.8.7 grid_4.2.2 quadprog_1.5-8 cli_3.6.5
## [45] tools_4.2.2 sandwich_3.1-1 magrittr_2.0.3 sass_0.4.10
## [49] pbivnorm_0.6.0 pkgconfig_2.0.3 MASS_7.3-60.0.1 Matrix_1.6-5
## [53] xml2_1.3.8 estimability_1.5.1 svglite_2.1.3 rmarkdown_2.29
## [57] rstudioapi_0.17.1 R6_2.6.1 nlme_3.1-164 compiler_4.2.2Introduction
We collected 440 responses using a representative sampling of UK based respondents on Prolific. Participants completed our 54-items long Hero scale measuring 5 outcomes that we hypothise to be related to perceptions of heroism:
- Heroes are the object of gratitude
- Heroes are shielded from criticism
- Heroes are not supported in demanding improvemets to their condition
- Hero-status inhibits victim status: we underestimate their suffering
- Hero-status inhibits villain status: we tolerate heroes breaking regulations
Participants then rated to what extent they consider the target to be heroes, and their attitude toward the target.
They entered their demographic.
The scale focused on the Police officers category, because this category show the greatest variance and polarisation in attitude and heroism.
GENERAL AIM: winnowing the scale down to 20-25 items.
Procedure: - Identifying items that have clear ceiling and floor effects, prioritising items that show satisfying variance and means. An ideal item elicits the full range of responses. We will also assess inter-item correlations: we would consider for rejection items correlating > .8, because they would be redundant
Using EFA to 1) assess the number of dimension in each scale, 2) reject all items that do not saturate > .3 on target dimension.
Assessing reliability of the dimensions and aiming for a reliability that is between .7 and .9 – reliable, but not redundant.
On the basis of the previous observations, and using our best judgment, keep only a limited number of items so that we end up with a full questionnaire of about 20 items.
Results
As an experimental way of reporting on the study, I start here with the conclusions of the document. From the initial 54-items long version, this study directs us toward a final 21-items long version.
Our final scale is a 21 items long questionnaire that has a satisfying reliability, valid structure, and hopefully a nice item coverage.
items <- c(
"Putting a sign in the window of my home or my car to support police officers",
"Change my social media profile picture to display my support of police officers",
"Sharing a supportive post about police officers on my social media",
"Donating to a campaign that aims to raise public awareness about the contributions of police officers",
"Volunteering time to help with initiatives that support the work of police officers",
"To what extent do you feel grateful toward Police officers?",
"Government proposing increased salaries",
"Government proposing additional annual leave",
"Government proposing improved pension benefits",
"Government proposing hiring additional staff to reduce the workload per police officer",
"Government proposing investment in workplace improvements (break rooms, etc.)",
"People should think twice before they criticize police officers",
"People should stop badmouthing police officers",
"Negative comments about police officers often go too far",
"It is okay to insult police officers",
"Just because they are police officers does not mean they should be immune from criticism",
"An online post that says: 'It’s justified to go out and kill police officers'",
"An online post that says: 'Police officers should die and burn in hell'",
"An online post that says: 'Police officers are evil and wish harm on other people'",
"An online post that says: 'Police officers do more harm than good'",
"An online post that says: 'Police officers are a problem for society'",
"Police officers should protest more for the rights they deserve",
"I think we should listen to what police officers are asking for",
"If police officers were protesting in the streets, I’d be among them to show my support",
"It would be wrong for police officers to actively demand greater rewards for their service",
"I would sign a petition supporting police officers’ demands for better working conditions",
"I support police officers who choose protest as a way to achieve fair working conditions",
"Police officers asking to have their wages raised",
"Police officers asking to obtain extra paid time off",
"Police officers asking to obtain better pension plans",
"Police officers asking to have their workload reduced through increased hiring of staff",
"Police officers asking to upgrade their workplace facilities",
"Victimised",
"Unfairly treated",
"Exploited",
"Disrespected",
"Vulnerable",
"I believe police officers are strong enough to face this condition",
"It shows that we are asking too much of police officers",
"This report shows that police officers require greater protection",
"This situation of police officers is unacceptable",
"There are other groups who might deserve our concern more than police officers",
"Police officers should be given more freedom in the way they do their work",
"It is a problem that rules and regulations could slow down police officers' work",
"Police officers can do their job better when they’re not forced to follow standard procedures",
"I would assume a police officer had good reasons if they chose to go against their boss’s instructions",
"Police officers should be able to do whatever it takes to achieve their mission",
"This police officer should face consequences for breaking the rules",
"This police officer should be held legally responsible for this action",
"This police officer should be severely punished in order to discourage other police officers from doing the same thing",
"Their commander should reprimand this police officer",
"This police officer should not face any consequences if this is the first time they broke the rules",
"This police officer should be protected from prosecution on the basis of this violation",
"There should be a law protecting police officers from facing civil lawsuits in similar situations")
MainScale <- c(rep("Gratitude - General", time = 5),
"Single Item Gratitude",
rep("Gratitude - Specific", time = 5),
rep("Criticism Acceptability - General", time = 5),
rep("Criticism Acceptability - Specific", time = 5),
rep("Support for Workers demands - General", time = 6),
rep("Support for Workers demands - Specific", time = 5),
rep("Victimhood - General", time = 5),
rep("Victimhood - Specific (migraines)", time = 5),
rep("Regulations violations acceptability - General", time = 5),
rep("Regulations violations acceptability - Dilemma", time = 7))
Included <- c("✘", "✘", "✔", "✔", "✔", # Grat Gen ✔
"✔", # Single item grat ✔
"✘","✘","✘","✘","✘", # Specific grat ✔
"✔","✔","✔","✘","✘", # Critic gener ✔
"✘","✔","✔","✘","✘", # Critic spec ✔
"✔","✘","✘","✘","✘","✔", # Support demand gen ✔
"✘","✘","✘","✘","✘", # Support demand spec ✔
"✔","✔","✔","✘","✘", # Victim gen
"✔","✔","✔","✘","✘", # victim spec
"✔","✘","✔","✘","✔", # Villain gen
"✘","✘","✘","✘","✘","✔","✔" # Villain spec
)
Reason <- c(rep("Based on distributions", time = 5),
"NA",
rep("Will need to be evaluated in a between participant design: this section correlates too much with the Support for Workers demand section", time = 5),
"NA", "NA", "NA", "Small loading, see EFA", "Small loading, see EFA",
"Ceiling effect, see distributions", "Acceptable balance between ignoring vs Prosecuting, see distributions","Acceptable balance between ignoring vs Prosecuting, see distributions", "Floor effect on Ignoring, see distributions", "Floor effect on Ignoring, see distributions",
"NA", "Incorrect dimension, see EFA", "Low loading, see EFA", "Incorrect dimension, see EFA", "Incorrect dimension, see EFA", "NA",
rep("Will need to be evaluated in a between participant design: this section correlates too much with the Specific Gratitude", time = 5),
"NA", "NA", "NA", "Low loading, see EFA", "Low loading, see EFA",
"NA", "NA", "NA", "Expert judgment: not directly relevant to hypothesis", "Unacceptable loading, see EFA",
"NA", "Expert judgment: Could agree with that, without supporting violation of regulation", "NA", "Expert judgment: Police officer's boss is still police officer...", "NA",
"Based on distribution: few disagree",
"Based on distribution: few disagree",
"Ok, but inclusion increase consistency to a problematic degree - i.e., does not add much variance? See Reliability test",
"Based on distribution: few disagree",
"Ok, but inclusion increase consistency to a problematic degree - i.e., does not add much variance? See Reliability test",
"NA",
"NA")
# 1. Build your table data (preserves input order)
item_tbl <- tibble(
MainScale = MainScale,
Item = items,
Included = Included,
Reason = Reason
) %>%
mutate(
Scale = sub(" -.*", "", MainScale),
Subscale = sub(".* - ", "", MainScale),
Subscale = ifelse(Scale == MainScale, MainScale, Subscale),
Scale = factor(Scale, levels = unique(Scale)),
Subscale = factor(Subscale, levels = unique(Subscale))
) %>%
dplyr::select(Scale, Subscale, Item, Included, Reason)
sub_bounds <- item_tbl %>%
mutate(row = row_number()) %>%
group_by(Scale, Subscale) %>%
summarize(end = max(row), .groups="drop")
item_tbl_colored <- item_tbl %>%
mutate(
Flag = Included,
Item = cell_spec(
Item,
background = ifelse(Flag=="✔", "#D4EDDA", "#F2DEDE"),
escape = FALSE
),
`Kept?` = cell_spec(
Flag,
background = ifelse(Flag=="✔", "#D4EDDA", "#F2DEDE"),
escape = FALSE
),
Reason2 = case_when(
grepl("distribution", Reason, ignore.case=TRUE) ~
paste0('<a href="#distr">', Reason, '</a>'),
grepl("EFA", Reason, ignore.case=TRUE) ~
paste0('<a href="#efa">', Reason, '</a>'),
grepl("reliability", Reason, ignore.case=TRUE) ~
paste0('<a href="#reliab">', Reason, '</a>'),
TRUE ~ Reason
),
`Reason for Exclusion` = cell_spec(
Reason2,
background = ifelse(Flag=="✔", "#D4EDDA", "#F2DEDE"),
escape = FALSE # <<< crucial
)
) %>%
dplyr::select(Scale, Subscale, Item, `Kept?`, `Reason for Exclusion`)
html_tbl <- item_tbl_colored %>%
kable(
"html",
escape = FALSE, # make sure kable doesn’t escape
col.names = c("Scale","Subscale","Item","Kept?","Reason for Exclusion")
) %>%
kable_styling(full_width = FALSE) %>%
collapse_rows(columns = 1:2, valign = "top") %>%
{ tbl <- .
for(i in seq_len(nrow(sub_bounds))) {
tbl <- row_spec(
tbl,
sub_bounds$end[i],
extra_css = "border-bottom:2px solid #333333;"
)
}
tbl
}
knitr::asis_output(as.character(html_tbl))| Scale | Subscale | Item | Kept? | Reason for Exclusion |
|---|---|---|---|---|
| Gratitude | General | Putting a sign in the window of my home or my car to support police officers | ✘ | Based on distributions |
| Change my social media profile picture to display my support of police officers | ✘ | Based on distributions | ||
| Sharing a supportive post about police officers on my social media | ✔ | Based on distributions | ||
| Donating to a campaign that aims to raise public awareness about the contributions of police officers | ✔ | Based on distributions | ||
| Volunteering time to help with initiatives that support the work of police officers | ✔ | Based on distributions | ||
| Single Item Gratitude | Single Item Gratitude | To what extent do you feel grateful toward Police officers? | ✔ | NA |
| Gratitude | Specific | Government proposing increased salaries | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Support for Workers demand section |
| Government proposing additional annual leave | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Support for Workers demand section | ||
| Government proposing improved pension benefits | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Support for Workers demand section | ||
| Government proposing hiring additional staff to reduce the workload per police officer | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Support for Workers demand section | ||
| Government proposing investment in workplace improvements (break rooms, etc.) | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Support for Workers demand section | ||
| Criticism Acceptability | General | People should think twice before they criticize police officers | ✔ | NA |
| People should stop badmouthing police officers | ✔ | NA | ||
| Negative comments about police officers often go too far | ✔ | NA | ||
| It is okay to insult police officers | ✘ | Small loading, see EFA | ||
| Just because they are police officers does not mean they should be immune from criticism | ✘ | Small loading, see EFA | ||
| Specific | An online post that says: ‘It’s justified to go out and kill police officers’ | ✘ | Ceiling effect, see distributions | |
| An online post that says: ‘Police officers should die and burn in hell’ | ✔ | Acceptable balance between ignoring vs Prosecuting, see distributions | ||
| An online post that says: ‘Police officers are evil and wish harm on other people’ | ✔ | Acceptable balance between ignoring vs Prosecuting, see distributions | ||
| An online post that says: ‘Police officers do more harm than good’ | ✘ | Floor effect on Ignoring, see distributions | ||
| An online post that says: ‘Police officers are a problem for society’ | ✘ | Floor effect on Ignoring, see distributions | ||
| Support for Workers demands | General | Police officers should protest more for the rights they deserve | ✔ | NA |
| I think we should listen to what police officers are asking for | ✘ | Incorrect dimension, see EFA | ||
| If police officers were protesting in the streets, I’d be among them to show my support | ✘ | Low loading, see EFA | ||
| It would be wrong for police officers to actively demand greater rewards for their service | ✘ | Incorrect dimension, see EFA | ||
| I would sign a petition supporting police officers’ demands for better working conditions | ✘ | Incorrect dimension, see EFA | ||
| I support police officers who choose protest as a way to achieve fair working conditions | ✔ | NA | ||
| Specific | Police officers asking to have their wages raised | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Specific Gratitude | |
| Police officers asking to obtain extra paid time off | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Specific Gratitude | ||
| Police officers asking to obtain better pension plans | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Specific Gratitude | ||
| Police officers asking to have their workload reduced through increased hiring of staff | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Specific Gratitude | ||
| Police officers asking to upgrade their workplace facilities | ✘ | Will need to be evaluated in a between participant design: this section correlates too much with the Specific Gratitude | ||
| Victimhood | General | Victimised | ✔ | NA |
| Unfairly treated | ✔ | NA | ||
| Exploited | ✔ | NA | ||
| Disrespected | ✘ | Low loading, see EFA | ||
| Vulnerable | ✘ | Low loading, see EFA | ||
| Specific (migraines) | I believe police officers are strong enough to face this condition | ✔ | NA | |
| It shows that we are asking too much of police officers | ✔ | NA | ||
| This report shows that police officers require greater protection | ✔ | NA | ||
| This situation of police officers is unacceptable | ✘ | Expert judgment: not directly relevant to hypothesis | ||
| There are other groups who might deserve our concern more than police officers | ✘ | Unacceptable loading, see EFA | ||
| Regulations violations acceptability | General | Police officers should be given more freedom in the way they do their work | ✔ | NA |
| It is a problem that rules and regulations could slow down police officers’ work | ✘ | Expert judgment: Could agree with that, without supporting violation of regulation | ||
| Police officers can do their job better when they’re not forced to follow standard procedures | ✔ | NA | ||
| I would assume a police officer had good reasons if they chose to go against their boss’s instructions | ✘ | Expert judgment: Police officer’s boss is still police officer… | ||
| Police officers should be able to do whatever it takes to achieve their mission | ✔ | NA | ||
| Dilemma | This police officer should face consequences for breaking the rules | ✘ | Based on distribution: few disagree | |
| This police officer should be held legally responsible for this action | ✘ | Based on distribution: few disagree | ||
| This police officer should be severely punished in order to discourage other police officers from doing the same thing | ✘ | Ok, but inclusion increase consistency to a problematic degree - i.e., does not add much variance? See Reliability test | ||
| Their commander should reprimand this police officer | ✘ | Based on distribution: few disagree | ||
| This police officer should not face any consequences if this is the first time they broke the rules | ✘ | Ok, but inclusion increase consistency to a problematic degree - i.e., does not add much variance? See Reliability test | ||
| This police officer should be protected from prosecution on the basis of this violation | ✔ | NA | ||
| There should be a law protecting police officers from facing civil lawsuits in similar situations | ✔ | NA |
Some correlational insights on how our final scales correlates between each others and with heroism and attitudes are available here.
Reproducibility Pipeline
From the source data, we need to do some data wrangling: checking attention checks, excluding one participant that timed out (and was excluded from the sample on Prolific side), recoding all responses into numerics. You can view our data wrangling (including exclusion of attention checks) by unfolding the code chung below.
- removing timed out participant and non-committed participants
Set <- read.csv("~/Downloads/Hero+Project+-+Scale+Development+-+Reliability_May+16,+2025_05.10.csv", comment.char="#")
#Set$Q89
# I remove useless headers
Set <- Set[-c(1:2),]
# I remove fake participants who said they would not provide quality data, because our qualtrics form does not allow the completion of our scale upon selection of this option.
Set <- subset(Set, Set$commit != "No, I won't")
# I select only the items of interest here (the scale)
prolific_export_6824733921d2ff36b6dea039 <- read.csv("~/Downloads/prolific_export_6824733921d2ff36b6dea039.csv")
AwaitR<- subset(prolific_export_6824733921d2ff36b6dea039, prolific_export_6824733921d2ff36b6dea039$Status == "AWAITING REVIEW")- removing unattentive participants
# 2. expected answers
expected <- c(
General_Support_Dema_2 = "Moderately disagree",
General.Villains._4 = "Moderately disagree",
Spec_Villains_4 = "Slightly agree"
)
# 3. compute pass/fail (TRUE = passed)
pass1 <- Set$General_Support_Dema_2 == expected["General_Support_Dema_2"]
pass2 <- Set$General.Villains._4 == expected["General.Villains._4"]
pass3 <- Set$Spec_Villains_4 == expected["Spec_Villains_4"]
# treat blanks or NAs as failures:
pass1[ is.na(pass1) ] <- FALSE
pass2[ is.na(pass2) ] <- FALSE
pass3[ is.na(pass3) ] <- FALSE
# 4. count failures per row
fail_count <- rowSums(!(cbind(pass1, pass2, pass3)))
# 5. keep those with fewer than 2 failures
Set <- Set[ fail_count < 2, ]
# One participant must have forgotten to close the debriefing routine, and timed out on prolific
# We need to remove her to preserve our representative sample
Set <- subset(Set, Set$PROLIFIC_PID != setdiff(Set$PROLIFIC_PID, AwaitR$Participant.id))
Set<- Set[, c(25:93, 98:105, 106,107)]- Recoding variables to numeric
# your six maps, combined into one big map
map_all <- c(
# full scale
"Not at all" = 1,
"Very little" = 2,
"A little" = 3,
"Somewhat" = 4,
"Quite a bit" = 5,
"Very much" = 6,
"A lot" = 7,
# block / prosecute scale
"Should be liked" = 1,
"Should be ignored, but they have a right to say that" = 2,
"Should be blocked or banned from the social media platform" = 3,
"Should be prosecuted using the UK laws against \"grossly offensive\" public messaging" = 4,
# disagree–agree
"Strongly disagree" = 1,
"Moderately disagree" = 2,
"Slightly disagree" = 3,
"Neither disagree, nor agree" = 4,
"Slightly agree" = 5,
"Moderately agree" = 6,
"Strongly agree" = 7,
# oppose–support
"Strongly oppose" = 1,
"Oppose" = 2,
"Somewhat oppose" = 3,
"Neither support nor oppose" = 4,
"Somewhat support" = 5,
"Support" = 6,
"Strongly support" = 7,
# likelihood
"Very unlikely" = 1,
"Quite unlikely" = 2,
"Slightly unlikely" = 3,
"Neither likely, nor unlikely" = 4,
"Slightly likely" = 5,
"Quite likely" = 6,
"Very likely" = 7,
#Attitude
"Very negative" = 1,
"Quite negative" = 2,
"Slightly negative" = 3,
"Neutral" = 4,
"Slightly positive" = 5,
"Quite positive" = 6,
"Very positive" = 7)
library(dplyr)
# Check and remove attention check (not done for this crash test on fake data)
#Set <- Set %>%
# select(-General_Support_Dema_2, -General.Villains._4, -Spec_Villains_4)
Set <- Set[, -c(43, 67, 73)]
# 1) Define your items, suffixes and how you map each suffix → a severity score
items <- c("Q78","Q101","Q102","Q103","Q104")
suffixes <- c("1","2","3","9","4")
# let's say: 1=liked, 2=ignored, 3=deleted, 9=banned, 4=prosecuted
severity <- setNames(1:5, suffixes)
# 2) Sanity-check: make sure every column is in df_numeric
all_cols <- unlist(lapply(items, function(itm) paste0(itm,"_",suffixes)))
missing <- setdiff(all_cols, names(Set))
if(length(missing)){
stop("I can’t find these columns in Set:\n ",
paste(missing, collapse = ", "))
}
# 3) Now do the recoding
for(itm in items){
# the five raw‐response columns for this item
cols <- paste0(itm, "_", suffixes)
# build an (nrow × 5) integer matrix of severity codes or NA
mat <- matrix(NA_integer_,
nrow = nrow(Set),
ncol = length(suffixes),
dimnames = list(NULL, suffixes))
for(i in seq_along(suffixes)){
suf <- suffixes[i]
v <- Set[[ paste0(itm, "_", suf) ]]
# if they ticked it (non-blank/non-NA), assign severity; else NA
mat[,i] <- ifelse(!is.na(v) & v != "", severity[suf], NA_integer_)
}
# collapse each row → the maximum severity, or NA if all were NA
Set[[itm]] <- apply(mat, 1, function(x) {
if(all(is.na(x))) NA_integer_ else max(x, na.rm = TRUE)
})
}
# 4) Optionally drop the original tick-box columns
pattern <- paste0("^(", paste(items, collapse="|"),
")_(", paste(suffixes, collapse="|"), ")$")
Set <- Set[ , !grepl(pattern, names(Set))]
# Now df_numeric has new columns Q78, Q101, Q102, Q103, Q104
# each coded 1–5 (or NA if nobody ticked anything).
# items <- c("Q78", "Q101", "Q102", "Q103", "Q104")
#
# for (itm in items) {
# # build the four column names, e.g. c("Q78_1","Q78_2","Q78_3","Q78_4")
# cols <- paste0(itm, "_", 1:4)
#
# # create a new column itm = the max of those four:
# df_numeric[[itm]] <- do.call(pmax,
# c(df_numeric[cols], # the four vectors
# na.rm = TRUE) # ignore NAs
# )
# }
#
# # if you want, drop the originals:
# df_numeric <- df_numeric[ , setdiff(names(df_numeric), paste0(rep(items, each=4), "_", 1:4))]
#
df_numeric <- Set %>%
# target every column that’s character or factor
mutate(across(where(~ is.character(.) || is.factor(.)),
# lookup each cell in map_all by name
~ map_all[as.character(.)] ))A. Item Distributions
From registration:
We will examine kurtosis and variance to flag items showing obvious skew or low variance (potential floor/ceiling effects).
NOTE: This operation is done PRIOR to reverse coding items.
# Define items per construct (uncomment 1st line and comment 2nd to include Single item)
#gratitude_items <- grep("Symbolic_Gratitude|Single|Support_Gov", names(df_numeric), value = TRUE)
gratitude_items <- grep("Symbolic_Gratitude|Support_Gov", names(df_numeric), value = TRUE)
criticism_items <- grep("General_Critic|Q78|Q101|Q102|Q103|Q104", names(df_numeric), value = TRUE)
demand_items <- grep("General_Support_Dema|Specific_Support_De", names(df_numeric), value = TRUE)
victim_items <- grep("General\\.Victims|Dismissing_Support", names(df_numeric), value = TRUE)
violation_items <- grep("General\\.Villains\\.|Spec_Villains", names(df_numeric), value = TRUE)
# Store all subscales in a named list for looping
scales <- list(
Gratitude = gratitude_items,
Criticism = criticism_items,
Demands = demand_items,
Victimhood = victim_items,
Violations = violation_items
)
item_diagnostics <- function(df, items) {
non_empty_items <- items[!sapply(df[items], function(x) all(is.na(x)))]
if (length(non_empty_items) == 0) return(NULL)
stats <- psych::describe(df[non_empty_items])
out <- stats[, c("mean", "sd", "skew", "kurtosis")]
flags <- ifelse(abs(out$skew) > 1 | abs(out$kurtosis) > 1, "⚠️", "")
# Create histograms using ggplot2
plots <- lapply(non_empty_items, function(item) {
ggplot(df, aes_string(x = item)) +
geom_histogram(bins = 20, fill = "grey", color = "black") +
theme_minimal() +
labs(title = paste("Histogram of", item), x = item, y = "Count")
})
names(plots) <- non_empty_items
return(list(
stats = out,
flag = flags,
plots = plots
))
}
# Run diagnostics for each scale
diagnostics <- lapply(scales, function(items) item_diagnostics(df_numeric, items))
diagnostics## $Gratitude
## $Gratitude$stats
## mean sd skew kurtosis
## Symbolic_Gratitude_1 2.33 1.67 1.11 0.05
## Symbolic_Gratitude_2 2.17 1.62 1.25 0.40
## Symbolic_Gratitude_3 3.03 1.99 0.45 -1.21
## Symbolic_Gratitude_4 2.71 1.78 0.65 -0.85
## Symbolic_Gratitude_5 2.60 1.72 0.76 -0.60
## Support_Gov_1 4.87 1.43 -0.59 0.18
## Support_Gov_2 4.58 1.45 -0.42 -0.16
## Support_Gov_3 4.71 1.53 -0.50 -0.20
## Support_Gov_4 5.65 1.26 -1.16 1.82
## Support_Gov_5 5.08 1.30 -0.82 1.07
##
## $Gratitude$flag
## [1] "⚠️" "⚠️" "⚠️" "" "" "" "" "" "⚠️" "⚠️"
##
## $Gratitude$plots
## $Gratitude$plots$Symbolic_Gratitude_1
##
## $Gratitude$plots$Symbolic_Gratitude_2
##
## $Gratitude$plots$Symbolic_Gratitude_3
##
## $Gratitude$plots$Symbolic_Gratitude_4
##
## $Gratitude$plots$Symbolic_Gratitude_5
##
## $Gratitude$plots$Support_Gov_1
##
## $Gratitude$plots$Support_Gov_2
##
## $Gratitude$plots$Support_Gov_3
##
## $Gratitude$plots$Support_Gov_4
##
## $Gratitude$plots$Support_Gov_5
##
##
##
## $Criticism
## $Criticism$stats
## mean sd skew kurtosis
## General_Critic_1 4.64 1.75 -0.60 -0.54
## General_Critic_2 4.72 1.69 -0.61 -0.37
## General_Critic_3 4.90 1.56 -0.64 -0.10
## General_Critic_4 2.22 1.54 1.33 1.02
## General_Critic_5 6.08 1.12 -1.47 2.64
## Q78 4.50 0.82 -1.59 1.67
## Q101 4.17 1.01 -1.00 -0.21
## Q102 3.17 1.15 0.36 -1.30
## Q103 2.45 0.90 1.48 1.42
## Q104 2.40 0.87 1.52 1.82
##
## $Criticism$flag
## [1] "" "" "" "⚠️" "⚠️" "⚠️" "⚠️" "⚠️" "⚠️" "⚠️"
##
## $Criticism$plots
## $Criticism$plots$General_Critic_1
##
## $Criticism$plots$General_Critic_2
##
## $Criticism$plots$General_Critic_3
##
## $Criticism$plots$General_Critic_4
##
## $Criticism$plots$General_Critic_5
##
## $Criticism$plots$Q78
##
## $Criticism$plots$Q101
##
## $Criticism$plots$Q102
##
## $Criticism$plots$Q103
##
## $Criticism$plots$Q104
##
##
##
## $Demands
## $Demands$stats
## mean sd skew kurtosis
## General_Support_Dema_1 3.98 1.56 -0.24 -0.39
## General_Support_Dema_3 5.27 1.36 -0.98 1.25
## General_Support_Dema_4 2.84 1.65 0.50 -0.74
## General_Support_Dema_5 3.33 1.50 0.42 -0.18
## General_Support_Dema_6 4.29 1.86 -0.45 -0.78
## General_Support_Dema_7 4.34 1.65 -0.47 -0.46
## Specific_Support_De_1 4.72 1.38 -0.53 0.35
## Specific_Support_De_2 4.18 1.48 -0.22 -0.28
## Specific_Support_De_3 4.63 1.52 -0.52 -0.13
## Specific_Support_De_4 5.42 1.33 -1.04 1.44
## Specific_Support_De_5 5.07 1.33 -0.85 1.00
##
## $Demands$flag
## [1] "" "⚠️" "" "" "" "" "" "" "" "⚠️" "⚠️"
##
## $Demands$plots
## $Demands$plots$General_Support_Dema_1
##
## $Demands$plots$General_Support_Dema_3
##
## $Demands$plots$General_Support_Dema_4
##
## $Demands$plots$General_Support_Dema_5
##
## $Demands$plots$General_Support_Dema_6
##
## $Demands$plots$General_Support_Dema_7
##
## $Demands$plots$Specific_Support_De_1
##
## $Demands$plots$Specific_Support_De_2
##
## $Demands$plots$Specific_Support_De_3
##
## $Demands$plots$Specific_Support_De_4
##
## $Demands$plots$Specific_Support_De_5
##
##
##
## $Victimhood
## $Victimhood$stats
## mean sd skew kurtosis
## General.Victims_1 3.04 1.65 0.76 -0.06
## General.Victims_2 3.32 1.57 0.51 -0.25
## General.Victims_3 2.81 1.58 0.81 0.04
## General.Victims_4 4.45 1.70 -0.09 -0.76
## General.Victims_5 3.38 1.79 0.52 -0.61
## Dismissing_Support._1 3.77 1.62 0.06 -0.77
## Dismissing_Support._2 4.79 1.50 -0.70 0.02
## Dismissing_Support._3 4.64 1.53 -0.59 -0.05
## Dismissing_Support._4 4.58 1.56 -0.47 -0.25
## Dismissing_Support._5 4.64 1.40 -0.20 -0.18
##
## $Victimhood$flag
## [1] "" "" "" "" "" "" "" "" "" ""
##
## $Victimhood$plots
## $Victimhood$plots$General.Victims_1
##
## $Victimhood$plots$General.Victims_2
##
## $Victimhood$plots$General.Victims_3
##
## $Victimhood$plots$General.Victims_4
##
## $Victimhood$plots$General.Victims_5
##
## $Victimhood$plots$Dismissing_Support._1
##
## $Victimhood$plots$Dismissing_Support._2
##
## $Victimhood$plots$Dismissing_Support._3
##
## $Victimhood$plots$Dismissing_Support._4
##
## $Victimhood$plots$Dismissing_Support._5
##
##
##
## $Violations
## $Violations$stats
## mean sd skew kurtosis
## General.Villains._1 3.52 1.64 -0.10 -1.01
## General.Villains._2 3.83 1.81 -0.15 -1.05
## General.Villains._3 3.23 1.63 0.24 -0.76
## General.Villains._5 3.95 1.66 -0.23 -0.73
## General.Villains._6 2.85 1.79 0.53 -0.97
## Spec_Villains_1 4.68 1.71 -0.43 -0.67
## Spec_Villains_2 4.66 1.76 -0.48 -0.60
## Spec_Villains_3 3.69 1.82 0.17 -1.01
## Spec_Villains_5 4.90 1.55 -0.50 -0.32
## Spec_Villains_6 3.66 1.85 0.17 -1.00
## Spec_Villains_7 3.78 1.85 0.04 -1.01
## Spec_Villains_8 3.78 1.85 -0.02 -1.06
##
## $Violations$flag
## [1] "⚠️" "⚠️" "" "" "" "" "" "⚠️" "" "" "⚠️" "⚠️"
##
## $Violations$plots
## $Violations$plots$General.Villains._1
##
## $Violations$plots$General.Villains._2
##
## $Violations$plots$General.Villains._3
##
## $Violations$plots$General.Villains._5
##
## $Violations$plots$General.Villains._6
##
## $Violations$plots$Spec_Villains_1
##
## $Violations$plots$Spec_Villains_2
##
## $Violations$plots$Spec_Villains_3
##
## $Violations$plots$Spec_Villains_5
##
## $Violations$plots$Spec_Villains_6
##
## $Violations$plots$Spec_Villains_7
##
## $Violations$plots$Spec_Villains_8
We will come back to these distributions to take the decisions of excluding items or not.
Interitem correlations
We can assess interitem correlations and flag any pairs of items that have problematic correlations (r > .8)
inter_item_corr <- lapply(names(scales), function(scale_name) {
items <- scales[[scale_name]]
# compute pairwise correlations, handling missing data
cor(df_numeric[, items], use = "pairwise.complete.obs")
})
names(inter_item_corr) <- names(scales)
# To inspect:
inter_item_corr$Gratitude # matrix of Gratitude items## Symbolic_Gratitude_1 Symbolic_Gratitude_2
## Symbolic_Gratitude_1 1.0000000 0.6814054
## Symbolic_Gratitude_2 0.6814054 1.0000000
## Symbolic_Gratitude_3 0.5857672 0.6952162
## Symbolic_Gratitude_4 0.6417293 0.6069718
## Symbolic_Gratitude_5 0.6329517 0.6299366
## Support_Gov_1 0.2981140 0.2673232
## Support_Gov_2 0.3045948 0.2784437
## Support_Gov_3 0.2511356 0.2119649
## Support_Gov_4 0.1783123 0.1810996
## Support_Gov_5 0.2221490 0.2184311
## Symbolic_Gratitude_3 Symbolic_Gratitude_4
## Symbolic_Gratitude_1 0.5857672 0.6417293
## Symbolic_Gratitude_2 0.6952162 0.6069718
## Symbolic_Gratitude_3 1.0000000 0.6314591
## Symbolic_Gratitude_4 0.6314591 1.0000000
## Symbolic_Gratitude_5 0.6285031 0.7347209
## Support_Gov_1 0.3319092 0.3846870
## Support_Gov_2 0.3237365 0.3809204
## Support_Gov_3 0.2708308 0.3411414
## Support_Gov_4 0.2235088 0.2324911
## Support_Gov_5 0.2976807 0.3002428
## Symbolic_Gratitude_5 Support_Gov_1 Support_Gov_2
## Symbolic_Gratitude_1 0.6329517 0.2981140 0.3045948
## Symbolic_Gratitude_2 0.6299366 0.2673232 0.2784437
## Symbolic_Gratitude_3 0.6285031 0.3319092 0.3237365
## Symbolic_Gratitude_4 0.7347209 0.3846870 0.3809204
## Symbolic_Gratitude_5 1.0000000 0.3623394 0.3843300
## Support_Gov_1 0.3623394 1.0000000 0.6582727
## Support_Gov_2 0.3843300 0.6582727 1.0000000
## Support_Gov_3 0.3377786 0.8005402 0.6971405
## Support_Gov_4 0.2546004 0.5840548 0.4648139
## Support_Gov_5 0.3007761 0.6729454 0.6512790
## Support_Gov_3 Support_Gov_4 Support_Gov_5
## Symbolic_Gratitude_1 0.2511356 0.1783123 0.2221490
## Symbolic_Gratitude_2 0.2119649 0.1810996 0.2184311
## Symbolic_Gratitude_3 0.2708308 0.2235088 0.2976807
## Symbolic_Gratitude_4 0.3411414 0.2324911 0.3002428
## Symbolic_Gratitude_5 0.3377786 0.2546004 0.3007761
## Support_Gov_1 0.8005402 0.5840548 0.6729454
## Support_Gov_2 0.6971405 0.4648139 0.6512790
## Support_Gov_3 1.0000000 0.5214954 0.6620897
## Support_Gov_4 0.5214954 1.0000000 0.5881364
## Support_Gov_5 0.6620897 0.5881364 1.0000000## General_Critic_1 General_Critic_2 General_Critic_3
## General_Critic_1 1.0000000 0.7290472 0.6162437
## General_Critic_2 0.7290472 1.0000000 0.6496881
## General_Critic_3 0.6162437 0.6496881 1.0000000
## General_Critic_4 -0.4237598 -0.5007043 -0.4494147
## General_Critic_5 -0.2814057 -0.2711385 -0.2111076
## Q78 0.2878318 0.3318746 0.3470202
## Q101 0.2824018 0.3393396 0.2995046
## Q102 0.3474104 0.4199911 0.2910539
## Q103 0.3296575 0.3954459 0.2831714
## Q104 0.3264426 0.4125989 0.2875994
## General_Critic_4 General_Critic_5 Q78 Q101
## General_Critic_1 -0.4237598 -0.2814057 0.2878318 0.2824018
## General_Critic_2 -0.5007043 -0.2711385 0.3318746 0.3393396
## General_Critic_3 -0.4494147 -0.2111076 0.3470202 0.2995046
## General_Critic_4 1.0000000 0.1677238 -0.2844583 -0.3572740
## General_Critic_5 0.1677238 1.0000000 -0.1225517 -0.1919241
## Q78 -0.2844583 -0.1225517 1.0000000 0.6593512
## Q101 -0.3572740 -0.1919241 0.6593512 1.0000000
## Q102 -0.3010456 -0.2707711 0.3739653 0.5238682
## Q103 -0.2867278 -0.3054382 0.2628089 0.3773415
## Q104 -0.2993394 -0.3255632 0.2652528 0.3523718
## Q102 Q103 Q104
## General_Critic_1 0.3474104 0.3296575 0.3264426
## General_Critic_2 0.4199911 0.3954459 0.4125989
## General_Critic_3 0.2910539 0.2831714 0.2875994
## General_Critic_4 -0.3010456 -0.2867278 -0.2993394
## General_Critic_5 -0.2707711 -0.3054382 -0.3255632
## Q78 0.3739653 0.2628089 0.2652528
## Q101 0.5238682 0.3773415 0.3523718
## Q102 1.0000000 0.6536286 0.6213285
## Q103 0.6536286 1.0000000 0.8615561
## Q104 0.6213285 0.8615561 1.0000000## General_Support_Dema_1 General_Support_Dema_3
## General_Support_Dema_1 1.0000000 0.4259651
## General_Support_Dema_3 0.4259651 1.0000000
## General_Support_Dema_4 0.4722696 0.3123635
## General_Support_Dema_5 -0.3379886 -0.3360912
## General_Support_Dema_6 0.5152555 0.5895854
## General_Support_Dema_7 0.7194470 0.4263484
## Specific_Support_De_1 0.5410753 0.6207053
## Specific_Support_De_2 0.4976216 0.4599649
## Specific_Support_De_3 0.5203713 0.5019356
## Specific_Support_De_4 0.3516846 0.5313623
## Specific_Support_De_5 0.4821087 0.5725136
## General_Support_Dema_4 General_Support_Dema_5
## General_Support_Dema_1 0.4722696 -0.3379886
## General_Support_Dema_3 0.3123635 -0.3360912
## General_Support_Dema_4 1.0000000 -0.1769896
## General_Support_Dema_5 -0.1769896 1.0000000
## General_Support_Dema_6 0.4920529 -0.3115103
## General_Support_Dema_7 0.3939309 -0.3749114
## Specific_Support_De_1 0.3973990 -0.4757226
## Specific_Support_De_2 0.3623177 -0.3384772
## Specific_Support_De_3 0.3815208 -0.4150208
## Specific_Support_De_4 0.2313963 -0.3230693
## Specific_Support_De_5 0.3441075 -0.3808493
## General_Support_Dema_6 General_Support_Dema_7
## General_Support_Dema_1 0.5152555 0.7194470
## General_Support_Dema_3 0.5895854 0.4263484
## General_Support_Dema_4 0.4920529 0.3939309
## General_Support_Dema_5 -0.3115103 -0.3749114
## General_Support_Dema_6 1.0000000 0.4480882
## General_Support_Dema_7 0.4480882 1.0000000
## Specific_Support_De_1 0.6172776 0.4492744
## Specific_Support_De_2 0.5438621 0.4234743
## Specific_Support_De_3 0.5708096 0.4453059
## Specific_Support_De_4 0.5034303 0.3844257
## Specific_Support_De_5 0.5457958 0.4357611
## Specific_Support_De_1 Specific_Support_De_2
## General_Support_Dema_1 0.5410753 0.4976216
## General_Support_Dema_3 0.6207053 0.4599649
## General_Support_Dema_4 0.3973990 0.3623177
## General_Support_Dema_5 -0.4757226 -0.3384772
## General_Support_Dema_6 0.6172776 0.5438621
## General_Support_Dema_7 0.4492744 0.4234743
## Specific_Support_De_1 1.0000000 0.6696164
## Specific_Support_De_2 0.6696164 1.0000000
## Specific_Support_De_3 0.7874651 0.6965644
## Specific_Support_De_4 0.5952847 0.4895244
## Specific_Support_De_5 0.6569249 0.5952618
## Specific_Support_De_3 Specific_Support_De_4
## General_Support_Dema_1 0.5203713 0.3516846
## General_Support_Dema_3 0.5019356 0.5313623
## General_Support_Dema_4 0.3815208 0.2313963
## General_Support_Dema_5 -0.4150208 -0.3230693
## General_Support_Dema_6 0.5708096 0.5034303
## General_Support_Dema_7 0.4453059 0.3844257
## Specific_Support_De_1 0.7874651 0.5952847
## Specific_Support_De_2 0.6965644 0.4895244
## Specific_Support_De_3 1.0000000 0.5578970
## Specific_Support_De_4 0.5578970 1.0000000
## Specific_Support_De_5 0.6763847 0.6497135
## Specific_Support_De_5
## General_Support_Dema_1 0.4821087
## General_Support_Dema_3 0.5725136
## General_Support_Dema_4 0.3441075
## General_Support_Dema_5 -0.3808493
## General_Support_Dema_6 0.5457958
## General_Support_Dema_7 0.4357611
## Specific_Support_De_1 0.6569249
## Specific_Support_De_2 0.5952618
## Specific_Support_De_3 0.6763847
## Specific_Support_De_4 0.6497135
## Specific_Support_De_5 1.0000000## General.Victims_1 General.Victims_2 General.Victims_3
## General.Victims_1 1.00000000 0.6713855 0.5731864
## General.Victims_2 0.67138548 1.0000000 0.6962943
## General.Victims_3 0.57318641 0.6962943 1.0000000
## General.Victims_4 0.49681067 0.6074045 0.4783806
## General.Victims_5 0.50039227 0.5196524 0.5487896
## Dismissing_Support._1 -0.07918481 -0.1362890 -0.1371862
## Dismissing_Support._2 0.31263244 0.3676747 0.3941558
## Dismissing_Support._3 0.35998503 0.4638258 0.4832380
## Dismissing_Support._4 0.31505905 0.4442468 0.4537226
## Dismissing_Support._5 -0.22560823 -0.2900841 -0.2518530
## General.Victims_4 General.Victims_5 Dismissing_Support._1
## General.Victims_1 0.4968107 0.5003923 -0.07918481
## General.Victims_2 0.6074045 0.5196524 -0.13628903
## General.Victims_3 0.4783806 0.5487896 -0.13718623
## General.Victims_4 1.0000000 0.4303689 -0.12681218
## General.Victims_5 0.4303689 1.0000000 -0.13345270
## Dismissing_Support._1 -0.1268122 -0.1334527 1.00000000
## Dismissing_Support._2 0.3195505 0.3186137 -0.53013362
## Dismissing_Support._3 0.3564861 0.3770826 -0.40570442
## Dismissing_Support._4 0.2927025 0.3950699 -0.47745954
## Dismissing_Support._5 -0.2371192 -0.2146079 0.26386008
## Dismissing_Support._2 Dismissing_Support._3
## General.Victims_1 0.3126324 0.3599850
## General.Victims_2 0.3676747 0.4638258
## General.Victims_3 0.3941558 0.4832380
## General.Victims_4 0.3195505 0.3564861
## General.Victims_5 0.3186137 0.3770826
## Dismissing_Support._1 -0.5301336 -0.4057044
## Dismissing_Support._2 1.0000000 0.7420092
## Dismissing_Support._3 0.7420092 1.0000000
## Dismissing_Support._4 0.7028783 0.7139396
## Dismissing_Support._5 -0.3654165 -0.4191086
## Dismissing_Support._4 Dismissing_Support._5
## General.Victims_1 0.3150590 -0.2256082
## General.Victims_2 0.4442468 -0.2900841
## General.Victims_3 0.4537226 -0.2518530
## General.Victims_4 0.2927025 -0.2371192
## General.Victims_5 0.3950699 -0.2146079
## Dismissing_Support._1 -0.4774595 0.2638601
## Dismissing_Support._2 0.7028783 -0.3654165
## Dismissing_Support._3 0.7139396 -0.4191086
## Dismissing_Support._4 1.0000000 -0.3695830
## Dismissing_Support._5 -0.3695830 1.0000000## General.Villains._1 General.Villains._2 General.Villains._3
## General.Villains._1 1.0000000 0.6546678 0.6849265
## General.Villains._2 0.6546678 1.0000000 0.6664463
## General.Villains._3 0.6849265 0.6664463 1.0000000
## General.Villains._5 0.5445641 0.5273651 0.5223148
## General.Villains._6 0.6468114 0.5496670 0.5994692
## Spec_Villains_1 -0.3837900 -0.3810328 -0.4128749
## Spec_Villains_2 -0.3705878 -0.3492408 -0.3553744
## Spec_Villains_3 -0.2479464 -0.2507775 -0.2072863
## Spec_Villains_5 -0.3198576 -0.3245697 -0.3631280
## Spec_Villains_6 0.4209671 0.3690516 0.4165039
## Spec_Villains_7 0.4195987 0.4077167 0.4414536
## Spec_Villains_8 0.4822774 0.4667863 0.4961686
## General.Villains._5 General.Villains._6 Spec_Villains_1
## General.Villains._1 0.5445641 0.6468114 -0.3837900
## General.Villains._2 0.5273651 0.5496670 -0.3810328
## General.Villains._3 0.5223148 0.5994692 -0.4128749
## General.Villains._5 1.0000000 0.4506359 -0.2803377
## General.Villains._6 0.4506359 1.0000000 -0.3440421
## Spec_Villains_1 -0.2803377 -0.3440421 1.0000000
## Spec_Villains_2 -0.2922569 -0.3143144 0.7418825
## Spec_Villains_3 -0.2007378 -0.1833572 0.6956086
## Spec_Villains_5 -0.2791749 -0.2906285 0.7459717
## Spec_Villains_6 0.3257169 0.3583707 -0.7343999
## Spec_Villains_7 0.3134733 0.3759420 -0.6554407
## Spec_Villains_8 0.3990436 0.4218577 -0.6682960
## Spec_Villains_2 Spec_Villains_3 Spec_Villains_5
## General.Villains._1 -0.3705878 -0.2479464 -0.3198576
## General.Villains._2 -0.3492408 -0.2507775 -0.3245697
## General.Villains._3 -0.3553744 -0.2072863 -0.3631280
## General.Villains._5 -0.2922569 -0.2007378 -0.2791749
## General.Villains._6 -0.3143144 -0.1833572 -0.2906285
## Spec_Villains_1 0.7418825 0.6956086 0.7459717
## Spec_Villains_2 1.0000000 0.6822903 0.6271558
## Spec_Villains_3 0.6822903 1.0000000 0.6237481
## Spec_Villains_5 0.6271558 0.6237481 1.0000000
## Spec_Villains_6 -0.7158454 -0.6594248 -0.6568093
## Spec_Villains_7 -0.6628063 -0.5871747 -0.5619117
## Spec_Villains_8 -0.6264340 -0.5794871 -0.5858361
## Spec_Villains_6 Spec_Villains_7 Spec_Villains_8
## General.Villains._1 0.4209671 0.4195987 0.4822774
## General.Villains._2 0.3690516 0.4077167 0.4667863
## General.Villains._3 0.4165039 0.4414536 0.4961686
## General.Villains._5 0.3257169 0.3134733 0.3990436
## General.Villains._6 0.3583707 0.3759420 0.4218577
## Spec_Villains_1 -0.7343999 -0.6554407 -0.6682960
## Spec_Villains_2 -0.7158454 -0.6628063 -0.6264340
## Spec_Villains_3 -0.6594248 -0.5871747 -0.5794871
## Spec_Villains_5 -0.6568093 -0.5619117 -0.5858361
## Spec_Villains_6 1.0000000 0.7308478 0.7087681
## Spec_Villains_7 0.7308478 1.0000000 0.7348321
## Spec_Villains_8 0.7087681 0.7348321 1.0000000Flagged correlations> .8
# Flag all item‐pairs with r > .8
flagged_high <- lapply(names(inter_item_corr), function(scale_name) {
m <- inter_item_corr[[scale_name]]
diag(m) <- NA # ignore the 1.0 diagonals
idx <- which(m > 0.8, arr.ind = TRUE) # find positions > .8
if (nrow(idx)==0) return(NULL) # none to flag
# build a little data.frame of the hits
data.frame(
Scale = scale_name,
Item1 = rownames(m)[idx[,1]],
Item2 = colnames(m)[idx[,2]],
Correlation = m[idx]
, row.names = NULL)
})
# bind into one table (or get NULL if empty)
flagged_high <- do.call(rbind, flagged_high)
if (is.null(flagged_high) || nrow(flagged_high)==0) {
message("No inter‐item correlations exceed 0.8 in any scale.")
} else {
print(flagged_high)
}## Scale Item1 Item2 Correlation
## 1 Gratitude Support_Gov_3 Support_Gov_1 0.8005402
## 2 Gratitude Support_Gov_1 Support_Gov_3 0.8005402
## 3 Criticism Q104 Q103 0.8615561
## 4 Criticism Q103 Q104 0.8615561Support_Gov_1 and Support_Gov_3 might be redundant. Q103 and Q104 (specific criticism) might be redundant.
Reversing items
We now reverse-score the items.
# In gratitude: No reverse scored items
# In criticism=
## Item 4 and 5 of general critic are reverse
df_numeric$General_Critic_4 <- 8 -df_numeric$General_Critic_4
df_numeric$General_Critic_5<- 8 -df_numeric$General_Critic_5
# Support demand : item #5 is reversed
df_numeric$General_Support_Dema_5<- 8 -df_numeric$General_Support_Dema_5
# Victimisation: Specific #1, Specific #5 are reversed
df_numeric$Dismissing_Support._1<- 8 -df_numeric$Dismissing_Support._1
df_numeric$Dismissing_Support._5<- 8 -df_numeric$Dismissing_Support._5
# Villain: Specific: 1, 2 3, 5
df_numeric$Spec_Villains_1 <- 8 -df_numeric$Spec_Villains_1
df_numeric$Spec_Villains_2 <- 8 -df_numeric$Spec_Villains_2
df_numeric$Spec_Villains_3 <- 8 - df_numeric$Spec_Villains_3
df_numeric$Spec_Villains_5 <- 8 - df_numeric$Spec_Villains_5B. Exploratory Structure Analyses (EFA)
From registration:
Prior to the EFA, we will evaluate the “factorability” of each subscale by computing 1) the Kaiser–Meyer–Olkin measure of sampling adequacy (aiming for KMO > .70), and 2) Bartlett’s test of sphericity (with p < .05 indicating the correlation matrix differs significantly from an identity matrix - where items are not inter-correlated). If both criteria are met, we will proceed with the registered EFA. If not, we will examine item-level KMOs and inter-item correlations to identify and address variables that undermine factorability before continuing.
–> All these conditions were met (see below)
We will perform parallel analyses to determine the number of dimensions in our subscale (based on simulating 500 random datasets, we can determine, see Ruscio & Roche, 2012 for a primer on parallel analyses). We expect 1 or 2 factors (distinguishing general/specific items or not).
–> We consistently observed 2 dimensions with two exceptions (see below)
library(psych)
for (scale_name in names(scales)) {
vars <- df_numeric[scales[[scale_name]]]
if (ncol(vars) < 2) {
message("Skipping ", scale_name, ": only ", ncol(vars), " item(s).")
next
}
# 1) KMO on the raw numeric matrix
kmo_out <- KMO(as.matrix(vars))
cat("\n\n===", scale_name, "===\n")
cat("Overall KMO:", round(kmo_out$MSA, 2), "\n")
# 2) Pearson correlation matrix
R <- cor(vars, use="pairwise.complete.obs")
# 3) Bartlett’s test on R
bart_out <- cortest.bartlett(R, n = nrow(df_numeric))
cat("Bartlett’s χ²:", round(bart_out$chisq,2),
"df =", bart_out$df,
"p =", format.pval(bart_out$p.value), "\n")
# 4) Scree plot
ev <- eigen(R)$values
plot(ev, type="b",
xlab="Factor #", ylab="Eigenvalue",
main=paste("Scree:", scale_name))
abline(h=1, lty=2)
# 5) Parallel analysis on Pearson R
fa.parallel(R,
n.obs = nrow(df_numeric),
fa = "fa",
n.iter = 500,
main = paste("Parallel Analysis:", scale_name))
mean_name <- paste0(scale_name, "_mean")
df_numeric[[mean_name]] <- rowMeans(vars, na.rm = TRUE)
cat("Stored ", mean_name, " (mean of ", ncol(vars), " items)\n", sep = "")
}##
##
## === Gratitude ===
## Overall KMO: 0.89
## Bartlett’s χ²: 2753.14 df = 45 p = < 2.22e-16
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA
## Stored Gratitude_mean (mean of 10 items)
##
##
## === Criticism ===
## Overall KMO: 0.82
## Bartlett’s χ²: 2210.36 df = 45 p = < 2.22e-16
## Parallel analysis suggests that the number of factors = 3 and the number of components = NA
## Stored Criticism_mean (mean of 10 items)
##
##
## === Demands ===
## Overall KMO: 0.91
## Bartlett’s χ²: 2738.72 df = 55 p = < 2.22e-16
## Parallel analysis suggests that the number of factors = 5 and the number of components = NA
## Stored Demands_mean (mean of 11 items)
##
##
## === Victimhood ===
## Overall KMO: 0.88
## Bartlett’s χ²: 2147.11 df = 45 p = < 2.22e-16
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA
## Stored Victimhood_mean (mean of 10 items)
##
##
## === Violations ===
## Overall KMO: 0.93
## Bartlett’s χ²: 3592.94 df = 66 p = < 2.22e-16
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA
## Stored Violations_mean (mean of 12 items)We consistently identify a 2-factor solution, with 2 exceptions:
Criticism has 3 solutions
Support for demands from the group has 5 solutions
Regarding Support for demands, the 5-factors solution identified in parallel analyses is possibly a fluke - and there is room for trusting the scree plot’s elbow, rather than the comparison with the simulated data. I thus favour a 2-factor solution.
From registration:
Each outcome will be analysed independently using EFA with oblimin rotation. Items with factor loadings < .3 on their intended dimension should be excluded.
#### ####
### Gratitude
items_ <- scales[["Gratitude"]]
# 2) subset your data
Subdf <- df_numeric[, items_]
# 3) get the Pearson R matrix and run ML‐FA with oblimin
Mat_cor <- cor(Subdf, use = "pairwise.complete.obs")
Res_fa <- fa(r = Mat_cor,
nfactors = 2,
n.obs = nrow(Subdf),
fm = "ml",
rotate = "oblimin")
# 4) print out the loadings
print(Res_fa$loadings, cutoff = .30)##
## Loadings:
## ML2 ML1
## Symbolic_Gratitude_1 0.803
## Symbolic_Gratitude_2 0.849
## Symbolic_Gratitude_3 0.780
## Symbolic_Gratitude_4 0.783
## Symbolic_Gratitude_5 0.792
## Support_Gov_1 0.876
## Support_Gov_2 0.736
## Support_Gov_3 0.903
## Support_Gov_4 0.648
## Support_Gov_5 0.784
##
## ML2 ML1
## SS loadings 3.225 3.179
## Proportion Var 0.323 0.318
## Cumulative Var 0.323 0.640### Two, perfectly defined subscale: general vs specific
GEN_gratitude_items <- grep("Symbolic_Gratitude", names(df_numeric), value = TRUE)
SPEC_gratitude_items <- grep("Support_Gov", names(df_numeric), value = TRUE)
#### ####
#### Criticism
items_ <- scales[["Criticism"]] # or scales$Gratitude
# 2) subset your data
Subdf <- df_numeric[, items_]
# 3) get the Pearson R matrix and run ML‐FA with oblimin
Mat_cor <- cor(Subdf, use = "pairwise.complete.obs")
Res_fa <- fa(r = Mat_cor,
nfactors = 3,
n.obs = nrow(Subdf),
fm = "ml",
rotate = "oblimin")
# 4) print out the loadings
print(Res_fa$loadings, cutoff = .30)##
## Loadings:
## ML3 ML2 ML1
## General_Critic_1 0.841
## General_Critic_2 0.865
## General_Critic_3 0.758
## General_Critic_4 0.476
## General_Critic_5
## Q78 0.615
## Q101 1.004
## Q102 0.546
## Q103 0.958
## Q104 0.916
##
## ML3 ML2 ML1
## SS loadings 2.324 2.121 1.488
## Proportion Var 0.232 0.212 0.149
## Cumulative Var 0.232 0.444 0.593## 3 factors: 1 clear general with only the 3 first that are good:
criticism_items_G <- grep("General_Critic_1|General_Critic_2|General_Critic_3|General_Critic_4", names(df_numeric), value = TRUE)
# Only the 'chill' posts are good. the two extreme ones measuring something else.
criticism_items_S <- grep("Q102|Q103|Q104", names(df_numeric), value = TRUE)
#### ####
####Demands
items_ <- scales[["Demands"]] # or scales$Gratitude
# 2) subset your data
Subdf <- df_numeric[, items_]
# 3) get the Pearson R matrix and run ML‐FA with oblimin
Mat_cor <- cor(Subdf, use = "pairwise.complete.obs")
Res_fa <- fa(r = Mat_cor,
nfactors = 5,
n.obs = nrow(Subdf),
fm = "ml",
rotate = "oblimin")
# 4) print out the loadings
print(Res_fa$loadings, cutoff = .30)##
## Loadings:
## ML3 ML1 ML2 ML4 ML5
## General_Support_Dema_1 0.603
## General_Support_Dema_3 0.360
## General_Support_Dema_4 0.574
## General_Support_Dema_5 0.351
## General_Support_Dema_6 0.690
## General_Support_Dema_7 0.968
## Specific_Support_De_1 0.997
## Specific_Support_De_2 0.343
## Specific_Support_De_3 0.310 0.341 0.385
## Specific_Support_De_4 0.731
## Specific_Support_De_5 0.677
##
## ML3 ML1 ML2 ML4 ML5
## SS loadings 1.378 1.341 1.401 1.002 0.375
## Proportion Var 0.125 0.122 0.127 0.091 0.034
## Cumulative Var 0.125 0.247 0.375 0.466 0.500# ML3: Soft help (we should listen to them, and improve pension and facilities, hire staff)
# ML1: ???
# ML2: Legitimacy to protest
# ML4: Active support (I would...)
# ML5: Time off + Hollidays
#Pure chaos. Maybe let's use two dimensions as scree plot would suggest
items_ <- scales[["Demands"]] # or scales$Gratitude
# 2) subset your data
Subdf <- df_numeric[, items_]
# 3) get the Pearson R matrix and run ML‐FA with oblimin
Mat_cor <- cor(Subdf, use = "pairwise.complete.obs")
Res_fa <- fa(r = Mat_cor,
nfactors = 2,
n.obs = nrow(Subdf),
fm = "ml",
rotate = "oblimin")
# 4) print out the loadings
print(Res_fa$loadings, cutoff = .30)##
## Loadings:
## ML1 ML2
## General_Support_Dema_1 0.919
## General_Support_Dema_3 0.644
## General_Support_Dema_4 0.398
## General_Support_Dema_5 0.420
## General_Support_Dema_6 0.582
## General_Support_Dema_7 0.768
## Specific_Support_De_1 0.893
## Specific_Support_De_2 0.715
## Specific_Support_De_3 0.864
## Specific_Support_De_4 0.772
## Specific_Support_De_5 0.787
##
## ML1 ML2
## SS loadings 4.236 1.658
## Proportion Var 0.385 0.151
## Cumulative Var 0.385 0.536# Let's keep the General that is distinct from specific (focus on protesting)
DemandSupp_G <- grep("General_Support_Dema_1|General_Support_Dema_4|General_Support_Dema_7", names(df_numeric), value = TRUE)
# As for the specific, they are all in.
DemandSupp_S <- grep("Specific_Support_De_1|Specific_Support_De_2|Specific_Support_De_3|Specific_Support_De_4|Specific_Support_De_5", names(df_numeric), value = TRUE)
#### ####
#### Victimhood
items_ <- scales[["Victimhood"]] # or scales$Gratitude
# 2) subset your data
Subdf <- df_numeric[, items_]
# 3) get the Pearson R matrix and run ML‐FA with oblimin
Mat_cor <- cor(Subdf, use = "pairwise.complete.obs")
Res_fa <- fa(r = Mat_cor,
nfactors = 2,
n.obs = nrow(Subdf),
fm = "ml",
rotate = "oblimin")
# 4) print out the loadings
print(Res_fa$loadings, cutoff = .30)##
## Loadings:
## ML2 ML1
## General.Victims_1 0.784
## General.Victims_2 0.890
## General.Victims_3 0.733
## General.Victims_4 0.653
## General.Victims_5 0.584
## Dismissing_Support._1 0.678
## Dismissing_Support._2 0.887
## Dismissing_Support._3 0.781
## Dismissing_Support._4 0.778
## Dismissing_Support._5 0.386
##
## ML2 ML1
## SS loadings 2.793 2.631
## Proportion Var 0.279 0.263
## Cumulative Var 0.279 0.542# General works fine
Victim_G <- grep("General.Victims_1|General.Victims_2|General.Victims_3|General.Victims_4|General.Victims_5", names(df_numeric), value = TRUE)
# Same for Specific
Victim_S <- grep("Dismissing_Support._1|Dismissing_Support._2|Dismissing_Support._3|Dismissing_Support._4|Dismissing_Support._5", names(df_numeric), value = TRUE)
#### ####
#### Violations
items_ <- scales[["Violations"]] # or scales$Gratitude
# 2) subset your data
Subdf <- df_numeric[, items_]
# 3) get the Pearson R matrix and run ML‐FA with oblimin
Mat_cor <- cor(Subdf, use = "pairwise.complete.obs")
Res_fa <- fa(r = Mat_cor,
nfactors = 2,
n.obs = nrow(Subdf),
fm = "ml",
rotate = "oblimin")
# 4) print out the loadings
print(Res_fa$loadings, cutoff = .30)##
## Loadings:
## ML1 ML2
## General.Villains._1 0.837
## General.Villains._2 0.772
## General.Villains._3 0.817
## General.Villains._5 0.634
## General.Villains._6 0.734
## Spec_Villains_1 0.868
## Spec_Villains_2 0.837
## Spec_Villains_3 0.886
## Spec_Villains_5 0.782
## Spec_Villains_6 0.826
## Spec_Villains_7 0.717
## Spec_Villains_8 0.659
##
## ML1 ML2
## SS loadings 4.484 3.026
## Proportion Var 0.374 0.252
## Cumulative Var 0.374 0.626# Here also: general works fine
Villain_G <- grep("General.Villains._1|General.Villains._2|General.Villains._3|General.Villains._5|General.Villains._6", names(df_numeric), value = TRUE)
## But specific not so much...
Villain_S <- grep("Spec_Villains_1|Spec_Villains_2|Spec_Villains_3|Spec_Villains_4|Spec_Villains_5|Spec_Villains_6|Spec_Villains_7|Spec_Villains_8", names(df_numeric), value = TRUE)
scales <- list(
Gratitude_G = GEN_gratitude_items,
Gratitude_S = SPEC_gratitude_items,
criticism_items_G = criticism_items_G,
criticism_items_S = criticism_items_S,
DemandSupp_G = DemandSupp_G,
DemandSupp_S = DemandSupp_S,# Only 2 items
Victim_G = Victim_G ,
Victim_S = Victim_S,
Villain_G = Villain_G,
Villain_S = Villain_S
)
for (name in names(scales)) {
items <- scales[[name]]
df_subset <- df_numeric[items]
df_numeric[[paste0(name, "_mean")]] <- rowMeans(df_subset, na.rm = TRUE)
}
# efa_results <- lapply(scales, function(items) {
# # Subset to those items, drop incomplete cases
# df_sub <- df_numeric[items]
# df_sub <- df_sub[complete.cases(df_sub), , drop = FALSE]
#
# # Run EFA: 2 factors, ML extraction, oblimin rotation
# fa(df_sub, nfactors = 2, fm = "ml", rotate = "oblimin")
# })
#
# # Name the list elements for clarity
# names(efa_results) <- names(scales)
#
#
# # Or to loop through all and print the loadings above |.30|:
# for(name in names(efa_results)) {
# cat("\n\n###", name, "Loadings\n")
# print(efa_results[[name]]$loadings, cutoff = .30)
# }In general: the EFAs identify perfectly the Specific vs General items - with a few exceptions:
Criticism: The two extreme specific posts about killing officers are their own dimension (possibly psychopathy?).
General support for demands: some general items seems to tap the same factor as the specific support (approving specific demands).
Most loadings were >.3 in the expected factors - but we might still want to use loadings to help us decide which items to include or exclude in the final version.
C. Reliability
From registration:
Subscale reliability will be assessed using McDonald’s ω (target > .7). Inter-item correlations will also be evaluated, and items with correlations > .8 may be removed due to redundancy. On average, to balance reliability with content coverage, we aim for a reliability that does not exceed ω = .9 (see Cliffton, 2020 for a discussion on reliability vs validity trade-offs).
As previously observed - intercorrelations are fine with two exceptions.
reliability_results <- lapply(scales, function(items) {
df_subset <- df_numeric[items]
# Keep only complete cases
df_subset <- df_subset[complete.cases(df_subset), ]
# Compute McDonald's omega via psych
psych::omega(df_subset, nfactors = 1)
})
omega_values <- sapply(reliability_results, function(res) res$omega.tot)
omega_summary <- tibble(
Scale = names(omega_values),
Omega_total = round(omega_values, 2)
)
omega_summary %>%
gt() %>%
tab_header("McDonald's ω (Total) by Subscale") %>%
fmt_number(columns = "Omega_total", decimals = 2)| McDonald's ω (Total) by Subscale | |
| Scale | Omega_total |
|---|---|
| Gratitude_G | 0.90 |
| Gratitude_S | 0.90 |
| criticism_items_G | 0.84 |
| criticism_items_S | 0.89 |
| DemandSupp_G | 0.79 |
| DemandSupp_S | 0.90 |
| Victim_G | 0.86 |
| Victim_S | 0.84 |
| Villain_G | 0.88 |
| Villain_S | 0.93 |
We are in our target - but some are dangerously close to .9 (Gratitude items).
We now need to achieve our ultimate target: reducing the number of items.
write.csv(df_numeric, "Data_Clean_FactorAnalysesHeroScale.csv", row.names = F)
df_numeric$Heroism_num <- as.numeric(df_numeric$hero_1)
df_numeric$Att_num <- as.numeric(df_numeric$attitude)D. Refining the scale
Our target is 2-3 items per subscale. We assume that we identified correctly General vs Specificity. Our analyses put forward some limitations in some subscales
General gratitude
Most items show a distribution that emphasise that most people would not do anything for police officers (a mode of 1 everywhere, especially in the first items).
The three last items (3, 4, 5) show the most variance:
Sharing a supportive post about police officers on my social media
Donating to a campaign that aims to raise public awareness about the contributions of police officers
Volunteering time to help with initiatives that support the work of police officers
Specific gratitude
See section on specific demands from police officers for mirroring things in an independent study.
Because the correlations between the two instigators (gov vs target) are too high – we can’t really expect to measure a difference in support within participants. Participants will have to either receive the government based version or the target based version.
This could be done in a set of independent studies dedicated to testing this contrast hypothesis. Maybe, see Economic studies in grant application.
I suggest we remove this section from our main questionnaire, for now.
Support for demands General
Items 1 and 7 are the only two showing high loadings on a dimension that is distinct from the specific demands. They focus over right to protest.
Police officers should protest more for the rights they deserve
I support police officers who choose protest as a way to achieve fair working conditions
Support for demands specific
See gov supported gratitude section. We will leave this section out for now.
General criticism
Items 4 and 5 do not saturate well on the target dimension: We keep the items 1:3:
People should think twice before they criticize police officers
People should stop badmouthing police officers
Negative comments about police officers often go too far
Specific criticism
Here, we have two subsets of items: the two first items are extreme and include threats of violence, whereas the three others do not include death threats. However, the 2nd death threat (101) does have some variance in responses (not everyone is willing to get the law involved, and some people are willing to ignore it.)
In contrast, the second cluster are mostly ignored by people, with the exception of 102 which does include a fair amount of people wanting the post to be banned, deleted, or even prosecuted.
Mixing 101 and 102 might provide the best content coverage and result i a nice variane between willing to ignore and willing to prosecute:
Police officers should die and burn in hell
Police officers are evil and wish harm on other people
General victimhood
They’re all good - the top three are the best - ‘vulnerable’ (5) is not performing that well in comparison to the others.
Let’s keep 1, 2, 3:
Victimised
Unfairly treated
Exploited
Specific victimhood (migraines)
5th is a no-go. I don’t like 4 (“This situation of police officers is unacceptable”) because it’s not that relevant for hypothesis.
I like 1 and 3 as being targeting our key hypothesis more specifically. I’d suggest 1, 2, 3:
I believe police officers are strong enough to face this condition
It shows that we are asking too much of police officers
This report shows that police officers require greater protection
General acceptability of breaking regulations
5 is the most normal item - but I don’t like it because the officer’s cop, is still a cop… so there’s a conflict (it’s also the item that has the lowest loading on the dimension).
I do not like item 2 (“It is a problem that rules and regulations could slow down police officers’ work”) because one might agree it is a problem that regulations could slow down police - without agreeing with the idea that regulations are a problem. As such, it seems slightly irrelevant.
I suggest keeping 1, 3, 6:
Police officers should be given more freedom in the way they do their work
Police officers can do their job better when they’re not forced to follow standard procedures
Police officers should be able to do whatever it takes to achieve their mission
Specific acceptability of breaking regulations
Items loading are all good… Let’s focus on distribution variance.
5 is a problem, because very few people score low. Items 1 and 2 have the same problem to some extant.
7 and 8 have good descriptives: means (both 3.78) are close to median point (= 4) – and high variance (SD = 1.85). But they are somewhat identical? interitem correlation of .73.
Now if I had to choose between 3 and 6 – Item 3 generalises to other police men: it can be a good thing, but also slightly irrelevant to this subsection on specific judgments. Item 6 is probably inconsistent with responses to items 7 and 8 - but that might improve item coverage. I’m afraid this will require some trial and error. But I want to test the following combination:
- Going by the loading; 7 and 8 only
- Going by the loadings + 1 item: 7, 8, 3, 6 | 7,8,3 |7,8,6
- Only including one of the redundant item: 7 (because best loading of the two), 3, 6
## [1] 6 1 5 4 4 3 7 5 2 1 6 1 4 5 4 6 2 3 6 5 6 5 5 3 4 6 4 5 5 5 2 6 6 1 4 4 3
## [38] 2 4 5 2 6 7 6 1 4 5 6 4 5 1 4 2 7 5 2 1 1 4 6 1 6 4 4 5 4 7 4 2 2 7 3 2 4
## [75] 7 4 5 7 5 4 4 5 3 1 7 6 2 7 7 5 4 7 7 7 5 4 7 2 7 4 1 4 5 4 4 6 2 4 6 2 5
## [112] 3 2 6 6 1 4 6 5 4 2 5 5 7 5 6 5 7 2 4 5 5 5 6 7 4 3 1 5 6 3 4 5 4 7 7 2 2
## [149] 7 6 3 5 2 2 2 6 3 4 2 3 3 1 3 3 5 5 5 4 7 3 4 6 5 4 3 6 5 7 7 4 4 4 6 3 3
## [186] 7 5 7 4 3 7 4 3 2 3 7 6 4 6 7 5 3 4 6 3 5 1 6 4 2 7 4 2 6 3 5 6 7 6 7 3 4
## [223] 2 3 6 2 7 7 1 3 6 1 4 5 1 7 3 4 5 3 5 3 5 3 3 5 3 6 6 1 7 6 4 7 5 2 1 6 3
## [260] 3 6 6 1 6 6 5 4 3 4 3 6 2 6 3 3 4 2 5 7 2 6 2 7 6 3 3 3 1 7 4 5 6 4 5 5 5
## [297] 2 1 2 4 4 7 6 7 5 1 5 6 7 3 2 1 3 7 4 3 4 6 4 7 3 2 3 3 3 6 4 7 6 6 2 6 5
## [334] 4 3 5 7 3 3 4 6 5 7 3 4 7 3 7 4 6 3 4 6 2 3 4 3 5 6 5 4 6 7 6 4 7 3 4 6 1
## [371] 6 7 6 1 5 1 6 6 7 7 1 2 1 7 6 6 3 3 7 7 7 1 6 1 3 5 6 6 5 5 3 2 3 1 3 3 4
## [408] 5 2 3 4 4 5 7 5 6 3 4 4 1 3 4 4 3 3 6 6 5 3 5 2 2 7 1 2 5 5 4 1 6Villain_S1 <- grep("Spec_Villains_7|Spec_Villains_8", names(df_numeric), value = TRUE)
Villain_S2 <- grep("Spec_Villains_7|Spec_Villains_8|Spec_Villains_3|Spec_Villains_6", names(df_numeric), value = TRUE)
Villain_S3 <- grep("Spec_Villains_7|Spec_Villains_8|Spec_Villains_3", names(df_numeric), value = TRUE)
Villain_S4 <- grep("Spec_Villains_7|Spec_Villains_8|Spec_Villains_6", names(df_numeric), value = TRUE)
Villain_S5 <- grep("Spec_Villains_7|Spec_Villains_3|Spec_Villains_6", names(df_numeric), value = TRUE)rm(scales)
scales <- list(
gratitude_G = gratitude_G,
Support_G = Support_G,
Criticism_G = Criticism_G,
Criticism_S = Criticism_S,
Victim_G = Victim_G ,
Victim_S = Victim_S,
Villain_G = Villain_G,
Villain_S1 = Villain_S1,
Villain_S2 = Villain_S2,
Villain_S3 = Villain_S3,
Villain_S4 = Villain_S4,
Villain_S5 = Villain_S5
)We recompute reliability of the final scale:
Reliability final
for (name in names(scales)) {
items <- scales[[name]]
df_subset <- df_numeric[items]
df_numeric[[paste0(name, "_mean")]] <- rowMeans(df_subset, na.rm = TRUE)
}
reliability_results <- lapply(scales, function(items) {
df_subset <- df_numeric[items]
# Keep only complete cases
df_subset <- df_subset[complete.cases(df_subset), ]
# Compute McDonald's omega via psych
psych::omega(df_subset, nfactors = 1)
})
omega_values <- sapply(reliability_results, function(res) res$omega.tot)
omega_summary <- tibble(
Scale = names(omega_values),
Omega_total = round(omega_values, 2)
)
omega_summary %>%
gt() %>%
tab_header("McDonald's ω (Total) by Subscale") %>%
fmt_number(columns = "Omega_total", decimals = 2)| McDonald's ω (Total) by Subscale | |
| Scale | Omega_total |
|---|---|
| gratitude_G | 0.86 |
| Support_G | 0.84 |
| Criticism_G | 0.84 |
| Criticism_S | 0.69 |
| Victim_G | 0.85 |
| Victim_S | 0.82 |
| Villain_G | 0.85 |
| Villain_S1 | 0.85 |
| Villain_S2 | 0.89 |
| Villain_S3 | 0.84 |
| Villain_S4 | 0.89 |
| Villain_S5 | 0.86 |
Looking at the reliability can direct us toward the best solution for villains_Specific: I think omega of .89 is too high for our endavour. I suggest Option1: Only the two items that gives a good mean + Variance, albeit being repeating each others. TO BE DISCUSSED
This police officer should be protected from prosecution on the basis of this violation
There should be a law protecting police officers from facing civil lawsuits in similar situations
We now have our final scale, comprising 20 items + 1 single item gratitude scale.
Correlational analyses
Number of items per scale:
rm(scales)
scales <- list(
gratitude_G = gratitude_G,
Support_G = Support_G,
Criticism_G = Criticism_G,
Criticism_S = Criticism_S,
Victim_G = Victim_G ,
Victim_S = Victim_S,
Villain_G = Villain_G,
Villain_S1 = Villain_S1
)
sapply(scales, length)## gratitude_G Support_G Criticism_G Criticism_S Victim_G Victim_S
## 3 2 2 2 3 3
## Villain_G Villain_S1
## 3 2scale_scores <- as.data.frame(
lapply(scales, function(item_vec) {
rowMeans(df_numeric[, item_vec], na.rm = TRUE)
})
)
scale_scores$Heroism <- df_numeric$Heroism_num
scale_scores$Attitude <- df_numeric$Att_num
scale_scores$Single_Gratitude <- df_numeric$Single_Item_Grat
PerformanceAnalytics::chart.Correlation(scale_scores)
- Gratitude
Sharing a supportive post about police officers on my social media
Donating to a campaign that aims to raise public awareness about the contributions of police officers
Volunteering time to help with initiatives that support the work of police officers
- Single-item gratitude
- To what extent do you feel grateful toward Police officers?
- Supporting demands from the workers - GENERAL
Police officers should protest more for the rights they deserve
I support police officers who choose protest as a way to achieve fair working conditions
- Criticism acceptability - GENERAL
People should think twice before they criticize police officers
People should stop badmouthing police officers
Negative comments about police officers often go too far
- Criticism acceptability - SPECIFIC
Police officers should die and burn in hell
Police officers are evil and wish harm on other people
- Support demand General
Police officers should protest more for the rights they deserve
I support police officers who choose protest as a way to achieve fair working conditions
- Victimhood - GENERAL
Victimised
Unfairly treated
Exploited
Victimhood - SPECIFIC
I believe police officers are strong enough to face this condition
It shows that we are asking too much of police officers
This report shows that police officers require greater protection
Regulation violations acceptability - GENERAL
Police officers should be given more freedom in the way they do their work
Police officers can do their job better when they’re not forced to follow standard procedures
Police officers should be able to do whatever it takes to achieve their mission
Regulation violations acceptability - SPECIFIC
This police officer should be protected from prosecution on the basis of this violation
There should be a law protecting police officers from facing civil lawsuits in similar situations
Exploratory analyses
Because we measured Heroism and Attitude toward police officers, we can test our main hypotheses, with the following registered caution:
We emit a priori caution with interpreting any null finding in this study: our hypotheses might hold only when comparing groups between them or when manipulating the Hero status (see our previous study; https://osf.io/ysvxb).
H1: Heroes inspire gratitude
##
## Call:
## lm(formula = scale_scores$gratitude_G ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.0682 -0.9511 -0.0563 0.8453 3.2279
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.76110 0.06431 42.936 < 2e-16 ***
## scale(scale_scores$Heroism) 0.42763 0.10681 4.003 7.35e-05 ***
## scale(scale_scores$Attitude) 0.48705 0.10662 4.568 6.43e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.341 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.2963, Adjusted R-squared: 0.2931
## F-statistic: 90.96 on 2 and 432 DF, p-value: < 2.2e-16effectsize::eta_squared(car::Anova(lm(scale_scores$gratitude_G ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.04 | [0.01, 1.00]
## scale(scale_scores$Attitude) | 0.05 | [0.02, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].Heroism predicts general feelings of gratitude, above and beyong attitude
H2: Heroism is associated to reduced support for demands from the worker
we test wether the more heroic we believe police officers are, the less support for them protesting - when controlling for attitude
##
## Call:
## lm(formula = scale_scores$Support_G ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9543 -0.8663 0.1337 0.9802 4.1247
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.15309 0.06664 62.318 < 2e-16 ***
## scale(scale_scores$Heroism) 0.38062 0.11069 3.439 0.000642 ***
## scale(scale_scores$Attitude) 0.16554 0.11049 1.498 0.134799
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.39 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.1244, Adjusted R-squared: 0.1203
## F-statistic: 30.68 on 2 and 432 DF, p-value: 3.467e-13effectsize::eta_squared(car::Anova(lm(scale_scores$Support_G ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.03 | [0.01, 1.00]
## scale(scale_scores$Attitude) | 5.17e-03 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].No – although Heroism does predict support for demands from workers, it is in the opposite direction to our prediction: the more we perceive officers to be heroic, the more we support their demands - above and beyond attitude.
H3: Heroism shields against criticism
##
## Call:
## lm(formula = scale_scores$Criticism_G ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.1420 -0.6631 0.0487 0.7377 3.4018
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.66889 0.05447 85.719 <2e-16 ***
## scale(scale_scores$Heroism) 0.18957 0.09047 2.095 0.0367 *
## scale(scale_scores$Attitude) 0.96620 0.09030 10.699 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.136 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.4964, Adjusted R-squared: 0.494
## F-statistic: 212.9 on 2 and 432 DF, p-value: < 2.2e-16effectsize::eta_squared(car::Anova(lm(scale_scores$Criticism_G ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.01 | [0.00, 1.00]
## scale(scale_scores$Attitude) | 0.21 | [0.16, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].Kind of – there is a small effect, independent of attitude. This would be hard to reproduce.
What about specific criticism? i.e., reporting vs ignoring hate speech against police officers
##
## Call:
## lm(formula = scale_scores$Criticism_S ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.14379 -0.48635 0.07265 0.58078 2.19548
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.67108 0.04200 87.413 < 2e-16 ***
## scale(scale_scores$Heroism) 0.01281 0.06972 0.184 0.854
## scale(scale_scores$Attitude) 0.34141 0.06958 4.907 1.32e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8748 on 431 degrees of freedom
## (6 observations deleted due to missingness)
## Multiple R-squared: 0.1404, Adjusted R-squared: 0.1364
## F-statistic: 35.2 on 2 and 431 DF, p-value: 6.912e-15effectsize::eta_squared(car::Anova(lm(scale_scores$Criticism_S ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 7.83e-05 | [0.00, 1.00]
## scale(scale_scores$Attitude) | 0.05 | [0.02, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].Surprisingly - there is no effect whatsoever of heroism on acceptability of hate speech against officers. This is a surprising null effect.
H4: Heroism inhibits victim-hood: we overestimate their resilience to hardship
##
## Call:
## lm(formula = scale_scores$Victim_G ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.1232 -0.8076 -0.2599 0.6783 4.7401
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.05920 0.05854 52.259 < 2e-16 ***
## scale(scale_scores$Heroism) 0.43149 0.09723 4.438 1.16e-05 ***
## scale(scale_scores$Attitude) 0.30284 0.09705 3.120 0.00193 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.221 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.2472, Adjusted R-squared: 0.2437
## F-statistic: 70.93 on 2 and 432 DF, p-value: < 2.2e-16effectsize::eta_squared(car::Anova(lm(scale_scores$Victim_G ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.04 | [0.02, 1.00]
## scale(scale_scores$Attitude) | 0.02 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].No – heroism predicts the perception of police officers as being exploited, victimized, and unfairly treated, Above and beyond attitude.
##
## Call:
## lm(formula = scale_scores$Victim_S ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5356 -0.6729 -0.0062 0.7617 2.9306
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.55037 0.05563 81.794 < 2e-16 ***
## scale(scale_scores$Heroism) 0.42398 0.09240 4.588 5.86e-06 ***
## scale(scale_scores$Attitude) 0.20791 0.09223 2.254 0.0247 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.16 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.2137, Adjusted R-squared: 0.21
## F-statistic: 58.7 on 2 and 432 DF, p-value: < 2.2e-16effectsize::eta_squared(car::Anova(lm(scale_scores$Victim_S ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.05 | [0.02, 1.00]
## scale(scale_scores$Attitude) | 0.01 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].Similar results using a specific situation – the more heroic, the more we think migraines are a sign that police officers should be protected.
Heroism protects against backlash from breaking the rules
Heroism might inhibit villain status and allow people to disregard regulations.
##
## Call:
## lm(formula = scale_scores$Villain_G ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9284 -1.0482 0.0205 1.0545 4.3368
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.19663 0.06671 47.916 <2e-16 ***
## scale(scale_scores$Heroism) 0.34989 0.11081 3.158 0.0017 **
## scale(scale_scores$Attitude) 0.14866 0.11061 1.344 0.1796
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.391 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.1057, Adjusted R-squared: 0.1016
## F-statistic: 25.54 on 2 and 432 DF, p-value: 3.298e-11effectsize::eta_squared(car::Anova(lm(scale_scores$Villain_G ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.02 | [0.01, 1.00]
## scale(scale_scores$Attitude) | 4.16e-03 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].Yes - attitude toward officers does not predict acceptability of breaking the rules for police officers - but heroism does. This is a huge win.
##
## Call:
## lm(formula = scale_scores$Villain_S1 ~ scale(scale_scores$Heroism) +
## scale(scale_scores$Attitude))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4809 -1.2647 0.0306 1.2238 3.9340
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.76818 0.07731 48.741 <2e-16 ***
## scale(scale_scores$Heroism) 0.31307 0.12841 2.438 0.0152 *
## scale(scale_scores$Attitude) 0.32292 0.12818 2.519 0.0121 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.612 on 432 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.1234, Adjusted R-squared: 0.1194
## F-statistic: 30.41 on 2 and 432 DF, p-value: 4.393e-13effectsize::eta_squared(car::Anova(lm(scale_scores$Villain_S1 ~
scale(scale_scores$Heroism) +
scale(scale_scores$Attitude)), type = "III"))## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 95% CI
## ------------------------------------------------------------
## scale(scale_scores$Heroism) | 0.01 | [0.00, 1.00]
## scale(scale_scores$Attitude) | 0.01 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].For the specific dilemma, things are more nuanced: yes heroism shields against public backlash from breaking the rules, but on an equal measure with attitude - and both effects are quite small.
NOTE: it is important to note that our predictions are not invalidated by null and reversed effects. Indeed, we must consider that: - Our hypotheses might make sense when comparing occupations, rather than looking within an occupation (see Simpson paradox) - Our hypotheses might appear upon manipulating heroism, rather than looking within an occupation
The reason for these two points is that a lot of things covary with heroism perception - there might be multiple counfounding variables that reverse our effects. Upon manipulating heroism, we could evaculate some of these counfounders. Similarly, comparing between occupations, might give us a wider scope on the general role of heroism in our hypotheses.
We anticipated the possibility that some of our hypotheses might not hold in this setting - as registered. Consequently, we do not revise our hypotheses.