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() 这样的函数就可以完成这一切。但我不确定美学如何从 ggplot().

转移到后续的 geom 函数中

此外，我在制作一个接收列名作为参数并使其与 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-05-17 创建

第二个选择是构建您自己的 ggproto Geom 来处理 ggplot2 中的这些计算，但现在这有点过分了。

Answer 2

由于我的第一个答案仍然是更简单的解决方案，所以我决定保留它。这个答案应该让 OP 更接近他们的目标。

构建 ggproto 对象可能很麻烦，具体取决于您要执行的操作。在您的情况下，您将 3 ggproto Geoms 类与新的 Stat.

的可能性结合在一起

三个 Geom 是：

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() 函数。有时，这些会直接修改数据。这些步骤通常有助于在此处进行自动处理，并且通常用于 standardize/transform 数据。一个很好的例子是 GeomTile 和 GeomRect，它们本质上是相同的 Geom，但是它们的 setup_data() 功能不同，因为它们的参数化不同。

假设您只想分配一个 x 和一个 y 美学，并保留 xmin、ymin、xmax 的计算， ymax 到 geoms/stats.

幸运的是，GeomPoint 只是 returns 没有修改的数据，所以我们需要先合并 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)

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))

^{由 reprex package (v1.0.0)}

于 2021-05-18 创建

显然你可以用它做更多的事情，包括额外的默认美学，这样你就可以单独控制 lines/points 的颜色和大小（可能想要覆盖 GeomPointError$setup_data() 到确保一切正确映射）。

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

ggplot(mpg, aes(cty, model)) +
    geom_point() +
    geom_point_error(color = 'red')

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

ggplot extension function to plot a superimposed mean in a scatterplot

r

ggplot2

plyr

ggproto