diff --git a/NEWS.md b/NEWS.md index d8167c66c9..2574dc2e9d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -290,6 +290,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 diff --git a/R/guide-legend.R b/R/guide-legend.R index b875fa1950..c8bf395f0a 100644 --- a/R/guide-legend.R +++ b/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 +} diff --git a/R/theme-elements.R b/R/theme-elements.R index b83822ed3a..833da1b192 100644 --- a/R/theme-elements.R +++ b/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"), diff --git a/R/theme.R b/R/theme.R index cb7859dfe2..bf65c565a9 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 51f92e1f96..0a4941266e 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()}})} 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) + +}) +