4

我正在尝试制作新的几何图形和统计数据。我从这个小插图中尝试了一个 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()？

4

1 回答 1

3

解释

所有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
于 2019-06-04T09:22:29.893 回答