使用 sf 对象的自定义几何图形扩展 ggplot2

Question

我正在尝试为ggplot 创建一个新几何，如here 所述，同时对其进行调整以处理简单特征对象。

作为一个例子，让我们进行绘制一组点的凸包的相同练习。因此，我编写了一个新的geom_envelope() 函数，从geom_sf() 借用元素和一个相应的GeomEnvelope ggproto 对象，该对象执行覆盖draw_group() 方法的计算（因为我想要一个多边形来代表完整的点集） .

但是，我必须遗漏一些东西，因为我无法绘制多边形。我已经尝试了一段时间，但要么得到错误，要么没有绘制任何内容。

library(sf); library(ggplot2); library(dplyr)

Npts <- 10
pts <- matrix(runif(2*Npts), ncol = 2) %>% 
  st_multipoint() %>% 
  st_sfc() %>% 
  st_cast("POINT") %>% 
  st_sf()

GeomEnvelope <- ggproto(
  "GeomEnvelope", GeomSf,

  required_aes = "geometry",

  default_aes = aes(
    shape = NULL,
    colour = "grey20",
    fill = "white",
    size = NULL,
    linetype = 1,
    alpha = 0.5,
    stroke = 0.5
  ),

  draw_key = draw_key_polygon,

  draw_group = function(data, panel_params, coord) {
    n <- nrow(data)
    if (n <= 2) return(grid::nullGrob())

    gp <- gpar(
      colour = data$colour,
      size = data$size,
      linetype = data$linetype,
      fill = alpha(data$fill, data$alpha),
      group = data$group,
      stringsAsFactors = FALSE
    )

    geometry <- sf::st_convex_hull(st_combine(sf::st_as_sf(data)))

    sf::st_as_grob(geometry, pch = data$shape, gp = gp)

  }
)


geom_envelope <- function(
  mapping = aes(),
  data = NULL,
  position = "identity",
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE,
  ...) {

  if (!is.null(data) && ggplot2:::is_sf(data)) {
    geometry_col <- attr(data, "sf_column")
  }
  else {
    geometry_col <- "geometry"
  }
  if (is.null(mapping$geometry)) {
    mapping$geometry <- as.name(geometry_col)
  }
  c(
    layer(
      geom = GeomEnvelope,
      data = data,
      mapping = mapping,
      stat = "identity",
      position = position,
      show.legend = if (is.character(show.legend))
        TRUE
      else
        show.legend,
      inherit.aes = inherit.aes,
      params = list(
        na.rm = na.rm,
        legend = if (is.character(show.legend))
          show.legend
        else
          "polygon",
        ...
      )
    ),
    coord_sf(default = TRUE)
  )
}

ggplot(pts) + geom_sf() + geom_envelope() + theme_bw()

^{由reprex package (v0.2.1) 于 2019 年 4 月 23 日创建}

Answer 1

如果这是您的实际用例（而不是它的简化示例），那么我想说您正在寻找的基本部分是自定义 Stat，而不是自定义 几何。数据计算/操作应该发生在前者中。

（作为参考，我通常查看GeomBoxplot / StatBoxplot 中的代码以找出应该发生的事情，因为该用例包括一堆分位数/异常值的计算，以及不同的组合接受各种美学映射的 grob 元素。）

具有可重复性的随机种子数据：

set.seed(123)

pts <- matrix(runif(2*Npts), ncol = 2) %>% 
  st_multipoint() %>% 
  st_sfc() %>% 
  st_cast("POINT") %>% 
  st_sf()

基本演示

下面的StatEnvelope 会将数据集传递给相关的几何层，并将每组内的几何值集合（如果没有指定分组美学，则将整个数据集视为一个组）为凸船体：

StatEnvelope <- ggproto(
  "StatEnvelope", Stat,
  required_aes = "geometry",
  compute_group = function(data, scales) {
    if(nrow(data) <= 2) return (NULL)
    data %>%
      group_by_at(vars(-geometry)) %>%
      summarise(geometry = sf::st_convex_hull(sf::st_combine(geometry))) %>%
      ungroup()
  }
)

ggplot(pts) + 
  geom_sf() +
  geom_sf(stat = StatEnvelope, 
          alpha = 0.5, color = "grey20", fill = "white", size = 0.5) +
  theme_bw()

升级

上述方法使用现有的geom_sf，在创建信封方面做得非常好。如果我们想指定一些默认的美学参数，而不是在 geom_sf 的每个实例中重复，我们仍然不需要定义新的 Geom。修改现有geom_sf 的函数就可以了。

geom_envelope <- function(...){
  suppressWarnings(geom_sf(stat = StatEnvelope, 
                           ..., # any aesthetic argument specified in the function 
                                # will take precedence over the default arguments
                                # below, with suppressWarning to mute warnings on
                                # any duplicated aesthetics
                           alpha = 0.5, color = "grey20", fill = "white", size = 0.5))
}

# outputs same plot as before
ggplot(pts) + 
  geom_sf() +
  geom_envelope() +
  theme_bw()

# with different aesthetic specifications for demonstration
ggplot(pts) + 
  geom_sf() +
  geom_envelope(alpha = 0.1, colour = "brown", fill = "yellow", size = 3) +
  theme_bw()

---

解释问题中发布的代码发生了什么

当我处理自定义的 ggproto 对象时，我喜欢使用的一个有用技巧是在我修改的每个函数中插入打印语句，例如"setting up parameters" 或 "drawing panel, step 3" 等。这让我可以很好地了解幕后发生的事情，并在函数（不可避免地）在第 1 次/第 2 次/ ... /第n次尝试。

在这种情况下，如果我们在运行ggplot(pts) + geom_sf() + geom_envelope() + theme_bw() 之前在GeomEnvelope 的draw_group 函数的开头插入print("draw group")，我们将观察到控制台中没有任何打印消息。换句话说，draw_group 函数从未被调用，因此其中定义的任何数据操作都不会影响输出。

Geom* 中有几个draw_* 函数，当我们要进行修改时可能会造成混淆。从code for Geom可以看出层次结构如下：

1. draw_layer（包括do.call(self$draw_panel, args) 行）
2. draw_panel（包括self$draw_group(group, panel_params, coord, ...) 行）
3. draw_group（Geom 未实现）。

所以draw_layer 触发draw_panel，而draw_panel 触发draw_group。 （反映这一点，Stat、compute_layer 触发 compute_panel 和 compute_panel 触发 compute_group。）

GeomSf，它继承自Geom（代码here），使用返回sf_grob(...) 的代码块覆盖Geom 的draw_panel 函数，并且确实如此不触发draw_group。

因此，当GeomEnvelope 继承GeomSf 的draw_panel 函数时，其draw_group 函数中的任何内容都不重要。图中绘制的内容取决于draw_panel，问题中的geom_envelope 层执行与geom_sf 基本相同的任务，分别绘制每个单独的点。如果您删除/注释掉geom_sf 层，您将看到相同的点；仅使用 color = "grey20"、alpha = 0.5 等，如 GeomSf 的 default_aes 中指定的那样。

（注意：fill = "white" 未使用，因为geom_sf 默认为GeomPoint 的点数据默认美学，这意味着它继承GeomPoint 的pch = 19 为其点形状，并绘制一个不受任何填充值影响的实心圆。）