ggplot 扩展函数在散点图中绘制叠加平均值

Question

我正在尝试创建一个扩展 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() 一起工作时遇到了困难。

Answer 1

我认为 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,inherit.aes = F),
    geom_point(data = data,
               mapping = aes(x = x, 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 中的这些计算，但现在有点太多了。

Answer 2

因为我的第一个答案仍然是更简单的解决方案，所以我决定保留它。这个答案应该让 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, width = NULL, # 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, width = NULL, height = NULL, 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, panel_params = panel_params, coord = coord, height = height) point_grob <- GeomPoint$draw_panel(data = data, panel_params = panel_params, coord = coord, 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, mapping = aes(x = drat, y = mpg)) +
  geom_point(shape = 21, fill = 'black', color = 'white', size = 3) +
  geom_point_error(color = "red", width = .1, height = .3)

^{由 reprex package (v1.0.0) 于 2021 年 5 月 18 日创建}

显然您可以用它做更多的事情，包括额外的默认美感，以便您可以分别控制线条/点的颜色和大小（可能需要覆盖 ggplot(data = mtcars, mapping = aes(x = drat, y = mpg)) + geom_point(shape = 21, fill = 'black', color = 'white', size = 3) + geom_point_error(aes(color = hp>100)) 以确保所有内容都正确映射).

最后，这个 geom 非常简单，因为它假设 GeomPointError$setup_data() 和 x 数据映射是连续的。它仍然适用于混合连续和离散，但看起来有点时髦

y