Prevent Säkerhetsvisaren 2.0

Code

# one package below requires that you use devtools to install them manually:
# first install devtools by
# install.packages('devtools')

library(RISEkbmRasch) # devtools::install_github("pgmj/RISEkbmRasch")
library(grateful)
library(ggrepel)
library(car)
library(kableExtra)
library(readxl)
library(tidyverse)
library(eRm)
library(mirt)
library(psych)
library(psychotree)
library(matrixStats)
library(reshape)
library(knitr)
library(patchwork)
library(formattable) 
library(glue)
library(haven)
library(labelled)
library(qualtRics)
library(janitor)
library(lavaanExtra)
library(lavaan)
library(lavaanPlot)
library(parameters)
library(marginaleffects)
library(modelsummary)
library(showtext)
library(broom)
source("theme_prevent.R")

### optional libraries
#library(TAM)
#library(skimr)

### some commands exist in multiple packages, here we define preferred ones that are frequently used
select <- dplyr::select
count <- dplyr::count
recode <- car::recode
rename <- dplyr::rename
annotate <- ggplot2::annotate

source("RISE_theme.R")

Code

# import item information
df <- read_spss("data/prevent_safety_itemlabels.sav")

# get metadata into a separate dataframe
item <- lapply(df, function(x) attributes(x)$label)

itemlabels_all <- data.frame(
  itemnr = names(df),
  item = unlist(item),
  row.names = NULL
)

itemlabels <- itemlabels_all %>% 
  filter(str_detect(itemnr, 'q1|q2|q3|q4')) %>% 
  separate_wider_delim(item, names =  c(NA,"item"), delim = ". - ")

Code

# import data
# qualtrics_token <- read.table("../.qualtrics_token", header = FALSE) %>% 
#   pull(V1)
# qualtrics_url <- "fra1.qualtrics.com"
# 
# qualtrics_api_credentials(api_key = qualtrics_token, 
#  base_url = qualtrics_url)
# 
# q <- all_surveys()
# mysurvey <- fetch_survey(surveyID = q$id[1],
#                          verbose = FALSE) %>% 
#   clean_names() %>% 
#   filter(start_date > '2024-03-26') # enkätstart 27e mars 2024, så filtrera bort äldre svar.
# 
# df <- mysurvey %>% 
#   filter(start_date > '2024-03-26') %>% 
#   select(starts_with("q"),age,gender,role,bransch,duration_in_seconds) %>% 
#   rownames_to_column("id")
# 
demogr_vars <- as.character(expression(age,gender,role,bransch))
# 
# write_csv(df,paste0(Sys.Date(),"_prevent_safety.csv"))
df <- read_csv("data/prevent_safety_data.csv")

Code

# recode to numerics
df2 <- df %>% 
  select(!q5a) %>% 
  #select(!q5b) %>%  #fritextsvar bortplockade
  mutate(across(starts_with("q"), ~ car::recode(.x,"'Stämmer helt'=3;'Stämmer ganska väl'=2;'Stämmer ganska dåligt'=1;'Stämmer inte alls'=0", as.factor = FALSE)))

1 Introduktion till analys

1.1 Kort om analysmetod

RISE har tagit fram fem grundläggande psykometriska kriterier som har varit utgångspunkt för analysarbetet. En artikel som beskriver kriterierna finns fritt tillgänglig som preprint (Johansson et al. 2023) och innehåller både en enklare och mera fördjupad beskrivning av kriterierna.

Nedan finns en förenklad beskrivning av de psykometriska kriterierna på svenska, som kommer från RISE rapport till MFoF om uppföljning av föräldraskapsstöd (Preuter, Johansson, and Bokström 2022):

När enkäter konstrueras och utvärderas bedöms dess psykometriska egenskaper, ofta kopplade till begreppen reliabilitet och validitet. Förenklat kan man säga att reliabilitet beskriver hur väl något mäts (vilken precision mätverktyget har), medan validitet beskriver hur väl innehållet i frågorna och svarskategorierna fångar det man avser att mäta. Dock råder i allmänhet oklara definitioner av begreppen och kriterier för huruvida dessa mätegenskaper uppfylls eller inte. Det medför att även enkäter som i forskningsartiklar beskrivs som “validerade” eller att de har “god reliabilitet” inte nödvändigtvis uppfyller vad som kan anses vara grundläggande kriterier. En mera omfattande beskrivning av de grundläggande psykometriska kriterierna återfinns i Bilaga 3 (separat dokument). Nedan listas kriterierna. Var och en av dem kräver psykometrisk analys av insamlade data för att bedöma.

Lista över grundläggande psykometriska kriterier:

Svarskategorierna fungerar som avsett

Frågorna fungerar likadant för olika grupper (kön, ålder, etc)

Unidimensionalitet (utan för starkt korrelerade residualer)

Frågornas svårighetsgrad passar målgruppens egenskaper/förmågor

Reliabilitet/mätosäkerheter över skalans omfång är adekvat, sett till användningsområdet

Omvandlingstabell till intervallskala

Kriterierna ovan är ställda för att säkerställa att det är lämpligt att använda summapoäng från en enkät/skala. Summapoängen bör i sin tur användas tillsammans med en omvandlingstabell till intervallskala innan några statistiska eller matematiska beräkningar görs. Tyvärr är det mycket vanligt att forskningsstudier enbart redovisar Cronbach’s alpha som ett mått på reliabilitet och/eller kvalitet på en enkät. Det är dessvärre gravt otillräckligt för att bedöma mätegenskaper hos ett mätverktyg, eftersom Cronbach’s alpha inte ger information om något av kriterierna ovan.

2 Svarsbortfall

Code

df2 %>% 
  select(starts_with(c("q1","q2","q3","q4"))) %>% 
  RImissing()

Code

df2 %>% 
  select(starts_with(c("q1","q2","q3","q4"))) %>% 
  RImissingP(n = 20)

Det är många som har missing data rakt igenom. Detta kan bero på att länken är öppen och tillgänglig även för “bottar” på internet, samt de som enbart är intresserade av att titta på frågorna men ej besvara dem.

Vi tittar på hur många/stor andel det rör sig om.

Code

df2 %>% 
  select(starts_with(c("q1","q2","q3","q4"))) %>% 
  mutate(Missing = rowSums(is.na(.))) %>%
  count(Missing) %>% 
  rename(`Antal saknade svar` = Missing) %>% 
  kbl_rise()

Antal saknade svar	n
0	309
1	7
2	4
3	2
4	1
6	8
11	2
13	28
14	2
15	1
18	1
19	52
20	1
21	1
22	154

Code

# all_missing <- df2 %>% 
#   select(starts_with(c("q1","q2","q3","q4"))) %>% 
#   mutate(Missing = rowSums(is.na(.))) %>%
#   rownames_to_column("id") %>% 
#   filter(Missing == 22) %>% 
#   pull(id)
# 
# df2 %>% 
#   rownames_to_column("id") %>% 
#   filter(id %in% all_missing) %>% 
#   select(all_of(demogr_vars)) %>% 
#   na.omit() %>% 
#   kbl_rise()

Code

df3 <- df2 %>% 
  select(id,starts_with(c("q1","q2","q3","q4"))) %>% 
  na.omit()

df3b <- df2 %>% 
  select(id,q6,starts_with(c("q1","q2","q3","q4"))) %>% 
  na.omit()

dif_variables <- df2 %>% 
  select(id,all_of(demogr_vars))

df_dif <- left_join(df3, dif_variables, by = "id")

d <- df3 %>% 
  select(starts_with(c("q1","q2","q3","q4"))) %>% 
  # reverse score 2 items
  mutate(across(c(q4_4,q2_2), ~ car::recode(.x,"3=0;2=1;1=2;0=3"))
  )

3 Demografiska data

Code

RIdemographics(df_dif$age,"Ålder")
RIdemographics(df_dif$gender,"Kön")
RIdemographics(df_dif$role,"Roll")
# bransch sorterad
df_dif %>% 
  count(bransch) %>% 
  mutate(Procent = round(n*100/sum(n),2)) %>% 
  arrange(desc(Procent)) %>% 
  rename(Bransch = bransch,
         Antal = n) %>% 
  kbl_rise()

Ålder	n	Percent
19-29	5	1.6
30-45	109	35.3
46-55	114	36.9
56+	81	26.2

Kön	n	Percent
Annat	2	0.6
Kvinna	159	51.5
Man	143	46.3
Vill ej ange	5	1.6

Roll	n	Percent
Arbetsledande med personal ansvar	74	24.0
Arbetsledande utan personalansvar	55	17.9
Medarbetare	179	58.1

Bransch	Antal	Procent
Annan verksamhet	111	35.92
Tillverkning	101	32.69
Bygg	34	11.00
Vård/omsorg	14	4.53
Energiförsörjning	13	4.21
Jordbruk, skogsbruk	10	3.24
Transport	10	3.24
Handel	7	2.27
Utvinning av mineral	4	1.29
Hotell/restaurang	3	0.97
Vattenförsörjning	1	0.32
NA	1	0.32

Vi har mycket låg representation av åldersgruppen 19-29.

Code

# create DIF-variables
dif_age <- factor(df_dif$age)
# too few responses in other gender groups, need to recode to missing
dif_gender <- df_dif %>% 
  mutate(gender = recode(gender,"'Vill ej ange'=NA;'Annat'=NA", as.factor = TRUE)) %>% 
  pull(gender)
dif_role <- factor(df_dif$role)
dif_bransch <- factor(df_dif$bransch)

4 Analys steg 1

4.1 Q1 Ledningens engagemang

Code

df.delskala <- d %>% 
  select(starts_with("q1"))

4.1.1 Deskriptiv statistik

Code

RIallresp(df.delskala)

Response category	Number of responses	Percent
0	56	6.0
1	236	25.5
2	367	39.6
3	268	28.9

4.1.2 Descriptives - item level

Code

RIlistItemsMargin(df.delskala, fontsize = 12)

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.

Code

RItileplot(df.delskala)

Code

RIbarstack(df.delskala)

Code

RIbarplot(df.delskala)

4.2 Q1 Rasch-analys

The eRm package, which uses Conditional Maximum Likelihood (CML) estimation, will be used primarily. For this analysis, the Partial Credit Model will be used.

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q1_1	0.617	0.604	-4.133	-4.632
q1_2	0.809	0.841	-1.99	-1.763
q1_3	0.579	0.601	-4.906	-4.867

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.67
1.32
0.01

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q1_1	q1_2
q1_1
q1_2	-0.44
q1_3	-0.17	-0.44
Note:
Relative cut-off value (highlighted in red) is -0.149, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Code

RItif(df.delskala, cutoff = 2.5)

Mycket låg reliabilitet, p.g.a. få items.

4.3 Q2 Säkert ledarskap

Code

df.delskala <- d %>% 
  select(starts_with("q2"))

4.3.1 Deskriptiv statistik

Code

RIallresp(df.delskala)

Response category	Number of responses	Percent
0	179	9.7
1	508	27.4
2	653	35.2
3	514	27.7

4.3.2 Descriptives - item level

Code

RIlistItemsMargin(df.delskala, fontsize = 12)

itemnr	item
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q2_2	Min närmsta chef har stort fokus på att kritisera misstag.
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.

Code

RItileplot(df.delskala)

Code

RIbarstack(df.delskala)

Code

RIbarplot(df.delskala)

4.4 Q2 Rasch-analys

The eRm package, which uses Conditional Maximum Likelihood (CML) estimation, will be used primarily. For this analysis, the Partial Credit Model will be used.

itemnr	item
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q2_2	Min närmsta chef har stort fokus på att kritisera misstag.
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q2_1	1.045	1.011	0.624	0.105
q2_2	2.022	1.762	8.421	6.954
q2_3	0.705	0.691	-3.714	-3.957
q2_4	0.63	0.61	-4.861	-5.067
q2_5	0.539	0.537	-5.7	-6.083
q2_6	0.589	0.551	-5.081	-6.032

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.74
1.32
1.11
0.92
0.90

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q2_1	q2_2	q2_3	q2_4	q2_5
q2_1
q2_2	-0.3
q2_3	-0.27	-0.31
q2_4	-0.18	-0.45	0.05
q2_5	-0.1	-0.22	-0.11	-0.01
q2_6	-0.04	-0.47	0.01	0.13	-0.05
Note:
Relative cut-off value (highlighted in red) is 0.044, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Item q2_2 “Min närmsta chef har stort fokus på att kritisera misstag.” avviker ur konstruktet. Mycket hög item fit och avvikande laddning på första kontrastfaktorn.

Residualkorrelation mellan q2_4 och q2_6

q2_4 Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_6 Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.

4.5 Q3 Förutsättningar

Code

df.delskala <- d %>% 
  select(starts_with("q3"))

4.5.1 Deskriptiv statistik

Code

RIallresp(df.delskala)

Response category	Number of responses	Percent
0	118	5.5
1	459	21.2
2	963	44.5
3	623	28.8

4.5.2 Descriptives - item level

Code

