用 geom_density 制作的比例密度曲线到 geom_histogram 的相似高度？

Question

我需要将密度线与 geom_histogram 的高度对齐，并将计数值保持在 y 轴上而不是密度上。

我有这两个版本：

#  Creating dataframe
library(ggplot2)

values <- c(rep(0,2), rep(2,3), rep(3,3), rep(4,3), 5, rep(6,2), 8, 9, rep(11,2))
data_to_plot <- as.data.frame(values)

# Option 1 ( y scale shows frequency, but geom_density line and geom_histogram are not matching )
ggplot(data_to_plot, aes(x = values)) +
  geom_histogram(aes(y = ..count..), binwidth = 1, colour= "black", fill = "white") +
  geom_density(aes(y=..count..), fill="blue", alpha = .2)+
  scale_x_continuous(breaks = seq(0, max(data_to_plot$values), 1))

y 比例显示频率，但 geom_density 线和 geom_histogram 不匹配

# Option 2 (geom_density line and geom_histogram are matching, but y scale density = 1)

ggplot(data_to_plot, aes(x = values)) +
  geom_histogram(aes(y = after_stat(ndensity)), binwidth = 1, colour= "black", fill = "white") +
  geom_density(aes(y = after_stat(ndensity)), fill="blue", alpha = .2)+
  scale_x_continuous(breaks = seq(0, max(data_to_plot$values), 1))

geom_density 线和 geom_histogram 是匹配的，但是 y 比例密度 = 1

我需要的是选项 2 中的绘图，但选项 1 中的 Y 比例尺。我可以通过为此特定数据添加 (aes(y=1.25*..count..) 来获得它，但我的数据不是静态的，这不适用于另一个数据集（只需修改values 测试）：

# Option 3 (with coefficient in aes())
ggplot(data_to_plot, aes(x = values)) +
  geom_histogram(aes(y = ..count..), binwidth = 1, colour= "black", fill = "white") +
  geom_density(aes(y=1.25*..count..), fill="blue", alpha = .2)+
  scale_x_continuous(breaks = seq(0, max(data_to_plot$values), 1))

期望的结果：y 比例显示频率和 geom_density 线与 geom_histogram 高度匹配

我无法对系数或 bin 进行硬编码。 这个问题与这里讨论的问题很接近，但它不适用于我的情况：

Programatically scale density curve made with geom_density to similar height to geom_histogram?

How to put geom_density and geom_histogram on same counts scale

Answer 1

密度曲线总是代表 0 和 1 之间的数据，而计数数据是 1 的倍数。因此，将这些数据绘制到同一个 y 轴上几乎没有意义。

左图显示了与您提供的数据相似的数据的密度线和直方图 - 我只是添加了一些。条形的高度显示相应 x 值的计数百分比。 y 尺度小于 1。

右图显示与左图相同，但添加了另一个显示计数的直方图。 y 尺度上升，2 个密度图缩小。

如果您想将两者缩放到相同的比例，您可以通过计算比例因子来实现。我已使用此比例因子将第二个 y 轴添加到第三个绘图并相应地出售第二个 y 轴。

为了明确什么属于什么比例，我将第二个 y 轴和属于它的数据涂成红色。

library(ggplot2)
library(patchwork)

values <- c(rep(0,2),rep(1,4), rep(2,6), rep(3,8), rep(4,12), rep(5,7), rep(6,4),rep(7,2))
df <- as.data.frame(values)

p1 <- ggplot(df, aes(x = values)) +
  stat_density(geom = 'line') +
  geom_histogram(aes(y = ..density..), binwidth = 1,color = 'white', fill = 'red', alpha = 0.2) 

p2 <- ggplot(df, aes(x = values)) +
  stat_density(geom = 'line') +
  geom_histogram(aes(y = ..count..), binwidth = 1, color = 'white', alpha = 0.2) +
  geom_histogram(aes(y = ..density..), binwidth = 1, color = 'white', alpha = 0.2) +
  ylab('density and counts')

# Find maximum of ..density..
m <- max(table(df$values)/sum(table(df$values)))

# Find maxium of df$values
mm <- max(table(df$values))

# Create Scaling factor for secondary axis
scaleF <- m/mm

p3 <- p1 + scale_y_continuous(
  limits = c(0, m),
  # Features of the first axis
  name = "density",
  # Add a second axis and specify its features
  sec.axis = sec_axis( trans=~(./scaleF), name = 'counts')
  ) + 
  theme(axis.ticks.y.right = element_line(color = "red"),
        axis.line.y.right = element_line(color = 'red'),
        axis.text.y.right = element_text(color = 'red'),
        axis.title.y.right = element_text(color = 'red')) +
  annotate("segment", x = 5, xend = 7, 
           y = 0.25, yend = .25, colour = "pink", size=3, alpha=0.6, arrow=arrow())

p1 | p2 | p3