8 Kunskaper och utveckling

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 = "ku")) %>% 
  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("q0011"),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("q0011"))

names(df) <- itemlabels$itemnr

8.1 Items

Code

itemlabels %>% 
  kbl_rise(width = 60)

itemnr	item
ku1	Mina kunskaper och färdigheter är till nytta i mitt arbete.
ku2	Jag har tillräckligt med kunskap/färdigheter för att kunna utföra mina arbetsuppgifter.
ku3	Jag har möjlighet att lära mig nya saker när arbetsuppgifterna kräver det.
ku4	Jag har möjlighet till långsiktig kompetensutveckling i mitt arbete.

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

8.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,"ku")

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

names(df) <- itemlabels$itemnr

df.omit.na <- df

8.2.2 Alla svar för alla frågor

Code

RIallresp(df.omit.na)

Response category	Number of responses	Percent
Alltid	619	32.6
Mycket ofta	793	41.7
Ganska ofta	282	14.8
Ibland	124	6.5
Sällan	56	2.9
Aldrig	26	1.4

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

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

Tills flera svar samlats in slår vi ihop de två lägsta svarskategorierna med varandra för ku1 och ku2.

Code

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

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

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

8.3 Rasch-analys 1

itemnr	item
ku1	Mina kunskaper och färdigheter är till nytta i mitt arbete.
ku2	Jag har tillräckligt med kunskap/färdigheter för att kunna utföra mina arbetsuppgifter.
ku3	Jag har möjlighet att lära mig nya saker när arbetsuppgifterna kräver det.
ku4	Jag har möjlighet till långsiktig kompetensutveckling i mitt arbete.

Item fit

Code

RIitemfitPCM(df.omit.na, samplesize = 250, nsamples = 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
ku1	0.857	0.887	-1.438	-1.084
ku2	0.962	0.976	-0.208	-0.06
ku3	0.512	0.502	-5.95	-6.015
ku4	0.716	0.658	-3.149	-4.046

PCA

Code

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

PCA of Rasch model residuals

Eigenvalues
2.19
1.07
0.71
0.02

Residual correlations

Code

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

	ku1	ku2	ku3	ku4
ku1
ku2	0.34
ku3	-0.36	-0.34
ku4	-0.57	-0.6	0.07
Note:
Relative cut-off value (highlighted in red) is -0.044, 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)

Det ser ut som att frågorna täcker två olika områden, ett med nuvarande kunskaper och deras koppling till arbetet, och ett med lära mig nytt och kompetensutveckling. Det finns kraftiga residualkorrelationer mellan båda paren av items. Det finns också oordnade svarskategorier för flera items.

Eftersom vi bara har fyra items är det tveksamt att det går att hitta en sammansättning med items som fungerar adekvat med detta utgångsläge. Vi provar att ta bort ett item för att testa, och väljer ku1, samt slår samman de två lägsta svarskategorierna för ku2 och ku3.

Code

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

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

8.4 Rasch-analys 2

itemnr	item
ku2	Jag har tillräckligt med kunskap/färdigheter för att kunna utföra mina arbetsuppgifter.
ku3	Jag har möjlighet att lära mig nya saker när arbetsuppgifterna kräver det.
ku4	Jag har möjlighet till långsiktig kompetensutveckling i mitt arbete.

Item fit

Code

RIitemfitPCM(df2, samplesize = 250, nsamples = 32)

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
ku2	1.102	1.137	1.025	1.353
ku3	0.359	0.382	-7.58	-8.325
ku4	0.555	0.51	-5.39	-6.33

PCA

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals

Eigenvalues
1.65
1.33
0.02

Residual correlations

Code

RIresidcorr(df2, cutoff = 0.2)

	ku2	ku3	ku4
ku2
ku3	-0.27
ku4	-0.61	-0.18
Note:
Relative cut-off value (highlighted in red) is -0.153, 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)

Problem med bl.a. trösklar och item fit kvarstår. Ytterligare item-exkluderingar leder till för få items.

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

itemnr	item
ku1	Mina kunskaper och färdigheter är till nytta i mitt arbete.
ku2	Jag har tillräckligt med kunskap/färdigheter för att kunna utföra mina arbetsuppgifter.
ku3	Jag har möjlighet att lära mig nya saker när arbetsuppgifterna kräver det.
ku4	Jag har möjlighet till långsiktig kompetensutveckling i mitt arbete.
Notera:
Borttagna item markerade med färg.

8.5.1 Förändringar i svarskategorier