问题描述
我正在尝试创建一个扩展 ggplot2 的自定义函数。该函数的目标是叠加具有水平和垂直标准误差的均值。下面的代码完成了整个事情。
library(plyr)
library(tidyverse)
summ <- ddply(mtcars,.(),summarise,dratSE = sqrt(var(drat))/length(drat),mpgSE = sqrt(var(mpg))/length(mpg),drat = mean(drat),mpg = mean(mpg))
ggplot(data = mtcars,mapping = aes(x = drat,y = mpg)) +
geom_point(shape = 21,fill = 'black',color = 'white',size = 3) +
geom_errorbarh(data = summ,aes(xmin = drat - dratSE,xmax = drat + dratSE)) +
geom_errorbar(data = summ,aes(ymin = mpg - mpgSE,ymax = mpg+mpgSE),width = .1) +
geom_point(data = summ,color='red',size=4)
理想情况下,只需使用 geom_scattermeans()
之类的函数即可完成这一切。但我不确定美学如何从 geom
转移到后续 ggplot()
函数中。
此外,我在制作一个接收列名作为参数的函数并使其与 ddply()
一起工作时遇到了困难。
解决方法
我认为 plyr
在这一点上已经不复存在了。我会推荐 dplyr
包。使用 dplyr
进行编程时,您可以使用 {{
(大卷曲,或作为 documentation says 拥抱)正确引用表达式。
library(ggplot2)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter,lag
#> The following objects are masked from 'package:base':
#>
#> intersect,setdiff,setequal,union
geom_point_error <- function(data,x,y,color = 'red',size = 4) {
data <- dplyr::summarise(
data,x_se = sqrt(var({{x}}))/length({{x}}),y_se = sqrt(var({{y}}))/length({{y}}),x = mean({{x}}),y = mean({{y}})
)
list(
geom_errorbarh(data = data,mapping = aes(y = y,xmin = x - x_se,xmax = x + x_se),inherit.aes = F),geom_errorbar(data = data,mapping = aes(x = x,ymin = y - y_se,ymax = y + y_se),width = .1,geom_point(data = data,y = y),color = color,size = size)
)
}
ggplot(data = mtcars,mapping = aes(x = drat,y = mpg)) +
geom_point(shape = 21,fill = 'black',color = 'white',size = 3) +
geom_point_error(mtcars,x = drat,y = mpg)
由 reprex package (v1.0.0) 于 2021 年 5 月 17 日创建
第二个选择是构建您自己的 ggproto
Geom
来处理 ggplot2
中的这些计算,但现在有点太多了。
因为我的第一个答案仍然是更简单的解决方案,所以我决定保留它。这个答案应该让 OP 更接近他们的目标。
根据您要执行的操作,构建 ggproto 对象可能很麻烦。在您的情况下,您将 3 个 ggproto
Geoms
类与新 Stat
的可能性结合在一起。
三个几何体是:
GeomErrorbar
GeomErrorbarh
GeomPoint
首先,有时您只需要继承其中一个类并覆盖该方法,但要将这三个类合并在一起,您需要做更多的工作。
让我们首先考虑这些 Geoms
中的每一个如何绘制它们的 grid
对象。根据 Geom
,它位于这些函数 draw_layer()
、draw_panel()
和 draw_group()
之一中。幸运的是,我们想要使用的每个 geom 只使用 draw_panel()
,这对我们来说意味着更少的工作 - 我们将直接调用这些方法并构建一个新的 grobTree
对象。我们只需要注意所有正确的参数都将传递给我们新的 Geom
的 draw_panel()
方法。
在开始编写自己的 draw_panel
之前,我们必须首先考虑 setup_params()
和 setup_data()
函数。有时,这些会直接修改数据。这些步骤通常有助于在此处进行自动处理,并且通常用于标准化/转换数据。一个很好的例子是 GeomTile
和 GeomRect
,它们本质上是相同的 Geom
,但它们的 setup_data()
函数不同,因为它们的参数化不同。
假设您只想分配一个 x
和一个 y
美学,并留下 xmin
、ymin
、xmax
和 { {1}} 到 geoms/stats。
幸运的是,ymax
只返回未经修改的数据,因此我们需要先合并 GeomPoint
和 GeomErrorbar
的 GeomErrorbarh
。为了跳过某些步骤,我将创建一个新的 setup_data()
,它将负责在 Stat
方法中为我们转换这些值。
请注意,compute_group()
和 GeomErrorbar
允许包含另一个参数 - GeomErrorbarh
和 width
,分别控制误差线的平坦部分的宽度
此外,在这些函数中,每个函数都会创建自己的 height
,xmin
,xmax
,ymin
- 所以我们需要区分这些参数。
首先将需要的信息加载到命名空间中
ymax
从新的 library(ggplot2)
library(grid)
"%||%" <- ggplot2:::`%||%`
开始,我决定将其称为 Stat
PointError
现在是有趣的部分,StatPointError <- ggproto(
"StatPointError",Stat,#having `width` and `height` as named parameters here insure
#that they will be available to the `Stat` ggproto object.
compute_group = function(data,scales,width = NULL,height = NULL){
data$width <- data$width %||% width %||% (resolution(data$x,FALSE)*0.9)
data$height <- data$height %||% height %||% (resolution(data$y,FALSE)*0.9)
data <- transform(
data,x = mean(x),y = mean(y),# positions for flat parts of vertical error bars
xmin = mean(x) - width /2,xmax = mean(x) + width / 2,# y positions of vertical error bars
ymin = mean(y) - sqrt(var(y))/length(y),ymax = mean(y) + sqrt(var(y))/length(y),#positions for flat parts of horizontal error bars
ymin_h = mean(y) - height /2,ymax_h = mean(y) + height /2,height = NULL,# x positions of horizontal error bars
xmin_h = mean(x) - sqrt(var(x))/length(x),xmax_h = mean(x) + sqrt(var(x))/length(x)
)
unique(data)
}
)
,我再次将 Geom
作为一致的名称。
PointError
最后,我们需要一个函数供用户调用,该函数将创建一个 GeomPointError <- ggproto(
"GeomPointError",GeomPoint,#include some additional defaults
default_aes = aes(
shape = 19,colour = "black",size = 1.5,# error bars have defaults of 0.5 - you may want to add another parameter?
fill = NA,alpha = NA,linetype = 1,stroke = 0.5,# for GeomPoint
width = 0.5,# for GeomErrorbar
height = 0.5,# for GeomErrorbarh
),draw_panel = function(data,panel_params,coord,na.rm = FALSE) {
#make errorbar grobs
data_errbar <- data
data_errbar[["size"]] <- 0.5
errorbar_grob <- GeomErrorbar$draw_panel(data = data_errbar,panel_params = panel_params,coord = coord,width = width,flipped_aes = FALSE)
#re-parameterize errbarh data
data_errbarh <- transform(data,xmin = xmin_h,xmax = xmax_h,ymin = ymin_h,ymax = ymax_h,xmin_h = NULL,xmax_h = NULL,ymin_h = NULL,ymax_h = NULL,size = 0.5)
#make errorbarh grobs
errorbarh_grob <- GeomErrorbarh$draw_panel(data = data_errbarh,height = height)
point_grob <- GeomPoint$draw_panel(data = data,na.rm = na.rm)
gt <- grobTree(
errorbar_grob,errorbarh_grob,point_grob,name = 'geom_point_error')
gt
}
)
对象。
Layer
现在我们可以测试这是否正常工作
geom_point_error <- function(mapping = NULL,data = NULL,position = "identity",...,na.rm = FALSE,show.legend = NA,inherit.aes = TRUE) {
layer(
data = data,mapping = mapping,stat = StatPointError,geom = GeomPointError,position = position,show.legend = show.legend,inherit.aes = inherit.aes,params = list(
na.rm = na.rm,...
)
)
}
ggplot(data = mtcars,size = 3) +
geom_point_error(color = "red",height = .3)
由 reprex package (v1.0.0) 于 2021 年 5 月 18 日创建
显然您可以用它做更多的事情,包括额外的默认美感,以便您可以分别控制线条/点的颜色和大小(可能需要覆盖 ggplot(data = mtcars,size = 3) +
geom_point_error(aes(color = hp>100))
以确保所有内容都正确映射).
最后,这个 geom 非常简单,因为它假设 GeomPointError$setup_data()
和 x
数据映射是连续的。它仍然适用于混合连续和离散,但看起来有点时髦
y