13  Psykologisk trygghet, stöd och möjlighet att påverka

Explorativ analys

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 = "st|pt|mp")) %>% 
  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("q0008"), starts_with("q0013"), starts_with("q0007"),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("q0008"), starts_with("q0013"), starts_with("q0007"))

names(df) <- itemlabels$itemnr

13.1 Bakgrundsdata

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
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
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
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

13.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("st", "mp", "pt"))

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("q0008"), starts_with("q0013"), starts_with("q0007"),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("q0008"), starts_with("q0013"), starts_with("q0007"))

names(df) <- itemlabels$itemnr

df.omit.na <- df

13.1.2 Alla svar för alla frågor

Code 
RIallresp(df.omit.na)
Response category Number of responses Percent
Alltid 2468 28.2
Mycket ofta 3195 36.5
Ganska ofta 1767 20.2
Ibland 874 10.0
Sällan 346 4.0
Aldrig 109 1.2
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)))

13.1.3 Descriptives - all items

Code 
RItileplot(df.omit.na)

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

Code 
RIbarplot(df.omit.na)

Vi har väldigt få svar i lägsta kategorierna genomgående. Vi slår ihop de två lägsta svarskategorierna för samtliga items utom st2.

Code 
#Temporärt slå ihop svarskategorier så att analyserna funkar

