Move guide building to ggplot_build() (#5483)

* Divorce building and drawing/assembly

* Fix test guide orders

* Disconnect theme from build step

* Move guide building to `ggplot_build()`

* Some error messages are now thrown earlier

* Adapt `guide_old()`

* Expose `data` to `process_layers()`

* Add news bullet

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* (internal) guide building is now part of `ggplot_build()` instead of 
+  `ggplot_gtable()` to allow guides to observe unmapped data (#5483).
+
 * `geom_violin()` gains a `bounds` argument analogous to `geom_density()`s (@eliocamp, #5493).
 
 * Legend titles no longer take up space if they've been removed by setting 

R/coord-cartesian-.R

@@ -151,5 +151,5 @@ panel_guides_grob <- function(guides, position, theme) {
     return(zeroGrob())
   }
   pair <- guides$get_position(position)
-  pair$guide$draw(theme, pair$params)
+  pair$guide$draw(theme, params = pair$params)
 }

R/guide-.R

@@ -117,9 +117,12 @@ new_guide <- function(..., available_aes = "any", super) {
 #'   `params$hash`. This ensures that e.g. `guide_legend()` can display both
 #'   `shape` and `colour` in the same guide.
 #'
-#' - `get_layer_key()` Extract information from layers. This can be used to
-#'   check that the guide's aesthetic is actually in use, or to gather
-#'   information about how legend keys should be displayed.
+#' - `process_layers()` Extract information from layers. This acts mostly
+#'   as a filter for which layers to include and these are then (typically)
+#'   forwarded to `get_layer_key()`.
+#'
+#' - `get_layer_key()` This can be used to gather information about how legend
+#'   keys should be displayed.
 #'
 #' - `setup_params()` Set up parameters at the beginning of drawing stages.
 #'   It can be used to overrule user-supplied parameters or perform checks on
@@ -253,7 +256,11 @@ Guide <- ggproto(
 
   # Function for extracting information from the layers.
   # Mostly applies to `guide_legend()` and `guide_binned()`
-  get_layer_key = function(params, layers) {
+  process_layers = function(self, params, layers, data = NULL) {
+    self$get_layer_key(params, layers, data)
+  },
+
+  get_layer_key = function(params, layers, data = NULL) {
     return(params)
   },
 
@@ -280,11 +287,14 @@ Guide <- ggproto(
 
   # Main drawing function that organises more specialised aspects of guide
   # drawing.
-  draw = function(self, theme, params = self$params) {
+  draw = function(self, theme, position = NULL, direction = NULL,
+                  params = self$params) {
 
     key <- params$key
 
     # Setup parameters and theme
+    params$position  <- params$position  %||% position
+    params$direction <- params$direction %||% direction
     params <- self$setup_params(params)
     elems  <- self$setup_elements(params, self$elements, theme)
     elems  <- self$override_elements(params, elems, theme)

R/guide-axis.R

@@ -486,7 +486,7 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme,
     !!aes := c(0, 1),
     !!opp := opp_value
   )
-  guide$draw(theme, params)
+  guide$draw(theme, params = params)
 }
 
 draw_axis_labels <- function(break_positions, break_labels, label_element, is_vertical,

R/guide-bins.R

@@ -298,15 +298,15 @@ GuideBins <- ggproto(
     params$title <- scale$make_title(
       params$title %|W|% scale$name %|W|% title
     )
+    params$key <- key
+    params
+  },
+
+  setup_params = function(params) {
     params$direction <- arg_match0(
-      params$direction %||% direction,
+      params$direction,
       c("horizontal", "vertical"), arg_nm = "direction"
     )
-    if (params$direction == "vertical") {
-      key$.value <- 1 - key$.value
-    }
-
-    params$key <- key
     valid_label_pos <- switch(
       params$direction,
       "horizontal" = c("bottom", "top"),
@@ -320,10 +320,6 @@ GuideBins <- ggproto(
         "not {.val {params$label.position}}."
       ))
     }
-    params
-  },
-
-  setup_params = function(params) {
     params <- GuideLegend$setup_params(params)
     params$byrow <- FALSE
     params$rejust_labels <- FALSE
@@ -345,10 +341,15 @@ GuideBins <- ggproto(
     }
     key$.label[c(1, n_labels)[!params$show.limits]] <- ""
 
-    just <- if (params$direction == "horizontal") {
-      elements$text$vjust
-    } else {
-      elements$text$hjust
+    just <- switch(
+      params$direction,
+      horizontal = elements$text$vjust,
+      vertical   = elements$text$hjust,
+      0.5
+    )
+
+    if (params$direction == "vertical") {
+      key$.value <- 1 - key$.value
     }
 
     list(labels = flip_element_grob(
@@ -363,6 +364,9 @@ GuideBins <- ggproto(
   },
 
   build_ticks = function(key, elements, params, position = params$position) {
+    if (params$direction == "vertical") {
+      key$.value <- 1 - key$.value
+    }
     key$.value[c(1, nrow(key))[!params$show.limits]] <- NA
     Guide$build_ticks(key$.value, elements, params, params$label.position)
   },

R/guide-colorbar.R

@@ -344,27 +344,10 @@ GuideColourbar <- ggproto(
   },
 
   extract_params = function(scale, params,
-                            title  = waiver(), direction = "vertical", ...) {
+                            title  = waiver(), ...) {
     params$title <- scale$make_title(
       params$title %|W|% scale$name %|W|% title
     )
-    params$direction <- arg_match0(
-      params$direction %||% direction,
-      c("horizontal", "vertical"), arg_nm = "direction"
-    )
-    valid_label_pos <- switch(
-      params$direction,
-      "horizontal" = c("bottom", "top"),
-      "vertical"   = c("right", "left")
-    )
-    params$label.position <- params$label.position %||% valid_label_pos[1]
-    if (!params$label.position %in% valid_label_pos) {
-      cli::cli_abort(paste0(
-        "When {.arg direction} is {.val {params$direction}}, ",
-        "{.arg label.position} must be one of {.or {.val {valid_label_pos}}}, ",
-        "not {.val {params$label.position}}."
-      ))
-    }
 
     limits <- c(params$decor$value[1], params$decor$value[nrow(params$decor)])
     params$key$.value <- rescale(
@@ -381,27 +364,28 @@ GuideColourbar <- ggproto(
     return(list(guide = self, params = params))
   },
 
-  get_layer_key = function(params, layers) {
-
-    guide_layers <- lapply(layers, function(layer) {
-
-      matched_aes <- matched_aes(layer, params)
-
-      # Check if this layer should be included
-      if (include_layer_in_guide(layer, matched_aes)) {
-        layer
-      } else {
-        NULL
-      }
-    })
-
-    if (length(compact(guide_layers)) == 0) {
-      return(NULL)
-    }
-    return(params)
+  get_layer_key = function(params, layers, data = NULL) {
+    params
   },
 
   setup_params = function(params) {
+    params$direction <- arg_match0(
+      params$direction,
+      c("horizontal", "vertical"), arg_nm = "direction"
+    )
+    valid_label_pos <- switch(
+      params$direction,
+      "horizontal" = c("bottom", "top"),
+      "vertical"   = c("right", "left")
+    )
+    params$label.position <- params$label.position %||% valid_label_pos[1]
+    if (!params$label.position %in% valid_label_pos) {
+      cli::cli_abort(paste0(
+        "When {.arg direction} is {.val {params$direction}}, ",
+        "{.arg label.position} must be one of {.or {.val {valid_label_pos}}}, ",
+        "not {.val {params$label.position}}."
+      ))
+    }
     params$title.position <- arg_match0(
       params$title.position %||%
         switch(params$direction, vertical = "top", horizontal = "left"),

R/guide-legend.R

@@ -244,7 +244,7 @@ GuideLegend <- ggproto(
 
   available_aes = "any",
 
-  hashables = exprs(title, key$.label, direction, name),
+  hashables = exprs(title, key$.label, name),
 
   elements = list(
     background  = "legend.background",
@@ -260,14 +260,10 @@ GuideLegend <- ggproto(
   ),
 
   extract_params = function(scale, params,
-                            title = waiver(), direction = NULL, ...) {
+                            title = waiver(), ...) {
     params$title <- scale$make_title(
       params$title %|W|% scale$name %|W|% title
     )
-    params$direction <- arg_match0(
-      params$direction %||% direction,
-      c("horizontal", "vertical"), arg_nm = "direction"
-    )
     if (isTRUE(params$reverse %||% FALSE)) {
       params$key <- params$key[nrow(params$key):1, , drop = FALSE]
     }
@@ -291,17 +287,26 @@ GuideLegend <- ggproto(
   },
 
   # Arrange common data for vertical and horizontal legends
-  get_layer_key = function(params, layers) {
+  process_layers = function(self, params, layers, data = NULL) {
+
+    include <- vapply(layers, function(layer) {
+      aes <- matched_aes(layer, params)
+      include_layer_in_guide(layer, aes)
+    }, logical(1))
+
+    if (!any(include)) {
+      return(NULL)
+    }
+
+    self$get_layer_key(params, layers[include], data[include])
+  },
+
+  get_layer_key = function(params, layers, data) {
 
     decor <- lapply(layers, function(layer) {
 
       matched_aes <- matched_aes(layer, params)
 
-      # Check if this layer should be included
-      if (!include_layer_in_guide(layer, matched_aes)) {
-        return(NULL)
-      }
-
       if (length(matched_aes) > 0) {
         # Filter out aesthetics that can't be applied to the legend
         n <- lengths(layer$aes_params, use.names = FALSE)
@@ -338,14 +343,15 @@ GuideLegend <- ggproto(
 
     # Remove NULL geoms
     params$decor <- compact(decor)
-
-    if (length(params$decor) == 0) {
-      return(NULL)
-    }
     return(params)
   },
 
   setup_params = function(params) {
+    params$direction <- arg_match0(
+      params$direction %||% direction,
+      c("horizontal", "vertical"), arg_nm = "direction"
+    )
+
     if ("title.position" %in% names(params)) {
       params$title.position <- arg_match0(
         params$title.position %||%

R/guide-none.R

@@ -35,7 +35,7 @@ GuideNone <- ggproto(
   },
 
   # Draw nothing
-  draw = function(self, params, theme) {
+  draw = function(self, ...) {
     zeroGrob()
   }
 )

R/guide-old.R

@@ -90,7 +90,7 @@ GuideOld <- ggproto(
   train = function(self, params, scale, aesthetic = NULL,
                    title = waiver(), direction = NULL) {
     params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
-    params$direction <- params$direction %||% direction
+    params$direction <- params$direction %||% direction %||% "vertical"
     params <- guide_train(params, scale, aesthetic)
     params
   },
@@ -103,13 +103,14 @@ GuideOld <- ggproto(
     guide_transform(params, coord, panel_params)
   },
 
-  get_layer_key = function(params, layers) {
+  process_layers = function(self, params, layers, data = NULL) {
     guide_geom(params, layers, default_mapping = NULL)
   },
 
-  draw = function(self, theme, params) {
+  draw = function(self, theme, position = NULL, direction = NULL, params) {
+    params$direction <- params$direction %||% direction %||% "placeholder"
     params$title.position <- params$title.position %||% switch(
-      params$direction %||% "placeholder",
+      params$direction,
       vertical = "top", horizontal = "left",
       NULL
     )