12 Krav, arbetetsbelastning och återhämtning

Code

library(foreign)
library(readxl)
library(RISEkbmRasch) # devtools::install_github("pgmj/RISEkbmRasch")
library(grateful) # devtools::install_github("Pakillo/grateful")
library(ggrepel)
library(car)
library(kableExtra)
library(readxl)
library(tidyverse)
library(eRm)
library(mirt)
library(psych)
library(ggplot2)
library(psychotree)
library(matrixStats)
library(reshape)
library(knitr)
library(cowplot)
library(formattable) 
library(glue)
library(hexbin)
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

# file paths will need to have "../" added at the beginning to be able to render document

# get itemlabels
itemlabels <- read_excel("../data/Itemlabels.xlsx") %>% 
  filter(str_detect(itemnr, pattern = "abk|å")) %>% 
  select(!Dimension)

spssDatafil <- "../data/2023-04-26 Prevent OSA-enkat.sav"

# read SurveyMonkey data
df <- read.spss(spssDatafil, to.data.frame = TRUE) %>% 
  select(starts_with("q0006"), starts_with("q0009"),q0001,q0002,q0003,q0004) %>% 
  rename(Kön = q0002,
         Ålder = q0001,
         Bransch = q0003,
         Hemarbete = q0004)



# SPSS format provides itemlabels too, we can save them in a dataframe
spssLabels <- df %>% attr('variable.labels') %>% as.data.frame()

dif.kön <- df$Kön
dif.ålder <- df$Ålder
dif.bransch <- df$Bransch
dif.hemarbete <- df$Hemarbete

df <- df %>% 
  select(starts_with("q0006"), starts_with("q0009"))

names(df) <- itemlabels$itemnr

12.1 Bakgrundsdata

Kön

Code

RIdemographics(dif.kön,"Kön")

Kön	n	Percent
Kvinna	402	69.7
Man	172	29.8
Annat	1	0.2
Vill ej uppge	2	0.3

Ålder

Code

RIdemographics(dif.ålder,"Ålder") # kanske även fixa en figur?

Ålder	n	Percent
18-29	22	3.8
30-39	103	17.8
40-49	175	30.2
50-59	215	37.1
60+	64	11.1

Bransch

Code

RIdemographics(dif.bransch,"Bransch")

Bransch	n	Percent
Kontorsarbete (oavsett bransch)	284	49.1
Industri	26	4.5
Hotell, restaurang, service	8	1.4
Handel	16	2.8
Skola, utbildning	67	11.6
Vård, omsorg	99	17.1
Byggverksamhet	7	1.2
Annat	71	12.3

Arbete hemifrån

Code

RIdemographics(dif.hemarbete,"Antal dagar med arbete hemifrån")

Antal dagar med arbete hemifrån	n	Percent
En dag	136	23.5
Två dagar	105	18.1
Tre dagar	35	6.0
Fyra dagar	10	1.7
Fem dagar	2	0.3
Jag arbetar aldrig eller sällan hemifrån	291	50.3

12.1.1 Svarsbortfall items

Vi filtrerar bort respondenter som har färre än två svar på frågorna i delskalan.

Code

# If you want to include participants with missing data, input the minimum number of items responses that a participant should have to be included in the analysis:
min.responses <- 2
scale.items <- itemlabels$itemnr

# Select the variables we will work with, and filter out respondents with a lot of missing data
df.omit.na <- df %>% 
  filter(length(scale.items)-rowSums(is.na(.[scale.items])) >= min.responses)

RImissing(df.omit.na, c("abk", "å"))

Vi har relativt få saknade svar, och tar därför bort respondenterna som inte har kompletta svar.

Code

df <- read.spss(spssDatafil, to.data.frame = TRUE) %>% 
  select(starts_with("q0006"), starts_with("q0009"),q0001,q0002,q0003,q0004) %>% 
  rename(Kön = q0002,
         Ålder = q0001,
         Bransch = q0003,
         Hemarbete = q0004) %>% 
  na.omit()

dif.kön <- df$Kön
dif.ålder <- df$Ålder
dif.bransch <- df$Bransch
dif.hemarbete <- df$Hemarbete

df <- df %>% 
  select(starts_with("q0006"), starts_with("q0009"))

