ggplot中结合geom_density与geom_histogram并显示计数Y轴的问题

想要制作两个仅颜色和X轴变量不同的分面直方图，同时叠加密度曲线，但当前代码存在两个问题：

1. 直方图Y轴被替换为密度值，无法显示原始计数
2. 两个图的Y轴范围不一致，右侧图重复显示Y轴刻度与标签

原始代码及数据如下：

library(patchwork)
library(tidyverse)

p1 <- ggplot(d, aes(x = hours)) +
  geom_histogram(aes(y = ..density..), 
                binwidth = 10, 
                fill = "goldenrod", alpha = 0.3, color = "black") +
  geom_density(aes(y = ..density..), 
               color = "dodgerblue3", lwd = 1) +  
  facet_wrap(~condition) +
  scale_x_continuous(breaks = seq(10, 90, by = 10),
                     expand = c(0, 0)) +
  labs(title = "Hours")

p2 <- ggplot(d, aes(x = money)) +
  geom_histogram(aes(y = ..density..), 
                binwidth = 10, 
                fill = "palegreen2", alpha = 0.3, color = "black") +
  geom_density(aes(y = ..density..), 
               color = "pink2", lwd = 1) +  
  facet_wrap(~condition) +
  scale_x_continuous(breaks = seq(10, 90, by = 10),
                     expand = c(0, 0)) +
  labs(title = "Money",
       y = NULL)

p1 + p2

d<-structure(list(hours = c(70, 10, 20, 10, 50, 10, 
50, 60, 50, 70, 40, 90, 40, 60, 70, 40, 50, 60, 80, 10, 90, 50, 
40, 40, 70, 50, 40, 10, 80, 70, 70, 90, 20, 10, 60, 90, 10, 20, 
90, 70, 30, 60, 90, 60, 90, 20, 20, 20, 10, 40), money = c(60, 
70, 10, 10, 40, 30, 40, 40, 50, 80, 90, 70, 50, 60, 80, 20, 10, 
90, 20, 40, 90, 40, 30, 60, 40, 60, 70, 90, 10, 20, 80, 90, 80, 
60, 70, 70, 60, 50, 60, 90, 90, 80, 60, 40, 30, 80, 30, 20, 60, 
20), condition = structure(c(4L, 5L, 5L, 5L, 5L, 2L, 4L, 4L, 
2L, 3L, 5L, 3L, 5L, 4L, 3L, 5L, 2L, 3L, 4L, 3L, 2L, 3L, 3L, 2L, 
4L, 4L, 2L, 3L, 2L, 5L, 3L, 5L, 2L, 4L, 5L, 2L, 5L, 2L, 2L, 3L, 
5L, 2L, 3L, 5L, 5L, 5L, 4L, 2L, 3L, 5L), levels = c("condition_control", 
"conditionA", "conditionB", "conditionC", "conditionD"
), class = "factor")), class = c("grouped_df", "tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -50L), groups = structure(list(
    condition = structure(2:5, levels = c("condition_control", 
    "conditionA", "conditionB", "conditionC", "conditionD"
    ), class = "factor"), .rows = structure(list(c(6L, 9L, 17L, 
    21L, 24L, 27L, 29L, 33L, 36L, 38L, 39L, 42L, 48L), c(10L, 
    12L, 15L, 18L, 20L, 22L, 23L, 28L, 31L, 40L, 43L, 49L), c(1L, 
    7L, 8L, 14L, 19L, 25L, 26L, 34L, 47L), c(2L, 3L, 4L, 5L, 
    11L, 13L, 16L, 30L, 32L, 35L, 37L, 41L, 44L, 45L, 46L, 50L
    )), ptype = integer(0), class = c("vctrs_list_of", "vctrs_vctr", 
    "list"))), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-4L), .drop = TRUE))

1. 保留直方图原始计数Y轴，同时叠加密度曲线 #

核心是把密度曲线的Y值转换为计数刻度下的对应值：

• 去掉geom_histogram的y = ..density..，默认显示计数
• 对geom_density的Y轴做转换：y = ..density.. * n() * 10，其中n()是每个分面的样本量，10是你设置的binwidth（密度×样本量×组距=计数刻度下的密度值）

2. 统一Y轴范围，隐藏右侧图的Y轴刻度与标签 #

• 提前计算两个变量的直方图最大计数，设置共同的Y轴范围
• 用theme隐藏右侧图的Y轴刻度和标签

修改后的完整代码 #

library(patchwork)
library(tidyverse)

# 计算两个变量的最大计数，统一Y轴范围
max_count <- max(
  hist(d$hours, breaks = seq(10, 90, by = 10), plot = FALSE)$counts,
  hist(d$money, breaks = seq(10, 90, by = 10), plot = FALSE)$counts
)

p1 <- ggplot(d, aes(x = hours)) +
  geom_histogram(binwidth = 10, fill = "goldenrod", alpha = 0.3, color = "black") +
  # 转换密度曲线Y值匹配计数刻度
  geom_density(aes(y = ..density.. * n() * 10), color = "dodgerblue3", lwd = 1) +  
  facet_wrap(~condition) +
  scale_x_continuous(breaks = seq(10, 90, by = 10), expand = c(0, 0)) +
  scale_y_continuous(limits = c(0, max_count), expand = c(0, 0)) +
  labs(title = "Hours")

p2 <- ggplot(d, aes(x = money)) +
  geom_histogram(binwidth = 10, fill = "palegreen2", alpha = 0.3, color = "black") +
  geom_density(aes(y = ..density.. * n() * 10), color = "pink2", lwd = 1) +  
  facet_wrap(~condition) +
  scale_x_continuous(breaks = seq(10, 90, by = 10), expand = c(0, 0)) +
  scale_y_continuous(limits = c(0, max_count), expand = c(0, 0)) +
  labs(title = "Money", y = NULL) +
  # 隐藏Y轴刻度和标签
  theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())

p1 + p2

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