如何用ggplot2绘制带权重的堆叠密度图？

问题背景 #

需要绘制加权堆叠密度图，两组观测数量相同但权重差异显著，要求每组的曲线下面积对应其权重在整体中的占比（组1面积远小于组2），但使用geom_density(position='stack')或position='fill'无法达到预期效果。

解决方案 #

核心思路是：geom_density的weight参数仅对组内观测的密度估计加权，若要让组间面积匹配权重比例，需对每组的密度曲线进行比例缩放。以下提供两种简洁的实现方式：

方法1：利用geom_density的scale参数（推荐）

直接在绘图时指定每组的缩放比例，该比例为组总权重占整体总权重的比值：

library(tidyverse)

# 生成示例数据
set.seed(123) # 固定随机种子保证结果可复现
var <- sort(rnorm(1000, mean = 5, sd = 2))
df <- tibble(
  id = c(rep(1, 1000), rep(2, 1000)), 
  var = c(var, var), 
  weight = c(rep(.1, 500), rep(.2, 500), rep(.9, 500), rep(.8, 500))
)

# 计算每组的缩放比例：组总权重 / 整体总权重
group_scales <- df %>% 
  group_by(id) %>% 
  summarise(scale_ratio = sum(weight)/sum(df$weight), .groups = "drop")

# 绘图
ggplot(df, aes(x = var, group = id, fill = factor(id), weight = weight)) +
  geom_density(position = "stack", aes(scale = scale_ratio), alpha = 0.7) +
  labs(x = "var", y = "Density", fill = "Group") +
  theme_minimal()

方法2：预计算加权密度后用geom_area绘制

先手动计算每组的加权密度，再调整密度值的缩放比例，最后用geom_area堆叠：

library(tidyverse)

# 生成示例数据（同上）
set.seed(123)
var <- sort(rnorm(1000, mean = 5, sd = 2))
df <- tibble(
  id = c(rep(1, 1000), rep(2, 1000)), 
  var = c(var, var), 
  weight = c(rep(.1, 500), rep(.2, 500), rep(.9, 500), rep(.8, 500))
)

# 计算每组总权重
group_weights <- df %>% 
  group_by(id) %>% 
  summarise(total_weight = sum(weight), .groups = "drop")

# 计算加权密度并缩放
density_data <- df %>% 
  group_by(id) %>% 
  summarise(dens = list(density(var, weights = weight, n = 1000)), .groups = "drop") %>% 
  unnest_wider(dens) %>% 
  select(id, x, y) %>% 
  left_join(group_weights, by = "id") %>% 
  # 缩放密度值，使组面积对应权重占比
  mutate(y_scaled = y * total_weight / sum(group_weights$total_weight))

# 绘图
ggplot(density_data, aes(x = x, y = y_scaled, fill = factor(id))) +
  geom_area(position = "stack", alpha = 0.7) +
  labs(x = "var", y = "Density", fill = "Group") +
  theme_minimal()

效果说明 #

两种方法都能让组1的曲线下面积约占15%，组2约占85%，完全匹配权重比例。其中方法1更简洁，直接利用ggplot的内置参数实现；方法2更灵活，适合需要对密度结果做进一步处理的场景。

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