如何解决ggplot 扩展函数在散点图中绘制叠加平均值
我正在尝试创建一个扩展 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 的可能性结合在一起。
三个几何体是：
GeomErrorbarGeomErrorbarhGeomPoint
首先，有时您只需要继承其中一个类并覆盖该方法，但要将这三个类合并在一起，您需要做更多的工作。
让我们首先考虑这些 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
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
