5 Stöd

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")) %>% 
  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"),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"))

names(df) <- itemlabels$itemnr

5.1 Items

Code

itemlabels %>% 
  kbl_rise(width = 60)

itemnr	item
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.

5.2 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

5.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,"st")

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

names(df) <- itemlabels$itemnr

df.omit.na <- df

5.2.2 Alla svar för alla frågor

Code

RIallresp(df.omit.na)

Response category	Number of responses	Percent
Alltid	947	27.8
Mycket ofta	1149	33.8
Ganska ofta	727	21.4
Ibland	375	11.0
Sällan	146	4.3
Aldrig	58	1.7

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

5.2.3 Descriptives - all items

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, i synnerhet för item st4. Vi slår därför ihop svarskategori 0 (aldrig) och 1 (sällan) för st4.

Code

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

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

5.3 Rasch-analys 1

itemnr	item
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.

Item fit

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
st1	0.721	0.763	-2.854	-2.512
st2	0.837	0.853	-1.392	-1.449
st3	0.698	0.678	-3.334	-3.558
st4	0.961	1.013	-0.474	0.201
st5	0.905	0.876	-1.194	-1.388
st6	1.092	1.008	0.953	0.006
st7	0.961	0.907	-0.377	-1.016

PCA

Code

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

PCA of Rasch model residuals

Eigenvalues
2.15
1.37
1.05
0.96
0.84

Residual correlations

Code

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

	st1	st2	st3	st4	st5	st6	st7
st1
st2	-0.09
st3	-0.14	0.07
st4	-0.39	-0.14	0.02
st5	-0.36	-0.08	-0.01	0.37
st6	0.02	-0.29	-0.25	-0.3	-0.27
st7	0.14	-0.33	-0.26	-0.28	-0.37	-0.03
Note:
Relative cut-off value (highlighted in red) is 0.058, 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, xlim = c(-5,5))

Item hierarchy

Code

RIitemHierarchy(df.omit.na)

Den initiala analysen indikerar problem med dimensionalitet (PCA eigenvalue > 2 och en tydlig uppdelning i 1st contrast loadings).

Det finns även residualkorrelationer över rekommenderade tröskelvärden (st2 och st3, st4 och st5, samt st1 och st7).

Eftersom st4 både sticker ut både tematiskt (fokuserar på det egna beteendet till skillnad från resterande items) samt har en stark residualkorrelation med st5, tas detta item bort från vidare analys.

Flera items har problem med de lägsta svarskategorierna. Vi avvaktar lite med åtgärd.

Code

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

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

5.4 Rasch-analys 2

itemnr	item
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.
st6	Jag får tekniskt stöd vid behov.
st7	Jag kan få handledning i mitt arbete om jag behöver det.

Item fit

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
st1	0.66	0.702	-3.655	-3.208
st2	0.837	0.861	-1.548	-1.424
st3	0.719	0.72	-2.902	-2.987
st5	1.048	1.003	0.534	-0.21
st6	1.018	0.968	0.16	-0.233
st7	0.88	0.861	-1.309	-1.466

PCA

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals

Eigenvalues
1.86
1.25
1.06
0.94
0.88

Residual correlations

Code

RIresidcorr(df2, cutoff = 0.2)

	st1	st2	st3	st5	st6	st7
st1
st2	-0.15
st3	-0.19	0.07
st5	-0.35	-0.04	0.05
st6	-0.05	-0.35	-0.27	-0.24
st7	0.08	-0.39	-0.28	-0.33	-0.1
Note:
Relative cut-off value (highlighted in red) is 0.032, which is 0.2 above the average correlation.

1st contrast loadings

Code

RIloadLoc(df2)

Analysis of response categories

Code

RIitemCats(df2, items = "all")

Targeting

Code

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

Item hierarchy

Code

RIitemHierarchy(df2)

Vi har två kluster av items, ett med items 1, 6 och 7 som handlar om mera praktiskt stöd i arbetet, och ett med items 2, 3 och 5 som handlar om socialt stöd.

Eftersom st3 har något hög residualkorrelation med både st2 och st5 tar vi bort st3 från vidare analys.

Vi slår samman de två lägsta svarskategorierna för st1 eftersom de är oordnade.

Även st2 har problem, men i mitten av skalan. Vi slår därför samman svarskategori 0+1 och 2+3.

