在R的ggplot2组合图表中取消右侧计数条形图的重复显示

我有一个名为df的数据框，包含3个Likert量表列（val1、val2、val3）和1个筛选列（var），数据结构如下：

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  

通过编写的plot_fun函数生成组合图表，左侧为分面的gglikert图，右侧为计数条形图。当前右侧的计数条形图针对No、Yes、All三个筛选条件重复显示了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输出：

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

要实现右侧计数条形图仅显示一次，需拆分图表生成逻辑：单独生成所有筛选条件对应的Likert图，再生成一次全局计数条形图，最后组合两者。

修改后的代码 #

# 定义生成单个Likert图的函数
plot_likert <- function(x, y) {
  .data <- df |>
    filter(var %in% x)

  .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"),
      axis.title = element_text(size = 14),
      axis.text = element_text(size = 10),
      strip.background = element_rect(color="black", fill="red", size=1.5, linetype="solid")
    )
}

# 单独生成全局计数条形图
plot_count <- function() {
  df %>%
    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()
    )
}

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

# 生成所有Likert图，再添加单个计数图
all_plots <- c(purrr::imap(.include, plot_likert), list(plot_count()))

# 组合图表：3个Likert图左侧纵向排列，计数图右侧匹配总高度
wrap_plots(all_plots, ncol = 2) +
  plot_layout(axes = "collect", guides = "collect", widths = c(.7, .3), heights = c(1,1,1)) &
  labs(x = NULL, y = NULL) &
  theme(legend.position = "bottom")

关键改动说明 #

1. 拆分函数：将原plot_fun拆分为plot_likert（仅生成对应筛选条件的Likert图）和plot_count（仅生成一次全局计数图），避免重复生成计数图。
2. 调整组合逻辑：先生成3个筛选条件的Likert图，再加入单个计数图，通过plot_layout的heights参数让计数图高度匹配三个Likert图的总高度，实现右侧只显示一次的效果。
3. 全局计数数据：plot_count直接使用完整的df数据，确保计数是全局的，不受筛选条件影响。

内容的提问来源于stack exchange，提问作者Homer Jay Simpson