From ff42a0c2cec8103e17b140383ed35b578881afa3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 10 Jan 2025 11:08:39 +0100 Subject: [PATCH 1/5] combine glyph layers into a single key earlier --- R/guide-legend.R | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/R/guide-legend.R b/R/guide-legend.R index 37aad2e3f0..f19a03dc04 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -271,7 +271,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) && @@ -387,22 +386,30 @@ 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) + 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) + + grob <- gTree(children = inject(gList(elements$key, !!!glyph))) + attr(grob, "width") <- width + attr(grob, "height") <- height + grob + }) + key_glyphs }, build_labels = function(key, elements, params) { @@ -791,3 +798,7 @@ deprecated_guide_args <- function( } theme } + +get_attr <- function(x, which, exact = TRUE, default = NULL) { + attr(x, which = which, exact = exact) %||% default +} From 3fce5e71c1240fbc109b281c72a907363d6f3eb1 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 10 Jan 2025 11:41:17 +0100 Subject: [PATCH 2/5] new `key.justification` theme element --- R/theme-elements.R | 1 + R/theme.R | 5 +++++ man/theme.Rd | 6 ++++++ 3 files changed, 12 insertions(+) diff --git a/R/theme-elements.R b/R/theme-elements.R index 947e4e0af3..96327f727d 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -586,6 +586,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"), diff --git a/R/theme.R b/R/theme.R index 2ebd892f62..23fcf27c16 100644 --- a/R/theme.R +++ b/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, diff --git a/man/theme.Rd b/man/theme.Rd index d28c10b149..d243d53f7f 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -84,6 +84,7 @@ theme( legend.key.spacing, legend.key.spacing.x, legend.key.spacing.y, + legend.key.justification, legend.frame, legend.ticks, legend.ticks.length, @@ -229,6 +230,11 @@ between legend keys given as a \code{unit}. Spacing in the horizontal (x) and vertical (y) direction inherit from \code{legend.key.spacing} or can be specified separately. \code{legend.key.spacing} inherits from \code{spacing}.} +\item{legend.key.justification}{Justification for positioning legend keys +when more space is available than needed for display. The default, \code{NULL}, +stretches keys into the available space. Can be a location like \code{"center"} +or \code{"top"}, or a two-element numeric vector.} + \item{legend.frame}{frame drawn around the bar (\code{\link[=element_rect]{element_rect()}}).} \item{legend.ticks}{tick marks shown along bars or axes (\code{\link[=element_line]{element_line()}})} From c98360e52d9960ea253582bbc5ffb45a72613030 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 10 Jan 2025 11:41:26 +0100 Subject: [PATCH 3/5] apply key justification --- R/guide-legend.R | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/R/guide-legend.R b/R/guide-legend.R index f19a03dc04..00cb3a6ee5 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -174,6 +174,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", @@ -373,6 +374,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) @@ -387,6 +391,7 @@ GuideLegend <- ggproto( build_decor = function(decor, grobs, elements, params) { 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) { @@ -404,7 +409,15 @@ GuideLegend <- ggproto( height <- vapply(glyph, get_attr, which = "height", default = 0, numeric(1)) height <- max(height, 0, key_size[2], na.rm = TRUE) - grob <- gTree(children = inject(gList(elements$key, !!!glyph))) + 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 From c85297362c16f1d1d5cb619a2f7141b053e09bcb Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 10 Jan 2025 11:44:03 +0100 Subject: [PATCH 4/5] add test --- .../guide-legend/legend-key-justification.svg | 136 ++++++++++++++++++ tests/testthat/test-guide-legend.R | 16 +++ 2 files changed, 152 insertions(+) create mode 100644 tests/testthat/_snaps/guide-legend/legend-key-justification.svg diff --git a/tests/testthat/_snaps/guide-legend/legend-key-justification.svg b/tests/testthat/_snaps/guide-legend/legend-key-justification.svg new file mode 100644 index 0000000000..25880c7d29 --- /dev/null +++ b/tests/testthat/_snaps/guide-legend/legend-key-justification.svg @@ -0,0 +1,136 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + + + + + + +10 +15 +20 +25 +30 +35 +mpg +disp + +drat + + + + + + +3 +4 +5 + +factor(cyl) + + + + + + +one line +up +to +four +lines +up +to +five +whole +lines +legend key justification + + diff --git a/tests/testthat/test-guide-legend.R b/tests/testthat/test-guide-legend.R index d4a47c145e..c68ab03297 100644 --- a/tests/testthat/test-guide-legend.R +++ b/tests/testthat/test-guide-legend.R @@ -212,3 +212,19 @@ test_that("legend.byrow works in `guide_legend()`", { expect_doppelganger("legend.byrow = TRUE", p) }) +test_that("legend.key.justification works as intended", { + + p <- ggplot(mtcars, aes(mpg, disp, colour = factor(cyl), size = drat)) + + geom_point() + + scale_size_continuous( + range = c(0, 20), breaks = c(3, 4, 5), limits = c(2.5, 5) + ) + + scale_colour_discrete( + labels = c("one line", "up\nto\nfour\nlines", "up\nto\nfive\nwhole\nlines") + ) + + theme(legend.key.justification = c(1, 0)) + + expect_doppelganger("legend key justification", p) + +}) + From 9b7c245662684159578cf8ccc28587c8f52494a6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 10 Jan 2025 11:45:49 +0100 Subject: [PATCH 5/5] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index e19471d2e2..c2ea12f087 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* New `theme(legend.key.justification)` to control the alignment of legend keys + (@teunbrand, #3669). * `geom_ribbon()` now appropriately warns about, and removes, missing values (@teunbrand, #6243). * `guide_*()` can now accept two inside legend theme elements: