如何解决离散值直方图叠加正态曲线扁平的问题？

背景 #

参与者对多项条目进行1-6分评分，需绘制各评分的频数分布，数据为离散值。

原始数据样本 #

structure(list(item = c("beads_1", "beads_2", "notebook_1", "notebook_2", 
"notebook_3", "notebook_4"), values = c(3L, 4L, 4L, 2L, 2L, 4L
), pid = c("5fb030143a5ee13bad82db81", "5fb030143a5ee13bad82db81", 
"5fb030143a5ee13bad82db81", "5fb030143a5ee13bad82db81", "5fb030143a5ee13bad82db81", 
"5fb030143a5ee13bad82db81"), age = c(25L, 25L, 25L, 25L, 25L, 
25L), sex = c(1L, 1L, 1L, 1L, 1L, 1L), bapq = c(3.166666667, 
3.166666667, 3.166666667, 3.166666667, 3.166666667, 3.166666667
), item_run = c(1L, 2L, 1L, 1L, 2L, 2L)), row.names = c(NA, 6L
), class = "data.frame")

统计频数的代码 #

unique.rate <- sort(unique(adu_pref2$values))
count <- table(adu_pref2$values)
count.rate <- data.frame(unique.rate, count)
count.rate <- count.rate[, -c(2)]

生成的频数数据框 #

structure(list(unique.rate = 1:6, Freq = c(2095L, 2905L, 5059L, 
8413L, 6666L, 3540L)), class = "data.frame", row.names = c(NA, 
-6L))

绘图代码（存在问题） #

adu_plot <- ggplot(count.rate, aes(unique.rate, Freq, fill=unique.rate, width = 1))

adu_plot + geom_bar(stat="identity") + 
        labs(y="Frequency", x="Rating") + 
        theme(legend.position="none") + stat_function(
    fun = dnorm, 
    args = list(count.rate, mean = mean(count.rate$Freq), sd = sd(count.rate$Freq)), 
    color = "red", 
    size = 1.2)

问题表现 #

直方图显示正常，但叠加的正态曲线底部呈扁平状，不符合预期：

解决方法 #

问题根源 #

1. stat_function的args参数错误传入了数据框count.rate，dnorm仅需mean和sd两个参数；
2. 错误使用了频数的均值和标准差，应基于原始评分数据（adu_pref2$values）计算统计量；
3. dnorm返回的是概率密度，需转换为频数（乘以总样本数×组距，此处组距为1）才能匹配直方图的频数刻度。

修正后的代码 #

# 基于原始评分数据计算均值和标准差
mean_vals <- mean(adu_pref2$values)
sd_vals <- sd(adu_pref2$values)
# 计算总样本数
total_n <- nrow(adu_pref2)

adu_plot <- ggplot(count.rate, aes(unique.rate, Freq, fill=unique.rate, width = 1))

adu_plot + geom_bar(stat="identity") + 
  labs(y="Frequency", x="Rating") + 
  theme(legend.position="none") + 
  stat_function(
    # 自定义函数将密度转换为频数
    fun = function(x) dnorm(x, mean = mean_vals, sd = sd_vals) * total_n * 1,
    color = "red", 
    size = 1.2
  )

补充说明 #

因评分是离散值（1-6），若想让曲线更贴合离散分布形态，可指定stat_function的n参数增加采样点，让曲线更平滑：

stat_function(
  fun = function(x) dnorm(x, mean = mean_vals, sd = sd_vals) * total_n * 1,
  color = "red", 
  size = 1.2,
  n = 100
)

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