21.3 Part 2: Adding aesthetics

We’ll tackle the first challenge by turning the diameter and tension arguments into aesthetics that can be set per-spring. There is surprisingly little to do here:

StatSpring <- ggproto("StatSpring", Stat, 
  setup_data = function(data, params) {
    if (anyDuplicated(data$group)) {
      data$group <- paste(data$group, seq_len(nrow(data)), sep = "-")
    }
    data
  },
  compute_panel = function(data, scales, n = 50) {
    cols_to_keep <- setdiff(names(data), c("x", "y", "xend", "yend"))
    springs <- lapply(seq_len(nrow(data)), function(i) {
      spring_path <- create_spring(data$x[i], data$y[i], data$xend[i], 
                                   data$yend[i], data$diameter[i],
                                   data$tension[i], n)
      cbind(spring_path, unclass(data[i, cols_to_keep]))
    })
    do.call(rbind, springs)
  },
  required_aes = c("x", "y", "xend", "yend"),
  optional_aes = c("diameter", "tension")
)

The main difference with our previous attempt is that the diameter and tension arguments to compute_panel() have gone away, and they’re now taken from the data (just like x, y, etc). This has a downside (that we’ll fix shortly): we can no longer set fixed aesthetics so we’ll also need to remove from the constructor:

geom_spring <- function(mapping = NULL, data = NULL, stat = "spring", 
                        position = "identity", ..., n = 50, arrow = NULL, 
                        lineend = "butt", linejoin = "round", na.rm = FALSE,
                        show.legend = NA, inherit.aes = TRUE) {
  layer(
    data = data, 
    mapping = mapping, 
    stat = stat, 
    geom = GeomPath, 
    position = position, 
    show.legend = show.legend, 
    inherit.aes = inherit.aes, 
    params = list(
      n = n, 
      arrow = arrow, 
      lineend = lineend, 
      linejoin = linejoin, 
      na.rm = na.rm, 
      ...
    )
  )
}

The stat_spring() constructor would require the same kind of change.

All that is left is to test our new implementation out:

some_data <- tibble(
  x = runif(5, max = 10),
  y = runif(5, max = 10),
  xend = runif(5, max = 10),
  yend = runif(5, max = 10),
  class = sample(letters[1:2], 5, replace = TRUE),
  tension = runif(5),
  diameter = runif(5, 0.5, 1.5)
)

ggplot(some_data, aes(x, y, xend = xend, yend = yend)) + 
  geom_spring(aes(tension = tension, diameter = diameter))

It appears to work, we can no longer set diameter and tension as parameters:

ggplot(some_data, aes(x, y, xend = xend, yend = yend)) + 
  geom_spring(diameter = 0.5)
#> Warning: Ignoring unknown parameters: diameter
#> Warning: Computation failed in `stat_spring()`:
#> argument is of length zero

21.3.1 Post-Mortem

In this section we further developed our spring stat so that diameter and tension can be used as aesthetics, varying across springs. Unfortunately, there’s a major downside: these features no longer can be set globally. We’re still also missing a way to control the scaling of the two aesthetics. Fixing both these problems requires the same next step: move our implementation away from Stat and towards a proper Geom.