Status Quo
library(tidyverse)
levels <- c("very unlikely" , "somewhat unlikely" ,
"neither likely nor unlikely", "somewhat likely", "very likely")
levels <- levels |> factor(levels)
sample(levels, 20, replace = T)
## [1] neither likely nor unlikely very unlikely
## [3] very likely very likely
## [5] somewhat likely very unlikely
## [7] very unlikely somewhat unlikely
## [9] very likely somewhat likely
## [11] somewhat likely very unlikely
## [13] somewhat unlikely neither likely nor unlikely
## [15] somewhat unlikely somewhat likely
## [17] neither likely nor unlikely neither likely nor unlikely
## [19] somewhat likely somewhat likely
## 5 Levels: very unlikely somewhat unlikely ... very likely
stress_synthetic_wide <- data.frame(v1 = sample(levels, 500, replace = T),
v2 = sample(levels, 500, replace = T),
v3 = sample(levels, 500, replace = T),
v4 = sample(levels, 500, replace = T),
v5 = sample(levels, 500, replace = T))
head(stress_synthetic_wide)
## v1 v2 v3
## 1 somewhat likely very unlikely somewhat unlikely
## 2 very likely very likely very likely
## 3 neither likely nor unlikely somewhat unlikely somewhat likely
## 4 somewhat unlikely very unlikely neither likely nor unlikely
## 5 very unlikely very likely somewhat likely
## 6 somewhat unlikely very likely very unlikely
## v4 v5
## 1 somewhat likely somewhat likely
## 2 somewhat likely somewhat unlikely
## 3 somewhat likely neither likely nor unlikely
## 4 somewhat likely neither likely nor unlikely
## 5 very unlikely somewhat likely
## 6 neither likely nor unlikely very unlikely
set.seed(12345)
stress_synthetic_long <- stress_synthetic_wide |>
pivot_longer(cols = everything()) |>
rename(question = name,
response = value ) |>
arrange(question) |>
mutate(response_collapse = case_when(response |> as.numeric() %in% 1:2 ~ "unlikley",
response |> as.numeric() %in% 4:5 ~ "likely",
response |> as.numeric() == 3 ~ "neither"))
library(ggstats)
stress_synthetic_long |>
ggplot() +
aes(y = question) +
geom_likert() +
aes(fill = response)

stress_synthetic_long |>
ggplot() +
aes(y = question) +
geom_likert(data = . %>% filter(response_collapse != "neither")) +
aes(fill = response) +
geom_likert_text(data = . %>% filter(response_collapse != "neither"),
aes(fill = response_collapse),
position_likert(vjust = .5))
## Warning in ggplot2::geom_text(mapping = mapping, data = data, position =
## position, : Ignoring unknown aesthetics: fill

# +
# geom_bar(data = . %>% filter(response_collapse == "neither"),
# position = )
geom_likert_text
## function (mapping = ggplot2::aes(!!!auto_contrast), data = NULL,
## position = position_likert(0.5), ..., complete = "fill",
## default_by = "x")
## {
## ggplot2::geom_text(mapping = mapping, data = data, position = position,
## complete = complete, default_by = default_by, stat = StatPropProp,
## ...)
## }
## <bytecode: 0x12a31a8e0>
## <environment: namespace:ggstats>