First let’s load the necessary libraries. Some additional libraries will be loaded as we go along.
library(tidyverse)
library(ggdist)
library(ggpp)
library(foreign)
library(readxl)
library(showtext)
library(stringr)
library(patchwork)
library(glue)
library(ggridges)
library(scales)
### 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::renameThen our fonts, colors, and the ggplot theme.
## Loading Google fonts (https://fonts.google.com/)
font_add_google("Noto Sans", "noto")
## Flama font with regular and italic font faces
font_add(family = "flama",
regular = "fonts/Flama-Font/Flama Regular.otf",
italic = "fonts/Flama-Font/Flama Italic.otf",
bold = "fonts/Flama-Font/FlamaBlack Regular.otf")
## Automatically use showtext to render text
showtext_auto()
prevent_green <- "#008332"
prevent_light_green <- "#76A100"
prevent_dark_blue <- "#003E6E"
prevent_blue <- "#005F89"
prevent_light_blue <- "#4398BA"
prevent_yellow <- "#FBB900"
prevent_red <- "#BE5014"
prevent_gray_red <- "#6C5861"
prevent_light_gray <- "#F0F0F0"
prevent_gray <- "#d3d3d3"
prevent_dark_gray <- "#3B3B3B"
prevent_turquoise <- "#009a9d"
prevent_green_comp <- "#D9ECE0"
prevent_light_green_comp <- "#DCE7BF"
prevent_dark_blue_comp <- "#BFCEDA"
prevent_blue_comp <- "#BFD7E1"
prevent_light_blue_comp <- "#D0E5EE"
prevent_yellow_comp <- "#FEEDBF"
prevent_red_comp <- "#EFD3C4"
prevent_green_contrast <- "#006632"
prevent_blue_contrast <- "#003E6E"
prevent_yellow_contrast <- "#FBD128"
prevent_red_contrast <- "#B01200"
prevent_gray_red_contrast <- "#68534E"
# manual palette creation, 7 colors
PREVENTpalette1 <- c("#6C5861", "#005F89", "#4398BA", "#76A100", "#008332", "#FBB900", "#FBD128")
# create palette with 12 colors based on Prevent colors above
PREVENTpalette2 <- colorRampPalette(colors = c("#6C5861", "#005F89", "#4398BA", "#76A100", "#008332", "#FBB900", "#FBD128"))(12)
theme_prevent <- function(fontfamily = "flama", axisTitleSize = 13, titlesize = 15,
margins = 12, axisface = "plain", stripsize = 12,
panelDist = 0.6, legendSize = 9, legendTsize = 10,
axisTextSize = 10, ...) {
theme(
text = element_text(family = fontfamily),
axis.title.x = element_text(
margin = margin(t = margins),
size = axisTitleSize
),
axis.title.y = element_text(
margin = margin(r = margins),
size = axisTitleSize
),
plot.title = element_text(
#family = "flama",
face = "bold",
size = titlesize
),
axis.title = element_text(
face = axisface
),
axis.text = element_text(size = axisTextSize),
plot.caption = element_text(
face = "italic"
),
legend.text = element_text(family = fontfamily, size = legendSize),
legend.title = element_text(family = fontfamily, size = legendTsize),
strip.text = element_text(size = stripsize),
panel.spacing = unit(panelDist, "cm", data = NULL),
legend.background = element_rect(color = "lightgrey"),
...
)
}
# these rows are for specific geoms, such as geom_text() and geom_text_repel(), to match font family. Add as needed
# update_geom_defaults("text", list(family = fontfamily)) +
# update_geom_defaults("text_repel", list(family = fontfamily)) +
# update_geom_defaults("textpath", list(family = fontfamily)) +
# update_geom_defaults("texthline", list(family = fontfamily))Moving on to item labels.
# get itemlabels for our sample domain (arbetsbelastning och krav)
itemlabels <- read.csv("06_ldrskp/finalItems.csv")
itemlabels itemnr item
1 ls1 Min chef ger mig återkoppling på hur jag utför arbetet.
2 ls2 Min chef har en god uppfattning om min arbetsbelastning.
3 ls3 Min chef agerar om jag har allt för mycket arbete att utföra.
4 ls5 Min chef hanterar konflikter på ett bra sätt.
5 ls6 Min chef och jag har tillräckligt med avstämningar.And loading data. We will use the items from the “Leadership” domain/subscale for the exampel visualizations.
spssDatafile <- "data/2023-04-26 Prevent OSA-enkat.sav"
# read unedited complete SurveyMonkey data file, downloaded in SPSS format
df <- read.spss(spssDatafile, to.data.frame = TRUE) %>%
select(starts_with("q0010")) %>% # include only items from abk and å
select(!ends_with("04")) %>% # remove item that did not work adequately in the psychometric analysis
na.omit() # remove participants with missing data (to simplify)
names(df) <- itemlabels$itemnr # set matching variable names - df and itemlabels need to have common "itemnr" labels
# show first 5 rows of df
df %>%
head(5) ls1 ls2 ls3 ls5 ls6
1 Ganska ofta Mycket ofta Ganska ofta Ganska ofta Ganska ofta
2 Sällan Ganska ofta Ganska ofta Ganska ofta Sällan
3 Ganska ofta Mycket ofta Ganska ofta Alltid Mycket ofta
4 Alltid Mycket ofta Alltid Mycket ofta Alltid
8 Ibland Sällan Aldrig Ibland IblandWe also need person scores based on their item responses in the domain. There are two ways to get this. The most correct way is to estimate these using a function from the catR package, thetaEst. Another option is to use a transformation table, where raw responses are simply summarized for each participant, and the sum score is looked up in the table.
We’ll first do the estimation, then the transformation table.
For this, we first need to recode the responses into integers, where the lowest response (“Aldrig”) is coded as 0, and so on, until “Alltid” = 5.
# vector of response categories
svarskategorier <- c("Aldrig","Sällan","Ibland","Ganska ofta","Mycket ofta","Alltid")
# recode responses to numbers and save the output in a separate dataframe
df.scored <- df %>%
mutate(across(everything(), ~ car::recode(.x,"'Aldrig'=0;
'Sällan' =1;
'Ibland'=2;
'Ganska ofta'=3;
'Mycket ofta'=4;
'Alltid'=5",
as.factor = FALSE)))Scored data means each participant has had their overall score estimated based on their responses on a subscale. The score is estimated based on the psychometric/Rasch analysis made separately for each scale.
We’ll borrow a simplified function from the RISEkbmRasch package, without actually loading the package.
#library(RISEkbmRasch) # devtools::install_github("pgmj/RISEkbmRasch")
library(catR)
estimateScores <- function(dfin, itemParams, model = "PCM", method = "WL") {
estTheta <- function(
personResponse, itemParameters = itemParams,
rmod = model, est = method) {
thetaEst(itemParameters, as.numeric(as.vector(personResponse)),
model = rmod, method = est
)
}
dfin %>%
t() %>%
as_tibble() %>%
map_dbl(., estTheta)
}
# we need to use the item parameters from the Rasch analysis previously made from the whole sample. There is one CSV-file per domain/subscale. The object containing item parameters needs to be a matrix.
itemParamsLeadership <- read.csv("06_ldrskp/itemParameters.csv") %>%
as.matrix()
# then estimate peron scores for this subscale/domain
df$score <- estimateScores(dfin = df.scored,
itemParams = itemParamsLeadership)
df$score %>%
head(5)[1] 1.5071640 0.4207452 2.3109255 3.9888486 -0.4714489We’ve stored the estimated person scores as variable df$score.
This can be used as a simple lookup & replace table, where raw response data is replaced with integers (starting at 0, as shown earlier), and then summed within the items in the domain/subscale. This is the “ordinal sum score” in the table below, which should be replaced with the “Logit score”, which is on an interval scale.
library(eRm)
scoringTable <- function(dfin) {
sink(nullfile())
ppar <- dfin %>%
PCM() %>%
person.parameter() %>%
print() %>%
as.data.frame()
sink()
scoreTable <- ppar %>%
dplyr::rename(
`Logit score` = "X1.Estimate", `Logit std.error` = "X1.Std.Error",
`Ordinal sum score` = "X1.Raw.Score"
) %>%
remove_rownames() %>%
mutate(across(where(is.numeric), ~ round(.x, 2)))
ordinal_to_interval_table <<- scoreTable
}
scoringTable(df.scored)
ordinal_to_interval_table Ordinal sum score Logit score Logit std.error
1 0 -4.11 NA
2 1 -3.21 1.06
3 2 -2.39 0.80
4 3 -1.85 0.68
5 4 -1.43 0.61
6 5 -1.08 0.57
7 6 -0.78 0.53
8 7 -0.51 0.51
9 8 -0.26 0.49
10 9 -0.02 0.48
11 10 0.20 0.47
12 11 0.42 0.46
13 12 0.63 0.46
14 13 0.85 0.47
15 14 1.07 0.47
16 15 1.29 0.48
17 16 1.53 0.49
18 17 1.78 0.51
19 18 2.06 0.53
20 19 2.36 0.56
21 20 2.69 0.60
22 21 3.09 0.65
23 22 3.55 0.72
24 23 4.15 0.84
25 24 5.05 1.10
26 25 6.01 NAA limitation of this table is that it will only list the values estimated in the sample used. Since our data is skewed it is safer to directly estimate the scores, as shown previously, to avoid issues with missing values in the lookup table. The table above (for the leadership domain) does contain values from ordinal sum score 0 up til the maximum ordinal sum score.
df.scored$score <- df$scoreWe’ll subset a sample of 17 random respondents to use for the visualizations.
set.seed(1523)
sampleMed <- 17
# pick random sample to use for visualization example
df.test20 <- df.scored %>%
slice_sample(n = sampleMed) %>%
add_column(group = "Mättillfälle 1")
# get another sample for examples comparing two measurements
df.test20b <- df.scored %>%
slice_sample(n = sampleMed) %>%
add_column(group = "Mättillfälle 2")
# combine data
df.compare20 <- rbind(df.test20, df.test20b)
df.compare20 %>%
head(5) ls1 ls2 ls3 ls5 ls6 score group
1 2 2 2 3 1 0.210077 Mättillfälle 1
2 3 3 3 1 2 0.629489 Mättillfälle 1
3 3 4 3 3 3 1.507164 Mättillfälle 1
4 4 5 5 5 5 4.000000 Mättillfälle 1
5 2 2 2 3 3 0.629489 Mättillfälle 1First we need to get scores for all domains that can be scored. These are estimated as described above, but will now be loaded from pre-estimated CSV-files.
df.scores <- read.csv("02_arbkrv/scored.csv") %>%
select(score) %>%
rename(`Arbetsbelastning och krav` = score) %>%
add_column(id = seq_along(1:nrow(.)))
df.scores <- read.csv("03_mpvrk/scored.csv") %>%
select(score) %>%
rename(`Möjlighet att påverka` = score) %>%
add_column(id = seq_along(1:nrow(.))) %>%
full_join(df.scores, by = "id")
df.scores <- read.csv("04_std/scored.csv") %>%
select(score) %>%
rename(Stöd = score) %>%
add_column(id = seq_along(1:nrow(.))) %>%
full_join(df.scores, by = "id")
df.scores <- read.csv("05_rec/scored.csv") %>%
select(score) %>%
rename(Återhämtning = score) %>%
add_column(id = seq_along(1:nrow(.))) %>%
full_join(df.scores, by = "id")
df.scores <- read.csv("06_ldrskp/scored.csv") %>%
select(score) %>%
rename(Ledarskap = score) %>%
add_column(id = seq_along(1:nrow(.))) %>%
full_join(df.scores, by = "id")
df.scores <- read.csv("09_psyktry/scored.csv") %>%
select(score) %>%
rename(`Psykologisk trygghet` = score) %>%
add_column(id = seq_along(1:nrow(.))) %>%
full_join(df.scores, by = "id")
df.scores$id <- NULL
df.scores %>%
head(5) Psykologisk trygghet Ledarskap Återhämtning Stöd Möjlighet att påverka
1 2.7406367 1.5071709 -0.5868049 0.9378689 2.2268184
2 1.9836984 0.4207466 0.8421092 0.9378689 0.5369188
3 3.7238499 2.3109342 2.5926417 2.4512128 2.2268184
4 1.1630728 3.9888470 1.9049085 2.8888545 3.5311443
5 0.9302564 -0.4714534 -0.2400615 0.3694309 -1.6064950
Arbetsbelastning och krav
1 0.1877164
2 -0.3339124
3 1.3733517
4 0.6561426
5 0.1877164The dataframe needs to be in long format for creating the figure/plot, and we’ll choose a random set of 17 participants for this too.
df.plot <- df.scores %>%
slice_sample(n = sampleMed) %>%
pivot_longer(everything(),
names_to = "Område",
values_to = "Indexvärde") %>%
group_by(Område) %>%
summarise(Medelvärde = mean(Indexvärde, na.rm = T))
df.plot# A tibble: 6 × 2
Område Medelvärde
<chr> <dbl>
1 Arbetsbelastning och krav 1.18
2 Ledarskap 1.24
3 Möjlighet att påverka 1.49
4 Psykologisk trygghet 2.92
5 Stöd 1.64
6 Återhämtning 1.42ggplot(df.plot) +
# plot mean values for each domain
geom_point(
aes(
x = Medelvärde,
y = Område
),
color = prevent_green,
size = 10,
shape = 16,
alpha = 0.9
) +
coord_cartesian(
xlim = c(-3, 4), # set x axis limits
clip = "off"
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent(axisTextSize = 11) +
labs(
title = "Översikt områden",
subtitle = "Värden längre till höger är bättre",
caption = "Gröna cirklar indikerar medelvärden. Skalan sträcker sig från lägsta till högsta möjliga värde.",
y = "",
x = ""
) +
theme(
axis.text.x = element_blank(), # remove text from x axis
axis.title = element_blank()
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 12)) + # wrap y label text
annotate("text",
x = 4, y = 0.2,
label = "Högsta\nmöjliga\nvärde",
color = "darkgrey",
size = 3
) +
annotate("text",
x = -3, y = 0.2,
label = "Lägsta\nmöjliga\nvärde",
color = "darkgrey",
size = 3
) +
update_geom_defaults("text", list(family = "flama")) # sets default font for annotate for the rest of the session
We need a comparison group.
set.seed(1452)
df.plot2 <- df.scores %>%
slice_sample(n = sampleMed) %>%
pivot_longer(everything(),
names_to = "Område",
values_to = "Indexvärde") %>%
group_by(Område) %>%
summarise(Medelvärde = mean(Indexvärde, na.rm = T))ggplot() +
# plot "previous measurement"
geom_point(
data = df.plot2,
aes(
x = Medelvärde,
y = Område
),
color = prevent_green,
size = 8,
shape = 16,
alpha = 0.4
) +
# plot mean values for each domain for the "new measurement
geom_point(
data = df.plot,
aes(
x = Medelvärde,
y = Område
),
color = prevent_green,
size = 10,
shape = 16,
alpha = 0.85 # slight transparency in case circles overlap
) +
coord_cartesian(
xlim = c(-3, 4), # set x axis limits
clip = "off" # don't clip the annotate text set at the end of the code chunk
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent() +
labs(
title = "Översikt områden",
subtitle = "Värden längre till höger är bättre",
caption = "Gröna cirklar indikerar medelvärden.\nMörka cirklar = senaste mätningen.\nLjusare/mindre cirklar = föregående mätning.",
y = "",
x = ""
) +
theme(
axis.text.x = element_blank(), # remove text from x axis
axis.title = element_blank()
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 12)) + # wrap y label text
annotate("text",
x = 4, y = 0.2,
label = "Högsta\nmöjliga\nvärde",
color = "darkgrey",
size = 3
) +
annotate("text",
x = -3, y = 0.2,
label = "Lägsta\nmöjliga\nvärde",
color = "darkgrey",
size = 3
)
Create dataframe with 17 random participants.
# create random sample dataset
df.plot20 <- df %>%
slice_sample(n = sampleMed) %>%
select(all_of(itemlabels$itemnr), score) %>%
pivot_longer(!score) %>% # we need long format for ggplot
rename(
itemnr = name,
svarskategori = value
) %>%
left_join(itemlabels, by = "itemnr") %>% # get item descriptions as a variable in the df
add_column(group = "Mättillfälle 1")
# enable comparisons by adding another random group
df.plot20b <- df %>%
slice_sample(n = sampleMed) %>%
select(all_of(itemlabels$itemnr), score) %>%
pivot_longer(!score) %>% # we need long format for ggplot
rename(
itemnr = name,
svarskategori = value
) %>%
left_join(itemlabels, by = "itemnr") %>% # get item descriptions as a variable in the df
add_column(group = "Mättillfälle 2")
df.plotComp20 <- rbind(df.plot20,df.plot20b)
df.plotComp20 %>%
head(10)# A tibble: 10 × 5
score itemnr svarskategori item group
<dbl> <chr> <fct> <chr> <chr>
1 2.64 ls1 Mycket ofta Min chef ger mig återkoppling på hur jag ut… Mätt…
2 2.64 ls2 Mycket ofta Min chef har en god uppfattning om min arbe… Mätt…
3 2.64 ls3 Mycket ofta Min chef agerar om jag har allt för mycket … Mätt…
4 2.64 ls5 Mycket ofta Min chef hanterar konflikter på ett bra sät… Mätt…
5 2.64 ls6 Mycket ofta Min chef och jag har tillräckligt med avstä… Mätt…
6 1.51 ls1 Ganska ofta Min chef ger mig återkoppling på hur jag ut… Mätt…
7 1.51 ls2 Mycket ofta Min chef har en god uppfattning om min arbe… Mätt…
8 1.51 ls3 Ganska ofta Min chef agerar om jag har allt för mycket … Mätt…
9 1.51 ls5 Ibland Min chef hanterar konflikter på ett bra sät… Mätt…
10 1.51 ls6 Mycket ofta Min chef och jag har tillräckligt med avstä… Mätt…Calculate median responses
df.medians <- df.plot20 %>%
# create numeric responses where 1 = "Aldrig, and 6 = "Alltid"
mutate(svarNum = as.integer(fct_rev(svarskategori))) %>%
add_column(id = rep(1:17, each = 5)) %>% # sample size = 17, and 5 questions in domain
select(itemnr,svarNum,id) %>%
pivot_wider(names_from = "itemnr",
values_from = "svarNum",
id_cols = "id")
df.medians %>%
head(10)# A tibble: 10 × 6
id ls1 ls2 ls3 ls5 ls6
<int> <int> <int> <int> <int> <int>
1 1 5 5 5 5 5
2 2 4 5 4 3 5
3 3 2 1 2 3 5
4 4 4 4 3 6 6
5 5 3 4 3 4 3
6 6 3 3 3 3 4
7 7 5 3 3 5 5
8 8 4 4 3 3 4
9 9 1 1 2 5 2
10 10 4 4 2 6 4# prepare dataframe to store values
medianResponses <- itemlabels
# get median values (can be .5 when we have an even N)
medians <- c()
for (i in medianResponses$itemnr) {
med1 <- median(df.medians[[i]])
medians <- c(medians,med1)
}
medianResponses$medians <- medians
medianResponses itemnr item medians
1 ls1 Min chef ger mig återkoppling på hur jag utför arbetet. 4
2 ls2 Min chef har en god uppfattning om min arbetsbelastning. 4
3 ls3 Min chef agerar om jag har allt för mycket arbete att utföra. 3
4 ls5 Min chef hanterar konflikter på ett bra sätt. 5
5 ls6 Min chef och jag har tillräckligt med avstämningar. 5ggplot(medianResponses) +
geom_point(aes(x = medians,
y = item),
color = prevent_green,
size = 12) +
theme_minimal() +
theme_prevent() +
labs(
title = "Indexfrågor",
subtitle = "Medianvärde per fråga",
y = "",
x = ""
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(limits = svarskategorier,
labels = ~ stringr::str_wrap(.x, width = 8))
df.plot20 %>%
dplyr::count(item, svarskategori) %>%
mutate(nFactor = factor(n)) %>%
mutate(svarskategori = fct_rev(svarskategori)) %>%
ggplot() +
geom_point(aes(x = svarskategori, y = item, size = n * 1.5, color = svarskategori),
# size = 3,
shape = 16
) +
geom_text(aes(x = svarskategori, y = item, label = n),
color = "white") +
scale_size_continuous(
range = c(7, 16), # set minimum and maximum point size
guide = "none" # remove legend for size aesthetic
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent(legend.position = "none") +
scale_color_viridis_d("",
begin = 0.2,
end = 0.8,
guide = "none" # remove legend for color aesthetic
) +
# scale_color_manual(values = PREVENTpalette1) +
labs(
title = "Indexfrågor",
subtitle = "Fördelning av svar",
y = "",
x = ""
) +
#guides(color = guide_legend(override.aes = list(size = 7))) + # make points in legend bigger
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(labels = ~ stringr::str_wrap(.x, width = 8))
mixPlot <- df.plot20 %>%
dplyr::count(item, svarskategori) %>%
mutate(nFactor = factor(n)) %>%
mutate(svarskategori = fct_rev(svarskategori))
ggplot(mixPlot %>% filter(item == "Min chef ger mig återkoppling på hur jag utför arbetet.")) +
geom_point(data = medianResponses,
aes(x = medians,
y = item),
color = prevent_green,
size = 12,
alpha = 0.4) +
geom_point(aes(x = svarskategori, y = item, size = n * 1.5, color = svarskategori),
# size = 3,
shape = 16
) +
geom_text(aes(x = svarskategori, y = item, label = n),
color = "white") +
scale_size_continuous(
range = c(7, 16), # set minimum and maximum point size
guide = "none"
) +
scale_color_viridis_d("",
begin = 0.2,
end = 0.8,
guide = "none" # remove legend for color aesthetic
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent(legend.position = "none") +
scale_color_viridis_d("",
begin = 0.2,
end = 0.8,
guide = "none" # remove legend for color aesthetic
) +
# scale_color_manual(values = PREVENTpalette1) +
labs(
title = "Indexfrågor",
subtitle = "Fördelning av svar",
y = "",
x = ""
) +
#guides(color = guide_legend(override.aes = list(size = 7))) + # make points in legend bigger
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(labels = ~ stringr::str_wrap(.x, width = 8))
df.medians <- df.plot20b %>%
# create numeric responses where 1 = "Aldrig, and 6 = "Alltid"
mutate(svarNum = as.integer(fct_rev(svarskategori))) %>%
add_column(id = rep(1:17, each = 5)) %>% # sample size = 17, and 5 questions in domain
select(itemnr,svarNum,id) %>%
pivot_wider(names_from = "itemnr",
values_from = "svarNum",
id_cols = "id")# prepare dataframe to store values
medianResponses2 <- itemlabels
# get median values (can be .5 when we have an even N)
medians <- c()
for (i in medianResponses2$itemnr) {
med1 <- median(df.medians[[i]])
medians <- c(medians,med1)
}
medianResponses2$medians <- medians
# medianComp <- rbind(medianResponses,medianResponses2) %>%
# add_column(Group = rep(1:2, each = 5))
# medianCompggplot() +
geom_point(data = medianResponses,
aes(x = medians,
y = item),
color = prevent_green,
size = 12,
alpha = 0.3,
position = position_nudge(x = 0.06, y = 0)
) +
geom_point(data = medianResponses2, # add new responses
aes(x = medians,
y = item),
color = prevent_green,
size = 12) +
theme_minimal() +
theme_prevent() +
labs(
title = "Indexfrågor",
subtitle = "Medianvärde per fråga",
caption = "Ljusgröna cirklar indikerar föregående mätning.\nÖverlappande cirklar indikerar samma medianvärde",
y = "",
x = ""
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(limits = svarskategorier,
labels = ~ stringr::str_wrap(.x, width = 8))
# read data again for negative acts questions, "krbet"
df.krbet <- read.spss(spssDatafile, to.data.frame = TRUE) %>%
select(starts_with("q0012")) %>%
mutate(across(starts_with("q0012"), ~ car::recode(.x,"'Dagligen'='Varje vecka'"))) %>% # merge categories
na.omit()
# krbet itemlabels
krbet.itemlabels <- read_excel("data/Itemlabels.xlsx") %>%
filter(str_detect(itemnr, pattern = "kb")) %>%
select(!Dimension)
names(df.krbet) <- krbet.itemlabels$itemnr
df.plot.krbet20 <- df.krbet %>%
slice_sample(n = 20) %>%
pivot_longer(everything()) %>% # we need long format for ggplot
rename(
itemnr = name,
svarskategori = value
) %>%
left_join(krbet.itemlabels, by = "itemnr") %>% # get item descriptions as a variable in the df
add_column(group = "Mättillfälle 1")
df.plot.krbet20b <- df.krbet %>%
slice_sample(n = 20) %>%
pivot_longer(everything()) %>% # we need long format for ggplot
rename(
itemnr = name,
svarskategori = value
) %>%
left_join(krbet.itemlabels, by = "itemnr") %>% # get item descriptions as a variable in the df
add_column(group = "Mättillfälle 2")
df.krbetComp <- rbind(df.plot.krbet20,df.plot.krbet20b)
krbet.svarskategorier <- c("Aldrig","Det har hänt","Varje månad","Varje vecka")df.plot.krbet20 %>%
dplyr::count(item, svarskategori) %>%
mutate(nFactor = factor(n)) %>%
ggplot() +
geom_point(aes(x = svarskategori, y = item, size = n * 1.5, color = svarskategori),
# size = 3,
shape = 16
) +
scale_size_continuous(
range = c(7, 18), # set minimum and maximum point size
guide = "none" # remove legend for size aesthetic
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent() +
scale_color_manual(values = c("#008332","#FBB900","#BE5014","#B01200","#B01200"),
guide = "none") +
labs(
title = "Kränkande beteenden",
subtitle = "Fördelning av svar",
y = "",
x = ""
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(breaks = krbet.svarskategorier,
limits = krbet.svarskategorier)
plot.krbetComp <- df.krbetComp %>%
dplyr::count(group, item, svarskategori) %>%
mutate(nFactor = factor(n))
ggplot() +
geom_point(
data = plot.krbetComp %>% filter(group == "Mättillfälle 2"),
aes(x = svarskategori, y = item, size = n * 1.5, color = svarskategori),
shape = 16
) +
geom_point(
data = plot.krbetComp %>% filter(group == "Mättillfälle 1"),
aes(x = svarskategori, y = item, size = n * 1.5, color = svarskategori),
alpha = 0.3,
shape = 16,
position = position_nudge(x = 0.15, y = 0)
) +
scale_size_continuous(
range = c(7, 18), # set minimum and maximum point size
guide = "none" # remove legend for size aesthetic
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent() +
scale_color_manual(
values = c("#008332", "#FBB900", "#BE5014", "#B01200", "#B01200"),
guide = "none"
) +
labs(
title = "Kränkande beteenden",
subtitle = "Fördelning av svar",
y = "",
x = ""
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(
breaks = krbet.svarskategorier,
limits = krbet.svarskategorier
)
df.plot.krbet20 %>%
dplyr::count(item, svarskategori) %>%
mutate(nFactor = factor(n)) %>%
ggplot() +
geom_point(aes(x = svarskategori, y = item, size = n * 1.5, color = svarskategori),
# size = 3,
shape = 16
) +
geom_text(aes(x = svarskategori, y = item, label = n),
color = "white") +
scale_size_continuous(
range = c(7, 18), # set minimum and maximum point size
guide = "none" # remove legend for size aesthetic
) +
### theming, colors, fonts, etc below
theme_minimal() +
theme_prevent() +
scale_color_manual(values = c("#008332","#FBB900","#BE5014","#B01200","#B01200"),
guide = "none") +
labs(
title = "Kränkande beteenden",
subtitle = "Fördelning av svar",
y = "",
x = ""
) +
scale_y_discrete(labels = ~ stringr::str_wrap(.x, width = 30)) +
scale_x_discrete(breaks = krbet.svarskategorier,
limits = krbet.svarskategorier)