names(df) <- itemlabels$itemnr

df.omit.na <- df

12.1.2 Alla svar för alla frågor

Code

RIallresp(df.omit.na)

Response category	Number of responses	Percent
Alltid	745	14.1
Mycket ofta	1432	27.1
Ganska ofta	1367	25.9
Ibland	941	17.8
Sällan	640	12.1
Aldrig	155	2.9

Code

# koda om svarskategorier till siffror
df.omit.na <- df.omit.na %>% 
  mutate(across(everything(), ~ car::recode(.x,"'Aldrig'=0;
                                            'Sällan' =1;
                                            'Ibland'=2;
                                            'Ganska ofta'=3;
                                            'Mycket ofta'=4;
                                            'Alltid'=5",
                                            as.factor = FALSE)))

12.2 Deskriptiva data

Tile plot

Code

RItileplot(df.omit.na)

Stacked bars

Code

RIbarstack(df.omit.na) + ylab("Item")

Barplots

Code

RIbarplot(df.omit.na)

Vi har väldigt få svar i lägsta kategorierna för items abk1 och slår därför ihop de två lägsta svarskategorierna för detta item.

Code

df.omit.na$abk3 <- recode(df.omit.na$abk3,"1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)

12.3 Rasch-analys 1

itemnr	item
abk1	Min arbetsbelastning är rimlig.
abk2	Jag hinner med mina arbetsuppgifter inom min arbetstid.
abk3	Mitt arbete är lagom omväxlande.
abk4	Jag upplever att andras krav på mig är rimliga.
abk5	Jag kan få hjälp om min arbetsbelastning är för hög.
abk6	Mitt arbete är fritt från psykiskt påfrestande arbetsuppgifter.
å1	Jag kan använda raster till att koppla av från arbetet.
å2	Jag har möjlighet att arbeta i lugnare takt efter arbetsintensiva perioder.
å3	Jag har tid för reflektion över hur jag har utfört arbetet.
å4	Jag har ork kvar för att göra andra saker efter arbetsdagens slut.
å5	Jag kan lägga tankar på arbetet åt sidan på min lediga tid.

Item fit

Code

RIitemfitPCM2(df.omit.na, samplesize = 250, nsamples = 32, cpu = 8)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
abk1	0.663	0.679	-4.082	-3.995
abk2	0.751	0.773	-2.873	-2.69
abk3	1.404	1.304	3.414	2.81
abk4	0.795	0.81	-2.245	-2.483
abk5	1.231	1.165	2.026	1.944
abk6	1.205	1.196	2.065	2.044
å1	0.987	0.923	0.276	-0.793
å2	0.706	0.719	-3.958	-3.309
å3	0.676	0.683	-4.2	-4.14
å4	0.824	0.812	-2.171	-2.638
å5	1.163	1.107	1.791	1.388

PCA

Code

RIpcmPCA(na.omit(df.omit.na))

PCA of Rasch model residuals

Eigenvalues
1.98
1.88
1.26
1.21
1.08

Residual correlations

Code

RIresidcorr(df.omit.na, cutoff = 0.2)

	abk1	abk2	abk3	abk4	abk5	abk6	å1	å2	å3	å4	å5
abk1
abk2	0.5
abk3	-0.19	-0.29
abk4	0.09	0.03	0.19
abk5	-0.1	-0.08	-0.1	-0.11
abk6	-0.14	-0.22	-0.02	0.04	-0.12
å1	-0.2	-0.15	-0.14	-0.24	-0.14	-0.26
å2	-0.09	0	-0.2	-0.25	-0.13	-0.24	0.12
å3	-0.04	-0.02	-0.17	-0.25	-0.08	-0.21	0.05	0.36
å4	-0.15	-0.22	-0.06	-0.08	-0.24	-0.04	-0.06	-0.04	-0.03
å5	-0.22	-0.18	-0.1	-0.15	-0.16	-0.02	0	-0.2	-0.25	0.07
Note:
Relative cut-off value (highlighted in red) is 0.11, which is 0.2 above the average correlation.

1st contrast loadings

Code

RIloadLoc(df.omit.na)

Analysis of response categories

Code

RIitemCats(df.omit.na, items = "all")

Targeting

Code

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

Item hierarchy

Code

RIitemHierarchy(df.omit.na)

Den initiala analysen som inkluderar samtliga items från områdena ‘arbetsbelastning och krav’ och ‘återhämtning’ visar att item abk1, abk3 och å3 visar låg item fit sett till rekommenderade tröskelvärden. Därtill visar å2 en relativt låg item fit, precis över det rekommenderade trsökelvärdet. Det finns även höga residualkorrelationer mellan abk1 och abk2, abk3 och abk4, samt å2 och å3. Item abk1, abk3 och å2 tas därför bort och analysen körs igen. Eftersom å2 kan tänkas vara ett relevant item i flera branscher än å3 tas å2 bort från fortsatt analys (det är inte möjligt att arbeta i en lugnare takt efter arbetsintensiva perioder i alla branscher). Vi slår också ihop svarsalternativ 1 och 2 för abk2, som visar oordnade trösklar.

Code

# create vector with eliminated items
removed_items <- c("abk1", "abk3", "å2")

# select all items except those removed
df2 <- df.omit.na %>%
  select(!any_of(removed_items)) %>%
  mutate(
    abk2 = recode(abk2, "0=0;1=1;2=1;3=2;4=3;5=4")
  )

12.4 Rasch-analys 2

itemnr	item
abk2	Jag hinner med mina arbetsuppgifter inom min arbetstid.
abk4	Jag upplever att andras krav på mig är rimliga.
abk5	Jag kan få hjälp om min arbetsbelastning är för hög.
abk6	Mitt arbete är fritt från psykiskt påfrestande arbetsuppgifter.
å1	Jag kan använda raster till att koppla av från arbetet.
å3	Jag har tid för reflektion över hur jag har utfört arbetet.
å4	Jag har ork kvar för att göra andra saker efter arbetsdagens slut.
å5	Jag kan lägga tankar på arbetet åt sidan på min lediga tid.

Item fit

Code

RIitemfitPCM2(df2, samplesize = 250, nsamples = 32, cpu = 8)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
abk2	0.773	0.767	-2.741	-2.997
abk4	0.808	0.831	-2.24	-2.194
abk5	1.097	1.093	0.944	1.072
abk6	1.104	1.111	1.1	1.273
å1	0.932	0.889	-0.819	-1.347
å3	0.714	0.713	-3.466	-3.559
å4	0.777	0.767	-2.649	-2.833
å5	1.022	1.001	0.27	0.11

PCA

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals

Eigenvalues
1.57
1.50
1.23
1.09
0.96

Residual correlations

Code

RIresidcorr(df2, cutoff = 0.2)

	abk2	abk4	abk5	abk6	å1	å3	å4	å5
abk2
abk4	0.1
abk5	-0.08	-0.12
abk6	-0.18	0.02	-0.19
å1	-0.11	-0.24	-0.18	-0.32
å3	0.06	-0.2	-0.08	-0.23	0.07
å4	-0.17	-0.09	-0.3	-0.1	-0.09	-0.01
å5	-0.19	-0.19	-0.24	-0.11	-0.06	-0.28	0
Note:
Relative cut-off value (highlighted in red) is 0.074, which is 0.2 above the average correlation.

1st contrast loadings

Code

RIloadLoc(df2)

Targeting

Code

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

Item hierarchy

Code

RIitemHierarchy(df2)

Analysens utfall ser bra ut. Abk4 och abk2 visar en residualkorrelation strax över det rekommenderade gränsvärdet, men eftersom den är marginell går vi vidare och undersöker DIF och reliabilitet.

12.4.0.1 DIF-analysis

En DIF-analys bör inte inkludera svarskategorier med för få svar. Därför har svarskategorier med färre än 50 svar antingen exkluderas eller slagits ihop med andra svarskategorier (se avsnittet om bakgrundsdata för exakt antal svar per ordinarie kategori). DIF-variablerna omkodades till att innehålla följande kategorier:

• Kön: man, kvinna
• Ålder: 30-39, 40-49, 50-59, 60+
• Bransch: kontorsarbete, ej kontorsarbete
• Hemarbete: aldrig eller sällan, en dag, minst två dagar

Koden nedan specificerar exakt hur omkodningen gick till.

Code

# Omkodning för kön
dif.kön <- recode(dif.kön,"'Annat'=NA;'Vill ej uppge'=NA")

# Omkodning för ålder
dif.ålder <- recode(dif.ålder,"'18-29'=NA")

# Omkodning för bransch
dif.bransch <- recode(dif.bransch,"'Industri'='Ej kontorsarbete';'Hotell, restaurang, service'='Ej kontorsarbete';'Handel'='Ej kontorsarbete';'Skola, utbildning'='Ej kontorsarbete';'Vård, omsorg'='Ej kontorsarbete';'Byggverksamhet'='Ej kontorsarbete';'Annat'='Ej kontorsarbete'")

#Omkodning för hemarbete
dif.hemarbete <- recode(dif.hemarbete,"'Fem dagar'='Minst två dagar';'Fyra dagar'='Minst två dagar';'Tre dagar'='Minst två dagar';'Två dagar'='Minst två dagar'")

Gender

Code

RIdifTable(df2, dif.kön)

[1] "No significant DIF found."

Age

Code

RIdifTable(df2, dif.ålder)

[1] "No significant DIF found."

Bransch

Code

RIdifTable(df2, dif.bransch)

Item	2	3	Mean location	StDev	MaxDiff
abk2	-0.072	-0.003	-0.038	0.049	0.069
abk4	-0.493	-0.454	-0.474	0.028	0.039
abk5	-0.065	0.210	0.072	0.195	0.276
abk6	0.238	-0.074	0.082	0.221	0.312
å1	0.053	0.106	0.079	0.038	0.054
å3	0.197	0.216	0.207	0.014	0.019
å4	0.027	-0.111	-0.042	0.098	0.138
å5	0.115	0.109	0.112	0.004	0.006

Hemarbete

Code

RIdifTable(df2, dif.hemarbete)

[1] "No significant DIF found."

Inga problem i DIF-analysen baserat på kön, ålder, bransch eller hemarbete.

12.4.1 Reliability

Code

RItif(df2, lo = -5, hi = 5)

Reliabiliteten ser mycket bra ut - vi går vidare med att plocka ut item-parametrar och en konverteringstabell.

12.4.2 Item-parametrar

Code

RIitemparams(df2)

	Threshold 1	Threshold 2	Threshold 3	Threshold 4	Threshold 5	Item location
abk2	-2.22	0.46	1.38	3.16	NA	0.69
abk4	-2.34	-0.92	-0.29	1.06	2.43	-0.01
abk5	-1.43	0.30	1.29	1.61	2.25	0.8
abk6	-1.14	-0.03	0.60	1.58	3.16	0.83
å1	-1.44	0.34	0.93	1.26	2.97	0.81
å3	-1.73	0.24	1.01	2.26	2.93	0.94
å4	-1.65	-0.09	0.69	1.67	2.96	0.72
å5	-1.23	0.03	0.88	1.42	3.13	0.85

Code

#RIitemparams(df2, "itemParams_arbkrv.csv")

12.4.2.1 Ordinal -> interval

Code

RIscoreSE(df2, width = 50)

Ordinal sum score	Logit score	Logit std.error
1	-3.350	0.903
2	-2.740	0.723
3	-2.305	0.630
4	-1.958	0.571
5	-1.663	0.529
6	-1.405	0.498
7	-1.172	0.474
8	-0.960	0.453
9	-0.764	0.436
10	-0.582	0.422
11	-0.411	0.410
12	-0.249	0.399
13	-0.096	0.389
14	0.050	0.381
15	0.191	0.374
16	0.326	0.368
17	0.457	0.363
18	0.585	0.360
19	0.711	0.357
20	0.834	0.356
21	0.957	0.355
22	1.080	0.356
23	1.204	0.358
24	1.330	0.361
25	1.458	0.365
26	1.590	0.371
27	1.727	0.378
28	1.871	0.387
29	2.022	0.398
30	2.183	0.412
31	2.356	0.428
32	2.545	0.448
33	2.752	0.472
34	2.985	0.503
35	3.252	0.545
36	3.571	0.604
37	3.975	0.698
38	4.000	0.705
39	4.000	0.705

12.4.3 Estimering av mätvärden

Code

df2$score <- RIestThetas(df2)
#write.csv(df2, "arbkrv_recSCORED.csv")