7

我正在尝试为此处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 包（v0.2.1）于 2019 年 4 月 23 日创建

4

1 回答 1

9

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

（作为参考，我通常查看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()

情节2

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

当我弄乱自定义的 ggproto 对象时，我喜欢使用的一个有用技巧是在我修改的每个函数中插入打印语句，例如"setting up parameters"，或"drawing panel, step 3"等。这使我能够很好地了解引擎盖下发生的事情，并跟踪当函数（不可避免地）在第 1 次/第 2 次/.../第 n 次尝试返回错误时出现问题。

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

中有几个draw_*函数Geom*，当我们要进行修改时可能会造成混淆。从 的代码中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(code here ),用一段返回 a 的代码覆盖Geom的函数, 并且不触发.draw_panelsf_grob(...)draw_group

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

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

于 2019-04-24T06:46:42.290 回答