同一 plot 上的多個直方圖上的正態曲線

Question

我的示例 dataframe：

sample1 <- seq(100,157, length.out =  50)
sample2 <- seq(113, 167, length.out = 50)
sample3 <- seq(95,160, length.out = 50)
sample4 <-seq(88, 110, length.out = 50)

df <- as.data.frame(cbind(sample1, sample2, sample3, sample4))

我設法為這四個變量創建了直方圖，它們共享相同的 y 軸。 現在我需要一個疊加法線曲線。 根據以前的帖子，我已經管理了一條密度曲線，但這不是我想要的。 這很接近，但我想要一條平滑的線......

這是我當前的繪圖代碼：

df <- as.data.table(df)
new.df<-melt(df,id.vars="sample")
names(new.df)=c("sample","type","value")

cdat <- ddply(new.df, "type", summarise, value.mean=mean(value))

ggplot(data = new.df,aes(x=value)) +
    geom_histogram(aes(x = value), bins = 15, colour = "black", fill = "gray") + 
    facet_wrap(~ type) + geom_density(aes(x = value),alpha=.2, fill="#FF6666") +
    geom_vline(data=cdat, aes(xintercept=value.mean),
               linetype="dashed", size=1, colour="black") +
  theme_classic() + 
  theme(text = element_text(size = 15), element_line(size = 0.5),aspect.ratio = 0.75 )

我找到了下面的代碼，我希望它可以解決問題，但這沒有給我任何東西：

stat_function(fun = dnorm, args = list(mean = mean(df$value), sd = sd(df$value)))

Answer 1

不幸的是， stat_function不能很好地處理 facet：它在每個 facet 上覆蓋相同的 function，而不考慮 faceting 變量。

我看到人們在 Stack Overflow 上發布 ggplot 問題的最常見原因之一是他們在試圖強迫 ggplot 進行過多的數據操作時迷路了。 geom_smooth和geom_function類的函數是常見任務的有用助手，但如果你想做一些復雜或不常見的事情，最好將你想要的數據生成到 plot，然后是 plot 它。

事實上， ggplot2的主要作者在這個線程中推薦這種方法來解決與你的問題非常相似的問題，他說：

---

我認為你最好在 ggplot2 之外生成數據然后繪制它。 請參閱https://speakerdeck.com/jennybc/row-oriented-workflows-in-r-with-the-tidyverse開始。

_{哈德利·威克姆，2018 年 4 月 26 日}

---

所以這是使用 tidyverse 的一種方法。 您使用普通的舊dnorm為每個樣本和 plot 創建geom_line的數據框。

請注意，您的直方圖是計數，因此您需要將它們更改為密度，或者將 dnorm output 乘以觀察次數 * binwidth，否則您將在 x 軸上得到一條明顯“平坦”的線，因為dnorm與計數相比，值都將非常小：

library(plyr)
library(dplyr)
library(tidyr)
library(ggplot2)

dfn <- df %>% 
  pivot_longer(everything()) %>%
  ddply("name", function(x) {
          xvar <- seq(min(x$value), max(x$value), length.out = 100)
          data.frame(value = xvar, 
                     y = 5 * nrow(x) * dnorm(xvar, mean(x$value), sd(x$value)))
        })


df %>% 
  pivot_longer(everything()) %>%
  group_by(name) %>%
  mutate(mean = mean(value), sd = sd(value)) %>%
  ggplot(aes(value)) +
  geom_histogram(aes(x = value), binwidth = 5, 
                   colour = "black", fill = "gray") + 
  facet_wrap(~ name) + 
  geom_vline(aes(xintercept = mean), 
               linetype = "dashed", size=1, colour="black") +
  geom_line(data = dfn, aes(y = y)) +
  theme_classic() + 
  theme(text = element_text(size = 15), element_line(size = 0.5),
        aspect.ratio = 0.75 ) 

^{由代表 package (v0.3.0) 於 2020 年 12 月 7 日創建}