✨ Justification for legend keys (#6279)

* combine glyph layers into a single key earlier

* new `key.justification` theme element

* apply key justification

* add test

* add news bullet

Author: teunbrand

NEWS.md

@@ -292,6 +292,8 @@
   particularly for data-points with a low radius near the center 
   (@teunbrand, #5023).
 * All scales now expose the `aesthetics` parameter (@teunbrand, #5841)
+* New `theme(legend.key.justification)` to control the alignment of legend keys 
+  (@teunbrand, #3669). 
 
 # ggplot2 3.5.1
 

R/guide-legend.R

@@ -178,6 +178,7 @@ GuideLegend <- ggproto(
     key            = "legend.key",
     key_height     = "legend.key.height",
     key_width      = "legend.key.width",
+    key_just       = "legend.key.justification",
     text           = "legend.text",
     theme.title    = "legend.title",
     spacing_x      = "legend.key.spacing.x",
@@ -275,7 +276,6 @@ GuideLegend <- ggproto(
       c("horizontal", "vertical"), arg_nm = "direction"
     )
     params$n_breaks <- n_breaks <- nrow(params$key)
-    params$n_key_layers <- length(params$decor) + 1 # +1 is key background
 
     # Resolve shape
     if (!is.null(params$nrow) && !is.null(params$ncol) &&
@@ -378,6 +378,9 @@ GuideLegend <- ggproto(
       elements$key <-
         ggname("legend.key", element_grob(elements$key))
     }
+    if (!is.null(elements$key_just)) {
+      elements$key_just <- valid.just(elements$key_just)
+    }
 
     elements$text <-
       label_angle_heuristic(elements$text, elements$text_position, params$angle)
@@ -391,22 +394,39 @@ GuideLegend <- ggproto(
 
   build_decor = function(decor, grobs, elements, params) {
 
-    key_size <- c(elements$width_cm, elements$height_cm) * 10
-
-    draw <- function(i) {
-      bg <- elements$key
-      keys <- lapply(decor, function(g) {
-        data <- vec_slice(g$data, i)
-        if (data$.draw %||% TRUE) {
-          key <- g$draw_key(data, g$params, key_size)
-          set_key_size(key, data$linewidth, data$size, key_size / 10)
-        } else {
-          zeroGrob()
+    key_size <- c(elements$width_cm, elements$height_cm)
+    just <- elements$key_just
+    idx <- seq_len(params$n_breaks)
+
+    key_glyphs <- lapply(idx, function(i) {
+      glyph <- lapply(decor, function(dec) {
+        data <- vec_slice(dec$data, i)
+        if (!(data$.draw %||% TRUE)) {
+          return(zeroGrob())
         }
+        key <- dec$draw_key(data, dec$params, key_size * 10)
+        set_key_size(key, data$linewidth, data$size, key_size)
       })
-      c(list(bg), keys)
-    }
-    unlist(lapply(seq_len(params$n_breaks), draw), FALSE)
+
+      width  <- vapply(glyph, get_attr, which = "width", default = 0, numeric(1))
+      width  <- max(width, 0, key_size[1], na.rm = TRUE)
+      height <- vapply(glyph, get_attr, which = "height", default = 0, numeric(1))
+      height <- max(height, 0, key_size[2], na.rm = TRUE)
+
+      vp <- NULL
+      if (!is.null(just)) {
+        vp <- viewport(
+          x = just[1], y = just[2], just = just,
+          width = unit(width, "cm"), height = unit(height, "cm")
+        )
+      }
+
+      grob <- gTree(children = inject(gList(elements$key, !!!glyph)), vp = vp)
+      attr(grob, "width")  <- width
+      attr(grob, "height") <- height
+      grob
+    })
+    key_glyphs
   },
 
   build_labels = function(key, elements, params) {
@@ -795,3 +815,7 @@ deprecated_guide_args <- function(
   }
   theme
 }
+
+get_attr <- function(x, which, exact = TRUE, default = NULL) {
+  attr(x, which = which, exact = exact) %||% default
+}

R/theme-elements.R

@@ -625,6 +625,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   legend.key.spacing  = el_def(c("unit", "rel"), "spacing"),
   legend.key.spacing.x = el_def(c("unit", "rel"), "legend.key.spacing"),
   legend.key.spacing.y = el_def(c("unit", "rel"), "legend.key.spacing"),
+  legend.key.justification = el_def(c("character", "numeric", "integer")),
   legend.frame        = el_def("element_rect", "rect"),
   legend.axis.line    = el_def("element_line", "line"),
   legend.ticks        = el_def("element_line", "legend.axis.line"),

R/theme.R

@@ -84,6 +84,10 @@
 #'   between legend keys given as a `unit`. Spacing in the horizontal (x) and
 #'   vertical (y) direction inherit from `legend.key.spacing` or can be
 #'   specified separately. `legend.key.spacing` inherits from `spacing`.
+#' @param legend.key.justification Justification for positioning legend keys
+#'   when more space is available than needed for display. The default, `NULL`,
+#'   stretches keys into the available space. Can be a location like `"center"`
+#'   or `"top"`, or a two-element numeric vector.
 #' @param legend.frame frame drawn around the bar ([element_rect()]).
 #' @param legend.ticks tick marks shown along bars or axes ([element_line()])
 #' @param legend.ticks.length length of tick marks in legend
@@ -393,6 +397,7 @@ theme <- function(...,
                   legend.key.spacing,
                   legend.key.spacing.x,
                   legend.key.spacing.y,
+                  legend.key.justification,
                   legend.frame,
                   legend.ticks,
                   legend.ticks.length,