如何在密度图中添加终止于图形区域内的均值/中位数线

需求说明 #

在分组密度图中为每个物种的Sepal.Length均值添加垂直线，要求线条仅从x轴延伸到对应密度曲线的顶部，而非贯穿整个绘图区域。

实现步骤 #

核心思路是先计算每个组均值对应的密度y值，再用geom_segment替代geom_vline绘制精准长度的线段。

修改后的完整代码 #

library(data.table)
library(ggplot2)

iris <- as.data.table(iris)

# 计算每组的均值和标准误
iris_summary <- iris[, .(
  sepal_mean = mean(Sepal.Length),
  sepal_se_low = mean(Sepal.Length) - sd(Sepal.Length)/sqrt(.N),
  sepal_se_high = mean(Sepal.Length) + sd(Sepal.Length)/sqrt(.N)
), by = Species]

# 定义函数：获取均值对应的密度曲线y值
get_density_y_at_mean <- function(species_data, mean_val) {
  dens <- density(species_data$Sepal.Length)
  # 通过插值匹配均值对应的密度y值
  dens_y <- approx(x = dens$x, y = dens$y, xout = mean_val)$y
  return(dens_y)
}

# 给统计结果添加均值对应的密度y值
iris_summary[, dens_y := get_density_y_at_mean(iris[Species == .BY[[1]]], sepal_mean), by = Species]

# 合并所有组的密度数据（用于标准误区域覆盖）
df.dens <- rbindlist(lapply(unique(iris$Species), function(sp) {
  dens <- density(iris[Species == sp, Sepal.Length])
  data.table(x = dens$x, y = dens$y, Species = sp)
}))

# 绘制图形
iris_density <- ggplot() +
  # 分组密度图
  geom_density(data = iris, aes(x = Sepal.Length, fill = Species), alpha = 0.5) +
  # 标准误区间白色覆盖区域
  geom_area(data = df.dens[Species == "setosa" & x %between% iris_summary[Species == "setosa", .(sepal_se_low, sepal_se_high)]],
            aes(x = x, y = y), fill = "white", alpha = 0.5) +
  geom_area(data = df.dens[Species == "versicolor" & x %between% iris_summary[Species == "versicolor", .(sepal_se_low, sepal_se_high)]],
            aes(x = x, y = y), fill = "white", alpha = 0.5) +
  geom_area(data = df.dens[Species == "virginica" & x %between% iris_summary[Species == "virginica", .(sepal_se_low, sepal_se_high)]],
            aes(x = x, y = y), fill = "white", alpha = 0.5) +
  # 绘制终止于密度顶部的均值垂直线
  geom_segment(data = iris_summary,
               aes(x = sepal_mean, xend = sepal_mean, y = 0, yend = dens_y),
               linetype = 2, linewidth = 0.7, color = "black")

print(iris_density)

关键修改点 #

• 新增插值函数：用approx解决密度数据点不一定刚好落在均值上的问题，精准匹配均值对应的密度y值。
• 替换线段绘制方式：用geom_segment明确指定线段起点（y=0）和终点（y=对应密度值），实现线条仅延伸到曲线顶部的效果。
• 简化数据合并逻辑：用rbindlist+lapply替代重复代码，让脚本更简洁易维护。

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