r - Manipulate ggproto to get multiple layers

Question

I'm trying to get multiple area layers out of a ggproto object. I don't know if this is even possible but in case it is, I'm unable to figure out how.

For instance, how can I get the code below to produce two area layers where one has y coordinates as half of the other -

StatDensityHalf <- ggproto("StatDensity2", Stat, 
  required_aes = "x",
  default_aes = aes(y = ..density..),

  compute_group = function(data, scales, bandwidth = 1) {
    d <- density(data$x, bw = bandwidth)
    rbind(
       data.frame(x = d$x, density = d$y, fill = 1),
       data.frame(x = d$x, density = d$y/2, fill =2)
    )
  }  
)

stat_density_half <- function(mapping = NULL, data = NULL, geom = "line",
                                position = "identity", na.rm = FALSE, show.legend = NA, 
                                inherit.aes = TRUE, bandwidth = NULL,
                                ...) {
  layer(
    stat = StatDensityHalf, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(bandwidth = bandwidth, na.rm = na.rm, ...)
  )
}


ggplot(mpg, aes(displ)) + 
  stat_density_half(bandwidth = 1, geom = "area", position = "stack")

Please note, I'm NOT looking for a workaround to produce the same plot as the example suggests. I'm looking for a generic solution to this problem.

Answer 1

Okay, finally got around to finishing this up. This creates two layers:

library(ggplot2)

StatDensityHalf <- 
    ggproto("StatDensity2", Stat,
            required_aes = "x",
            default_aes = aes(y = ..density..),
            compute_group = function(data, scales, bandwidth = 1,fak=1,fillgrp="1"){
                 d <- density(data$x, bw = bandwidth)
                data.frame(x = d$x, density = d$y / fak, fill = fillgrp)
             }
    )

stat_density_half <- function(mapping = NULL, data = NULL, geom = "line", 
                              position = "identity", na.rm = FALSE, show.legend = NA,
                              inherit.aes = TRUE, bandwidth = NULL, ...) {
    list(
      layer(
        stat = StatDensityHalf, data = data, mapping = mapping, geom = geom,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(bandwidth = bandwidth, na.rm = na.rm, fak = 1, fillgrp = "1", ...)),

      layer(
        stat = StatDensityHalf, data = data, mapping = mapping, geom = geom,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(bandwidth = bandwidth, na.rm = na.rm, fak = 2, fillgrp = "2", ...))
      )
    }

ggplot(mpg, aes(cty)) +
  stat_density_half(bandwidth = 2, geom = "area", position = "stack") +
  scale_fill_manual(values = c("2" = "red", "1" = "blue"))

Yields:

Update:

In the first iteration I had two ggproto's because I didn't really see how to add parameters to a ggproto (here fak and fillgrp). The solution was to add them explicitly to the compute_group function in addition adding them to the params list, otherwise the ggproto wrapper complains and fails.