用 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

用 geom_density 绘制的鳞片密度曲线与 geom_histogram 的相似高度？

Scale density curve made with geom_density to similar height of geom_histogram?

curve

r

histogram

ggplot2

density-plot