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

Posted 2023-02-16

【中文标题】在 R 的 ggplot2 中一起使用 stat_function 和 facet_wrap

【英文标题】：using stat_function and facet_wrap together in ggplot2 in R

【发布时间】：2010-11-25 12:09:00

【问题描述】：

我正在尝试使用 ggplot2 绘制晶格类型数据，然后在样本数据上叠加正态分布，以说明基础数据与正常值相差多远。我希望顶部的普通 dist 具有与面板相同的均值和标准差。

这是一个例子：

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 绘图有问题：

我在这里做错了什么？

【问题讨论】：

以后，您能否使用混合大小写的 或 下划线的变量名，但不能同时使用两者。它要了我的命！

好的，这很好。 :)

我将“答案”移到了问题区域。我应该把它放在那里开始。我向那些制作 cmets 的人道歉，因为他们没有转移。以后我会更加深思熟虑如何做到这一点。

【参考方案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) 

【讨论】：

在您解释之后，这完全有道理。 stat_function 是为单曲线设计的，这对我来说并不直观。我只是假设我做错了。感谢您花时间举例说明，这非常有帮助。

还是stat_function不能为每个面板提供不同的曲线吗？似乎人们只是想传递一个命名的函数列表，并将这些名称与提供给facet_wrap 的分类变量相匹配，或者将函数作为参数提供在原始数据表中？

@cboettig 不，而且不太可能会。命名列表不适用于多个分面变量。

@hadley 我不明白这个问题。为什么stat_function 不能仅引用特定面板中绘制的数据框部分来评估其参数？

【参考方案2】：

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

我也对将理论密度覆盖在经验数据上感到沮丧，所以我编写了一个函数来自动化这个过程。自 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 package (v0.3.0) 于 2021-01-28 创建}

【参考方案3】：

我认为您需要提供更多信息。这似乎有效：

 pg <- ggplot(dd, aes(Predicted_value)) ## need aesthetics in the ggplot
 pg <- pg + geom_density() 
 ## gotta provide the arguments of the dnorm
 pg <- pg + stat_function(fun=dnorm, colour='red',            
            args=list(mean=mean(dd$Predicted_value), sd=sd(dd$Predicted_value)))
 ## wrap it!
 pg <- pg + facet_wrap(~State_CD)
 pg

我们为每个面板提供相同的均值和 sd 参数。获取特定面板的平均值和标准差作为练习留给读者* ;)

'*' 也就是说，不知道怎么弄……

【讨论】：

面板特定均值和标准差可以通过使用 library(plyr) 和 ddply(dd, .(State_CD), summarise, ...) 获得

努力，但是... OP 在顶部声明"I would like to have the normal dist on top to have the same mean and stdev as the panel."

【参考方案4】：

如果你愿意使用 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 package (v0.2.1) 于 2019-01-15 创建}

【讨论】：

答案很好，但代码必须符合问题：library(ggformula);主题集（主题bw（））； dd % gf_fitdistr(dist = "dnorm", color = "blue")

【参考方案5】：

如果您不想“手动”生成正态分布折线图，仍然使用 stat_function，并并排显示图形——那么您可以考虑使用“Cookbook”上发布的“multiplot”函数for R" 作为 facet_wrap 的替代方案。您可以将多图代码复制到您的项目from here。

复制代码后，请执行以下操作：

# Some fake data (copied from hadley's answer)
dd <- data.frame(
  predicted = rnorm(72, mean = 2, sd = 2),
  state = rep(c("A", "B", "C"), each = 24)
) 

# Split the data by state, apply a function on each member that converts it into a 
# plot object, and return the result as a vector.
plots <- lapply(split(dd,dd$state),FUN=function(state_slice) 
  # The code here is the plot code generation. You can do anything you would 
  # normally do for a single plot, such as calling stat_function, and you do this 
  # one slice at a time.
  ggplot(state_slice, aes(predicted)) + 
    geom_density() + 
    stat_function(fun=dnorm, 
                  args=list(mean=mean(state_slice$predicted), 
                            sd=sd(state_slice$predicted)),
                  color="red")
)

# Finally, present the plots on 3 columns.
multiplot(plotlist = plots, cols=3)

【参考方案6】：

我认为最好的办法是使用 geom_line 手动绘制线。

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")
dd$Predicted_value<-dd$Predicted_value*as.numeric(dd$State_CD) #make different by state

##Calculate means and standard deviations by level
means<-as.numeric(by(dd[,2],dd$State_CD,mean))
sds<-as.numeric(by(dd[,2],dd$State_CD,sd))

##Create evenly spaced evaluation points +/- 3 standard deviations away from the mean
dd$vals<-0
for(i in 1:length(levels(dd$State_CD)))
    dd$vals[dd$State_CD==levels(dd$State_CD)[i]]<-seq(from=means[i]-3*sds[i], 
                            to=means[i]+3*sds[i],
                            length.out=sum(dd$State_CD==levels(dd$State_CD)[i]))

##Create normal density points
dd$norm<-with(dd,dnorm(vals,means[as.numeric(State_CD)],
                        sds[as.numeric(State_CD)]))


pg <- ggplot(dd, aes(Predicted_value)) 
pg <- pg + geom_density() 
pg <- pg + geom_line(aes(x=vals,y=norm),colour="red") #Add in normal distribution
pg <- pg + facet_wrap(~State_CD,scales="free")
pg