9 Kränkande beteenden

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 = "kb")) %>% 
  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("q0012"),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("q0012"))

names(df) <- itemlabels$itemnr

9.1 Items

Code

itemlabels %>% 
  kbl_rise(width = 50)

itemnr	item
kb1	Blivit utsatt för att någon undanhåller information som har påverkat din prestation.
kb2	Blivit utsatt för skvaller eller rykten spridda om dig.
kb3	Blivit ignorerad eller exkluderad.
kb4	Fått kränkande eller stötande kommentarer om dig som person, dina attityder eller ditt privatliv.
kb5	Blivit utskälld eller varit föremål för andras aggressiva utbrott.
kb6	Blivit påmind om dina felsteg eller misstag.
kb7	Blivit utsatt för ett otrevligt bemötande när du närmar dig andra.

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

9.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,"kb")

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

names(df) <- itemlabels$itemnr

df.omit.na <- df

9.2.2 Alla svar för alla frågor

Code

RIallresp(df.omit.na)

Response category	Number of responses	Percent
Aldrig	2060	62.3
Det har hänt	1077	32.6
Varje månad	88	2.7
Varje vecka	57	1.7
Dagligen	22	0.7

Det är tveksamt om området kränkande beteenden är lämpat för att utgöra ett index. Rimligen är det förhållandevis få personer som blivit utsatta för kränkningarna som ingår i skalan, vilket påverkar de psykometriska egenskaperna. Analysen utförs dock ändå i explorativt syfte.

Code

# koda om svarskategorier till siffror
df.omit.na <- df.omit.na %>% 
  mutate(across(everything(), ~ car::recode(.x,"'Aldrig'=0;
                                            'Det har hänt' =1;
                                            'Varje månad'=2;
                                            'Varje vecka'=3;
                                            'Dagligen'=4",
                                            as.factor = FALSE)))

9.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 högsta kategorierna, vilket kan bero på underlaget, och/eller att förekomsten är låg. Vi slår ihop de högsta två svarsalternativen (dagligen och varje vecka) för att kunna utföra analysen.

Code

#Temporärt slå ihop svarskategorier så att analyserna funkar
df.omit.na <- df.omit.na %>% 
  mutate(across(everything(), ~ recode(.x,"4=3"))) # Slå ihop svarskategorier

9.3 Rasch-analys 1

itemnr	item
kb1	Blivit utsatt för att någon undanhåller information som har påverkat din prestation.
kb2	Blivit utsatt för skvaller eller rykten spridda om dig.
kb3	Blivit ignorerad eller exkluderad.
kb4	Fått kränkande eller stötande kommentarer om dig som person, dina attityder eller ditt privatliv.
kb5	Blivit utskälld eller varit föremål för andras aggressiva utbrott.
kb6	Blivit påmind om dina felsteg eller misstag.
kb7	Blivit utsatt för ett otrevligt bemötande när du närmar dig andra.

Item fit

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
kb1	0.969	0.97	-0.314	-0.331
kb2	0.927	0.922	-0.69	-0.723
kb3	0.876	0.896	-1.124	-0.864
kb4	0.572	0.696	-2.651	-2.501
kb5	1.062	1.08	0.533	0.734
kb6	0.849	0.799	-1.448	-1.945
kb7	0.826	0.802	-1.71	-1.89

PCA

Code

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

PCA of Rasch model residuals

Eigenvalues
1.77
1.28
1.18
0.99
0.94

Residual correlations

Code

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

	kb1	kb2	kb3	kb4	kb5	kb6	kb7
kb1
kb2	-0.2
kb3	0.17	-0.17
kb4	-0.16	0.03	-0.06
kb5	-0.35	-0.21	-0.35	-0.17
kb6	-0.26	-0.13	-0.34	-0.14	0.09
kb7	-0.22	-0.24	-0.19	-0.09	0.04	-0.01
Note:
Relative cut-off value (highlighted in red) is 0.059, 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)

Eftersom det är genomgående problem med oordnade trösklar slår vi ihop ‘dagligen’, ‘varje vecka’ och ‘varje månad’ till att börja med.

Code

# select all items except those removed
df2 <- df.omit.na %>% 
  mutate(across(everything(), ~ recode(.x,"3=2;4=2"))) #Slå ihop svarskategorier

9.4 Rasch-analys 2

