1

我正在尝试创建一个扩展 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(). 在此处输入图像描述

4

2 回答 2

2

我认为plyr在这一点上已经不复存在了。我会推荐这个dplyr包。与您一起编程时，dplyr可以使用{{（curly-curly，或文档中所说的 embracing ）来正确引用表达式。

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 包于 2021-05-17 创建(v1.0.0)

第二种选择是构建您自己的ggproto Geom内部来处理这些计算ggplot2，但目前这有点多。

于 2021-05-17T20:59:40.640 回答
1

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

根据您要执行的操作，构建 ggproto 对象可能会很麻烦。在您的情况下，您将 3 个ggproto Geoms类与新的Stat.

三个 Geom 是：

  • GeomErrorbar
  • GeomErrorbarh
  • GeomPoint

开始时，有时您只需要从其中一个类继承并覆盖该方法，但要将这三个合并在一起，您需要做更多的工作。

让我们首先考虑它们中的每一个是如何Geoms绘制它们的grid对象的。取决于Geom它在这些函数之一中draw_layer()，draw_panel()和draw_group()。幸运的是，我们想要使用的每个几何对象都只使用draw_panel()这意味着我们的工作量要少一些——我们将直接调用这些方法并构建一个新grobTree对象。我们只需要注意所有正确的参数都在我们的新Geom方法draw_panel()中。

在我们开始编写自己的 之前draw_panel，我们必须首先考虑setup_params()和setup_data()函数。有时，这些会直接修改数据。这些步骤通常有助于在这里进行自动处理，并且通常用于标准化/转换数据。一个很好的例子是GeomTileand GeomRect，它们本质上是相同Geom的 s 但它们的setup_data()功能不同，因为它们的参数化不同。

假设您只想分配一个x和 一个y美学，并将 、 、 和 的计算留给xmingeoms ymin/ xmaxstats 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)


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 包于 2021-05-18 创建(v1.0.0)

显然你可以做更多的事情，包括额外的默认美学，这样你就可以分别控制线条/点的颜色和大小（可能想要覆盖GeomPointError$setup_data()以确保所有内容都正确映射）。

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

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

于 2021-05-18T16:17:41.903 回答