基本演示

Question

我正在尝试根据here为ggplot创建一个新的几何图形，同时使之适应简单特征对象。

作为示例，让我们做同样的练习，绘制一组点的凸包。因此，我写了一个新的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-04-23创建}

Answer 1

如果这是您的实际用例（而不是它的简化示例），那么我想说的是，您要查找的基本部分是自定义 Stat ，而不是自定义< strong> Geom 。数据计算/操作应在前者内进行。

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

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

set.seed(123)

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

基本演示

以下StatEnvelope将获取传递到相关geom层的数据集，并将每组内的几何值集合（如果未指定分组美观，则将整个数据集视为一组）转换为凸包：

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实例中重复，我们 still 无需定义新的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次尝试。

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

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

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

因此Geom触发draw_layer，而draw_panel触发draw_panel。（在draw_group中，Stat触发器compute_layer和compute_panel触发器compute_panel对此进行镜像。）

继承自compute_group（代码here）的

GeomSf，并用返回{{的代码块}覆盖Geom的{{1}}函数1}}和不触发Geom。

因此，当draw_panel继承sf_grob(...)的{{1}}函数时，其draw_group函数中的任何内容都不重要。绘图中绘制的内容取决于GeomEnvelope，问题中的GeomSf层实际上执行与draw_panel相同的任务，分别绘制每个点。如果您删除/注释draw_group层，则会看到相同的点；只需使用draw_panel的{{1}}中指定的color =“ grey20”，alpha = 0.5等。

（注意：未使用geom_envelope，因为geom_sf默认为geom_sf对点数据的默认美感，这意味着它继承了GeomSf的default_aes的点形状，并绘制不受任何填充值影响的实心圆。）

使用自定义几何为sf对象扩展ggplot2

1 个答案:

基本演示

升级

说明问题中发布的代码的情况