Prevents enkät för organisatorisk och social arbetsmiljö

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 = "ls")) %>% 
  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("q0010"),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("q0010"))

names(df) <- itemlabels$itemnr

7.1 Items

Code

itemlabels %>% 
  kbl_rise(width = 60)

itemnr	item
ls1	Min chef ger mig återkoppling på hur jag utför arbetet.
ls2	Min chef har en god uppfattning om min arbetsbelastning.
ls3	Min chef agerar om jag har allt för mycket arbete att utföra.
ls4	Min chef ser till att alla kommer till tals.
ls5	Min chef hanterar konflikter på ett bra sätt.
ls6	Min chef och jag har tillräckligt med avstämningar.

7.2 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

7.2.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,"ls")

Vi har extremt 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("q0010"),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("q0010"))

names(df) <- itemlabels$itemnr

df.omit.na <- df

7.2.2 Alla svar för alla frågor

Code

RIallresp(df.omit.na)

Response category	Number of responses	Percent
Alltid	497	17.4
Mycket ofta	712	24.9
Ganska ofta	665	23.2
Ibland	494	17.3
Sällan	347	12.1
Aldrig	147	5.1

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

7.2.3 Descriptives - all items

Code

RItileplot(df.omit.na)

Code

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

Code

RIbarplot(df.omit.na)

Vi har tillräckligt många svar för samtliga svarskategorier och items så vi går vidare och utför analysen.

7.3 Rasch-analys 1

itemnr	item
ls1	Min chef ger mig återkoppling på hur jag utför arbetet.
ls2	Min chef har en god uppfattning om min arbetsbelastning.
ls3	Min chef agerar om jag har allt för mycket arbete att utföra.
ls4	Min chef ser till att alla kommer till tals.
ls5	Min chef hanterar konflikter på ett bra sätt.
ls6	Min chef och jag har tillräckligt med avstämningar.

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
ls1	0.815	0.772	-2.211	-2.681
ls2	0.754	0.764	-3.148	-2.947
ls3	0.87	0.832	-1.36	-1.909
ls4	0.821	0.853	-1.866	-1.575
ls5	0.926	0.932	-0.639	-0.718
ls6	0.929	0.97	-0.6	-0.26

Code

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

PCA of Rasch model residuals
Eigenvalues
1.92
1.38
0.99
0.93
0.77

Code

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

	ls1	ls2	ls3	ls4	ls5
ls1
ls2	0.03
ls3	-0.09	0.09
ls4	-0.36	-0.32	-0.27
ls5	-0.35	-0.41	-0.29	0.23
ls6	-0.03	-0.18	-0.33	-0.26	-0.25
Note:
Relative cut-off value (highlighted in red) is 0.013, 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)

Överlag ser analysens utfall bra ut. Dock finns det en residualkorrelation mellan ls4 och ls5 klart över rekommenderade gränsvärden. Vi testar att ta bort ls4 från vidare analys.

Code

# create vector with eliminated items
removed_items <- c("ls4")

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

7.4 Rasch-analys 2

itemnr	item
ls1	Min chef ger mig återkoppling på hur jag utför arbetet.
ls2	Min chef har en god uppfattning om min arbetsbelastning.
ls3	Min chef agerar om jag har allt för mycket arbete att utföra.
ls5	Min chef hanterar konflikter på ett bra sätt.
ls6	Min chef och jag har tillräckligt med avstämningar.

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
ls1	0.718	0.688	-3.457	-3.89
ls2	0.68	0.691	-3.905	-3.643
ls3	0.796	0.773	-2.427	-2.823
ls5	1.056	1.055	0.602	0.755
ls6	0.869	0.909	-1.179	-1.094

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals
Eigenvalues
1.55
1.40
1.07
0.96
0.01

Code

RIresidcorr(df2, cutoff = 0.2)

	ls1	ls2	ls3	ls5
ls1
ls2	-0.07
ls3	-0.19	0.01
ls5	-0.34	-0.38	-0.26
ls6	-0.12	-0.28	-0.43	-0.22
Note:
Relative cut-off value (highlighted in red) is -0.027, 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)

7.4.1 Targeting

Code

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

Figur 7.1: Targeting för området Ledarskap

Förutom en något låg item fit för ls2 ser analysens utfall bra ut. Vi går vidare med att undersöka DIF och reliabilitet.

7.5 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 verkar finnas mindre DIF-effekter baserade på ålder och kön. Dock är skillnaden i item location inte tillräckligt stor (enligt rekommenderade tröskelvärden) för att motivera exkludering av items. Vi går vidare och undersöker reliabilitet.

7.6 Reliability

Code

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

