为 draw_key 定义/修改数据

Question

This question came up on answering How to show arrows in backward and forward directions in a ggplot2 legend?

I thought that a good way to automatically define the direction of the arrow in the glyph would be to pass this value, here "direction", as an aesthetic and to swap the direction of the segmentsGrob accordingly. It seems that draw_key_... uses "data" and "params" like Stat and Geom do, but it is only a data frame with a single row and it only contains four variables.

## browser()
# Browse[1]> data
# colour size linetype alpha
# 1 #F8766D  0.5        1    NA

I also tried - without success - to add direction as an aesthetic with:

GeomArrow <- ggproto(NULL, GeomSegment)
GeomArrow$required_aes <- c("x", "y", "xend", "yend", "direction")

How can I modify this data that is used in draw_key?

library(ggplot2)
foo <- structure(list(direction = c("backward", "forward"), 
                      x = c(0, 0), xend = c(1, 1), y = c(1, 1.2), 
                      yend = c(1, 1.2)), row.names = 1:2, class = "data.frame")

StatArrow <- ggproto(NULL, StatIdentity)
StatArrow$compute_layer <- function (self, data, params, layout) 
{
    swap <- data$direction == "backward"
    v1 <- data$x
    v2 <- data$xend
    data$x[swap] <- v2[swap]
    data$xend[swap] <- v1[swap]
    data
}

# draw_key_segment_custom <- function(data, params = list(direction), size) {
## ... 
## the idea was to simply switch x0 and x1 in the segmentsGrob depending on the new aesthetic
## This does not work because "data$direction" does not exist
## something like 
  # if(data$direction == "backward") {
  #   x0 = 0.9
  #   x1 = 0.1
  # } else {
  #   x0 = 0.1
  #   x1 = 0.9
  # }
  ## then 
  # grid::segmentsGrob(x0, 0.5, x1, 0.5,
                     ##...)
## but 
## browser()
# Browse[1]> data
# colour size linetype alpha
# 1 #F8766D  0.5        1    NA

# }

## direction as an aesthetic works despite this warning
ggplot() +
  geom_segment(data = foo,
               stat = "arrow",
               aes(x, y, xend = xend, yend = yend, col = direction, 
                   direction = direction),
               arrow = arrow(length = unit(0.3, "cm"), type = "closed")
             ## does not work, as per above
             # key_glyph = "segment_custom"
)
#> Warning: Ignoring unknown aesthetics: direction

^{Created on 2022-06-28 by the reprex package (v2.0.1)}

Answer 1

I think you first thought was correct, that it would be a required_aes of the Geom. If we make such a Geom:

library(ggplot2)
library(rlang)

foo <- structure(list(direction = c("backward", "forward"), 
                      x = c(0, 0), xend = c(1, 1), y = c(1, 1.2), 
                      yend = c(1, 1.2)), row.names = 1:2, class = "data.frame")

GeomArrow <- ggproto(
  NULL, GeomSegment,
  required_aes = c("x", "y", "xend", "yend", "direction"),
  draw_layer = function (self, data, params, layout, coord) 
  {
    swap <- data$direction == "backward"
    v1 <- data$x
    v2 <- data$xend
    data$x[swap] <- v2[swap]
    data$xend[swap] <- v1[swap]
    GeomSegment$draw_layer(data, params, layout, coord)
  }
)

And declare an appropriate key drawing function

draw_key_arrow = function(data, params, size) {
  grid::segmentsGrob(
    x0 = ifelse(data$direction == "forward", 0.1, 0.9),
    x1 = ifelse(data$direction == "forward", 0.9, 0.1),
    # Rest is just like vanilla
    y0 = 0.5, y1 = 0.5,
    gp = grid::gpar(
      col  = alpha(data$colour %||% data$fill %||% "black", data$alpha),
      fill = alpha(params$arrow.fill %||% data$colour %||% data$fill %||% 
                     "black", data$alpha),
      lwd = (data$size %||% 0.5) * .pt,
      lty = data$linetype %||% 1, lineend = "butt"
    ),
    arrow = params$arrow
  )
}

Then we should be able to render the plot if (!!!) we also map the direction aesthetic to a scale with a legend.

ggplot() +
  stat_identity(
    geom = GeomArrow,
    data = foo,
    aes(x, y, xend = xend, yend = yend, col = direction, direction = direction),
    arrow = arrow(length = unit(0.3, "cm"), type = "closed"),
    key_glyph = draw_key_arrow
  ) +
  # Hijacking a generic identity scale by specifying aesthetics
  scale_colour_identity(aesthetics = "direction", guide = "legend")

^{Created on 2022-07-04 by the reprex package (v2.0.1)}

---

From comments: The relevant source code can be currently found in ggplot2/R/guide-legend.r