RIlistItemsMargin(df.delskala, fontsize = 12)

itemnr	item
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_3	Jag upplever att jag har rätt förutsättningar för att kunna jobba säkert.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q3_7	Jag upplever att risker åtgärdas när de påtalats.

Code

RItileplot(df.delskala)

Code

RIbarstack(df.delskala)

Code

RIbarplot(df.delskala)

4.6 Q3 Rasch-analys

The eRm package, which uses Conditional Maximum Likelihood (CML) estimation, will be used primarily. For this analysis, the Partial Credit Model will be used.

itemnr	item
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_3	Jag upplever att jag har rätt förutsättningar för att kunna jobba säkert.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q3_7	Jag upplever att risker åtgärdas när de påtalats.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q3_1	0.722	0.717	-3.655	-3.515
q3_2	0.919	0.918	-0.814	-0.883
q3_3	0.626	0.641	-4.69	-4.45
q3_4	0.894	1.054	-0.78	0.522
q3_5	1.112	1.126	1.346	1.393
q3_6	0.743	0.733	-2.758	-3.047
q3_7	0.992	0.969	-0.053	-0.406

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.48
1.39
1.17
1.08
0.97

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q3_1	q3_2	q3_3	q3_4	q3_5	q3_6
q3_1
q3_2	-0.16
q3_3	-0.09	-0.05
q3_4	-0.25	-0.02	-0.07
q3_5	-0.12	-0.34	-0.09	-0.13
q3_6	-0.03	-0.14	-0.09	-0.23	-0.24
q3_7	-0.1	-0.16	-0.26	-0.26	-0.24	-0.03
Note:
Relative cut-off value (highlighted in red) is 0.052, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

Item	2	3	Mean location	StDev	MaxDiff
q3_1	-0.071	0.283	0.106	0.251	0.354
q3_2	0.235	0.293	0.264	0.041	0.058
q3_3	0.999	0.101	0.550	0.635	0.898
q3_4	-1.010	-1.475	-1.243	0.329	0.465
q3_5	0.620	0.347	0.484	0.193	0.273
q3_6	-0.544	-0.313	-0.428	0.164	0.231
q3_7	-0.228	0.763	0.268	0.701	0.992

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

q3_3 har låg item fit, vilket är väntat med när ett generellt item kombineras med mera specifika items som mäter aspekter av samma sak. I övrigt ser allt ok ut, möjligen undantaget DIF för roll.

4.7 Q4 Säkert medarbetarskap

Code

df.delskala <- d %>% 
  select(starts_with("q4"))

4.7.1 Deskriptiv statistik

Code

RIallresp(df.delskala)

Response category	Number of responses	Percent
0	136	7.3
1	453	24.4
2	793	42.8
3	472	25.5

4.7.2 Descriptives - item level

Code

RIlistItemsMargin(df.delskala, fontsize = 12)

itemnr	item
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_4	Ibland tar vi genvägar i arbetet för att arbetsvardagen ska bli smidigare, även om det kan innebära ökad risk.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

Code

RItileplot(df.delskala)

Code

RIbarstack(df.delskala)

Code

RIbarplot(df.delskala)

4.8 Q4 Rasch-analys

The eRm package, which uses Conditional Maximum Likelihood (CML) estimation, will be used primarily. For this analysis, the Partial Credit Model will be used.

itemnr	item
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_4	Ibland tar vi genvägar i arbetet för att arbetsvardagen ska bli smidigare, även om det kan innebära ökad risk.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q4_1	0.721	0.707	-3.491	-3.82
q4_2	0.752	0.713	-2.831	-3.601
q4_3	0.892	0.906	-1.232	-1.102
q4_4	1.348	1.317	3.49	3.441
q4_5	0.852	0.917	-1.225	-0.772
q4_6	0.586	0.59	-5.326	-5.576

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.57
1.38
1.17
1.04
0.82

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q4_1	q4_2	q4_3	q4_4	q4_5
q4_1
q4_2	-0.04
q4_3	-0.06	0.01
q4_4	-0.24	-0.28	-0.27
q4_5	-0.2	-0.16	-0.38	-0.31
q4_6	-0.02	-0.18	-0.16	-0.23	0.11
Note:
Relative cut-off value (highlighted in red) is 0.041, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

Item	2	3	Mean location	StDev	MaxDiff
q4_1	-0.563	-0.180	-0.372	0.270	0.382
q4_2	-0.180	-0.519	-0.349	0.240	0.339
q4_3	0.002	0.032	0.017	0.021	0.030
q4_4	1.553	0.934	1.244	0.438	0.619
q4_5	-0.258	0.639	0.191	0.635	0.898
q4_6	-0.555	-0.907	-0.731	0.249	0.352

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Item q4_4 avviker med hög item fit och laddning på första residualkontrasten. Passar inte in i konstruktet.

Residualkorrelation mellan items q4_5 och q4_6.

q4_5 Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6 Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

q4_6 har låg item fit och bör tas bort.

4.9 NOSACQ-frågorna

Code

nosacq5 <- c("q1_1","q1_2","q2_1","q3_1","q4_1")

Code

df.delskala <- d %>% 
  select(all_of(nosacq5))

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q1_1	0.666	0.632	-3.844	-4.567
q1_2	0.758	0.75	-2.885	-3.219
q2_1	0.697	0.701	-3.787	-3.666
q3_1	0.92	0.923	-1.02	-0.798
q4_1	1.105	1.108	1.23	1.246

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.54
1.26
1.13
1.07
0.00

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q1_1	q1_2	q2_1	q3_1
q1_1
q1_2	-0.03
q2_1	-0.05	-0.16
q3_1	-0.27	-0.25	-0.27
q4_1	-0.31	-0.35	-0.23	-0.19
Note:
Relative cut-off value (highlighted in red) is -0.012, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Code

RItif(df.delskala, cutoff = 2)

Frågorna fungerar tillsammans, dock med låg reliabilitet och något låg item fit för två items.

I en norsk forskningsartikel av Ajslev och kollegor (2017) används fem frågor från NOSACQ-50 (Kines et al. 2011) som återfinns i den danska arbetsmiljöundersökningen NRCWE Arbejdsmiljø og Helbred 2012. Det verkar dock inte som att dessa fem items är samma som de fem som återfinns i Prevents enkät.

Det man gör i artikeln är att dikotomisera de fem frågorna, så de två negativa/positiva svarskategorierna slås samman, och så räknar man “antalet arbetsmiljöproblem” på en skala 0-5. Sedan används den variabeln för att undersöka samband med självrapporterade olyckor. Vårt dataset innehåller också en självrapporterad variabel gällande olycka, och vi återkommer till analys av samband längre fram i detta dokument.

Code

thetas_nosacq <- RIestThetas(df.delskala)

4.10 Explorativ analys

Även om vi har hypoteser om vilka items som ska hänga samman i separata områden finns ett intresse av att undersöka eventuella korsladdningar och annat.

Code

# Define latent variables
latent <- list(
  f1 = names(d)
)
# Write the model, and check it
efa_0 <- write_lavaan(latent = latent)

# one-factor model
f1 <- 'efa("efa")*f1 =~ q1_1 + q1_2 + q1_3 + q2_1 + q2_2 + q2_3 + q2_4 + q2_5 + q2_6 + q3_1 + q3_2 + q3_3 + q3_4 + q3_5 + q3_6 + q3_7 + q4_1 + q4_2 + q4_3 + q4_4 + q4_5 + q4_6'
# two-factor
f2 <- 'efa("efa")*f1 + 
       efa("efa")*f2 =~ q1_1 + q1_2 + q1_3 + q2_1 + q2_2 + q2_3 + q2_4 + q2_5 + q2_6 + q3_1 + q3_2 + q3_3 + q3_4 + q3_5 + q3_6 + q3_7 + q4_1 + q4_2 + q4_3 + q4_4 + q4_5 + q4_6'

f3 <- 'efa("efa")*f1 + 
       efa("efa")*f2 + 
efa("efa")*f3 =~ q1_1 + q1_2 + q1_3 + q2_1 + q2_2 + q2_3 + q2_4 + q2_5 + q2_6 + q3_1 + q3_2 + q3_3 + q3_4 + q3_5 + q3_6 + q3_7 + q4_1 + q4_2 + q4_3 + q4_4 + q4_5 + q4_6'

f4 <- 'efa("efa")*f1 + 
       efa("efa")*f2 + 
efa("efa")*f3 +
efa("efa")*f4 =~ q1_1 + q1_2 + q1_3 + q2_1 + q2_2 + q2_3 + q2_4 + q2_5 + q2_6 + q3_1 + q3_2 + q3_3 + q3_4 + q3_5 + q3_6 + q3_7 + q4_1 + q4_2 + q4_3 + q4_4 + q4_5 + q4_6'

f5 <- 'efa("efa")*f1 + 
       efa("efa")*f2 + 
efa("efa")*f3 +
efa("efa")*f4 +
efa("efa")*f5 =~ q1_1 + q1_2 + q1_3 + q2_1 + q2_2 + q2_3 + q2_4 + q2_5 + q2_6 + q3_1 + q3_2 + q3_3 + q3_4 + q3_5 + q3_6 + q3_7 + q4_1 + q4_2 + q4_3 + q4_4 + q4_5 + q4_6'

