在R中的ggplot2中一起使用stat_function和facet_wrap

Question

我试图用ggplot2绘制格子类型数据,然后在样本数据上叠加正态分布,以说明基础数据的正常程度.我想让顶部的正常dist与面板具有相同的均值和stdev.

这是一个例子:

library(ggplot2)

#make some example data
dd<-data.frame(matrix(rnorm(144, mean=2, sd=2),72,2),c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")

#This works
pg <- ggplot(dd) + geom_density(aes(x=Predicted_value)) +  facet_wrap(~State_CD)
print(pg)

这一切都很好,并产生了一个很好的三个数据面板图.如何在顶部添加正常dist？看来我会使用stat_function,但这会失败:

#this fails
pg <- ggplot(dd) + geom_density(aes(x=Predicted_value)) + stat_function(fun=dnorm) +  facet_wrap(~State_CD)
print(pg)

似乎stat_function与facet_wrap功能不相符.我如何让这两个玩得很好？

- - - - - - 编辑 - - - - -

我试图整合下面两个答案中的想法,但我仍然没有:

使用这两个答案的组合我可以一起破解这个:

library(ggplot)
library(plyr)

#make some example data
dd<-data.frame(matrix(rnorm(108, mean=2, sd=2),36,2),c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")

DevMeanSt <- ddply(dd, c("State_CD"), function(df)mean(df$Predicted_value)) 
colnames(DevMeanSt) <- c("State_CD", "mean")
DevSdSt <- ddply(dd, c("State_CD"), function(df)sd(df$Predicted_value) )
colnames(DevSdSt) <- c("State_CD", "sd")
DevStatsSt <- merge(DevMeanSt, DevSdSt)

pg <- ggplot(dd, aes(x=Predicted_value))
pg <- pg + geom_density()
pg <- pg + stat_function(fun=dnorm, colour='red', args=list(mean=DevStatsSt$mean, sd=DevStatsSt$sd))
pg <- pg + facet_wrap(~State_CD)
print(pg)

这是非常接近...除了正常的dist绘图有问题:

我在这做错了什么？

Answer 1

stat_function旨在覆盖每个面板中的相同功能.(没有明显的方法来匹配函数的参数与不同的面板).

正如Ian建议的那样,最好的方法是自己生成正常曲线,并将它们绘制为一个单独的数据集(这是你以前出错的地方 - 合并对于这个例子来说没有意义,如果你仔细看你会看到这就是为什么你会得到奇怪的锯齿模式).

以下是我如何解决问题:

dd <- data.frame(
  predicted = rnorm(72, mean = 2, sd = 2),
  state = rep(c("A", "B", "C"), each = 24)
) 

grid <- with(dd, seq(min(predicted), max(predicted), length = 100))
normaldens <- ddply(dd, "state", function(df) {
  data.frame( 
    predicted = grid,
    density = dnorm(grid, mean(df$predicted), sd(df$predicted))
  )
})

ggplot(dd, aes(predicted))  + 
  geom_density() + 
  geom_line(aes(y = density), data = normaldens, colour = "red") +
  facet_wrap(~ state) 

Answer 2

最初作为这个问题的答案发布，我也被鼓励在这里分享我的解决方案。

我也对将理论密度叠加在经验数据上感到沮丧，所以我编写了一个函数来自动化这个过程。自从 2009 年这个问题首次提出以来，ggplot2 极大地扩展了可扩展性，所以我将它放在 github 上的扩展包中（编辑：你现在可以在 CRAN 上找到它）。

library(ggplot2)
library(ggh4x)

set.seed(0)

# Make the example data
dd <- data.frame(matrix(rnorm(144, mean=2, sd=2),72,2),
                 c(rep("A",24),rep("B",24),rep("C",24)))
colnames(dd) <- c("x_value", "Predicted_value",  "State_CD")

ggplot(dd, aes(Predicted_value)) +
  geom_density() +
  stat_theodensity(colour = "red") +
  facet_wrap(~ State_CD)

^{由reprex 包(v0.3.0)于 2021-01-28 创建}

Answer 3

如果您愿意使用 ggformula，那么这非常简单。（也可以混合搭配并使用 ggformula 仅用于分布覆盖，但我将说明完整的 ggformula 方法。）

library(ggformula)
theme_set(theme_bw())

gf_dens( ~ Sepal.Length | Species, data = iris) %>%
  gf_fitdistr(color = "red") %>% 
  gf_fitdistr(dist = "gamma", color = "blue")

^{由reprex 包(v0.2.1)于 2019-01-15 创建}