Guide training bugfix (#5428)

* Ensure scales/aesthetics are parallel

* Adapt tests

* Add argument names

Author: teunbrand

R/coord-.R

@@ -97,17 +97,18 @@ Coord <- ggproto("Coord",
     aesthetics <- c("x", "y", "x.sec", "y.sec")
     names(aesthetics) <- aesthetics
     is_sec <- grepl("sec$", aesthetics)
+    scales <- panel_params[aesthetics]
 
     # Do guide setup
     guides <- guides$setup(
-      panel_params, aesthetics,
+      scales, aesthetics,
       default = params$guide_default %||% guide_axis(),
       missing = params$guide_missing %||% guide_none()
     )
     guide_params <- guides$get_params(aesthetics)
 
     # Resolve positions
-    scale_position <- lapply(panel_params[aesthetics], `[[`, "position")
+    scale_position <- lapply(scales, `[[`, "position")
     guide_position <- lapply(guide_params, `[[`, "position")
     guide_position[!is_sec] <- Map(
       function(guide, scale) guide %|W|% scale,

R/guides-.R

@@ -301,12 +301,19 @@ Guides <- ggproto(
       horizontal = c("center", "top")
     )
 
-    # Setup and train on scales
+    # Extract the non-position scales
     scales <- scales$non_position_scales()$scales
     if (length(scales) == 0) {
       return(no_guides)
     }
-    guides <- self$setup(scales)
+
+    # Ensure a 1:1 mapping between aesthetics and scales
+    aesthetics <- lapply(scales, `[[`, "aesthetics")
+    scales     <- rep.int(scales, lengths(aesthetics))
+    aesthetics <- unlist(aesthetics, recursive = FALSE, use.names = FALSE)
+
+    # Setup and train scales
+    guides <- self$setup(scales, aesthetics = aesthetics)
     guides$train(scales, theme$legend.direction, labels)
     if (length(guides$guides) == 0) {
       return(no_guides)
@@ -343,28 +350,16 @@ Guides <- ggproto(
     default = self$missing,
     missing = self$missing
   ) {
-
-    if (is.null(aesthetics)) {
-      # Aesthetics from scale, as in non-position guides
-      aesthetics <- lapply(scales, `[[`, "aesthetics")
-      scale_idx  <- rep(seq_along(scales), lengths(aesthetics))
-      aesthetics <- unlist(aesthetics, FALSE, FALSE)
-    } else {
-      # Scale based on aesthetics, as in position guides
-      scale_idx  <- seq_along(scales)[match(aesthetics, names(scales))]
-    }
-
     guides <- self$guides
 
     # For every aesthetic-scale combination, find and validate guide
-    new_guides <- lapply(seq_along(scale_idx), function(i) {
-      idx <- scale_idx[i]
+    new_guides <- lapply(seq_along(scales), function(idx) {
 
       # Find guide for aesthetic-scale combination
       # Hierarchy is in the order:
       # plot + guides(XXX) + scale_ZZZ(guide = XXX) > default(i.e., legend)
       guide <- resolve_guide(
-        aesthetic = aesthetics[i],
+        aesthetic = aesthetics[idx],
         scale     = scales[[idx]],
         guides    = guides,
         default   = default,

tests/testthat/test-guides.R

@@ -178,10 +178,15 @@ test_that("guide merging for guide_legend() works as expected", {
     scales <- scales_list()
     scales$add(scale1)
     scales$add(scale2)
+    scales <- scales$scales
+
+    aesthetics <- lapply(scales, `[[`, "aesthetics")
+    scales <- rep.int(scales, lengths(aesthetics))
+    aesthetics <- unlist(aesthetics, FALSE, FALSE)
 
     guides <- guides_list(NULL)
-    guides <- guides$setup(scales$scales)
-    guides$train(scales$scales, "vertical", labs())
+    guides <- guides$setup(scales, aesthetics)
+    guides$train(scales, "vertical", labs())
     guides$merge()
     guides$params
   }
@@ -279,7 +284,7 @@ test_that("legend reverse argument reverses the key", {
   scale$train(LETTERS[1:4])
 
   guides <- guides_list(NULL)
-  guides <- guides$setup(list(scale))
+  guides <- guides$setup(list(scale), "colour")
 
   guides$params[[1]]$reverse <- FALSE
   guides$train(list(scale), "horizontal", labels = labs())