df.omit.na$st1<-recode(df.omit.na$st1,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
#df.omit.na$st2<-recode(df.omit.na$st2,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$st3<-recode(df.omit.na$st3,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$st4<-recode(df.omit.na$st4,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$st5<-recode(df.omit.na$st5,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$st6<-recode(df.omit.na$st6,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$st7<-recode(df.omit.na$st7,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)

df.omit.na$pt1<-recode(df.omit.na$pt1,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$pt2<-recode(df.omit.na$pt2,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$pt3<-recode(df.omit.na$pt3,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$pt4<-recode(df.omit.na$pt4,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$pt5<-recode(df.omit.na$pt5,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$pt6<-recode(df.omit.na$pt6,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$pt7<-recode(df.omit.na$pt7,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)

df.omit.na$mp1<-recode(df.omit.na$mp1,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$mp2<-recode(df.omit.na$mp2,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$mp3<-recode(df.omit.na$mp3,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$mp4<-recode(df.omit.na$mp4,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)
df.omit.na$mp5<-recode(df.omit.na$mp5,"0=0;1=0;2=1;3=2;4=3;5=4",as.factor=FALSE)

13.2 Rasch-analys 1

itemnr item
mp1 Jag har de resurser som behövs för att kunna utföra mina arbetsuppgifter.
mp2 Jag kan prioritera i vilken ordning mina arbetsuppgifter ska utföras.
mp3 Jag har tillräckligt med befogenheter för att kunna utföra mina arbetsuppgifter.
mp4 Jag kan påverka beslut som rör mina arbetsuppgifter.
mp5 Jag kan själv bestämma min arbetstakt.
st1 Jag vet vem jag ska vända mig till för att få stöd och hjälp med att utföra arbetet.
st2 Det finns personer på mitt arbete som jag kan prata förtroligt med.
st3 Vi samarbetar bra på min arbetsplats.
st4 Jag visar uppskattning till mina kollegor för deras arbetsinsatser.
st5 Mina kollegor visar uppskattning för mina arbetsinsatser.
st6 Jag får tekniskt stöd vid behov.
st7 Jag kan få handledning i mitt arbete om jag behöver det.
pt1 Jag har en positiv känsla när jag kommer till jobbet.
pt2 Jag känner mig delaktig i gemenskapen på min arbetsplats.
pt3 Jag kan begå misstag utan att det hålls emot mig.
pt4 Jag kan öppet diskutera olika typer av svårigheter.
pt5 Jag blir inkluderad även om jag tycker annorlunda.
pt6 Mina ansträngningar värdesätts.
pt7 Mina idéer ges tid och uppmärksamhet.
Code 
RIitemfitPCM2(df.omit.na, samplesize = 250, nsamples = 32, cpu = 8)
OutfitMSQ InfitMSQ OutfitZSTD InfitZSTD
mp1 0.889 0.933 -0.883 -0.65
mp2 1.059 1.048 0.501 0.321
mp3 0.749 0.738 -2.529 -3.176
mp4 1.148 1.215 1.415 2.054
mp5 1.14 1.083 1.377 0.884
st1 1.358 1.239 3.482 2.542
st2 1.348 1.291 3.051 2.987
st3 0.776 0.764 -2.261 -2.642
st4 0.826 0.812 -1.412 -1.932
st5 0.961 0.877 -0.391 -1.152
st6 0.787 0.777 -2.132 -2.567
st7 0.668 0.703 -3.349 -3.351
pt1 0.702 0.717 -2.9 -3.239
pt2 0.637 0.635 -4.085 -4.399
pt3 0.961 0.96 -0.652 -0.293
pt4 1.117 1.132 1.231 1.259
pt5 0.947 0.952 -0.496 -0.369
pt6 0.961 0.944 -0.288 -0.498
pt7 1.351 1.299 3.443 2.971
Code 
RIpcmPCA(na.omit(df.omit.na))
PCA of Rasch model residuals
Eigenvalues
3.18
2.07
1.72
1.45
1.30
Code 
RIresidcorr(df.omit.na, cutoff = 0.2)
mp1 mp2 mp3 mp4 mp5 st1 st2 st3 st4 st5 st6 st7 pt1 pt2 pt3 pt4 pt5 pt6 pt7
mp1
mp2 0.03
mp3 -0.08 0.16
mp4 -0.19 0.04 0.12
mp5 -0.17 0.08 0.05 0.46
st1 0.14 -0.11 -0.16 -0.11 -0.08
st2 0.3 -0.07 -0.11 -0.05 -0.1 0.16
st3 -0.1 -0.12 0 -0.16 -0.19 -0.11 -0.16
st4 -0.22 -0.03 0.07 -0.09 -0.03 -0.19 -0.25 0.31
st5 -0.14 -0.06 -0.04 -0.16 -0.13 -0.11 -0.22 0.03 0.2
st6 -0.12 0.04 0.06 -0.13 -0.16 -0.18 -0.24 0.06 0.16 0.35
st7 -0.14 0.04 0.08 -0.14 -0.08 -0.24 -0.26 0.02 0.31 0.38 0.44
pt1 -0.11 -0.06 -0.11 -0.08 0.14 -0.27 -0.23 0.04 0.11 0.05 0.16 0.25
pt2 -0.14 -0.12 -0.09 -0.12 -0.02 -0.23 -0.2 0.07 0.13 0 0.12 0.23 0.48
pt3 0.07 -0.11 -0.08 -0.14 -0.18 0.08 0.01 -0.08 -0.27 -0.16 -0.22 -0.23 -0.12 -0.04
pt4 -0.16 -0.18 -0.05 0.04 -0.07 -0.03 -0.08 -0.11 -0.22 -0.12 -0.24 -0.32 -0.23 -0.18 0.14
pt5 -0.07 -0.21 -0.07 -0.06 -0.15 -0.01 -0.1 0.02 -0.04 -0.16 -0.24 -0.14 -0.12 -0.04 0.02 0.13
pt6 -0.02 -0.24 -0.14 -0.13 -0.23 -0.07 -0.06 0 -0.18 -0.22 -0.15 -0.19 -0.12 0 0.05 0.13 0.37
pt7 -0.03 -0.14 -0.22 -0.15 -0.16 0.02 0 -0.1 -0.28 -0.15 -0.25 -0.34 -0.22 -0.23 0.22 0.35 -0.01 0.22
Note:
Relative cut-off value (highlighted in red) is 0.15, which is 0.2 above the average correlation.
Code 
RIloadLoc(df.omit.na)

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

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

Code 
RIitemHierarchy(df.omit.na)

Analysens utfall indikerar flertalet psykometriska problem, vi börjar med att ta bort st7, pt1 och pt2 som visar låg item fit och residualkorrelationer.

Code 
# create vector with eliminated items
removed_items <- c("st7", "pt1", "pt2")

# select all items except those removed
df2 <- df.omit.na %>%
  select(!all_of(removed_items))

13.3 Rasch-analys 2

itemnr item
mp1 Jag har de resurser som behövs för att kunna utföra mina arbetsuppgifter.
mp2 Jag kan prioritera i vilken ordning mina arbetsuppgifter ska utföras.
mp3 Jag har tillräckligt med befogenheter för att kunna utföra mina arbetsuppgifter.
mp4 Jag kan påverka beslut som rör mina arbetsuppgifter.
mp5 Jag kan själv bestämma min arbetstakt.
st1 Jag vet vem jag ska vända mig till för att få stöd och hjälp med att utföra arbetet.
st2 Det finns personer på mitt arbete som jag kan prata förtroligt med.
st3 Vi samarbetar bra på min arbetsplats.
st4 Jag visar uppskattning till mina kollegor för deras arbetsinsatser.
st5 Mina kollegor visar uppskattning för mina arbetsinsatser.
st6 Jag får tekniskt stöd vid behov.
pt3 Jag kan begå misstag utan att det hålls emot mig.
pt4 Jag kan öppet diskutera olika typer av svårigheter.
pt5 Jag blir inkluderad även om jag tycker annorlunda.
pt6 Mina ansträngningar värdesätts.
pt7 Mina idéer ges tid och uppmärksamhet.
Code 
RIitemfitPCM2(df2, samplesize = 250, nsamples = 32, cpu = 8)
OutfitMSQ InfitMSQ OutfitZSTD InfitZSTD
mp1 0.817 0.865 -1.686 -1.596
mp2 0.989 0.994 0.07 -0.209
mp3 0.712 0.703 -3.151 -3.516
mp4 1.086 1.144 0.83 1.513
mp5 1.137 1.055 1.583 0.538
st1 1.211 1.107 2.141 1.235
st2 1.186 1.146 1.78 1.592
st3 0.764 0.749 -2.532 -2.688
st4 0.854 0.835 -1.32 -1.75
st5 0.962 0.886 -0.372 -1.309
st6 0.825 0.817 -1.659 -1.973
pt3 0.896 0.892 -1.215 -1.137
pt4 1.005 1.021 -0.138 0.438
pt5 0.873 0.891 -1.334 -1.016
pt6 0.886 0.88 -1.271 -1.351
pt7 1.2 1.157 2.008 1.422
Code 
RIpcmPCA(na.omit(df2))
PCA of Rasch model residuals
Eigenvalues
2.55
1.97
1.74
1.29
1.15
Code 
RIresidcorr(df2, cutoff = 0.2)
mp1 mp2 mp3 mp4 mp5 st1 st2 st3 st4 st5 st6 pt3 pt4 pt5 pt6 pt7
mp1
mp2 0.02
mp3 -0.09 0.16
mp4 -0.22 0.02 0.11
mp5 -0.18 0.08 0.06 0.45
st1 0.1 -0.15 -0.2 -0.15 -0.1
st2 0.27 -0.1 -0.14 -0.08 -0.12 0.11
st3 -0.09 -0.11 0.02 -0.17 -0.16 -0.13 -0.18
st4 -0.19 0.01 0.1 -0.07 0.01 -0.19 -0.25 0.35
st5 -0.13 -0.03 -0.01 -0.15 -0.1 -0.12 -0.22 0.07 0.25
st6 -0.08 0.09 0.11 -0.11 -0.11 -0.17 -0.22 0.12 0.23 0.4
pt3 0.05 -0.12 -0.09 -0.16 -0.18 0.04 -0.03 -0.08 -0.24 -0.15 -0.19
pt4 -0.21 -0.21 -0.09 0 -0.09 -0.09 -0.14 -0.13 -0.22 -0.13 -0.23 0.1
pt5 -0.09 -0.22 -0.08 -0.09 -0.15 -0.05 -0.14 0.03 -0.01 -0.14 -0.2 -0.01 0.1
pt6 -0.04 -0.26 -0.15 -0.15 -0.23 -0.11 -0.11 0 -0.15 -0.2 -0.11 0.03 0.1 0.36
pt7 -0.08 -0.18 -0.26 -0.2 -0.19 -0.04 -0.07 -0.12 -0.28 -0.16 -0.25 0.19 0.31 -0.05 0.18
Note:
Relative cut-off value (highlighted in red) is 0.139, which is 0.2 above the average correlation.
Code 
RIloadLoc(df2)

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

Code 
RIitemHierarchy(df2)

Vi tar också bort st6, mp5, mp2 och st4 som har residualkorrelationer och sticker ut tematiskt.

Code 
# create vector with eliminated items OBS testa att byt till pt7
removed_items <- c("st7", "pt1", "pt2", "st6", "mp5", "mp2", "st4")

# select all items except those removed
df2 <- df.omit.na %>%
  select(!all_of(removed_items))

13.4 Rasch-analys 3

itemnr item
mp1 Jag har de resurser som behövs för att kunna utföra mina arbetsuppgifter.
mp3 Jag har tillräckligt med befogenheter för att kunna utföra mina arbetsuppgifter.
mp4 Jag kan påverka beslut som rör mina arbetsuppgifter.
st1 Jag vet vem jag ska vända mig till för att få stöd och hjälp med att utföra arbetet.
st2 Det finns personer på mitt arbete som jag kan prata förtroligt med.
st3 Vi samarbetar bra på min arbetsplats.
st5 Mina kollegor visar uppskattning för mina arbetsinsatser.
pt3 Jag kan begå misstag utan att det hålls emot mig.
pt4 Jag kan öppet diskutera olika typer av svårigheter.
pt5 Jag blir inkluderad även om jag tycker annorlunda.
pt6 Mina ansträngningar värdesätts.
pt7 Mina idéer ges tid och uppmärksamhet.
Code 
RIitemfitPCM2(df2, samplesize = 250, nsamples = 32, cpu = 8)
OutfitMSQ InfitMSQ OutfitZSTD InfitZSTD
mp1 0.774 0.83 -2.367 -1.908
mp3 0.8 0.788 -2.042 -2.378
mp4 1.245 1.226 2.369 2.242
st1 1.109 1.038 0.964 0.43
st2 1.059 1.051 0.607 0.664
st3 0.82 0.798 -1.909 -2.116
st5 1.088 0.999 0.909 -0.197
pt3 0.812 0.812 -2.341 -1.949
pt4 0.915 0.933 -0.783 -0.809
pt5 0.802 0.826 -1.99 -1.898
pt6 0.787 0.793 -2.349 -2.359
pt7 1.063 1.028 0.773 0.262
Code 
RIpcmPCA(na.omit(df2))
PCA of Rasch model residuals
Eigenvalues
1.99
1.70
1.34
1.21
1.05
Code 
RIresidcorr(df2, cutoff = 0.2)
mp1 mp3 mp4 st1 st2 st3 st5 pt3 pt4 pt5 pt6 pt7
mp1
mp3 -0.06
mp4 -0.2 0.17
st1 0.05 -0.18 -0.14
st2 0.23 -0.13 -0.07 0.03
st3 -0.08 0.1 -0.1 -0.14 -0.19
st5 -0.09 0.1 -0.07 -0.1 -0.2 0.15
pt3 -0.02 -0.09 -0.16 -0.04 -0.13 -0.1 -0.14
pt4 -0.3 -0.09 0 -0.18 -0.25 -0.16 -0.13 0.02
pt5 -0.16 -0.07 -0.08 -0.12 -0.23 0.02 -0.12 -0.09 0.02
pt6 -0.11 -0.15 -0.16 -0.21 -0.22 -0.01 -0.19 -0.06 0.01 0.31
pt7 -0.17 -0.27 -0.21 -0.14 -0.18 -0.16 -0.17 0.1 0.24 -0.15 0.09
Note:
Relative cut-off value (highlighted in red) is 0.119, which is 0.2 above the average correlation.
Code 
RIloadLoc(df2)

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

Code 
RIitemHierarchy(df2)

Vi tar också bort pt7, mp1 och st3 som har höga residualkorrelationer.

Code 
# create vector with eliminated items OBS testa att byt till pt7
removed_items <- c("st7", "pt1", "pt2", "st6", "mp5", "mp2", "st4", "pt7", "mp1", "st3")

# select all items except those removed
df2 <- df.omit.na %>%
  select(!all_of(removed_items))

13.5 Rasch-analys 4

itemnr item
mp3 Jag har tillräckligt med befogenheter för att kunna utföra mina arbetsuppgifter.
mp4 Jag kan påverka beslut som rör mina arbetsuppgifter.
st1 Jag vet vem jag ska vända mig till för att få stöd och hjälp med att utföra arbetet.
st2 Det finns personer på mitt arbete som jag kan prata förtroligt med.
st5 Mina kollegor visar uppskattning för mina arbetsinsatser.
pt3 Jag kan begå misstag utan att det hålls emot mig.
pt4 Jag kan öppet diskutera olika typer av svårigheter.
pt5 Jag blir inkluderad även om jag tycker annorlunda.
pt6 Mina ansträngningar värdesätts.
Code 
RIitemfitPCM2(df2, samplesize = 250, nsamples = 32, cpu = 8)
OutfitMSQ InfitMSQ OutfitZSTD InfitZSTD
mp3 0.764 0.741 -2.448 -2.991
mp4 1.129 1.128 1.338 1.218
st1 1.027 0.987 0.399 -0.192
st2 1.034 1.014 0.301 0.152
st5 1.029 0.975 0.449 -0.22
pt3 0.811 0.81 -2.094 -2.219
pt4 0.92 0.905 -1.002 -0.932
pt5 0.766 0.773 -2.572 -2.377
pt6 0.792 0.79 -2.293 -2.424
Code 
RIpcmPCA(na.omit(df2))
PCA of Rasch model residuals
Eigenvalues
1.73
1.51
1.16
1.15
1.01
Code 
RIresidcorr(df2, cutoff = 0.2)
mp3 mp4 st1 st2 st5 pt3 pt4 pt5 pt6
mp3
mp4 0.12
st1 -0.21 -0.2
st2 -0.15 -0.13 0.01
st5 0.08 -0.12 -0.12 -0.21
pt3 -0.09 -0.2 -0.04 -0.12 -0.13
pt4 -0.12 -0.05 -0.2 -0.26 -0.14 0.03
pt5 -0.1 -0.15 -0.15 -0.26 -0.14 -0.09 0
pt6 -0.15 -0.2 -0.21 -0.21 -0.18 -0.04 0.01 0.3
Note:
Relative cut-off value (highlighted in red) is 0.094, which is 0.2 above the average correlation.
Code 
RIloadLoc(df2)

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

Code 
RIitemHierarchy(df2)

Vi tar även bort pt6 som har en hög residualkorrelation med pt5.

Code 
# create vector with eliminated items OBS testa att byt till pt7
removed_items <- c("st7", "pt1", "pt2", "st6", "mp5", "mp2", "st4", "pt7", "mp1", "st3", "pt6")

# select all items except those removed
df2 <- df.omit.na %>%
  select(!all_of(removed_items))

13.6 Rasch-analys 5

itemnr item
mp3 Jag har tillräckligt med befogenheter för att kunna utföra mina arbetsuppgifter.
mp4 Jag kan påverka beslut som rör mina arbetsuppgifter.
st1 Jag vet vem jag ska vända mig till för att få stöd och hjälp med att utföra arbetet.
st2 Det finns personer på mitt arbete som jag kan prata förtroligt med.
st5 Mina kollegor visar uppskattning för mina arbetsinsatser.
pt3 Jag kan begå misstag utan att det hålls emot mig.
pt4 Jag kan öppet diskutera olika typer av svårigheter.
pt5 Jag blir inkluderad även om jag tycker annorlunda.
Code 
RIitemfitPCM2(df2, samplesize = 250, nsamples = 32, cpu = 8)
OutfitMSQ InfitMSQ OutfitZSTD InfitZSTD
mp3 0.718 0.706 -3.23 -3.512
mp4 1.073 1.083 0.898 0.819
st1 0.957 0.933 -0.539 -0.888
st2 0.954 0.95 -0.423 -0.597
st5 0.971 0.927 -0.14 -0.676
pt3 0.796 0.795 -2.469 -2.29
pt4 0.945 0.902 -0.445 -0.998
pt5 0.849 0.824 -1.733 -1.85
Code 
RIpcmPCA(na.omit(df2))
PCA of Rasch model residuals
Eigenvalues
1.55
1.42
1.19
1.04
1.02
Code 
RIresidcorr(df2, cutoff = 0.2)
mp3 mp4 st1 st2 st5 pt3 pt4 pt5
mp3
mp4 0.1
st1 -0.25 -0.24
st2 -0.18 -0.16 -0.02
st5 0.06 -0.15 -0.15 -0.25
pt3 -0.1 -0.22 -0.05 -0.13 -0.14
pt4 -0.12 -0.06 -0.21 -0.27 -0.15 0.04
pt5 -0.07 -0.13 -0.12 -0.23 -0.12 -0.05 0.04
Note:
Relative cut-off value (highlighted in red) is 0.081, which is 0.2 above the average correlation.
Code 
RIloadLoc(df2)

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

Code 
RIitemHierarchy(df2)

Det ser generellt bra ut. mp3 och mp4 har en något hög residualkorrelation, men eftersom denna ligger strax över tröskelvärdet är det oklart om ytterligare en item-exkludering är motiverad. Till att börja med går vi vidare och undersöker hur DIF och reliabilitet ser ut när mp3 och mp4 inkluderas.

13.6.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'")
Code 
RIdifTable(df2, dif.kön)
[1] "No significant DIF found."
Code 
RIdifTable(df2, dif.ålder)
[1] "No significant DIF found."
Code 
RIdifTable(df2, dif.bransch)
[1] "No significant DIF found."
Code 
RIdifTable(df2, dif.hemarbete)

Item 2 3 Mean location StDev MaxDiff
mp3 -0.302 -0.121 -0.211 0.128 0.182
mp4 -0.324 0.115 -0.105 0.310 0.439
st1 0.154 0.292 0.223 0.098 0.138
st2 0.324 0.324 0.324 0.000 0.000
st5 -0.113 -0.019 -0.066 0.067 0.095
pt3 0.351 0.164 0.257 0.133 0.187
pt4 0.041 -0.320 -0.139 0.255 0.361
pt5 -0.131 -0.435 -0.283 0.215 0.304

Det finns en signifikant och hyfsat substatiell DIF för hemarbete (mp4). Vi går vidare och undersöker reliabiliteten.

13.6.0.2 Reliability

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

Reliabiliteten ser mycket bra ut. Dock har mp4 både en substantiell DIF-effekt samt en något hög residualkorrelation med mp3. Vi testar därför att exkludera mp4.

Code 
# create vector with eliminated items OBS testa att byt till pt7
removed_items <- c("st6", "st7", "mp5", "mp2", "st4", "pt7", "pt1", "pt6", "pt2", "st3", "mp1", "mp4")

# select all items except those removed
df2 <- df.omit.na %>%
  select(!all_of(removed_items))

13.7 Rasch-analys 6

itemnr item
mp3 Jag har tillräckligt med befogenheter för att kunna utföra mina arbetsuppgifter.
st1 Jag vet vem jag ska vända mig till för att få stöd och hjälp med att utföra arbetet.
st2 Det finns personer på mitt arbete som jag kan prata förtroligt med.
st5 Mina kollegor visar uppskattning för mina arbetsinsatser.
pt3 Jag kan begå misstag utan att det hålls emot mig.
pt4 Jag kan öppet diskutera olika typer av svårigheter.
pt5 Jag blir inkluderad även om jag tycker annorlunda.
Code 
RIitemfitPCM2(df2, samplesize = 250, nsamples = 32, cpu = 8)
OutfitMSQ InfitMSQ OutfitZSTD InfitZSTD
mp3 0.779 0.762 -2.362 -2.683
st1 0.943 0.918 -0.637 -0.953
st2 0.962 0.954 -0.401 -0.447
st5 0.984 0.938 -0.161 -0.609
pt3 0.775 0.782 -2.524 -2.582
pt4 0.963 0.93 -0.43 -0.717
pt5 0.849 0.838 -1.581 -1.813
Code 
RIpcmPCA(na.omit(df2))
PCA of Rasch model residuals
Eigenvalues
1.52
1.36
1.13
1.08
0.96
Code 
RIresidcorr(df2, cutoff = 0.2)
mp3 st1 st2 st5 pt3 pt4 pt5
mp3
st1 -0.25
st2 -0.17 -0.06
st5 0.06 -0.19 -0.28
pt3 -0.11 -0.1 -0.17 -0.18
pt4 -0.11 -0.24 -0.28 -0.16 0.02
pt5 -0.07 -0.16 -0.25 -0.14 -0.08 0.03
Note:
Relative cut-off value (highlighted in red) is 0.062, which is 0.2 above the average correlation.
Code 
RIloadLoc(df2)

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

Code 
RIitemHierarchy(df2)

Analysernas utfall ser bra ut - det finns inte längre någon residualkorrelation över det rekommenderade tröskelvärdet. Vi går vidare och undersöker DIF och reliabilitet utan mp4.

13.7.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'")
Code 
RIdifTable(df2, dif.kön)
[1] "No significant DIF found."
Code 
RIdifTable(df2, dif.ålder)
[1] "No significant DIF found."
Code 
RIdifTable(df2, dif.bransch)
[1] "No significant DIF found."
Code 
RIdifTable(df2, dif.hemarbete)
[1] "No significant DIF found."

Det finns inte längre några signifikanta DIF-effekter. Vi går vidare och undersöker reliabiliteten.

13.7.0.2 Reliability

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

Reliabiliteten ser bra ut även utan mp4 (en marginell minsking). Vi går vidare och tar fram item-parametrar och en konverteringstabell.

13.7.1 Item-parametrar

Code 
RIitemparams(df2)
Threshold 1 Threshold 2 Threshold 3 Threshold 4 Threshold 5 Item location
mp3 -1.08 -0.40 0.35 1.95 NA 0.2
st1 -0.35 0.04 0.97 1.96 NA 0.65
st2 -0.59 0.36 0.61 1.19 2.24 0.76
st5 -0.70 0.02 0.32 1.79 NA 0.36
pt3 -0.82 -0.20 0.75 3.09 NA 0.71
pt4 -1.19 -0.30 0.41 2.49 NA 0.35
pt5 -0.71 -0.71 0.15 1.94 NA 0.17

13.7.1.1 Ordinal -> interval

Code 
RIscoreSE(df2, width = 50)
Ordinal sum score Logit score Logit std.error
0 -3.451 1.408
1 -2.365 0.818
2 -1.860 0.640
3 -1.523 0.549
4 -1.264 0.494
5 -1.050 0.456
6 -0.864 0.429
7 -0.696 0.410
8 -0.542 0.396
9 -0.396 0.386
10 -0.257 0.378
11 -0.122 0.374
12 0.011 0.371
13 0.143 0.370
14 0.275 0.372
15 0.409 0.375
16 0.546 0.380
17 0.688 0.387
18 0.837 0.396
19 0.995 0.408
20 1.164 0.424
21 1.348 0.442
22 1.551 0.465
23 1.777 0.493
24 2.035 0.528
25 2.333 0.573
26 2.690 0.636
27 3.139 0.733
28 3.772 0.917
29 4.000 1.002

13.7.2 Estimering av mätvärden

Code 
df2$score <- RIestThetas(df2)
write.csv(df2, "scored.csv")