efa_f1 <- 
  cfa(model = f1,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f2 <- 
  cfa(model = f2,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f3 <- 
  cfa(model = f3,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f4 <- 
  cfa(model = f4,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f5 <- 
  cfa(model = f5,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

4.10.1 EFA model fit

Code

# define fit metrics of interest
fit_metrics_robust <- c("chisq.scaled", "df", "pvalue.scaled", 
                         "cfi.robust", "tli.robust", "rmsea.robust", 
                        "rmsea.ci.lower.robust","rmsea.ci.upper.robust",
                        "srmr")

rbind(
  fitmeasures(efa_f1, fit_metrics_robust),
  fitmeasures(efa_f2, fit_metrics_robust),
  fitmeasures(efa_f3, fit_metrics_robust),
  fitmeasures(efa_f4, fit_metrics_robust),
  fitmeasures(efa_f5, fit_metrics_robust)) %>% 
  # wrangle
  data.frame() %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  add_column(Model = paste0("f",c(1:5)), .before = "chisq.scaled") %>% 
  rename(Chi2 = chisq.scaled,
         p = pvalue.scaled,
         CFI = cfi.robust,
         TLI = tli.robust,
         RMSEA = rmsea.robust,
         CI_low = rmsea.ci.lower.robust,
         CI_high = rmsea.ci.upper.robust,
         SRMR = srmr) %>% 
  kbl_rise()

Model	Chi2	df	CFI	TLI	RMSEA	CI_low	CI_high	SRMR
f1	936.242	209	0.813	0.793	0.138	0.129	0.147	0.064
f2	700.635	188	0.862	0.831	0.125	0.115	0.135	0.051
f3	458.557	168	0.919	0.889	0.101	0.090	0.112	0.039
f4	317.656	149	0.947	0.918	0.087	0.075	0.100	0.031
f5	219.706	131	0.968	0.943	0.073	0.058	0.087	0.023

4.10.2 EFA faktorladdningar

Endast 4- och 5-faktormodellerna har acceptabla model fit-värden, så vi tittar närmare på dem.

Code

inspect(efa_f4,what="std")$lambda %>% 
  round(2) %>% 
  as_tibble() %>% 
  mutate(across(everything(), ~ cell_spec(.x, color = case_when(.x >= 0.4 ~ "red", TRUE ~ "black")))) %>%
  add_column(Item = names(d), .before = 'f1') %>% 
  formattable()

Item	f1	f2	f3	f4
q1_1	0.98	-0.05	-0.01	0
q1_2	0.81	0.08	-0.02	-0.01
q1_3	0.93	0.03	-0.04	0.01
q2_1	0.73	-0.01	0.08	0.09
q2_2	-0.16	0.33	0.3	0
q2_3	0	0.86	-0.07	0.1
q2_4	0.05	0.73	0.11	0.1
q2_5	0.19	0.61	0.28	-0.08
q2_6	0.16	0.68	0.07	0.1
q3_1	0.21	0.14	0.55	0.07
q3_2	0.07	-0.04	0.65	0.17
q3_3	0	0.09	0.88	-0.03
q3_4	0.04	-0.12	0.74	0.1
q3_5	0	0.27	0.56	-0.02
q3_6	0.17	0.1	0.57	0.13
q3_7	0.58	0.12	0.25	0
q4_1	0.06	0.2	0.08	0.57
q4_2	0.04	-0.07	0.16	0.78
q4_3	0.05	0.23	-0.15	0.69
q4_4	0.15	-0.03	0.2	0.22
q4_5	0.23	0.15	0.34	0.22
q4_6	0.21	0.18	0.22	0.4

Code

inspect(efa_f5,what="std")$lambda %>% 
  round(2) %>% 
  as_tibble() %>% 
  mutate(across(everything(), ~ cell_spec(.x, color = case_when(.x >= 0.4 ~ "red", TRUE ~ "black")))) %>%
  add_column(Item = names(d), .before = 'f1') %>% 
  formattable()

Item	f1	f2	f3	f4	f5
q1_1	0.97	0.01	-0.05	-0.02	0
q1_2	0.8	-0.01	0.09	-0.01	0
q1_3	0.93	-0.08	0.06	0.01	0.01
q2_1	0.72	0.01	0	0.09	0.09
q2_2	-0.13	0.54	0.17	0.04	0.07
q2_3	0.02	0.05	0.82	-0.05	0.12
q2_4	0.04	0	0.7	0.17	0.09
q2_5	0.23	0.33	0.54	0.12	-0.08
q2_6	0.15	-0.06	0.68	0.15	0.07
q3_1	0.19	0	0.14	0.58	0.04
q3_2	0.03	-0.07	0	0.74	0.12
q3_3	-0.01	0.09	0.08	0.87	-0.06
q3_4	0	-0.09	-0.08	0.83	0.05
q3_5	0	0.13	0.22	0.53	-0.02
q3_6	0.18	0.2	0.04	0.5	0.13
q3_7	0.61	0.2	0.06	0.14	0.02
q4_1	0.09	0.13	0.17	0.04	0.57
q4_2	0.05	0.06	-0.07	0.16	0.73
q4_3	0.03	-0.14	0.27	-0.05	0.69
q4_4	0.18	0.26	-0.12	0.06	0.25
q4_5	0.28	0.39	0	0.15	0.26
q4_6	0.26	0.25	0.09	0.09	0.43

4.11 CFA

Vi gör en konfirmatorisk faktoranalys för att kunna titta på modification indices, korsladdningar och residualkorrelationer i en multidimensionell modell.

Code

# Define latent variables
latent_cfa <- list(
  ledningen = c("q1_1","q1_2","q1_3"),
  ledarskap = c("q2_1","q2_2","q2_3","q2_4", "q2_5", "q2_6"),
  föruts = c("q3_1","q3_2","q3_3","q3_4", "q3_5", "q3_6","q3_7"),
  medarb = paste0("q4_",c(1:6)) 
)
# Write the model, and check it
cfa_0 <- write_lavaan(latent = latent_cfa)

cfa_out <- 
  cfa(model = cfa_0,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

rbind(fitmeasures(cfa_out, fit_metrics_robust)) %>% 
  # wrangle
  data.frame() %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  #add_column(Model = paste0("f",c(1:5)), .before = "chisq.scaled") %>% 
  rename(Chi2 = chisq.scaled,
         p = pvalue.scaled,
         CFI = cfi.robust,
         TLI = tli.robust,
         RMSEA = rmsea.robust,
         CI_low = rmsea.ci.lower.robust,
         CI_high = rmsea.ci.upper.robust,
         SRMR = srmr) %>% 
  kbl_rise()

Chi2	df	p	CFI	TLI	RMSEA	CI_low	CI_high	SRMR
645.972	203	0	0.885	0.869	0.11	0.1	0.12	0.052

4.11.1 Modification indices

Ordnade efter storlek, störst först.

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q2_2	Min närmsta chef har stort fokus på att kritisera misstag.
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_3	Jag upplever att jag har rätt förutsättningar för att kunna jobba säkert.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q3_7	Jag upplever att risker åtgärdas när de påtalats.
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_4	Ibland tar vi genvägar i arbetet för att arbetsvardagen ska bli smidigare, även om det kan innebära ökad risk.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

4.11.2 Korsladdningar

Med MI > 10.

Code

modificationIndices(cfa_out,
                    standardized = T) %>% 
  as.data.frame(row.names = NULL) %>% 
  filter(mi > 10,
         op == "=~") %>% 
  arrange(desc(mi)) %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  kbl_rise(fontsize = 14, tbl_width = 75)

lhs	op	rhs	mi	epc	sepc.lv	sepc.all	sepc.nox
ledningen	=~	q2_1	91.226	-1.163	-1.075	-1.075	-1.075
ledningen	=~	q3_7	46.426	-0.802	-0.742	-0.742	-0.742
ledarskap	=~	q3_7	35.148	-0.774	-0.660	-0.660	-0.660
föruts	=~	q2_1	29.712	-0.698	-0.602	-0.602	-0.602
föruts	=~	q2_3	25.439	0.674	0.581	0.581	0.581
medarb	=~	q3_7	20.707	-0.681	-0.540	-0.540	-0.540
föruts	=~	q4_5	16.188	-0.594	-0.512	-0.512	-0.512
ledningen	=~	q2_3	16.027	0.570	0.527	0.527	0.527
ledningen	=~	q3_3	14.920	0.477	0.441	0.441	0.441
medarb	=~	q2_1	13.595	-0.623	-0.494	-0.494	-0.494
föruts	=~	q4_3	13.289	0.557	0.480	0.480	0.480
ledningen	=~	q2_4	12.780	0.446	0.413	0.413	0.413
ledarskap	=~	q3_4	12.453	0.551	0.470	0.470	0.470
medarb	=~	q3_3	11.674	0.493	0.391	0.391	0.391
föruts	=~	q2_5	10.030	-0.377	-0.325	-0.325	-0.325

4.11.3 Residualkorrelationer

Code

modificationIndices(cfa_out,
                    standardized = T) %>% 
  as.data.frame(row.names = NULL) %>% 
  filter(mi > 10,
         op == "~~") %>% 
  arrange(desc(mi)) %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  kbl_rise(fontsize = 14, tbl_width = 75)

lhs	op	rhs	mi	epc	sepc.lv	sepc.all	sepc.nox
q1_1	~~	q2_1	22.455	-0.139	-0.139	-0.699	-0.699
q2_1	~~	q2_4	17.665	0.165	0.165	0.655	0.655
q2_3	~~	q2_4	16.231	-0.115	-0.115	-0.402	-0.402
q4_2	~~	q4_3	13.896	-0.146	-0.146	-0.314	-0.314
q2_1	~~	q2_5	12.795	0.134	0.134	0.601	0.601
q2_1	~~	q2_3	11.486	0.156	0.156	0.501	0.501
q1_2	~~	q2_1	11.316	-0.110	-0.110	-0.417	-0.417
q3_3	~~	q3_4	11.206	-0.128	-0.128	-0.330	-0.330
q2_4	~~	q2_6	10.720	-0.079	-0.079	-0.376	-0.376
q3_2	~~	q3_4	10.360	-0.149	-0.149	-0.310	-0.310

4.12 Rasch explorativ

Vi provar att lägga in alla 22 items i en Rasch-modell.

Code

df.delskala <- d

The eRm package, which uses Conditional Maximum Likelihood (CML) estimation, will be used primarily. For this analysis, the Partial Credit Model will be used.

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q2_2	Min närmsta chef har stort fokus på att kritisera misstag.
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_3	Jag upplever att jag har rätt förutsättningar för att kunna jobba säkert.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q3_7	Jag upplever att risker åtgärdas när de påtalats.
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_4	Ibland tar vi genvägar i arbetet för att arbetsvardagen ska bli smidigare, även om det kan innebära ökad risk.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q1_1	0.755	0.737	-2.492	-3.205
q1_2	0.896	0.874	-1.31	-1.582
q1_3	0.71	0.716	-3.366	-3.599
q2_1	0.803	0.825	-2.326	-1.994
q2_2	2.721	1.982	11.723	8.723
q2_3	1.008	1.014	0.141	0.162
q2_4	0.804	0.763	-1.991	-3.027
q2_5	0.637	0.675	-4.075	-3.958
q2_6	0.688	0.724	-3.345	-3.482
q3_1	0.769	0.778	-2.798	-2.739
q3_2	1.03	1.018	0.469	0.139
q3_3	0.819	0.835	-2.135	-1.943
q3_4	1.121	1.268	0.994	2.634
q3_5	1.082	1.118	0.977	1.253
q3_6	0.726	0.736	-3	-3.173
q3_7	0.756	0.737	-2.792	-3.307
q4_1	0.959	0.92	-0.404	-0.8
q4_2	1.009	1.016	0.153	0.229
q4_3	1.208	1.232	2.229	2.456
q4_4	1.66	1.642	6.071	6.216
q4_5	0.867	0.903	-1.085	-0.967
q4_6	0.714	0.703	-3.397	-3.669

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
2.43
2.24
1.93
1.60
1.46

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q1_1	q1_2	q1_3	q2_1	q2_2	q2_3	q2_4	q2_5	q2_6	q3_1	q3_2	q3_3	q3_4	q3_5	q3_6	q3_7	q4_1	q4_2	q4_3	q4_4	q4_5
q1_1
q1_2	0.25
q1_3	0.43	0.28
q2_1	0.25	0.18	0.19
q2_2	-0.19	-0.19	-0.33	-0.21
q2_3	-0.13	-0.07	-0.1	-0.14	0.04
q2_4	-0.14	-0.13	-0.05	-0.16	-0.13	0.32
q2_5	-0.08	-0.09	-0.05	-0.1	0.03	0.19	0.2
q2_6	-0.1	0	-0.06	-0.02	-0.14	0.31	0.33	0.17
q3_1	-0.06	-0.03	0.02	-0.05	-0.19	-0.12	-0.15	-0.08	-0.03
q3_2	-0.06	-0.08	-0.1	-0.09	-0.07	-0.24	-0.05	-0.15	-0.12	0.11
q3_3	-0.11	-0.15	-0.13	-0.04	-0.06	-0.21	-0.17	0.01	-0.13	0.23	0.25
q3_4	-0.07	-0.19	-0.08	0.01	-0.11	-0.22	-0.1	-0.23	-0.16	0.06	0.23	0.24
q3_5	-0.15	-0.07	-0.13	-0.18	0	-0.1	-0.04	0.02	-0.12	0.11	-0.06	0.19	0.12
q3_6	-0.08	-0.02	-0.1	-0.05	-0.02	-0.18	-0.16	-0.04	-0.12	0.17	0.09	0.18	0.05	-0.03
q3_7	0.12	0.11	0.15	0.14	-0.13	-0.24	-0.09	0.12	-0.05	0.01	-0.01	-0.05	-0.07	-0.13	0.02
q4_1	-0.13	-0.13	-0.04	-0.03	-0.12	0	0	-0.08	0.01	-0.13	-0.17	-0.17	-0.14	-0.03	-0.07	-0.13
q4_2	-0.09	-0.14	-0.1	-0.04	-0.08	-0.1	-0.06	-0.25	-0.11	-0.09	0.06	-0.15	-0.08	-0.18	-0.07	-0.08	0.2
q4_3	-0.12	-0.03	-0.06	-0.1	-0.12	0.14	0.02	-0.22	0.08	-0.12	-0.1	-0.26	-0.13	-0.19	-0.19	-0.19	0.18	0.26
q4_4	0.01	-0.1	-0.09	-0.11	0.17	-0.17	-0.14	-0.14	-0.29	-0.1	-0.12	-0.08	-0.03	-0.03	-0.04	-0.17	0	-0.01	0
q4_5	-0.04	-0.08	-0.08	-0.09	0.05	-0.14	-0.12	0.05	-0.14	-0.13	-0.06	-0.06	0.01	-0.03	-0.01	0.13	-0.06	0.03	-0.15	-0.17
q4_6	-0.11	-0.01	-0.02	0.04	-0.2	-0.01	-0.05	-0.02	-0.06	-0.02	-0.18	-0.06	-0.15	-0.1	0.02	-0.03	0.14	0.05	0.08	-0.03	0.15
Note:
Relative cut-off value (highlighted in red) is 0.157, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Vi tar bort q2_2 och q4_4, samt löser ut de residualkorrelationer som även tidigare setts genom att ta bort: q4_6, q2_6, q2_5.

4.13 Rasch expl 2

Code

rem_item <- c("q2_2", "q4_4", "q4_6", "q2_6", "q2_5")
df.delskala <- d %>% 
  select(!all_of(rem_item))

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_3	Jag upplever att jag har rätt förutsättningar för att kunna jobba säkert.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q3_7	Jag upplever att risker åtgärdas när de påtalats.
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q1_1	0.864	0.737	-1.286	-3.146
q1_2	0.926	0.896	-0.869	-1.2
q1_3	0.707	0.703	-3.421	-3.76
q2_1	0.816	0.839	-1.981	-1.884
q2_3	1.137	1.159	1.322	1.873
q2_4	0.86	0.853	-1.394	-1.711
q3_1	0.782	0.793	-2.67	-2.565
q3_2	1.035	1.03	0.558	0.119
q3_3	0.874	0.866	-1.357	-1.658
q3_4	1.109	1.254	0.858	2.485
q3_5	1.196	1.192	1.918	2.154
q3_6	0.765	0.769	-2.373	-2.835
q3_7	0.814	0.766	-2.153	-2.906
q4_1	1.01	0.985	0.079	-0.098
q4_2	1.05	1.049	0.602	0.671
q4_3	1.279	1.309	2.935	3.246
q4_5	0.979	0.958	-0.159	-0.37

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
2.33
2.15
1.50
1.23
1.18

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q1_1	q1_2	q1_3	q2_1	q2_3	q2_4	q3_1	q3_2	q3_3	q3_4	q3_5	q3_6	q3_7	q4_1	q4_2	q4_3
q1_1
q1_2	0.22
q1_3	0.39	0.23
q2_1	0.22	0.14	0.13
q2_3	-0.12	-0.06	-0.1	-0.14
q2_4	-0.15	-0.14	-0.08	-0.17	0.36
q3_1	-0.11	-0.08	-0.04	-0.1	-0.12	-0.16
q3_2	-0.11	-0.14	-0.17	-0.14	-0.25	-0.07	0.06
q3_3	-0.16	-0.19	-0.18	-0.08	-0.19	-0.17	0.2	0.22
q3_4	-0.14	-0.24	-0.16	-0.04	-0.23	-0.13	0.01	0.19	0.2
q3_5	-0.18	-0.1	-0.17	-0.21	-0.08	-0.03	0.08	-0.1	0.17	0.1
q3_6	-0.11	-0.05	-0.15	-0.08	-0.15	-0.15	0.14	0.06	0.17	0.01	-0.04
q3_7	0.08	0.07	0.1	0.11	-0.22	-0.09	-0.03	-0.06	-0.08	-0.12	-0.15	0
q4_1	-0.15	-0.15	-0.07	-0.06	0.02	0.02	-0.15	-0.2	-0.18	-0.17	-0.03	-0.07	-0.14
q4_2	-0.13	-0.18	-0.16	-0.08	-0.09	-0.07	-0.13	0.02	-0.19	-0.13	-0.21	-0.09	-0.11	0.19
q4_3	-0.15	-0.06	-0.1	-0.13	0.16	0.03	-0.15	-0.13	-0.28	-0.16	-0.2	-0.21	-0.21	0.18	0.25
q4_5	-0.07	-0.1	-0.12	-0.12	-0.1	-0.09	-0.15	-0.09	-0.07	-0.02	-0.03	-0.02	0.12	-0.06	0.02	-0.16
Note:
Relative cut-off value (highlighted in red) is 0.141, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Det är tydligt att det finns multidimensionalitet i data, även efter att ha tagit bort våra mest problematiska items. Detta framgår utifrån PCA av residualer samt residualkorrelationer. Således avbryter vi denna explorativa analys.

5 Kommentarer steg 1

5.1 Generellt

Reverserade items (q4_4 och q2_2) funkar dåligt dimensionalitetsmässigt.

q2_2 Min närmsta chef har stort fokus på att kritisera misstag.
q4_4 Ibland tar vi genvägar i arbetet för att arbetsvardagen ska bli smidigare, även om det kan innebära ökad risk.

Ev. titta närmare på:

DIF för roll gällande “Förutsättningar”.
DIF för ålder gällande “Säkert Medarbetarskap”.

5.2 Ledningens engagemang

Låg reliabilitet p.g.a. få items. Låg item fit för två items.

5.3 Säkert ledarskap

Item q2_2 “Min närmsta chef har stort fokus på att kritisera misstag.” avviker ur konstruktet. Mycket hög item fit och avvikande laddning på första kontrastfaktorn.

Residualkorrelation mellan q2_4 och q2_6

q2_4 Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_6 Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.

5.4 Förutsättningar

q3_3 kan tas bort. q3_4-6 hanterar området bättre pga högre specificitet (tydligare avgränsning) i frågeställningarna.

5.5 Säkert medarbetarskap

Item q4_4 avviker med hög item fit och laddning på första residualkontrasten. Passar inte in i konstruktet.

Residualkorrelation mellan items q4_5 och q4_6.

q4_5 Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6 Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

q4_6 har låg item fit och bör tas bort.

5.6 Utifrån EFA/CFA multidimensionell analys

q2_1 och q3_7 hänger mer ihop med q1 (ledningen), q3_7 även med q2 - q2_1 Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet. - q3_7 Jag upplever att risker åtgärdas när de påtalats.

Residualkorrelation mellan q3_7 och q2_5: - q2_5 Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.

q2_2 funkar som nämnt inte bra, men noterar intressant residualkorrelation med q4_5

q4_5 Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q2_2 Min närmsta chef har stort fokus på att kritisera misstag.

q4_5 korsladdar på q3 i 4-faktors CFA

5.7 Åtgärder att testa

5.7.1 q2

q2_2 tas bort, q2_1 flyttas till q1

5.7.2 q3

q3_3 tas bort pga redundans. q3_7 flyttas till q1

5.7.3 q4

q4_5 har residualkorrelation med q4_6, kan ev fungera bättre i q3 så vi flyttar den dit.

q4_4 tas bort

6 Analys steg 2

6.1 Q1 Ledningens engagemang

q2_1 flyttas till q1
q3_7 flyttas till q1

Code

df.delskala <- d %>% 
  select(starts_with("q1"),q2_1,q3_7)

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q3_7	Jag upplever att risker åtgärdas när de påtalats.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q1_1	0.713	0.676	-3.077	-3.793
q1_2	0.889	0.899	-1.284	-1.107
q1_3	0.671	0.666	-3.84	-4.049
q2_1	0.92	0.914	-0.774	-1.045
q3_7	0.949	0.949	-0.586	-0.567

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.46
1.28
1.24
1.01
0.01

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q1_1	q1_2	q1_3	q2_1
q1_1
q1_2	-0.21
q1_3	0.02	-0.18
q2_1	-0.19	-0.25	-0.28
q3_7	-0.3	-0.28	-0.24	-0.19
Note:
Relative cut-off value (highlighted in red) is -0.008, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Code

RItif(df.delskala, cutoff = 2)

Code

RIitemparams(df.delskala)

	Threshold 1	Threshold 2	Threshold 3	Item location
q1_1	-2.68	0.46	4.06	0.61
q1_2	-2.47	1.75	5.16	1.48
q1_3	-2.59	1.85	4.88	1.38
q2_1	-3.18	1.08	4.85	0.92
q3_7	-1.64	1.61	5.21	1.73
Note:
Item location is the average of the thresholds for each item.

Code

RIitemparams(df.delskala,output = "file",filename = "q1_params.csv")

Code

RIscoreSE(df.delskala,score_range = c(-6,8))

Ordinal sum score	Logit score	Logit std.error
0	-5.026	1.638
1	-3.692	1.042
2	-2.899	0.904
3	-2.205	0.873
4	-1.469	0.896
5	-0.586	0.922
6	0.294	0.884
7	1.017	0.842
8	1.672	0.830
9	2.347	0.846
10	3.106	0.864
11	3.872	0.853
12	4.556	0.847
13	5.220	0.886
14	5.990	1.027
15	7.301	1.621

Code

RIscoreSE(df.delskala,score_range = c(-6,8),output = "figure")

Code

items_q1 <- names(df.delskala)
thetas_q1 <- RIestThetas(df.delskala,theta_range = c(-6,8))

6.2 Q2 Säkert ledarskap

q2_2 tas bort
q2_1 flyttas till q1

Code

df.delskala <- d %>% 
  select(starts_with("q2")) %>% 
  select(!c(q2_1,q2_2))

itemnr	item
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q2_3	0.886	0.889	-1.291	-1.167
q2_4	0.706	0.704	-3.429	-3.423
q2_5	0.832	0.816	-1.608	-1.977
q2_6	0.708	0.674	-3.396	-3.89

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.41
1.32
1.26
0.01

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q2_3	q2_4	q2_5
q2_3
q2_4	-0.31
q2_5	-0.34	-0.27
q2_6	-0.31	-0.2	-0.27
Note:
Relative cut-off value (highlighted in red) is -0.084, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Code

RItif(df.delskala, cutoff = 2)

Code

RIitemparams(df.delskala)

	Threshold 1	Threshold 2	Threshold 3	Item location
q2_3	-1.49	1.55	4.79	1.61
q2_4	-1.88	1.21	4.24	1.19
q2_5	-2.54	-0.08	3.24	0.21
q2_6	-2.00	1.22	3.66	0.96
Note:
Item location is the average of the thresholds for each item.

Code

RIitemparams(df.delskala,output = "file",filename = "q2_params.csv")

Code

RIscoreSE(df.delskala,score_range = c(-6,8))

Ordinal sum score	Logit score	Logit std.error
0	-4.236	1.655
1	-2.879	1.057
2	-2.055	0.919
3	-1.322	0.883
4	-0.562	0.883
5	0.234	0.879
6	0.993	0.867
7	1.723	0.868
8	2.480	0.881
9	3.259	0.898
10	4.045	0.945
11	4.933	1.088
12	6.352	1.695

Code

RIscoreSE(df.delskala,score_range = c(-6,8), output = "figure")

Code

items_q2 <- names(df.delskala)
thetas_q2 <- RIestThetas(df.delskala,theta_range = c(-6,8))

6.3 Q3 Förutsättningar

q3_3 tas bort pga redundans
q3_7 flyttas till q1

Code

df.delskala <- d %>% 
  select(starts_with("q3"),q4_5) %>% 
  select(!c(q3_3,q3_7))

itemnr	item
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q3_1	0.703	0.706	-3.718	-3.557
q3_2	0.871	0.871	-1.419	-1.578
q3_4	0.821	0.96	-1.429	-0.34
q3_5	1.009	1.008	0.173	0.116
q3_6	0.694	0.682	-3.524	-3.802
q4_5	0.967	0.93	-0.27	-0.625

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.42
1.33
1.29
1.03
0.92

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q3_1	q3_2	q3_4	q3_5	q3_6
q3_1
q3_2	-0.11
q3_4	-0.22	-0.02
q3_5	-0.1	-0.34	-0.16
q3_6	0.01	-0.1	-0.23	-0.25
q4_5	-0.27	-0.25	-0.25	-0.21	-0.12
Note:
Relative cut-off value (highlighted in red) is 0.027, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Code

RItif(df.delskala, cutoff = 2)

Code

RIitemparams(df.delskala)

	Threshold 1	Threshold 2	Threshold 3	Item location
q3_1	-1.46	0.92	3.75	1.07
q3_2	-1.18	0.54	4.15	1.17
q3_4	-2.20	-0.78	1.99	-0.33
q3_5	-0.95	0.93	3.87	1.28
q3_6	-1.35	0.14	2.93	0.58
q4_5	-0.63	0.45	2.20	0.67
Note:
Item location is the average of the thresholds for each item.

Code

RIitemparams(df.delskala,output = "file",filename = "q3_params.csv")

Code

RIscoreSE(df.delskala,score_range = c(-6,8))

Ordinal sum score	Logit score	Logit std.error
0	-3.963	1.539
1	-2.736	0.935
2	-2.089	0.764
3	-1.607	0.681
4	-1.202	0.635
5	-0.837	0.609
6	-0.492	0.595
7	-0.157	0.590
8	0.179	0.593
9	0.525	0.603
10	0.889	0.620
11	1.283	0.643
12	1.713	0.672
13	2.188	0.705
14	2.711	0.742
15	3.283	0.787
16	3.919	0.861
17	4.697	1.022
18	6.028	1.627

Code

RIscoreSE(df.delskala,score_range = c(-6,8),output = "figure")

Code

items_q3 <- names(df.delskala)
thetas_q3 <- RIestThetas(df.delskala,theta_range = c(-6,8))

6.4 Q4 Säkert medarbetarskap

q4_5 har residualkorrelation med q4_6, kan ev fungera bättre i q3 så vi flyttar den dit.

q4_4 tas bort.

Code

df.delskala <- d %>% 
  select(starts_with("q4")) %>% 
  select(!c(q4_4,q4_5))

itemnr	item
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

Code

RIitemfitPCM2(df.delskala, 250, 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
q4_1	0.737	0.74	-3.233	-3.224
q4_2	0.759	0.75	-2.826	-2.875
q4_3	0.861	0.855	-1.576	-1.662
q4_6	0.767	0.77	-2.757	-2.832

Code

RIpcmPCA(df.delskala)

PCA of Rasch model residuals
Eigenvalues
1.50
1.30
1.19
0.00

Code

RIresidcorr(df.delskala, cutoff = 0.2)

	q4_1	q4_2	q4_3
q4_1
q4_2	-0.24
q4_3	-0.34	-0.25
q4_6	-0.13	-0.3	-0.35
Note:
Relative cut-off value (highlighted in red) is -0.068, which is 0.2 above the average correlation.

Code

RIloadLoc(df.delskala)

Code

RIitemCats(df.delskala)

Code

# increase fig-height above as needed, if you have many items
RItargeting(df.delskala)

Code

RIitemHierarchy(df.delskala)

Code

RIdifTable(df.delskala, dif_gender)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_age)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_role)

[1] "No significant DIF found."

Code

RIdifTable(df.delskala, dif_bransch)

[1] "No significant DIF found."

Code

RIpfit(df.delskala)

Code

RItif(df.delskala, cutoff = 2)

Code

RIitemparams(df.delskala)

	Threshold 1	Threshold 2	Threshold 3	Item location
q4_1	-2.48	0.84	4.25	0.87
q4_2	-1.50	0.68	4.04	1.07
q4_3	-1.50	1.50	4.30	1.43
q4_6	-2.45	0.70	3.78	0.68
Note:
Item location is the average of the thresholds for each item.

Code

RIitemparams(df.delskala,output = "file",filename = "q4_params.csv")

Code

RIscoreSE(df.delskala,score_range = c(-6,8))

Ordinal sum score	Logit score	Logit std.error
0	-4.292	1.676
1	-2.904	1.076
2	-2.040	0.936
3	-1.269	0.892
4	-0.497	0.874
5	0.246	0.858
6	0.948	0.858
7	1.680	0.884
8	2.525	0.913
9	3.372	0.909
10	4.134	0.931
11	4.956	1.060
12	6.298	1.649

Code

RIscoreSE(df.delskala,score_range = c(-6,8),output = "figure")

Code

items_q4 <- names(df.delskala)
thetas_q4 <- RIestThetas(df.delskala,theta_range = c(-6,8))

7 Summering delskalor

Code

data.frame(thetas_q1, thetas_q2, thetas_q3, thetas_q4, thetas_nosacq) %>% 
  write_csv("thetas.csv")
df_thetas <- read_csv("thetas.csv")

Här är items fördelade på delskalor.

Code

data.frame(
  delskala = c("Ledningens Engagemang","Säkert ledarskap","Förutsättningar","Säkert medarbetarskap"),
  items = c(paste(items_q1, collapse = ", "),
            paste(items_q2, collapse = ", "),
            paste(items_q3, collapse = ", "),
            paste(items_q4, collapse = ", ")),
  stringsAsFactors = FALSE
) %>% 
  knitr::kable()

delskala	items
Ledningens Engagemang	q1_1, q1_2, q1_3, q2_1, q3_7
Säkert ledarskap	q2_3, q2_4, q2_5, q2_6
Förutsättningar	q3_1, q3_2, q3_4, q3_5, q3_6, q4_5
Säkert medarbetarskap	q4_1, q4_2, q4_3, q4_6

Eftersom vi flyttat runt items en del dubbelkollar vi så det inte blivit någon dubblett.

Code

# check for duplicates
duplicated(c(items_q1,items_q2,items_q3,items_q4))

 [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
[13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE

Code

# make a table similar to the one above, but add in itemlabels for item descriptions
items_final_set <- data.frame(
  delskala = c(rep("Ledningens Engagemang", length(items_q1)),
               rep("Säkert ledarskap", length(items_q2)),
               rep("Förutsättningar", length(items_q3)),
               rep("Säkert medarbetarskap", length(items_q4))
  ),
  itemnr = c(items_q1,items_q2,items_q3,items_q4),
  stringsAsFactors = FALSE
) %>% 
  left_join(itemlabels, by = "itemnr")

items_final_set %>%
  kbl_rise() %>% 
  collapse_rows(columns = 1)

delskala	itemnr	item
Ledningens Engagemang	q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
	q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
	q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.
	q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
	q3_7	Jag upplever att risker åtgärdas när de påtalats.
Säkert ledarskap	q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
	q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
	q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
	q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.
Förutsättningar	q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
	q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
	q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
	q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
	q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
	q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
Säkert medarbetarskap	q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
	q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
	q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
	q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

Code

#write_csv(items_final_set, "items_final_set.csv")

Av de 22 items som prövats i denna analys har 3 tagits bort:

q2_2 Min närmsta chef har stort fokus på att kritisera misstag.
q3_3 Jag upplever att jag har rätt förutsättningar för att kunna jobba säkert.
q4_4 Ibland tar vi genvägar i arbetet för att arbetsvardagen ska bli smidigare, även om det kan innebära ökad risk.

Både q2_2 och q4_4 har tagits bort på grund av att de inte passar in, vilket delvis kan bero på att de är de enda negativt formulerade frågorna (som därmed har reverserad svarsskala i analysen). Gällande q3_3 hade den kunnat vara kvar, men delskalan fungerar tillräckligt bra utan den, och den tillförde relativt lite information eftersom det är en generell fråga om förutsättningar.

7.1 CFA nya delskalor

Vi gör en CFA på de nya delskalorna, och passar på att lägga till en “higher order” latent variabel utifrån de fyra delskalorna.

Code

# Define latent variables
latent_cfa2 <- list(
  ledningen = items_q1,
  ledarskap = items_q2,
  föruts = items_q3,
  medarb = items_q4,
  säkerhet = c("ledningen", "ledarskap", "föruts", "medarb")
)
# Write the model, and check it
cfa_2 <- write_lavaan(latent = latent_cfa2)

cfa_out2 <- 
  cfa(model = cfa_2,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

# define fit metrics of interest
fit_metrics_robust <- c("chisq.scaled", "df", "pvalue.scaled", 
                         "cfi.robust", "tli.robust", "rmsea.robust", 
                        "rmsea.ci.lower.robust","rmsea.ci.upper.robust",
                        "srmr")

rbind(fitmeasures(cfa_out2, fit_metrics_robust)) %>% 
  # wrangle
  data.frame() %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  #add_column(Model = paste0("f",c(1:5)), .before = "chisq.scaled") %>% 
  rename(Chi2 = chisq.scaled,
         p = pvalue.scaled,
         CFI = cfi.robust,
         TLI = tli.robust,
         RMSEA = rmsea.robust,
         CI_low = rmsea.ci.lower.robust,
         CI_high = rmsea.ci.upper.robust,
         SRMR = srmr) %>% 
  kbl_rise()

Chi2	df	p	CFI	TLI	RMSEA	CI_low	CI_high	SRMR
344.551	148	0	0.929	0.917	0.096	0.084	0.108	0.041

7.1.1 Faktorladdningar

Code

lavaanPlot(model = cfa_out2, 
           coefs = T, stand = T, covs = T,
           node_options = list(fontname = "Helvetica", fontsize = 18), 
           edge_options = list(color = "grey", fontsize = 18),
           graph_options = list(rankdir = "TD"))

7.1.2 Modification indices

Ordnade efter storlek, störst först.

itemnr	item
q1_1	Ledningen uppmuntrar medarbetarna att arbeta säkert även i perioder när schemat är pressat.
q1_2	Ledningen involverar medarbetarna i beslut som rör säkerheten.
q1_3	Ledningen visar i sitt agerande att säkerhet alltid prioriteras högt.
q2_1	Jag anser att ambitionen att minska antalet olyckor genomsyrar det dagliga arbetet.
q2_3	Min närmsta chef berömmer oss ofta när vi jobbar säkert.
q2_4	Min närmsta chef påminner mig om att följa säkerhetsreglerna även i pressade situationer.
q2_5	Min närmsta chef lyssnar och agerar när jag berättar om något som inte fungerar gällande säkerheten.
q2_6	Min närmsta chef involverar mig i att prata om säkra beteenden och hur vi ska agera för att en olycka inte skall inträffa.
q3_1	Jag får de instruktioner och den vägledning jag behöver för att kunna utföra arbetet på ett säkert sätt.
q3_2	De säkerhetsföreskrifter och regler som gäller på vår arbetsplats är lätta att förstå och följa.
q3_4	Jag upplever att jag har rätt kompetens för att kunna jobba säkert.
q3_5	Jag upplever att jag har tillräckligt med tid för att kunna jobba säkert.
q3_6	Jag upplever att jag har tillgång till korrekt utrustning för att kunna jobba säkert.
q3_7	Jag upplever att risker åtgärdas när de påtalats.
q4_1	Vi hjälper varandra att jobba säkert även under stressiga perioder.
q4_2	När vi ser någon arbeta riskfyllt säger vi till personen.
q4_3	Som medarbetare visar vi uppskattning när någon arbetar säkert.
q4_5	Jag kan påpeka brister i säkerheten utan rädsla för negativa konsekvenser.
q4_6	Vi som arbetar här tar varandras synpunkter och förslag rörande säkerhet på allvar.

7.1.3 Korsladdningar

Med MI > 10.

Code

modificationIndices(cfa_out2,
                    standardized = T) %>% 
  as.data.frame(row.names = NULL) %>% 
  filter(mi > 10,
         op == "=~") %>% 
  arrange(desc(mi)) %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  kbl_rise(fontsize = 14, tbl_width = 75)

lhs	op	rhs	mi	epc	sepc.lv	sepc.all	sepc.nox
föruts	=~	q3_7	19.948	-0.584	-0.501	-0.501	-0.501
säkerhet	=~	q4_5	17.377	-1.463	-1.216	-1.216	-1.216
säkerhet	=~	q3_7	16.882	-0.766	-0.637	-0.637	-0.637
medarb	=~	q4_5	16.567	-0.675	-0.548	-0.548	-0.548
säkerhet	=~	q2_5	14.809	-0.664	-0.552	-0.552	-0.552
säkerhet	=~	q4_6	14.168	-1.203	-0.999	-0.999	-0.999
ledningen	=~	q2_5	13.849	-0.355	-0.321	-0.321	-0.321
föruts	=~	q2_3	13.820	0.491	0.421	0.421	0.421
föruts	=~	q2_5	13.415	-0.467	-0.401	-0.401	-0.401
föruts	=~	q4_6	12.531	-0.677	-0.581	-0.581	-0.581
säkerhet	=~	q3_4	12.207	1.255	1.043	1.043	1.043
föruts	=~	q4_3	11.146	0.616	0.528	0.528	0.528
ledarskap	=~	q3_7	10.968	-0.355	-0.292	-0.292	-0.292
ledningen	=~	q2_3	10.428	0.340	0.308	0.308	0.308
ledarskap	=~	q3_4	10.346	0.574	0.473	0.473	0.473
säkerhet	=~	q2_3	10.301	0.558	0.463	0.463	0.463

7.1.4 Residualkorrelationer

Code

modificationIndices(cfa_out2,
                    standardized = T) %>% 
  as.data.frame(row.names = NULL) %>% 
  filter(mi > 10,
         op == "~~") %>% 
  arrange(desc(mi)) %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  kbl_rise(fontsize = 14, tbl_width = 75)

lhs	op	rhs	mi	epc	sepc.lv	sepc.all	sepc.nox
q3_2	~~	q3_4	14.707	-0.179	-0.179	-0.356	-0.356
q3_7	~~	q2_5	12.049	-0.106	-0.106	-0.615	-0.615
q4_5	~~	q4_6	11.615	-0.117	-0.117	-0.578	-0.578

7.2 Korrelation mellan delskalorna

Code

# Define latent variables
latent_cfa3 <- list(
  ledningen = items_q1,
  ledarskap = items_q2,
  föruts = items_q3,
  medarb = items_q4
  #säkerhet = c("ledningen", "ledarskap", "föruts", "medarb")
)
# Write the model, and check it
cfa_3 <- write_lavaan(latent = latent_cfa3)

cfa_out3 <- 
  cfa(model = cfa_3,
      data = d,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

cfa_summary3 <- summary(cfa_out3, standardized = TRUE)

cfa_summary3[["pe"]] %>% 
  as.data.frame() %>% 
  filter(op == "~~",
         !str_detect(lhs,"q"),
         !lhs == rhs) %>% 
  select(!c(exo,pvalue)) %>% 
  mutate_if(is.numeric, ~ round(., 3)) %>%
  kbl_rise()

lhs	op	rhs	est	se	z	std.lv	std.all	std.nox
ledningen	~~	ledarskap	0.622	0.031	20.366	0.834	0.834	0.834
ledningen	~~	föruts	0.679	0.029	23.353	0.874	0.874	0.874
ledningen	~~	medarb	0.604	0.034	17.975	0.821	0.821	0.821
ledarskap	~~	föruts	0.598	0.034	17.841	0.845	0.845	0.845
ledarskap	~~	medarb	0.564	0.034	16.603	0.843	0.843	0.843
föruts	~~	medarb	0.598	0.034	17.568	0.859	0.859	0.859

7.3 CFA övergripande säkerhet

Utifrån estimerade mätvärden (thetas) från varje delskala.

Code

# Define latent variables
latent_cfa2nd <- list(
  säkerhet = names(df_thetas[c(1:4)])
)
# Write the model, and check it
cfa_2nd <- write_lavaan(latent = latent_cfa2nd)

cfa_out2nd <- 
  cfa(model = cfa_2nd,
      data = df_thetas,
      rotation = "oblimin",
      estimator = "MLR")

# define fit metrics of interest
fit_metrics_robust <- c("chisq.scaled", "df", "pvalue.scaled", 
                         "cfi.robust", "tli.robust", "rmsea.robust", 
                        "rmsea.ci.lower.robust","rmsea.ci.upper.robust",
                        "srmr")

rbind(fitmeasures(cfa_out2nd, fit_metrics_robust)) %>% 
  # wrangle
  data.frame() %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  #add_column(Model = paste0("f",c(1:5)), .before = "chisq.scaled") %>% 
  rename(Chi2 = chisq.scaled,
         p = pvalue.scaled,
         CFI = cfi.robust,
         TLI = tli.robust,
         RMSEA = rmsea.robust,
         CI_low = rmsea.ci.lower.robust,
         CI_high = rmsea.ci.upper.robust,
         SRMR = srmr) %>% 
  kbl_rise()

Chi2	df	p	CFI	TLI	RMSEA	CI_low	CI_high	SRMR
1.019	2	0.601	1	1.005	0	0	0.109	0.006

Code

lavaanPlot(model = cfa_out2nd, 
           coefs = T, stand = T, covs = T,
           node_options = list(fontname = "Helvetica", fontsize = 18), 
           edge_options = list(color = "grey", fontsize = 18),
           graph_options = list(rankdir = "TD"))

8 Meta-frågor om enkäten

Code

itemlabels_all %>% 
  filter(itemnr %in% c("q5a","q5b")) %>% 
  kbl_rise()

itemnr	item
q5a	Tycker du att frågorna ovan täcker in det som är viktigt för att beskriva de grundläggande aspekterna av säkerhetskulturen på en arbetsplats?
q5b	Om du har förslag på frågor eller områden som saknas i enkäten, vänligen beskriv det här:

8.1 Kvantitativ fråga

Code

# svarskategorier <- df %>%
#   select(q5a) %>%
#   pivot_longer(everything()) %>%
#   na.omit() %>%
#   distinct(value) %>%
#   pull(value)

total_n <- df %>%
  select(q5a) %>%
  na.omit() %>%
  nrow()
  
q5a_long <- df %>% 
  select(q5a) %>% 
  pivot_longer(everything()) %>%
  na.omit() %>% 
  count(name, value) %>% # räkna hur många individer i varje svarskategori
  mutate(Procent = (100 * n / sum(n))) %>% # räkna fram procent för varje svarskategori
  mutate(across(where(is.numeric), ~ round(.x, 2))) %>%
  rename(
    Svarskategori = value, # byt namn på variabler inför skapande av figur.
    Fråga = name
  ) %>%
  left_join(itemlabels, by = join_by("Fråga" == "itemnr"))

q5a_long %>%
  ggplot(aes(x = Svarskategori, y = Procent, fill = Svarskategori)) +
  scale_y_continuous(limits = c(0, 75), breaks = seq(0, 100, 10)) + # starta alltid y på 0
  scale_x_discrete(
    guide = guide_axis(n.dodge = 1),
    labels = ~ str_wrap(as.character(.x), 18)
  ) +
  geom_col() +
  geom_text(aes(label = paste0("n = ", n)),
    color = "darkgrey",
    size = 4,
    position = position_dodge(width = 0.9),
    vjust = -0.4
  ) +
  scale_fill_viridis_d(direction = -1) +
  theme_minimal() +
  theme_prevent() +
  theme(legend.position = "none") +
  labs(
    title = str_wrap("Tycker du att frågorna täcker in det som är viktigt för att beskriva de grundläggande aspekterna av säkerhetskulturen på en arbetsplats?", 59),
    subtitle = paste0(
      "Antal svar totalt: ", total_n,
      ". Andel positiva: ", q5a_long[1, 4] + q5a_long[2, 4], "%."
    ),
    caption = str_wrap("Staplarnas höjd anger andel (%) av respondenterna som svarat i respektive svarskategori. Siffran ovanför staplarna anger antalet respondenter som svarat i den kategorin.", 100)
  )

8.2 Fritextkommentarer

Code

fritext_n <- df %>% 
  select(q5b) %>% 
  na.omit() %>% 
  nrow()

73 fritextsvar. Vi samlar dem i en CSV-fil. Dessa tillgängliggörs ej med annan data eftersom respondenter kan skriva vad som helst i detta fält.

Code

write_csv(na.omit(df$q5b) %>% as.data.frame(), "fritext.csv")

9 Varit med om olycka?

Code

total_n_q6 <- df %>%
  select(q6) %>%
  na.omit() %>%
  nrow()

q6_long <- df %>%
  mutate(q6 = factor(q6,
    levels = c("Nej", "Ja, en gång", "Ja, två gånger", "Ja, tre gånger", "Ja, fyra gånger eller fler"),
    ordered = TRUE
  )) %>%
  select(q6) %>%
  pivot_longer(everything()) %>%
  na.omit() %>%
  count(name, value) %>% # räkna hur många individer i varje svarskategori
  mutate(Procent = (100 * n / sum(n))) %>% # räkna fram procent för varje svarskategori
  mutate(across(where(is.numeric), ~ round(.x, 2))) %>%
  rename(
    Svarskategori = value, # byt namn på variabler inför skapande av figur.
    Fråga = name
  ) %>%
  add_column(item = "Har du det senaste året varit med om en eller flera arbetsplatsolyckor som resulterat i mer än en dags frånvaro från arbetet?")

q6_long %>%
  ggplot(aes(x = Svarskategori, y = Procent, fill = Svarskategori)) +
  scale_y_continuous(limits = c(0, 75), breaks = seq(0, 100, 10)) + # starta alltid y på 0
  geom_col() +
  geom_text(aes(label = paste0("n = ", n)),
    color = "darkgrey",
    size = 4,
    position = position_dodge(width = 0.9),
    vjust = -0.5
  ) +
  scale_fill_viridis_d(direction = -1) +
  theme_minimal() +
  theme_prevent() +
  theme(
    legend.position = "none",
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank()
  ) +
  labs(
    title = str_wrap("Har du det senaste året varit med om en eller flera arbetsplatsolyckor som resulterat i mer än en dags frånvaro från arbetet?", 70),
    subtitle = paste0("Antal svar totalt: ", total_n_q6),
    caption = str_wrap("Staplarnas höjd anger andel (%) av respondenterna som svarat i respektive svarskategori. Siffran ovanför staplarna anger antalet respondenter (n) som svarat i den kategorin.", 100)
  )

9.1 Strukturell ekvationsmodell

Code

d_sem <- df2 %>% 
  select(starts_with(c("q1","q2","q3","q4")),q6,id) %>% 
  mutate(q6dik = ifelse(q6 == "Nej",0,1)) %>% 
  filter(id %in% df3$id)

d_sem %>% 
  count(q6,q6dik)

# A tibble: 6 × 3
  q6                         q6dik     n
  <chr>                      <dbl> <int>
1 Ja, en gång                    1    20
2 Ja, fyra gånger eller fler     1    16
3 Ja, tre gånger                 1     5
4 Ja, två gånger                 1    27
5 Nej                            0   156
6 <NA>                          NA    85

Code

d_sem <- cbind(d_sem,df_thetas)

nosacq5 <- c("q1_1","q1_2","q2_1","q3_1","q4_1")

final.items <- read_csv("items_final_set.csv")
items_q1 <- final.items %>% 
  filter(delskala == "Ledningens Engagemang") %>%
  pull(itemnr)
items_q2 <- final.items %>% 
  filter(delskala == "Säkert ledarskap") %>%
  pull(itemnr)
items_q3 <- final.items %>%
  filter(delskala == "Förutsättningar") %>%
  pull(itemnr)
items_q4 <- final.items %>%
  filter(delskala == "Säkert medarbetarskap") %>%
  pull(itemnr)

# Define latent variables
latent_cfa2 <- list(
  ledningen = items_q1,
  ledarskap = items_q2,
  föruts = items_q3,
  medarb = items_q4,
  säkerhet = c("ledningen", "ledarskap", "föruts", "medarb")
)

# Define latent variables
latent_cfa3 <- list(
  ledningen = items_q1,
  ledarskap = items_q2,
  föruts = items_q3,
  medarb = items_q4
)

9.1.1 Säkerhet som latent prediktor för olycka

Med övergripande “säkerhet” som latent variabel och prediktor för utfallet olycka (q6) dikotomiserat, d.v.s. där frekvensen av olyckor inte tas med, utan bara ja/nej. Vi har såpass få respondenter som angett att de varit med om olyckor att vi inte kan använda det mera graderade utfallet.

Code

regression1 <- list(
  q6dik = "säkerhet"
)

# Write the model, and check it
sem1 <- write_lavaan(latent = latent_cfa2,
                    regression = regression1)

sem1_out <- 
  sem(model = sem1,
      data = d_sem,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

sem1_reg <- lavaan_reg(sem1_out)
lavaan_reg(sem1_out, nice_table = TRUE, highlight = TRUE)

Outcome	Predictor	SE	Z	p	b	95% CI (b)	b*	95% CI (b*)
q6dik	säkerhet	0.09	-3.51	< .001***	-0.32	[-0.51, -0.14]	-0.28	[-0.43, -0.12]

Code

exp(sem1_reg$b)

[1] 0.722535

Code

#lavPredictY(sem1_out, xnames = "säkerhet", ynames = "q6dik")

# https://stats.stackexchange.com/questions/596407/comparing-lavaansem-to-probit-regression-output
coef(sem1_out)["q6dik|t1"]

 q6dik|t1 
0.5141561

9.1.2 De fyra delskalorna som separata latenta prediktorer

Code

regression2 <- list(
  q6dik = c("ledningen", "ledarskap", "föruts", "medarb")
)
# Write the model, and check it
sem_2 <- write_lavaan(latent = latent_cfa3,
                      regression = regression2)

sem_out2 <- 
  sem(model = sem_2,
      data = d_sem,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

#summary(sem2_out)
#lavaan_reg(sem2_out)
lavaan_reg(sem_out2, nice_table = TRUE, highlight = TRUE)

Outcome	Predictor	SE	Z	p	b	95% CI (b)	b*	95% CI (b*)
q6dik	ledningen	0.29	-1.27	.206	-0.36	[-0.92, 0.20]	-0.33	[-0.85, 0.18]
q6dik	ledarskap	0.31	0.67	.503	0.21	[-0.40, 0.81]	0.17	[-0.32, 0.66]
q6dik	föruts	0.38	-0.16	.869	-0.06	[-0.80, 0.67]	-0.05	[-0.69, 0.59]
q6dik	medarb	0.33	-0.24	.813	-0.08	[-0.72, 0.57]	-0.06	[-0.59, 0.46]

9.1.3 De fyra delskalorna som prediktorer

med estimerade mätvärden.

Code

glm_all_theta <- glm(q6dik ~ thetas_q1 + thetas_q2 + thetas_q3 + thetas_q4, data = d_sem, family = binomial(link = "probit")) #probit is same as lavaan SEM uses

tidy(glm_all_theta)

# A tibble: 5 × 5
  term        estimate std.error statistic p.value
  <chr>          <dbl>     <dbl>     <dbl>   <dbl>
1 (Intercept)  -0.243     0.136     -1.79   0.0736
2 thetas_q1    -0.105     0.0558    -1.88   0.0601
3 thetas_q2     0.0285    0.0526     0.541  0.588 
4 thetas_q3    -0.0185    0.0853    -0.217  0.828 
5 thetas_q4    -0.0153    0.0641    -0.238  0.812

9.1.4 NOSACQ-frågorna som latent prediktor

Code

regression3 <- list(
  q6dik = "nosacq"
)

latent_cfa4 <- list(
  nosacq = nosacq5
)

# Write the model, and check it
sem3 <- write_lavaan(latent = latent_cfa4,
                    regression = regression3)

sem3_out <- 
  sem(model = sem3,
      data = d_sem,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)

sem3_reg <- lavaan_reg(sem3_out)
lavaan_reg(sem3_out, nice_table = TRUE, highlight = TRUE)

Outcome	Predictor	SE	Z	p	b	95% CI (b)	b*	95% CI (b*)
q6dik	nosacq	0.09	-3.99	< .001***	-0.35	[-0.53, -0.18]	-0.32	[-0.48, -0.16]

Code

exp(sem3_reg$b)

[1] 0.7030214

9.1.5 NOSACQ estimerade mätvärden

Plot av rådata med jitter på den dikotomiserade variabeln (bara 0 och 1 är möjliga svar).

Code

ggplot(
  d_sem,
  aes(x = thetas_nosacq, y = q6dik)
) +
  geom_jitter(width = 0.02, height = 0.02) +
  geom_smooth(method = "loess") +
  scale_y_continuous(breaks = c(0, 1)) +
  geom_vline(xintercept = 1.5, linetype = "dashed") +
  labs(
    x = "Estimerade mätvärden (theta) för de fem NOSACQ-frågorna",
    y = "Varit med om olycka (1) eller inte(0)", title = "Rådata"
  )

Ser ut som att vi når “botten” vid nosacq theta = 1.5?

9.1.5.1 glm()

Vi passar på att testa de två R-paketen som implementerar Firth’s penalized logistic regression, som är allmänt rekommenderat vid mindre sampelstorlekar och/eller vid lågfrekventa utfall i data. Först kommer vanlig logistisk regression, sedan Firth’s justerade metod två gånger.

Code

glm_nosacq_theta <- glm(q6dik ~ thetas_nosacq, data = d_sem, family = binomial(link = "logit"))

tidy(glm_nosacq_theta)

# A tibble: 2 × 5
  term          estimate std.error statistic  p.value
  <chr>            <dbl>     <dbl>     <dbl>    <dbl>
1 (Intercept)     -0.366    0.196      -1.86 0.0625  
2 thetas_nosacq   -0.263    0.0779     -3.37 0.000742

Code

plot_predictions(glm_nosacq_theta, by = "thetas_nosacq") +#, transform = "exp")
    labs(
    x = "Estimerade mätvärden (theta) för de fem NOSACQ-frågorna",
    y = "Varit med om olycka (1) eller inte(0)", title = "Predicerade värden i statistisk modell", subtitle = "glm(q6dik ~ thetas_nosacq, data = d_sem, family = binomial(link = 'logit'))"
  )

Code

library(logistf)
glm_nosacq_theta_p <- logistf(q6dik ~ thetas_nosacq, data = d_sem, family = binomial(link = "logit"))
summary(glm_nosacq_theta_p)

logistf(formula = q6dik ~ thetas_nosacq, data = d_sem, family = binomial(link = "logit"))

Model fitted by Penalized ML
Coefficients:
                    coef   se(coef) lower 0.95  upper 0.95     Chisq
(Intercept)   -0.3653137 0.19464971 -0.7488053  0.01817077  3.488884
thetas_nosacq -0.2592295 0.07702015 -0.4138043 -0.11023716 11.721294
                         p method
(Intercept)   0.0617822231      2
thetas_nosacq 0.0006178899      2

Method: 1-Wald, 2-Profile penalized log-likelihood, 3-None

Likelihood ratio test=11.72129 on 1 df, p=0.0006178899, n=224
Wald test = 39.57521 on 1 df, p = 3.156649e-10

Code

library(brglm2)
glm_nosacq_theta_p2 <- glm(q6dik ~ thetas_nosacq, data = d_sem, family = binomial(link = "logit"), method = "brglmFit")
tidy(glm_nosacq_theta_p2)

# A tibble: 2 × 5
  term          estimate std.error statistic  p.value
  <chr>            <dbl>     <dbl>     <dbl>    <dbl>
1 (Intercept)     -0.365    0.196      -1.86 0.0628  
2 thetas_nosacq   -0.259    0.0777     -3.34 0.000851

Code

plot_predictions(glm_nosacq_theta_p2, by = "thetas_nosacq") +#, transform = "exp")
    labs(
    x = "Estimerade mätvärden (theta) för de fem NOSACQ-frågorna",
    y = "Varit med om olycka (1) eller inte(0)", title = "Predicerade värden i statistisk modell", subtitle = "glm(q6dik ~ thetas_nosacq, data = d_sem, family = binomial(link = 'logit'), method = 'brglmFit')"
  )

Denna metod fångar inte “utplaningen” som sker efter x ~ 1.5, så vi behöver hitta en analysmetod som bättre passar data.

9.1.5.2 gam()

Code

library(mgcViz) # https://mfasiolo.github.io/mgcViz/articles/mgcviz.html
b <- gam(q6dik ~ s(thetas_nosacq), data = d_sem, method = "REML")
# b <- getViz(b)
# plot( sm(b, 1) )
# 
# lowest <- predict.gam(b) %>% min()
predict.gam(b) %>% 
  as.data.frame() %>% 
  ggplot(aes(.)) + 
  geom_histogram() +
  xlab("Predicted values")

Code

plot_predictions(b, condition = "thetas_nosacq") #transform = "exp")

Code

plot_predictions(b, condition = "thetas_nosacq", transform = "exp") + labs(y = "q6dik exponentiated")

Code

#plot_slopes(b, variables = "thetas_nosacq", condition = "thetas_nosacq")

Här är nosacq_theta = 2 “botten”. Det ser också rimligt ut som gränsvärde utifrån targetingfiguren (sektion 4.11), och motsvarar att ha svarat nästa högsta svarsalternativet på alla fem frågorna.

9.1.6 NOSACQ sum scores gam()

Code

d_sem <- d_sem %>% 
  mutate(nosacq_sumscore = rowSums(across(all_of(nosacq5))))

hist(d_sem$nosacq_sumscore, breaks = 15)
abline(v = mean(d_sem$nosacq_sumscore))

Code

b2 <- gam(q6dik ~ s(nosacq_sumscore), data = d_sem, method = "REML")
# b <- getViz(b)
# plot( sm(b, 1) )
# 
# lowest <- predict.gam(b) %>% min()
predict.gam(b2) %>% 
  as.data.frame() %>% 
  ggplot(aes(.)) + 
  geom_histogram() +
  xlab("Predicted values")

Code

plot_predictions(b2, condition = "nosacq_sumscore") + scale_x_continuous(breaks = seq(0,15,2)) #transform = "exp")

Code

plot_predictions(b2, condition = "nosacq_sumscore", transform = "exp") + labs(y = "q6dik exponentiated") + scale_x_continuous(breaks = seq(0,15,2))

Code

#plot_slopes(b2, variables = "nosacq_sumscore", condition = "nosacq_sumscore")

Sum score 10 = svarsalternativ 2 på alla fem frågorna. Men även 8-9 verkar ge goda utfall (1-2 frågor med svar “Stämmer ganska dåligt”). Allt detta med reservation för att vi har ett litet sampel.

10 Programvara som använts för analyserna

Code

pkgs <- cite_packages(cite.tidyverse = TRUE, 
                      output = "table",
                      bib.file = "grateful-refs.bib",
                      include.RStudio = TRUE,
                      out.dir = getwd())
formattable(pkgs, 
            table.attr = 'class=\"table table-striped\" style="font-size: 15px; font-family: Lato; width: 80%"')

Package	Version	Citation
base	4.3.3	R Core Team (2024)
brglm2	0.9.2	Kosmidis, Kenne Pagui, and Sartori (2020); Kosmidis and Firth (2021); Kosmidis (2023)
car	3.1.2	Fox and Weisberg (2019)
eRm	1.0.6	Mair and Hatzinger (2007b); Mair and Hatzinger (2007a); Hatzinger and Rusch (2009); Rusch, Maier, and Hatzinger (2013); Koller, Maier, and Hatzinger (2015); Debelak and Koller (2019)
formattable	0.2.1	Ren and Russell (2021)
ggrepel	0.9.5	Slowikowski (2024)
glue	1.7.0	Hester and Bryan (2024)
janitor	2.2.0	Firke (2023)
kableExtra	1.4.0	Zhu (2024)
knitr	1.45	Xie (2014); Xie (2015); Xie (2023)
labelled	2.12.0	Larmarange (2023)
lavaan	0.6.17	Rosseel (2012)
lavaanExtra	0.2.0	Thériault (2023)
lavaanPlot	0.8.1	Lishinski (2024)
logistf	1.26.0	Heinze et al. (2023)
marginaleffects	0.18.0	Arel-Bundock (2024)
matrixStats	1.2.0	Bengtsson (2023)
mgcViz	0.1.11	Fasiolo et al. (2020)
mirt	1.41	Chalmers (2012)
modelsummary	2.0.0	Arel-Bundock (2022)
parameters	0.21.6	Lüdecke et al. (2020)
patchwork	1.2.0	Pedersen (2024)
psych	2.4.3	William Revelle (2024)
psychotree	0.16.1	Trepte and Verbeet (2010); Strobl, Wickelmaier, and Zeileis (2011); Strobl, Kopf, and Zeileis (2015); Komboz, Zeileis, and Strobl (2018); Wickelmaier and Zeileis (2018)
qualtRics	3.2.0	Ginn, O’Brien, and Silge (2024)
reshape	0.8.9	Wickham (2007)
RISEkbmRasch	0.1.33.4	Johansson (2024)
rmarkdown	2.26	Xie, Allaire, and Grolemund (2018); Xie, Dervieux, and Riederer (2020); Allaire et al. (2024)
showtext	0.9.7	Qiu and See file AUTHORS for details. (2024)
tidyverse	2.0.0	Wickham et al. (2019)

Code

sessionInfo()

R version 4.3.3 (2024-02-29)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Sonoma 14.4.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/Stockholm
tzcode source: internal

attached base packages:
 [1] parallel  grid      stats4    stats     graphics  grDevices utils    
 [8] datasets  methods   base     

other attached packages:
 [1] glmnet_4.1-8           Matrix_1.6-5           ranger_0.16.0         
 [4] vip_0.4.1              dotwhisker_0.7.4       yardstick_1.3.1       
 [7] workflowsets_1.1.0     workflows_1.1.4        tune_1.2.0            
[10] rsample_1.2.1          recipes_1.0.10         parsnip_1.2.1         
[13] modeldata_1.3.0        infer_1.0.7            dials_1.2.1           
[16] scales_1.3.0           tidymodels_1.2.0       mgcViz_0.1.11         
[19] qgam_1.3.4             mgcv_1.9-1             nlme_3.1-164          
[22] brglm2_0.9.2           logistf_1.26.0         broom_1.0.5           
[25] modelsummary_2.0.0     lordif_0.3-3           rms_6.8-0             
[28] Hmisc_5.1-1            doParallel_1.0.17      iterators_1.0.14      
[31] foreach_1.5.2          showtext_0.9-7         showtextdb_3.0        
[34] sysfonts_0.8.8         marginaleffects_0.18.0 parameters_0.21.6     
[37] lavaanPlot_0.8.1       lavaan_0.6-17          lavaanExtra_0.2.0     
[40] janitor_2.2.0          qualtRics_3.2.0        labelled_2.12.0       
[43] haven_2.5.4            knitr_1.45             readxl_1.4.3          
[46] grateful_0.2.4         RISEkbmRasch_0.1.33.4  hexbin_1.28.3         
[49] catR_3.17              glue_1.7.0             ggrepel_0.9.5         
[52] patchwork_1.2.0        reshape_0.8.9          matrixStats_1.2.0     
[55] psychotree_0.16-1      psychotools_0.7-3      partykit_1.2-20       
[58] mvtnorm_1.2-4          libcoin_1.0-10         psych_2.4.3           
[61] mirt_1.41              lattice_0.22-5         eRm_1.0-6             
[64] lubridate_1.9.3        forcats_1.0.0          stringr_1.5.1         
[67] dplyr_1.1.4            purrr_1.0.2            readr_2.1.5           
[70] tidyr_1.3.1            tibble_3.2.1           ggplot2_3.5.0         
[73] tidyverse_2.0.0        kableExtra_1.4.0       formattable_0.2.1     
[76] car_3.1-2              carData_3.0-5         

loaded via a namespace (and not attached):
  [1] DiceDesign_1.10         RColorBrewer_1.1-3      insight_0.19.10        
  [4] numDeriv_2016.8-1.1     tools_4.3.3             backports_1.4.1        
  [7] sjlabelled_1.2.0        utf8_1.2.4              R6_2.5.1               
 [10] vegan_2.6-4             jomo_2.7-6              permute_0.9-7          
 [13] withr_3.0.0             enrichwith_0.3.1        GGally_2.2.1           
 [16] gridExtra_2.3           textshaping_0.3.7       quantreg_5.97          
 [19] cli_3.6.2               officer_0.6.5           sandwich_3.1-0         
 [22] labeling_0.4.3          polspline_1.1.24        askpass_1.2.0          
 [25] tables_0.9.17           pbapply_1.7-2           pbivnorm_0.6.0         
 [28] systemfonts_1.0.5       foreign_0.8-86          gfonts_0.2.0           
 [31] svglite_2.1.3           parallelly_1.36.0       httpcode_0.3.0         
 [34] rstudioapi_0.16.0       visNetwork_2.1.2        generics_0.1.3         
 [37] shape_1.4.6             vroom_1.6.5             zip_2.3.0              
 [40] rempsyc_0.1.7           fansi_1.0.6             abind_1.4-5            
 [43] lifecycle_1.0.4         multcomp_1.4-25         yaml_2.3.8             
 [46] snakecase_0.11.1        inum_1.0-5              ggstance_0.3.6         
 [49] promises_1.2.1          crayon_1.5.2            mitml_0.4-5            
 [52] miniUI_0.1.1.1          pillar_1.9.0            boot_1.3-29            
 [55] estimability_1.4.1      future.apply_1.11.2     codetools_0.2-19       
 [58] pan_1.9                 fontLiberation_0.1.0    data.table_1.15.4      
 [61] vctrs_0.6.5             cellranger_1.1.0        gtable_0.3.4           
 [64] datawizard_0.10.0       gower_1.0.1             xfun_0.43              
 [67] mime_0.12               prodlim_2023.08.28      coda_0.19-4            
 [70] survival_3.5-8          timeDate_4032.109       hardhat_1.3.1          
 [73] lava_1.7.3              DiagrammeR_1.0.10       ellipsis_0.3.2         
 [76] TH.data_1.1-2           ipred_0.9-14            fontquiver_0.2.1       
 [79] bit64_4.0.5             Deriv_4.1.3             KernSmooth_2.23-22     
 [82] rpart_4.1.23            colorspace_2.1-0        nnet_7.3-19            
 [85] mnormt_2.1.1            tidyselect_1.2.0        emmeans_1.9.0          
 [88] curl_5.2.0              bit_4.0.5               compiler_4.3.3         
 [91] htmlTable_2.4.2         flextable_0.9.5         mice_3.16.0            
 [94] SparseM_1.81            xml2_1.3.6              fontBitstreamVera_0.1.1
 [97] bayestestR_0.13.2       checkmate_2.3.1         quadprog_1.5-8         
[100] digest_0.6.34           minqa_1.2.6             rmarkdown_2.26         
[103] htmltools_0.5.8.1       pkgconfig_2.0.3         base64enc_0.1-3        
[106] lme4_1.1-35.3           lhs_1.1.6               fastmap_1.1.1          
[109] rlang_1.1.3             htmlwidgets_1.6.4       shiny_1.8.0            
[112] farver_2.1.1            zoo_1.8-12              jsonlite_1.8.8         
[115] dcurver_0.9.2           magrittr_2.0.3          Formula_1.2-5          
[118] GPfit_1.0-8             munsell_0.5.0           Rcpp_1.0.12            
[121] gdtools_0.3.7           viridis_0.6.4           furrr_0.3.1            
[124] stringi_1.8.3           MASS_7.3-60.0.1         plyr_1.8.9             
[127] ggstats_0.5.1           formula.tools_1.7.1     listenv_0.9.0          
[130] splines_4.3.3           hms_1.1.3               uuid_1.2-0             
[133] crul_1.4.2              GPArotation_2023.11-1   evaluate_0.23          
[136] renv_1.0.3              operator.tools_1.6.3    nloptr_2.0.3           
[139] tzdb_0.4.0              httpuv_1.6.13           MatrixModels_0.5-3     
[142] openssl_2.1.1           future_1.33.2           xtable_1.8-4           
[145] later_1.3.2             ragg_1.2.7              viridisLite_0.4.2      
[148] class_7.3-22            cluster_2.1.6           gamm4_0.2-6            
[151] timechange_0.2.0        globals_0.16.2

11 Referenser

Ajslev, Jeppe, Efat Lali Dastjerdi, Johnny Dyreborg, Pete Kines, Katharina Christiane Jeschke, Emil Sundstrup, Markus Due Jakobsen, Nils Fallentin, and Lars Louis Andersen. 2017. “Safety Climate and Accidents at Work: Cross-Sectional Study Among 15,000 Workers of the General Working Population.” Safety Science 91 (January): 320–25. https://doi.org/10.1016/j.ssci.2016.08.029.

Allaire, JJ, Yihui Xie, Christophe Dervieux, Jonathan McPherson, Javier Luraschi, Kevin Ushey, Aron Atkins, et al. 2024. rmarkdown: Dynamic Documents for r. https://github.com/rstudio/rmarkdown.

Arel-Bundock, Vincent. 2022. “modelsummary: Data and Model Summaries in R.” Journal of Statistical Software 103 (1): 1–23. https://doi.org/10.18637/jss.v103.i01.

———. 2024. marginaleffects: Predictions, Comparisons, Slopes, Marginal Means, and Hypothesis Tests. https://CRAN.R-project.org/package=marginaleffects.

Bengtsson, Henrik. 2023. matrixStats: Functions That Apply to Rows and Columns of Matrices (and to Vectors). https://CRAN.R-project.org/package=matrixStats.

Chalmers, R. Philip. 2012. “mirt: A Multidimensional Item Response Theory Package for the R Environment.” Journal of Statistical Software 48 (6): 1–29. https://doi.org/10.18637/jss.v048.i06.

Debelak, Rudolf, and Ingrid Koller. 2019. “Testing the Local Independence Assumption of the Rasch Model with Q3-Based Nonparametric Model Tests.” Applied Psychological Measurement 44. https://doi.org/10.1177/0146621619835501.

Fasiolo, Matteo, Nedellec, Rapha"el, Goude, Yannig, Wood, and Simon N. 2020. “Scalable Visualisation Methods for Modern Generalized Additive Models.” Journal of the Royal Statistical Society (B) 29 (1): 78–86.

Firke, Sam. 2023. janitor: Simple Tools for Examining and Cleaning Dirty Data. https://CRAN.R-project.org/package=janitor.

Fox, John, and Sanford Weisberg. 2019. An R Companion to Applied Regression. Third. Thousand Oaks CA: Sage. https://socialsciences.mcmaster.ca/jfox/Books/Companion/.

Ginn, Jasper, Joseph O’Brien, and Julia Silge. 2024. qualtRics: Download “Qualtrics” Survey Data. https://CRAN.R-project.org/package=qualtRics.

Hatzinger, Reinhold, and Thomas Rusch. 2009. “IRT Models with Relaxed Assumptions in eRm: A Manual-Like Instruction.” Psychology Science Quarterly 51.

Heinze, Georg, Meinhard Ploner, Lena Jiricka, and Gregor Steiner. 2023. logistf: Firth’s Bias-Reduced Logistic Regression. https://CRAN.R-project.org/package=logistf.

Hester, Jim, and Jennifer Bryan. 2024. glue: Interpreted String Literals. https://CRAN.R-project.org/package=glue.

Johansson, Magnus. 2024. RISEkbmRasch: Psychometric Analysis in r with Rasch Measurement Theory. https://github.com/pgmj/RISEkbmRasch.

Johansson, Magnus, Marit Preuter, Simon Karlsson, Marie-Louise Möllerberg, Hanna Svensson, and Jeanette Melin. 2023. “Valid and Reliable? Basic and Expanded Recommendations for Psychometric Reporting and Quality Assessment.” https://doi.org/10.31219/osf.io/3htzc.

Kines, Pete, Jorma Lappalainen, Kim Lyngby Mikkelsen, Espen Olsen, Anders Pousette, Jorunn Tharaldsen, Kristinn Tómasson, and Marianne Törner. 2011. “Nordic Safety Climate Questionnaire (NOSACQ-50): A New Tool for Diagnosing Occupational Safety Climate.” International Journal of Industrial Ergonomics 41 (6): 634–46. https://doi.org/10.1016/j.ergon.2011.08.004.

Koller, Ingrid, Marco Maier, and Reinhold Hatzinger. 2015. “An Empirical Power Analysis of Quasi-Exact Tests for the Rasch Model: Measurement Invariance in Small Samples.” Methodology 11. https://doi.org/10.1027/1614-2241/a000090.

Komboz, Basil, Achim Zeileis, and Carolin Strobl. 2018. “Tree-Based Global Model Tests for Polytomous Rasch Models.” Educational and Psychological Measurement 78 (1): 128–66. https://doi.org/10.1177/0013164416664394.

Kosmidis, Ioannis. 2023. brglm2: Bias Reduction in Generalized Linear Models. https://CRAN.R-project.org/package=brglm2.

Kosmidis, Ioannis, and David Firth. 2021. “Jeffreys-Prior Penalty, Finiteness and Shrinkage in Binomial-Response Generalized Linear Models.” Biometirka 108: 71–82. https://doi.org/10.1093/biomet/asaa052.

Kosmidis, Ioannis, Euloge Clovis Kenne Pagui, and Nicola Sartori. 2020. “Mean and Median Bias Reduction in Generalized Linear Models.” Statistics and Computing 30: 43–59. https://doi.org/10.1007/s11222-019-09860-6.

Larmarange, Joseph. 2023. labelled: Manipulating Labelled Data. https://CRAN.R-project.org/package=labelled.

Lishinski, Alex. 2024. lavaanPlot: Path Diagrams for “Lavaan” Models via “DiagrammeR”. https://CRAN.R-project.org/package=lavaanPlot.

Lüdecke, Daniel, Mattan S. Ben-Shachar, Indrajeet Patil, and Dominique Makowski. 2020. “Extracting, Computing and Exploring the Parameters of Statistical Models Using R.” Journal of Open Source Software 5 (53): 2445. https://doi.org/10.21105/joss.02445.

Mair, Patrick, and Reinhold Hatzinger. 2007a. “CML Based Estimation of Extended Rasch Models with the eRm Package in r.” Psychology Science 49. https://doi.org/10.18637/jss.v020.i09.

———. 2007b. “Extended Rasch Modeling: The eRm Package for the Application of IRT Models in r.” Journal of Statistical Software 20. https://doi.org/10.18637/jss.v020.i09.

Pedersen, Thomas Lin. 2024. patchwork: The Composer of Plots. https://CRAN.R-project.org/package=patchwork.

Preuter, Marit, Magnus Johansson, and Tomas Bokström. 2022. Strukturer och indikatorer för uppföljning av föräldraskapsstöd. RISE rapport 2022:70. RISE Research Institutes of Sweden. http://urn.kb.se/resolve?urn=urn:nbn:se:ri:diva-59978.

Qiu, Yixuan, and authors/contributors of the included software. See file AUTHORS for details. 2024. showtext: Using Fonts More Easily in r Graphs. https://CRAN.R-project.org/package=showtext.

R Core Team. 2024. R: A Language and Environment for Statistical Computing. Vienna, Austria: R Foundation for Statistical Computing. https://www.R-project.org/.

Ren, Kun, and Kenton Russell. 2021. formattable: Create “Formattable” Data Structures. https://CRAN.R-project.org/package=formattable.

Rosseel, Yves. 2012. “lavaan: An R Package for Structural Equation Modeling.” Journal of Statistical Software 48 (2): 1–36. https://doi.org/10.18637/jss.v048.i02.

Rusch, Thomas, Marco Maier, and Reinhold Hatzinger. 2013. “Linear Logistic Models with Relaxed Assumptions in r.” In Algorithms from and for Nature and Life, edited by Berthold Lausen, Dirk van den Poel, and Alfred Ultsch. Studies in Classification, Data Analysis, and Knowledge Organization. New York: Springer. https://doi.org/10.1007/978-3-319-00035-0_34.

Slowikowski, Kamil. 2024. ggrepel: Automatically Position Non-Overlapping Text Labels with “ggplot2”. https://CRAN.R-project.org/package=ggrepel.

Strobl, Carolin, Julia Kopf, and Achim Zeileis. 2015. “Rasch Trees: A New Method for Detecting Differential Item Functioning in the Rasch Model.” Psychometrika 80 (2): 289–316. https://doi.org/10.1007/s11336-013-9388-3.

Strobl, Carolin, Florian Wickelmaier, and Achim Zeileis. 2011. “Accounting for Individual Differences in Bradley-Terry Models by Means of Recursive Partitioning.” Journal of Educational and Behavioral Statistics 36 (2): 135–53. https://doi.org/10.3102/1076998609359791.

Thériault, Rémi. 2023. “lavaanExtra: Convenience Functions for Lavaan.” Journal of Open Source Software 8 (90): 5701. https://doi.org/10.21105/joss.05701.

Trepte, Sabine, and Markus Verbeet, eds. 2010. Allgemeinbildung in Deutschland – Erkenntnisse Aus Dem SPIEGEL Studentenpisa-Test. Wiesbaden: VS Verlag.

Wickelmaier, Florian, and Achim Zeileis. 2018. “Using Recursive Partitioning to Account for Parameter Heterogeneity in Multinomial Processing Tree Models.” Behavior Research Methods 50 (3): 1217–33. https://doi.org/10.3758/s13428-017-0937-z.

Wickham, Hadley. 2007. “Reshaping Data with the Reshape Package.” Journal of Statistical Software 21 (12). https://www.jstatsoft.org/v21/i12/.

Wickham, Hadley, Mara Averick, Jennifer Bryan, Winston Chang, Lucy D’Agostino McGowan, Romain François, Garrett Grolemund, et al. 2019. “Welcome to the tidyverse.” Journal of Open Source Software 4 (43): 1686. https://doi.org/10.21105/joss.01686.

William Revelle. 2024. psych: Procedures for Psychological, Psychometric, and Personality Research. Evanston, Illinois: Northwestern University. https://CRAN.R-project.org/package=psych.

Xie, Yihui. 2014. “knitr: A Comprehensive Tool for Reproducible Research in R.” In Implementing Reproducible Computational Research, edited by Victoria Stodden, Friedrich Leisch, and Roger D. Peng. Chapman; Hall/CRC.

———. 2015. Dynamic Documents with R and Knitr. 2nd ed. Boca Raton, Florida: Chapman; Hall/CRC. https://yihui.org/knitr/.

———. 2023. knitr: A General-Purpose Package for Dynamic Report Generation in r. https://yihui.org/knitr/.

Xie, Yihui, J. J. Allaire, and Garrett Grolemund. 2018. R Markdown: The Definitive Guide. Boca Raton, Florida: Chapman; Hall/CRC. https://bookdown.org/yihui/rmarkdown.

Xie, Yihui, Christophe Dervieux, and Emily Riederer. 2020. R Markdown Cookbook. Boca Raton, Florida: Chapman; Hall/CRC. https://bookdown.org/yihui/rmarkdown-cookbook.

Zhu, Hao. 2024. kableExtra: Construct Complex Table with “kable” and Pipe Syntax. https://CRAN.R-project.org/package=kableExtra.

Reuse

CC BY 4.0