r - 使用 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()

创建于 2019-04-23 由 reprex package (v0.2.1)

Answer 1

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

(作为引用，我通常查看 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 次尝试时返回错误时跟踪出错的地方。

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

有几个 draw_* Geom* 中的函数，当我们想要进行修改时，这可能会令人困惑。来自 code for 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 。)
GeomSf ，继承自 Geom (代码 here )，覆盖 Geom的 draw_panel带有返回 sf_grob(...) 的代码块的函数, 和 不 触发 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 的点形状，并绘制了一个实体圆不受任何填充值的影响。)