Figur 7.2: Reliabilitet för området Ledarskap

7.7 Person fit

Code

RIpfit(df2)

7.8 Item-parametrar

Code

RIitemparams(df2)

	Threshold 1	Threshold 2	Threshold 3	Threshold 4	Threshold 5	Item location
ls1	-2.02	-0.15	0.79	2.23	4.20	1.01
ls2	-1.73	-0.14	0.48	1.60	4.14	0.87
ls3	-1.77	0.37	1.24	2.19	3.41	1.09
ls5	-1.29	-0.28	0.69	1.61	3.06	0.76
ls6	-1.71	-0.40	0.27	1.14	2.27	0.31

Code

#RIitemparams(df2, "itemParams_ldrskp.csv")

7.9 Transformeringstabell

Code

RIscoreSE(df2, width = 50, score_range = c(-3,5))

Ordinal sum score	Logit score	Logit std.error
0	-3.000	0.982
2	-2.208	0.753
3	-1.734	0.660
4	-1.350	0.602
5	-1.021	0.560
6	-0.732	0.529
7	-0.471	0.506
8	-0.232	0.489
9	-0.006	0.477
10	0.210	0.470
11	0.421	0.465
12	0.629	0.465
13	0.840	0.467
14	1.054	0.473
15	1.275	0.482
16	1.507	0.494
17	1.754	0.510
18	2.019	0.531
19	2.311	0.558
20	2.637	0.593
21	3.009	0.639
22	3.449	0.702
23	3.989	0.798
24	4.714	0.980
25	5.000	1.077

7.9.1 Estimering av mätvärden

Code

df2$score <- RIestThetas(df2, theta_range = c(-3,5))
write.csv(df2, "scored.csv")
summary(df2$score)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-3.0000  0.2101  1.2752  1.3885  2.3109  5.0000

Code

ggplot(
  data = df2,
  aes(x = score, y = 0, fill = factor(score))
  ) +
  geom_dotplot(color = "white", 
                dotsize = 1,
                binwidth = 0.13) +
   # plot mean value
  geom_point(
    aes(
      x = mean(score),
      y = 0
    ),
    size = 6,
    shape = 18,
    color = "black"
  ) +
    # errorbar has brackets at the endpoints
  geom_errorbar(
    aes(
      xmin = mean(score) - sd(score),
      xmax = mean(score) + sd(score),
      y = 0,
      width = 0.025
    ),
    color = "black"
  ) +
  theme_minimal(base_family = "Lato") +
  theme_rise() +
  coord_cartesian(xlim = c(-3,5)) +
  scale_color_viridis_d("Antal svar",
    begin = 0.2,
    aesthetics = c("fill", "color"),
    guide = "none"
  ) +
  labs(
    title = "Mätvärden",
    subtitle = "Värden längre till höger är bättre",
    caption = "Svart diamant indikerar medelvärde, strecken runt indikerar en standardavvikelse.",
    y = "Antal respondenter",
    x = "Mätvärden"
  ) +
  theme(
    #axis.text.x = element_blank(), # remove text from both axes
    axis.text.y = element_blank()
  )

7.10 Rekommenderade items

Code

itemlabels %>% 
  filter(itemnr %in% names(df2)) %>% 
  write_csv("finalItems.csv")

itemlabels %>% 
  filter(!itemnr %in% names(df2)) %>% 
  write_csv("removedItems.csv")

itemlabels %>% 
  kbl_rise(width = 50,
           options = "hover") %>% 
  row_spec(c(4), background = "lightpink") %>% 
  footnote(general_title = "Notera: ",
           "Borttagna item markerade med färg.")

itemnr	item
ls1	Min chef ger mig återkoppling på hur jag utför arbetet.
ls2	Min chef har en god uppfattning om min arbetsbelastning.
ls3	Min chef agerar om jag har allt för mycket arbete att utföra.
ls4	Min chef ser till att alla kommer till tals.
ls5	Min chef hanterar konflikter på ett bra sätt.
ls6	Min chef och jag har tillräckligt med avstämningar.
Notera:
Borttagna item markerade med färg.

7 Ledarskap

7.1 Items

7.2 Bakgrundsdata

7.2.1 Svarsbortfall items

7.2.2 Alla svar för alla frågor

7.2.3 Descriptives - all items

7.3 Rasch-analys 1

7.4 Rasch-analys 2

7.4.1 Targeting

7.5 DIF-analysis

7.6 Reliability

7.7 Person fit

7.8 Item-parametrar

7.9 Transformeringstabell

7.9.1 Estimering av mätvärden

7.10 Rekommenderade items

7.10.1 Förändringar i svarskategorier