ggproto：如何在compute_layer（）中获取非美学参数值？

Question

我试图制作新的宝石和统计数据。我尝试了这个vignette的StatChull代码。 我的目标是操纵一个不是美学价值的外部参数。这样的事情：

stat_custom(data = df, mapping = aes(x = xval, y = val), myparam = myval, geom = "custom")

问题是，当我使用compute_group（）创建自定义统计信息时，我可以获得自定义参数。一旦我将compute_group（）更改为compute_layer（），程序就会停止工作。

这是stat_chull（）的工作程序：

StatChull <- ggproto("StatChull", Stat,
                     compute_group = function(self, data, scales, params, na.rm, myparam) {
                       message("My param has value ", myparam)
                       # browser()
                       data[chull(data$x, data$y), , drop = FALSE]
                     },

                     required_aes = c("x", "y")
)

stat_chull <- function(mapping = NULL, data = NULL, geom = "polygon",
                       position = "identity", na.rm = FALSE, myparam = "", show.legend = NA, 
                       inherit.aes = TRUE, ...) {
  layer(
    stat = StatChull, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, myparam = myparam, ...)
  )
}

ggplot(mpg, aes(displ, hwy)) + 
  geom_point() + 
  stat_chull(fill = NA, colour = "black", myparam = "myval")

这在控制台上打印：

My param has value myval

当我将 compute_group（）更改为 compute_layer（）时，此程序会出错：

StatChull <- ggproto("StatChull", Stat,
                     compute_layer = function(self, data, scales, params, na.rm, myparam) {
                       message("My param has value ", myparam)
                       # browser()
                       data[chull(data$x, data$y), , drop = FALSE]
                     },

                     required_aes = c("x", "y")
)

stat_chull <- function(mapping = NULL, data = NULL, geom = "polygon",
                       position = "identity", na.rm = FALSE, myparam = "", show.legend = NA, 
                       inherit.aes = TRUE, ...) {
  layer(
    stat = StatChull, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, myparam = myparam, ...)
  )
}

ggplot(mpg, aes(displ, hwy)) + 
  geom_point() + 
  stat_chull(fill = NA, colour = "black", myparam = "myval")

这在控制台上打印：

Warning: Ignoring unknown parameters: myparam

Error in message("My param has value ", myparam): argument "myparam" is missing, with no default

有谁能告诉我如何在compute_layer（）中获取参数值？

谢谢！

Answer 1

说明

所有geom_*()和stat_*()函数都是layer()的包装。如果我们检查其中的代码，可以看到与Stat相关的参数值捕获在stat_params中，该值是通过stat$parameters(TRUE)获得的，其中stat是指特定的Stat * ggproto对象：

> layer
function (geom = NULL, stat = NULL, data = NULL, mapping = NULL, 
    position = NULL, params = list(), inherit.aes = TRUE, check.aes = TRUE, 
    check.param = TRUE, show.legend = NA) 
{
    ... # omitted
    params <- rename_aes(params)
    aes_params <- params[intersect(names(params), geom$aesthetics())]
    geom_params <- params[intersect(names(params), geom$parameters(TRUE))]
    stat_params <- params[intersect(names(params), stat$parameters(TRUE))]
    all <- c(geom$parameters(TRUE), stat$parameters(TRUE), geom$aesthetics())
    extra_param <- setdiff(names(params), all)
    if (check.param && length(extra_param) > 0) {
        warning("Ignoring unknown parameters: ", paste(extra_param, 
            collapse = ", "), call. = FALSE, immediate. = TRUE)
    }
    extra_aes <- setdiff(mapped_aesthetics(mapping), c(geom$aesthetics(), 
        stat$aesthetics()))
    if (check.aes && length(extra_aes) > 0) {
        warning("Ignoring unknown aesthetics: ", paste(extra_aes, 
            collapse = ", "), call. = FALSE, immediate. = TRUE)
    }
    ggproto("LayerInstance", Layer, geom = geom, geom_params = geom_params, 
        stat = stat, stat_params = stat_params, data = data, 
        mapping = mapping, aes_params = aes_params, position = position, 
        inherit.aes = inherit.aes, show.legend = show.legend)
}

StatChull从Stat继承而来，其参数函数不变：

> Stat$parameters
<ggproto method>
  <Wrapper function>
    function (...) 
f(..., self = self)

  <Inner function (f)>
    function (self, extra = FALSE) 
{
    panel_args <- names(ggproto_formals(self$compute_panel))
    group_args <- names(ggproto_formals(self$compute_group))
    args <- if ("..." %in% panel_args) 
        group_args
    else panel_args
    args <- setdiff(args, names(ggproto_formals(Stat$compute_group)))
    if (extra) {
        args <- union(args, self$extra_params)
    }
    args
}

解决方案

从以上所述，我们可以知道stat$parameters取决于相关Stat *的compute_panel / compute_group函数中列出的函数参数。因此，以下方法将起作用：

StatChull <- ggproto("StatChull", 
                     Stat,
                     compute_layer = function (self, data, params, layout) {
                       message("My param has value ", params$myparam)
                       data[chull(data$x, data$y), , drop = FALSE]
                     },
                     compute_group = function(self, data, scales, na.rm, myparam) {
                       # this function is never triggered, but defined here
                       # in order for myparam to be included in stat_params
                     },
                     required_aes = c("x", "y")
)

# no change to stat_chull

请注意，我们为StatChull定义了一个简单的compute_group函数。由于compute_layer直接返回数据集（从Stat正常情况下，compute_group由compute_panel触发，而compute_layer触发）则永远不会触发此函数，但是由于它确实包含myparam作为其函数参数之一，因此myparam现在被识别为params中的参数值之一。

（您也可以通过定义简单的compute_panel函数来获得相同的结果。）

演示：

ggplot(mpg, aes(displ, hwy)) + 
  geom_point() + 
  stat_chull(fill = NA, colour = "black", myparam = "myval")

My param has value myval