4

I'm trying to make new geoms and stats. I tried a StatChull code from this vignette. My goal is to manipulate an external parameter which is not an aesthetic value. Something like this:

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

The thing is, when I make custom stat with compute_group(), I can get the custom parameter. As soon as I change compute_group() to compute_layer(), program stops working.

Here is a working program for 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")

This prints on console:

My param has value myval

This programs errors when I change compute_group() to 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")

This prints on console:

Warning: Ignoring unknown parameters: myparam

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

Can anyone tell me how do I access parameter values in compute_layer()?

Z.Lin
  • 28,055
  • 6
  • 54
  • 94
Nirmal
  • 667
  • 5
  • 9

1 Answers1

4

Explanation

All geom_*() and stat_*() functions are wrappers around layer(). If we examine the code in that, we can see that the parameter values associated with a Stat are captured in stat_params, which is obtained via stat$parameters(TRUE), where stat refers to the specific Stat* ggproto object:

> 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 inherits from Stat with no change to its parameter function, which would be:

> 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
}

Solution

From the above, we can tell that stat$parameters depends on the function arguments listed in the relevant Stat*'s compute_panel / compute_group functions. As such, the following will work:

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

Note that we've defined a trivial compute_group function for StatChull. This function is never triggered since compute_layer returns a dataset directly (under normal circumstances for Stat, compute_group is triggered by compute_panel, which is in turn triggered by compute_layer), but since it does include myparam as one of its function arguments, myparam is now recognized as one of the parameter values in params.

(You can also achieve the same result by defining a trivial compute_panel function instead, too.)

Demonstration:

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

plot

My param has value myval
Z.Lin
  • 28,055
  • 6
  • 54
  • 94