r - ggproto:如何访问compute_layer() 中的非美学参数值？

Question

我正在尝试制作新的几何图形和统计信息。我从这个 vignette 尝试了一个 StatChull 代码. 我的目标是操纵一个不是美学值(value)的外部参数。 像这样的东西:

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

当我更改时，此程序会出错 计算组()至 计算层() :

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

请注意，我们已经定义了一个微不足道的 compute_group StatChull 的函数。自 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