如何在ggplot2中快速筛选变量均值Top/Bottom10%的分组绘图

核心思路 #

先按分组计算目标变量的均值，通过百分位数自动筛选出Top10%和Bottom10%的分组，再基于筛选后的数据集绘图。这种方法无需手动挑选分组，换变量时只需修改参数或变量名即可复用。

可复用函数方案（推荐） #

封装成函数后，换变量只需要传不同参数，最省事：

library(tidyverse)

plot_top_bottom_10 <- function(data, group_col, value_col) {
  # 计算分组均值并筛选目标分组
  target_groups <- data %>%
    drop_na({{group_col}}, {{value_col}}) %>%  # 剔除缺失值，避免均值计算出错
    group_by({{group_col}}) %>%
    summarise(mean_val = mean({{value_col}}, na.rm = TRUE)) %>%
    ungroup() %>%
    mutate(
      pct_rank = percent_rank(mean_val),  # 计算均值的百分位数排名
      keep = pct_rank <= 0.1 | pct_rank >= 0.9  # 标记保留Top10%和Bottom10%的分组
    ) %>%
    filter(keep) %>%
    pull({{group_col}})  # 提取要保留的分组名称
  
  # 生成箱线图
  data %>%
    filter({{group_col}} %in% target_groups) %>%
    ggplot(aes(x = {{group_col}}, y = {{value_col}}, fill = {{group_col}})) +
    geom_boxplot(outlier.shape = NA) +
    stat_summary(fun = mean, geom = "point", shape = 20, size = 5, color = "red", fill = "red") +
    theme(legend.position = "none") +
    theme(axis.text.x = element_text(angle = 40, hjust = 1, vjust = 1, face = "bold",
                                     colour = "black", size = rel(0.8))) +
    labs(title = paste0(quo_name(enquo(value_col)), "的Top10%与Bottom10%分组箱线图"),
         x = quo_name(enquo(group_col)),
         y = quo_name(enquo(value_col)))
}

使用示例

• 绘制height的Top10%和Bottom10%分组：

plot_top_bottom_10(starwars, homeworld, height)

• 换成mass只需改参数：

plot_top_bottom_10(starwars, homeworld, mass)

分步实现方案（适合理解逻辑） #

如果不想用函数，也可以分步写代码，换变量时替换对应变量名即可：

处理height变量：

library(tidyverse)

# 筛选目标分组
target_groups <- starwars %>%
  drop_na(homeworld, height) %>%
  group_by(homeworld) %>%
  summarise(mean_height = mean(height, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(pct_rank = percent_rank(mean_height)) %>%
  filter(pct_rank <= 0.1 | pct_rank >= 0.9) %>%
  pull(homeworld)

# 绘图
ggplot(subset(starwars, homeworld %in% target_groups), 
       aes(x = homeworld, y = height, fill = homeworld)) +
  geom_boxplot(outlier.shape = NA) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 5, color = "red", fill = "red") +
  theme(legend.position = "none") +
  theme(axis.text.x = element_text(angle = 40, hjust = 1, vjust = 1, face = "bold",
                                   colour = "black", size = rel(0.8)))

换成mass变量：

只需要把代码里的height全部替换为mass：

target_groups <- starwars %>%
  drop_na(homeworld, mass) %>%
  group_by(homeworld) %>%
  summarise(mean_mass = mean(mass, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(pct_rank = percent_rank(mean_mass)) %>%
  filter(pct_rank <= 0.1 | pct_rank >= 0.9) %>%
  pull(homeworld)

ggplot(subset(starwars, homeworld %in% target_groups), 
       aes(x = homeworld, y = mass, fill = homeworld)) +
  geom_boxplot(outlier.shape = NA) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 5, color = "red", fill = "red") +
  theme(legend.position = "none") +
  theme(axis.text.x = element_text(angle = 40, hjust = 1, vjust = 1, face = "bold",
                                   colour = "black", size = rel(0.8)))

内容的提问来源于stack exchange，提问作者Noah