使用 R 中的 ggplot 2 合并条形图中的条形

Question

我有一个名为 df 的数据框，它有 3 个 Likert 量表级别列和一个过滤器列：

df
# A tibble: 50 × 4
   val1                   val2                   val3                var  
   <chr>                  <chr>                  <chr>               <chr>
 1 "Very \n Dissatisfied" "Neutral"              "Very \n Dissatisf… Yes  
 2 "Neutral"              "Neutral"              "Neutral"           No   
 3 "Dissatisfied"         "Satisfied"            "Neutral"           Yes  
 4 "Very \n Satisfied"    "Satisfied"            "Very \n Satisfied" Yes  
 5 "Very \n Dissatisfied" "Very \n Dissatisfied" "Neutral"           Yes  
 6 "Very \n Satisfied"    "Very \n Satisfied"    "Very \n Satisfied" Yes  
 7 "Dissatisfied"         "Neutral"              "Dissatisfied"      Yes  
 8 "Neutral"              "Satisfied"            "Neutral"           Yes  
 9 "Satisfied"            "Very \n Satisfied"    "Satisfied"         No   
10 "Neutral"              "Satisfied"            "Neutral"           Yes  

上一个问题的结果函数这里

给了我所有相同值的条形图。这是正确的。！！我想要的只是不要重复 3 次（20,30 和 50），我想在右图的这一栏上重复一次。不是 3 次。

这可能吗？

plot_fun <- function(x, y) {
  .data <- df |>
    filter(var %in% x)

  p1 <- .data |>
    ggstats::gglikert(include = -var) +
    aes(y = reorder(.question,
      ifelse(
        .answer %in% c("Very \n Dissatisfied", "Dissatisfied"),
        1, 0
      ),
      FUN = sum
    ), decreasing = TRUE) +
     facet_wrap(~paste0("var to ", y))+ scale_fill_manual(values = custom_colors) +
       theme(
        strip.text = element_text(size = 14,color = "black"),               # Increase facet label size
        axis.title = element_text(size = 14),               # Increase axis title size
        axis.text = element_text(size = 10))+               # Increase axis text size
    theme(strip.background = element_rect(color="black", fill="red", size=1.5, linetype="solid"))

  p2 <- .data %>%
    tidyr::pivot_longer(-var) |>
    filter(!is.na(value)) |> 
    mutate(
      name = reorder(name,
        ifelse(
          value %in% c("Very \n Dissatisfied", "Dissatisfied"),
          1, 0
        ),
        FUN = sum
      )
    ) |>
   ggplot(aes(y = name)) +
    geom_bar(fill = "lightgrey")+
    theme_light()+
    geom_text(aes(label = ..count..), 
              stat = "count",
              position=position_stack(vjust = 0.5))+
      theme(
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank())

  
  list(p1, p2)
}

.include <- list(No = "No", Yes = "Yes", All = c("Yes", "No"))

purrr::imap(.include, plot_fun) |>
  purrr::reduce(c) |>
  wrap_plots(ncol = 2) +
  plot_layout(axes = "collect", guides = "collect", widths = c(.7, .3)) &
  labs(x = NULL, y = NULL) &
  theme(legend.position = "bottom")

数据

 dput(df)
