使用权重创建堆叠密度图

Question

我正在尝试使用ggplot2 创建一个加权密度图，显示两组的分布，每个组占某个分布的一小部分。我遇到的困难源于这样一个事实，尽管两组在数据中的观察数量相同，但它们的权重不同，我希望图表中每个组的区域都能反映这种权重差异。

我的数据看起来像这样。

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

请注意，第 1 组的权重较低（0.1 或 .2），而第 2 组的权重较高（0.9 或 .8）。另请注意，对于任何给定的 var 值，权重加起来为 1。在实际数据中，每个组所占的份额在 var 的分布中以更复杂的方式存在差异。

我尝试将这些数据绘制如下，虽然使用权重捕获了每个组内分布变化的方式，但它没有捕获分布变化的方式之间团体。

library(ggplot2)

var <- rnorm(1000, mean = 5, sd = 2)

df %>%
  ggplot(aes(x = var, group = id, fill = factor(id), weight = weight)) + 
  geom_density(position = 'stack')

结果图看起来像这样。

很明显，这些组分别不占密度曲线下面积的 15% 和 85% 左右，但是当我们使用position = 'fill' 时，这个问题就更清楚了。

每个组似乎占据了相似的区域，显然是因为在考虑分组之前应用了加权。我希望看到一个解决方案，该解决方案导致与第 1 组相关的区域与其重量相称（即比与第 2 组相关的区域小得多）。

需要澄清的是，与每个组相关的高度应该不同。在上图中，第 1 组和第 2 组之间的分界线应该明显更高，从而使第 1 组占据的区域明显更小。

Answer 1

处理两组的相对密度有点模棱两可。显然，每个组的密度需要有 1 的整数才能成为真实密度。最接近的可能是两条曲线的积分总和为 1，我认为这需要您自己进行密度计算，然后绘制为堆叠的geom_area：

library(tidyverse)

df %>%
  nest(data = -id) %>%
  summarize(id = factor(id),
            weight = unlist(map(data, ~sum(.x$weight))),
            dens = map(data, function(.x) {
              x <- density(.x$var, weights = .x$weight/sum(.x$weight))
              data.frame(x = x$x, y = x$y)
              })) %>%
  mutate(weight = weight / sum(weight)) %>%
  unnest(dens) %>%
  mutate(y = y * weight) %>%
  ggplot(aes(x, y, fill = id)) +
  geom_area(position = 'stack', color = 'black') +
  labs(y = 'density', x = 'var')

Answer 2

我不完全确定我是否正确理解您，但也许您可以根据重量预先计算值，然后像这样堆叠它：

library(ggplot2)
library(dplyr)

# Stacked
df %>%
  mutate(weighted_var = var*weight) %>%
  ggplot(aes(x = weighted_var, fill = factor(id), group = id)) +
  geom_density(position = 'stack')

并像这样检查填充组：

# Fill
df %>%
  mutate(weighted_var = var*weight) %>%
  ggplot(aes(x = weighted_var, fill = factor(id), group = id)) +
  geom_density(position = 'fill')

^{创建于 2022-11-01，reprex v2.0.2}