itemnr	item
kb1	Blivit utsatt för att någon undanhåller information som har påverkat din prestation.
kb2	Blivit utsatt för skvaller eller rykten spridda om dig.
kb3	Blivit ignorerad eller exkluderad.
kb4	Fått kränkande eller stötande kommentarer om dig som person, dina attityder eller ditt privatliv.
kb5	Blivit utskälld eller varit föremål för andras aggressiva utbrott.
kb6	Blivit påmind om dina felsteg eller misstag.
kb7	Blivit utsatt för ett otrevligt bemötande när du närmar dig andra.

Item fit

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
kb1	0.983	0.969	-0.21	-0.345
kb2	0.882	0.891	-1.037	-1.091
kb3	0.928	0.945	-0.5	-0.423
kb4	0.618	0.785	-2.148	-1.817
kb5	1.097	1.092	0.895	0.965
kb6	0.87	0.87	-1.341	-1.386
kb7	0.858	0.849	-1.503	-1.788

PCA

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals

Eigenvalues
1.75
1.29
1.18
1.01
0.94

Residual correlations

Code

RIresidcorr(df2, cutoff = 0.2)

	kb1	kb2	kb3	kb4	kb5	kb6	kb7
kb1
kb2	-0.15
kb3	0.16	-0.16
kb4	-0.18	0	-0.05
kb5	-0.31	-0.23	-0.32	-0.17
kb6	-0.23	-0.11	-0.36	-0.15	0.04
kb7	-0.23	-0.21	-0.19	-0.08	-0.01	-0.05
Note:
Relative cut-off value (highlighted in red) is 0.058, 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)

Item 4 har något låg item fit, och det finns en residualkorrelation mellan items 1 och 3.

Vi exkluderar kb1 som har en något hög residualkorrelation med kb3.

Code

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

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

9.5 Rasch-analys 3

itemnr	item
kb2	Blivit utsatt för skvaller eller rykten spridda om dig.
kb3	Blivit ignorerad eller exkluderad.
kb4	Fått kränkande eller stötande kommentarer om dig som person, dina attityder eller ditt privatliv.
kb5	Blivit utskälld eller varit föremål för andras aggressiva utbrott.
kb6	Blivit påmind om dina felsteg eller misstag.
kb7	Blivit utsatt för ett otrevligt bemötande när du närmar dig andra.

Item fit

Code

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

	OutfitMSQ	InfitMSQ	OutfitZSTD	InfitZSTD
kb2	0.87	0.88	-1.028	-1.044
kb3	1.117	1.054	1.125	0.529
kb4	0.593	0.75	-2.4	-2.135
kb5	1.02	1.033	0.244	0.375
kb6	0.838	0.84	-1.808	-1.804
kb7	0.824	0.823	-1.86	-1.982

PCA

Code

RIpcmPCA(na.omit(df2))

PCA of Rasch model residuals

Eigenvalues
1.59
1.28
1.09
1.04
1.00

Residual correlations

Code

RIresidcorr(df2, cutoff = 0.2)

	kb2	kb3	kb4	kb5	kb6	kb7
kb2
kb3	-0.13
kb4	-0.03	-0.03
kb5	-0.3	-0.32	-0.23
kb6	-0.15	-0.34	-0.19	-0.02
kb7	-0.26	-0.17	-0.12	-0.08	-0.1
Note:
Relative cut-off value (highlighted in red) is 0.035, 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)

Item 4 har fortsatt något låg outfit medan infit (som är viktigare) är inom rimliga nivåer.

9.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."

9.7 Reliability

Code

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

Vi har få svarströsklar och som väntat kommer reliabiliteten inte upp i önskvärda nivåer någonstans på skalan.

9.8 Person fit

Code

RIpfit(df2)

9.9 Item-parametrar

Code

RIitemparams(df2)

	Threshold 1	Threshold 2	Item location
kb2	-1.04	1.80	0.38
kb3	-1.31	2.00	0.34
kb4	0.08	2.67	1.37
kb5	-1.30	2.46	0.58
kb6	-1.83	1.78	-0.03
kb7	-1.27	2.64	0.69

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

itemnr	item
kb1	Blivit utsatt för att någon undanhåller information som har påverkat din prestation.
kb2	Blivit utsatt för skvaller eller rykten spridda om dig.
kb3	Blivit ignorerad eller exkluderad.
kb4	Fått kränkande eller stötande kommentarer om dig som person, dina attityder eller ditt privatliv.
kb5	Blivit utskälld eller varit föremål för andras aggressiva utbrott.
kb6	Blivit påmind om dina felsteg eller misstag.
kb7	Blivit utsatt för ett otrevligt bemötande när du närmar dig andra.
Notera:
Borttagna item markerade med färg.