Подмножество 2 ggplots в R, чтобы уменьшить ось Y
У меня есть фрейм данных в R с двумя столбцами. Первый столбец с именем var имеет 40 категорий, а столбец val имеет значения Лайкерта. После графика Лайкерта и графика счетчика в результате получается уродливый непонятный график (прилагаемое изображение). Есть ли способ отобразить 20 худших категорий (на основе «Категорически не согласен» и «Не согласен»)? Проблема была бы легкой, если бы она возникла до построения графика. Но теперь я не знаю, как с этим справиться. Любая помощь?
library(tibble)
# Create 40 categories
var_levels <- paste0("Category_", 1:40)
likert_levels <- c(
"Strongly disagree",
"Disagree",
"Neither agree nor disagree",
"Agree",
"Strongly agree"
)
set.seed(42)
df <- tibble(
var = sample(var_levels, 500, replace = TRUE), # Random values from 40 categories
val = sample(likert_levels, 500, replace = TRUE) # Random values from Likert levels
)
df
df2=df%>%
mutate(across(everything(), as.factor))%>%
group_by(var)%>%
mutate(row = row_number()) %>%
pivot_wider(names_from = var, # The values in 'var' will become new column names
values_from = val)%>%
select(-row)
v1 = ggstats::gglikert(df2)+
aes(y = reorder(.question,
ifelse(
.answer %in% c("Strongly disagree", "Disagree"),
1, 0),FUN = sum),decreasing=TRUE)
v2 <- df %>%
mutate(
var = reorder(var,
ifelse(
val %in% c("Strongly disagree", "Disagree"),
1, 0
),
FUN = sum
)
) |>
count(var, name = "count") %>%
ggplot(., aes(y = var, x = count)) +
geom_bar(stat = "identity", fill = "lightgrey")
ggarrange(v1, v2, widths = c(6, 2))
Ответы 1
Вот один из возможных вариантов, который просто вычисляет относительные частоты перед построением графика, для чего я использую ave. на основе этого расчета вы сможете выбрать 20 худших категорий.
Примечание. Помимо «Сильного несогласия» и «Не согласен», я включаю половину от нейтральной категории.
library(tibble)
# Create 40 categories
var_levels <- paste0("Category_", 1:40)
likert_levels <- c(
"Strongly disagree",
"Disagree",
"Neither agree nor disagree",
"Agree",
"Strongly agree"
)
set.seed(42)
df <- tibble(
var = sample(var_levels, 500, replace = TRUE), # Random values from 40 categories
val = sample(likert_levels, 500, replace = TRUE) # Random values from Likert levels
)
df
library(tidyverse)
library(ggplot2)
library(ggpubr)
df <- df %>%
mutate(
val = factor(val, likert_levels),
var = reorder(
var,
ave(
as.numeric(val), var,
FUN = \(x) {
sum(x %in% 1:2) / length(x[!is.na(x)])
}
)
)
)
worst20 <- levels(df$var)[-(1:20)]
df2 <- df %>%
filter(var %in% worst20) |>
group_by(var) %>%
mutate(row = row_number()) %>%
pivot_wider(
names_from = var, # The values in 'var' will become new column names
values_from = val,
names_vary = "fastest",
) %>%
select(-row)
v1 <- ggstats::gglikert(df2) +
aes(y = reorder(
factor(.question, levels = levels(df$var)),
ave(
as.numeric(.answer), .question,
FUN = \(x) {
sum(x %in% 1:2) / length(x[!is.na(x)])
}
)
))
v2 <- df %>%
filter(var %in% worst20) |>
count(var, name = "count") %>%
ggplot(., aes(y = var, x = count)) +
geom_bar(stat = "identity", fill = "lightgrey")
ggarrange(v1, v2, widths = c(6, 2))
Ага. Как я уже заметил: половину отсчета я отношу к нейтральной категории. Просто оставьте деталь + .5 * sum(x %in% 3).
Я удалил его, но он все еще не работает. Я по-прежнему отсортирован произвольно. Кроме того, некоторые категории по-разному сопоставляются в patchwork::wrap_plots(list(v1, v2)). Почему?
Ага. ты прав. Во-первых, произошла ошибка, поскольку я на самом деле заказал «Согласен» и «Полностью согласен» (т. е. 4 и 5). Во-вторых, была ошибка, связанная с порядком связей, т.е. категорий с одинаковой «суммой». С этой целью я добавил factor(.question, levels = levels(df$var)), чтобы .question имел тот же порядок, что и var. Я отредактировал код соответствующим образом.
Очень хорошо. Большое спасибо, Стефан. Но я заметил, что проценты слева не отсортированы должным образом. Например, в вашем выводе, начиная снизу, есть 83%, затем 3 раза по 67% и после этого 70%. Это неправильно при сортировке.