Code

# create vector with eliminated items
removed_items <- c("st4", "st3")

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

5.5 Rasch-analys 3

itemnr	item
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.
st6	Jag får tekniskt stöd vid behov.
st7	Jag kan få handledning i mitt arbete om jag behöver det.

Item fit

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
st1	0.612	0.633	-4.585	-4.364
st2	0.859	0.872	-1.336	-1.641
st5	1.065	1.033	0.865	0.206
st6	0.889	0.861	-1.17	-1.382
st7	0.765	0.749	-2.764	-2.974

PCA

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals

Eigenvalues
1.68
1.32
1.14
0.86
0.00

Residual correlations

Code

RIresidcorr(df2, cutoff = 0.2)

	st1	st2	st5	st6	st7
st1
st2	-0.05
st5	-0.35	0.03
st6	-0.13	-0.3	-0.28
st7	0.01	-0.36	-0.37	-0.21
Note:
Relative cut-off value (highlighted in red) is -0.001, which is 0.2 above the average correlation.

1st contrast loadings

Code

RIloadLoc(df2)

Analysis of response categories

Code

RIitemCats(df2, items = "all")

Targeting

Code

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

Item hierarchy

Code

RIitemHierarchy(df2)

5.5.1 Targeting

Code

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

Figur 5.1: Targeting för området Stöd

Analysen visar att st1 har en något låg item fit, men ändå över MSQ 0.6. Det finns också två residualkorrelationer som går strax över gränsvärdet, men ligger mycket nära. Vi gör inga ytterligare åtgärder.

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

[1] "No significant DIF found."

Hemarbete

Code

RIdifTable(df2, dif.hemarbete)

[1] "No significant DIF found."

Ingen DIF baserat på kön, ålder, bransch och hemarbete över rekommenderade gränsvärden.

5.7 Reliability

Code

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

Figur 5.2: Reliabilitet för området Stöd

Reliabiliteten kommer upp i önskade nivåer på vissa delar av skalan. Vi går vidare och plockar ut item-parametrar och en konverteringstabell.

5.8 Person fit

Code

RIpfit(df2)

5.9 Item-parametrar

Code

RIitemparams(df2)

	Threshold 1	Threshold 2	Threshold 3	Threshold 4	Threshold 5	Item location
st1	-0.84	-0.07	0.49	2.04	NA	0.4
st2	-1.00	1.03	1.35	NA	NA	0.46
st5	-1.99	-0.89	0.45	1.27	2.90	0.35
st6	-1.21	-0.35	0.31	1.21	2.34	0.46
st7	-0.36	0.54	0.85	1.51	2.63	1.04

5.10 Transformeringstabell

Code

RIscoreSE(df2 , width = 50)

Ordinal sum score	Logit score	Logit std.error
0	-3.575	1.503
1	-2.384	0.899
2	-1.778	0.719
3	-1.348	0.625
4	-1.007	0.567
5	-0.720	0.527
6	-0.467	0.498
7	-0.238	0.478
8	-0.025	0.463
9	0.176	0.452
10	0.369	0.446
11	0.559	0.444
12	0.747	0.445
13	0.938	0.450
14	1.135	0.460
15	1.343	0.474
16	1.568	0.496
17	1.819	0.525
18	2.107	0.567
19	2.451	0.628
20	2.889	0.725
21	3.510	0.909
22	4.000	1.107

5.10.1 Estimering av mätvärden

Code

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

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-1.7780  0.7471  1.3430  1.5359  2.1066  4.0000 

Code

ggplot(
  data = df2,
  aes(x = score, y = 0, fill = factor(score))
  ) +
  geom_dotplot(color = "white", 
                dotsize = 1,
                binwidth = 0.11) +
   # 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(-4,4)) +
  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()
  )

5.11 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(3,4), background = "lightpink") %>% 
  footnote(general_title = "Notera: ",
           "Borttagna item markerade med färg.")

itemnr	item
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.
Notera:
Borttagna item markerade med färg.

5.11.1 Förändringar i svarskategorier

Code

st1 = recode(st1, "1=0;2=1;3=2;4=3;5=4")
st2 = recode(st2, "1=0;2=1;3=1;4=2;5=3")

Test med Stöd delad i två?