R语言如何绘制无上下四分位数、须间垂连的定制箱线图

嘿，我明白你想要的是一种极简风格的箱线图——只保留中位数和异常值，用须把中位数和异常值的范围连起来，还要在须的两端加小垂直线对吧？我来给你两种实现方式，一种用基础R，另一种用ggplot2，你可以挑顺手的来：

方法一：基础R实现 #

基础R的boxplot()函数本身有不少可调整的参数，我们可以先隐藏掉不需要的元素，再手动添加自定义的须和垂直线：

# 先获取箱线图的统计数据（不绘图）
bp_stats <- boxplot(mpg ~ cyl, data = mtcars, plot = FALSE)

# 绘制空坐标轴，只保留中位数点
plot(
  x = 1:length(unique(mtcars$cyl)), 
  y = bp_stats$stats[3,],  # 3号位置是中位数
  xlim = c(0.5, length(unique(mtcars$cyl)) + 0.5),
  ylim = range(c(bp_stats$stats, bp_stats$out)),  # 包含所有值和异常值的范围
  xlab = "Number of Cylinders",
  ylab = "Miles Per Gallon",
  main = "Car Milage Data",
  xaxt = "n",  # 先不画x轴刻度
  pch = 16,    # 中位数用实心圆点
  cex = 1.2    # 放大中位数点
)

# 添加x轴刻度
axis(1, at = 1:length(unique(mtcars$cyl)), labels = unique(mtcars$cyl))

# 循环给每个组添加须和垂直线
for (i in 1:length(unique(mtcars$cyl))) {
  # 筛选当前组的异常值
  group_outliers <- bp_stats$out[bp_stats$group == i]
  
  if (length(group_outliers) > 0) {
    # 画连接中位数到异常值最小值、最大值的须
    lines(c(i, i), c(bp_stats$stats[3, i], min(group_outliers)), lty = 1)
    lines(c(i, i), c(bp_stats$stats[3, i], max(group_outliers)), lty = 1)
    
    # 在须的两端添加小垂直线
    lines(c(i - 0.1, i + 0.1), c(min(group_outliers), min(group_outliers)))
    lines(c(i - 0.1, i + 0.1), c(max(group_outliers), max(group_outliers)))
  }
}

# 添加异常值点（用红色突出）
points(bp_stats$group, bp_stats$out, pch = 19, col = "red")

或者更偷懒一点，直接用boxplot()的参数隐藏箱子和默认须，再补画自定义元素：

# 先画基础图，隐藏箱子、默认须和须端垂直线，只保留中位数和异常值
boxplot(mpg ~ cyl, data = mtcars,
        main = "Car Milage Data",
        xlab = "Number of Cylinders",
        ylab = "Miles Per Gallon",
        boxwex = 0,        # 箱子宽度设为0，隐藏箱子
        whisklty = 0,      # 隐藏默认的须
        staplelty = 0,     # 隐藏默认须的垂直线
        outline = TRUE,    # 保留异常值点
        medlwd = 2)        # 加粗中位数线

# 同样获取统计数据，补画自定义须和垂直线
bp_stats <- boxplot(mpg ~ cyl, data = mtcars, plot = FALSE)
for (i in 1:length(unique(mtcars$cyl))) {
  group_outliers <- bp_stats$out[bp_stats$group == i]
  if (length(group_outliers) > 0) {
    lines(c(i, i), c(bp_stats$stats[3, i], min(group_outliers)))
    lines(c(i, i), c(bp_stats$stats[3, i], max(group_outliers)))
    lines(c(i - 0.1, i + 0.1), c(min(group_outliers), min(group_outliers)))
    lines(c(i - 0.1, i + 0.1), c(max(group_outliers), max(group_outliers)))
  }
}

方法二：ggplot2实现 #

如果你习惯用ggplot2，这种定制化的图会更灵活，我们可以分步构建每个元素：

library(ggplot2)
library(dplyr)
library(tidyr)

# 先计算每个气缸组的中位数、异常值范围
mtcars_custom <- mtcars %>%
  group_by(cyl) %>%
  mutate(
    med = median(mpg),
    q1 = quantile(mpg, 0.25),
    q3 = quantile(mpg, 0.75),
    iqr = q3 - q1,
    lower_bound = q1 - 1.5 * iqr,
    upper_bound = q3 + 1.5 * iqr
  ) %>%
  # 筛选出异常值
  filter(mpg < lower_bound | mpg > upper_bound) %>%
  group_by(cyl) %>%
  summarise(
    med = unique(med),
    min_out = min(mpg),
    max_out = max(mpg),
    outliers = list(mpg)
  ) %>%
  unnest(outliers)  # 展开异常值列表

# 构建图形
ggplot() +
  # 添加异常值点
  geom_point(data = mtcars_custom,
             aes(x = factor(cyl), y = outliers),
             color = "red", size = 2) +
  # 添加中位数点
  geom_point(data = mtcars_custom %>% distinct(cyl, med),
             aes(x = factor(cyl), y = med),
             shape = 16, size = 3) +
  # 画连接中位数到异常值最小值的须
  geom_segment(data = mtcars_custom %>% distinct(cyl, med, min_out),
               aes(x = factor(cyl), xend = factor(cyl),
                   y = med, yend = min_out)) +
  # 画连接中位数到异常值最大值的须
  geom_segment(data = mtcars_custom %>% distinct(cyl, med, max_out),
               aes(x = factor(cyl), xend = factor(cyl),
                   y = med, yend = max_out)) +
  # 须下端的垂直线
  geom_segment(data = mtcars_custom %>% distinct(cyl, min_out),
               aes(x = as.numeric(factor(cyl)) - 0.1,
                   xend = as.numeric(factor(cyl)) + 0.1,
                   y = min_out, yend = min_out)) +
  # 须上端的垂直线
  geom_segment(data = mtcars_custom %>% distinct(cyl, max_out),
               aes(x = as.numeric(factor(cyl)) - 0.1,
                   xend = as.numeric(factor(cyl)) + 0.1,
                   y = max_out, yend = max_out)) +
  # 添加标题和坐标轴标签
  labs(title = "Car Milage Data",
       x = "Number of Cylinders",
       y = "Miles Per Gallon") +
  theme_bw()  # 用简洁的主题

两种方法都能实现你要的效果，基础R不需要额外包，ggplot2则更便于后续调整样式~

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