structure(list(val1 = c("Very \n Dissatisfied", "Neutral", "Dissatisfied", 
"Very \n Satisfied", "Very \n Dissatisfied", "Very \n Satisfied", 
"Dissatisfied", "Neutral", "Satisfied", "Neutral", "Very \n Dissatisfied", 
"Very \n Satisfied", "Very \n Dissatisfied", "Satisfied", "Neutral", 
"Very \n Dissatisfied", "Neutral", "Neutral", "Satisfied", "Neutral", 
"Very \n Satisfied", "Dissatisfied", "Dissatisfied", "Satisfied", 
"Neutral", "Dissatisfied", "Satisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Very \n Dissatisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Dissatisfied", "Dissatisfied", "Neutral", "Dissatisfied", 
"Dissatisfied", "Very \n Dissatisfied", "Satisfied", "Satisfied", 
"Neutral", "Very \n Dissatisfied", "Very \n Satisfied", "Very \n Dissatisfied", 
"Satisfied", "Very \n Dissatisfied", "Very \n Dissatisfied", 
"Satisfied", "Dissatisfied", "Dissatisfied"), val2 = c("Neutral", 
"Neutral", "Satisfied", "Satisfied", "Very \n Dissatisfied", 
"Very \n Satisfied", "Neutral", "Satisfied", "Very \n Satisfied", 
"Satisfied", "Very \n Dissatisfied", "Very \n Satisfied", "Satisfied", 
"Very \n Satisfied", "Satisfied", "Neutral", "Dissatisfied", 
"Satisfied", "Neutral", "Satisfied", "Satisfied", "Neutral", 
"Very \n Satisfied", "Very \n Satisfied", "Satisfied", "Satisfied", 
"Very \n Satisfied", "Satisfied", "Neutral", "Neutral", "Neutral", 
"Neutral", "Neutral", "Satisfied", "Satisfied", "Dissatisfied", 
"Neutral", "Satisfied", "Very \n Satisfied", "Satisfied", "Satisfied", 
"Very \n Dissatisfied", "Satisfied", "Neutral", "Satisfied", 
"Very \n Dissatisfied", "Neutral", "Satisfied", "Neutral", "Satisfied"
), val3 = c("Very \n Dissatisfied", "Neutral", "Neutral", "Very \n Satisfied", 
"Neutral", "Very \n Satisfied", "Dissatisfied", "Neutral", "Satisfied", 
"Neutral", "Very \n Dissatisfied", "Very \n Satisfied", "Very \n Dissatisfied", 
"Satisfied", "Neutral", "Very \n Dissatisfied", "Satisfied", 
"Neutral", "Satisfied", "Neutral", "Very \n Satisfied", "Neutral", 
"Satisfied", "Satisfied", "Neutral", "Dissatisfied", "Satisfied", 
"Very \n Satisfied", "Neutral", "Very \n Dissatisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Satisfied", "Dissatisfied", "Dissatisfied", 
"Very \n Dissatisfied", "Dissatisfied", "Very \n Dissatisfied", 
"Satisfied", "Satisfied", "Neutral", "Very \n Dissatisfied", 
"Very \n Satisfied", "Very \n Dissatisfied", "Satisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Satisfied", "Neutral", "Dissatisfied"), var = c("Yes", 
"No", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "No", "Yes", 
"No", "No", "Yes", "No", "No", "No", "No", "No", "Yes", "No", 
"No", "Yes", "No", "No", "No", "Yes", "No", "No", "Yes", "No", 
"No", "No", "No", "No", "Yes", "No", "No", "No", "Yes", "No", 
"No", "Yes", "Yes", "No", "Yes", "Yes", "No", "No", "No", "Yes"
)), row.names = c(NA, -50L), class = c("tbl_df", "tbl", "data.frame"
))
likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)

Answer 1

只需拆下枢轴部分即可：

library(tidyverse)
library(patchwork)

likert_levels <- c(
  "Very \n Dissatisfied", "Dissatisfied", "Neutral",
  "Satisfied", "Very \n Satisfied"
)

plot_fun <- function(x, y) {
  .data <- df |>
    filter(var %in% x) |>
    mutate(
      across(-var, ~ factor(.x, likert_levels))
    )

  p1 <- .data |>
    ggstats::gglikert(include = -var) +
    aes(y = reorder(.question,
      ifelse(
        .answer %in% c("Very \n Dissatisfied", "Dissatisfied"),
        1, 0
      ),
      FUN = sum
    ), decreasing = TRUE) +
    facet_wrap(~ paste0("var to ", y)) +
    # scale_fill_manual(values = custom_colors) +
    theme(
      strip.text = element_text(size = 14, color = "black"), # Increase facet label size
      axis.title = element_text(size = 14), # Increase axis title size
      axis.text = element_text(size = 10)
    ) + # Increase axis text size
    theme(strip.background = element_rect(color = "black", fill = "red", size = 1.5, linetype = "solid"))

  p2 <- .data %>%
    count() |> 
    ggplot(aes(y = factor(1), x = n)) +
    geom_col(fill = "lightgrey") +
    theme_light() +
    geom_text(aes(label = n),
      position = position_stack(vjust = 0.5)
    ) +
    theme(
      axis.text.y = element_blank(),
      axis.ticks.y = element_blank()
    )

  list(p1, p2)
}

.include <- list(No = "No", Yes = "Yes", All = c("Yes", "No"))

purrr::imap(.include, plot_fun) |>
  purrr::reduce(c) |>
  wrap_plots(ncol = 2) +
  plot_layout(guides = "collect", widths = c(.7, .3)) &
  labs(x = NULL, y = NULL) &
  theme(legend.position = "bottom")