Подмножество 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))


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