Skip to content

Commit 6b09d17

Browse files
clauswilkehadley
clauswilke
authored and
hadley
committed
Enable margins settings for guide titles (#2556)
* set legend title alignment via theme. * enable margins in legend title * Force guide order for legends with multiple guides, so that visual tests don't fail just because the legends jump around. * enable margins for legend text. closes #1502. * restore correct defaults for label positioning * Added one visual test case for margins and alignment in legend.title and legend.text theme elements. * enable debugging option for guide titles and labels * Make debug color more subdued. * replace switch statements by if statements. * move assignments into if statements
1 parent f59ed7c commit 6b09d17

File tree

7 files changed

+427
-161
lines changed

7 files changed

+427
-161
lines changed

‎NEWS.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -327,6 +327,9 @@ up correct aspect ratio, and draws a graticule.
327327
and it can handle multi-line titles. Minor tweaks were made to `guide_legend()`
328328
to make sure the two legend functions behave as similarly as possible.
329329
(@clauswilke, #2397 and #2398)
330+
331+
* The theme elements `legend.title` and `legend.text` now respect the settings of `margin`,
332+
`hjust`, and `vjust`. (@clauswilke, #2465, #1502)
330333

331334
* Non-angle parameters of `label.theme` or `title.theme` can now be set in `guide_legend()` and
332335
`guide_colorbar()`. (@clauswilke, #2544)

‎R/guide-colorbar.r

Lines changed: 175 additions & 117 deletions
Original file line numberDiff line numberDiff line change
@@ -256,44 +256,40 @@ guide_geom.colorbar <- function(guide, layers, default_mapping) {
256256
guide_gengrob.colorbar <- function(guide, theme) {
257257

258258
# settings of location and size
259-
switch(guide$direction,
260-
"horizontal" = {
261-
label.position <- guide$label.position %||% "bottom"
262-
if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid")
263-
264-
barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5))
265-
barheight <- height_cm(guide$barheight %||% theme$legend.key.height)
266-
},
267-
"vertical" = {
268-
label.position <- guide$label.position %||% "right"
269-
if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid")
270-
271-
barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width)
272-
barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5))
273-
})
259+
if (guide$direction == "horizontal") {
260+
label.position <- guide$label.position %||% "bottom"
261+
if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid")
262+
263+
barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5))
264+
barheight <- height_cm(guide$barheight %||% theme$legend.key.height)
265+
} else { # guide$direction == "vertical"
266+
label.position <- guide$label.position %||% "right"
267+
if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid")
268+
269+
barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width)
270+
barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5))
271+
}
274272

275273
barlength <- switch(guide$direction, "horizontal" = barwidth, "vertical" = barheight)
276274
nbreak <- nrow(guide$key)
277275

278-
grob.bar <-
279-
if (guide$raster) {
280-
image <- switch(guide$direction, horizontal = t(guide$bar$colour), vertical = rev(guide$bar$colour))
281-
rasterGrob(image = image, width = barwidth, height = barheight, default.units = "cm", gp = gpar(col = NA), interpolate = TRUE)
282-
} else {
283-
switch(guide$direction,
284-
horizontal = {
285-
bw <- barwidth / nrow(guide$bar)
286-
bx <- (seq(nrow(guide$bar)) - 1) * bw
287-
rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight, default.units = "cm",
288-
gp = gpar(col = NA, fill = guide$bar$colour))
289-
},
290-
vertical = {
291-
bh <- barheight / nrow(guide$bar)
292-
by <- (seq(nrow(guide$bar)) - 1) * bh
293-
rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth, height = bh, default.units = "cm",
294-
gp = gpar(col = NA, fill = guide$bar$colour))
295-
})
276+
# make the bar grob (`grob.bar`)
277+
if (guide$raster) {
278+
image <- switch(guide$direction, horizontal = t(guide$bar$colour), vertical = rev(guide$bar$colour))
279+
grob.bar <-rasterGrob(image = image, width = barwidth, height = barheight, default.units = "cm", gp = gpar(col = NA), interpolate = TRUE)
280+
} else {
281+
if (guide$direction == "horizontal") {
282+
bw <- barwidth / nrow(guide$bar)
283+
bx <- (seq(nrow(guide$bar)) - 1) * bw
284+
grob.bar <-rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight, default.units = "cm",
285+
gp = gpar(col = NA, fill = guide$bar$colour))
286+
} else { # guide$direction == "vertical"
287+
bh <- barheight / nrow(guide$bar)
288+
by <- (seq(nrow(guide$bar)) - 1) * bh
289+
grob.bar <-rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth, height = bh, default.units = "cm",
290+
gp = gpar(col = NA, fill = guide$bar$colour))
296291
}
292+
}
297293

298294
# make frame around color bar if requested (colour is not NULL)
299295
if (!is.null(guide$frame.colour)) {
@@ -324,12 +320,17 @@ guide_gengrob.colorbar <- function(guide, theme) {
324320
# and to obtain the title fontsize.
325321
title.theme <- guide$title.theme %||% calc_element("legend.title", theme)
326322

323+
title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0
324+
title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5
325+
327326
grob.title <- ggname("guide.title",
328327
element_grob(
329328
title.theme,
330329
label = guide$title,
331-
hjust = guide$title.hjust %||% theme$legend.title.align %||% 0,
332-
vjust = guide$title.vjust %||% 0.5
330+
hjust = title.hjust,
331+
vjust = title.vjust,
332+
margin_x = TRUE,
333+
margin_y = TRUE
333334
)
334335
)
335336

@@ -344,96 +345,123 @@ guide_gengrob.colorbar <- function(guide, theme) {
344345
hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt")))
345346
vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt")))
346347

347-
# label
348+
# Labels
349+
350+
# get the defaults for label justification. The defaults are complicated and depend
351+
# on the direction of the legend and on label placement
352+
just_defaults <- label_just_defaults.colorbar(guide$direction, label.position)
353+
# don't set expressions left-justified
354+
if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1
355+
356+
# get the label theme
348357
label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
349-
grob.label <- {
350-
if (!guide$label)
351-
zeroGrob()
352-
else {
353-
hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||%
354-
if (any(is.expression(guide$key$.label))) 1 else switch(guide$direction, horizontal = 0.5, vertical = 0)
355-
vjust <- y <- guide$label.vjust %||% 0.5
356-
switch(guide$direction, horizontal = {x <- label_pos; y <- vjust}, "vertical" = {x <- hjust; y <- label_pos})
357-
358-
label <- guide$key$.label
359-
360-
# If any of the labels are quoted language objects, convert them
361-
# to expressions. Labels from formatter functions can return these
362-
if (any(vapply(label, is.call, logical(1)))) {
363-
label <- lapply(label, function(l) {
364-
if (is.call(l)) substitute(expression(x), list(x = l))
365-
else l
366-
})
367-
label <- do.call(c, label)
368-
}
369-
g <- element_grob(element = label.theme, label = label,
370-
x = x, y = y, hjust = hjust, vjust = vjust)
371-
ggname("guide.label", g)
358+
359+
# We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual
360+
# setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which
361+
# seems worse
362+
if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL
363+
if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL
364+
365+
# label.theme in param of guide_legend() > theme$legend.text.align > default
366+
hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||%
367+
just_defaults$hjust
368+
vjust <- guide$label.vjust %||% label.theme$vjust %||%
369+
just_defaults$vjust
370+
371+
# make the label grob (`grob.label`)
372+
if (!guide$label)
373+
grob.label <- zeroGrob()
374+
else {
375+
if (guide$direction == "horizontal") {
376+
x <- label_pos
377+
y <- rep(vjust, length(label_pos))
378+
margin_x <- FALSE
379+
margin_y <- TRUE
380+
} else { # guide$direction == "vertical"
381+
x <- rep(hjust, length(label_pos))
382+
y <- label_pos
383+
margin_x <- TRUE
384+
margin_y <- FALSE
372385
}
386+
label <- guide$key$.label
387+
388+
# If any of the labels are quoted language objects, convert them
389+
# to expressions. Labels from formatter functions can return these
390+
if (any(vapply(label, is.call, logical(1)))) {
391+
label <- lapply(label, function(l) {
392+
if (is.call(l)) substitute(expression(x), list(x = l))
393+
else l
394+
})
395+
label <- do.call(c, label)
396+
}
397+
grob.label <- element_grob(
398+
element = label.theme,
399+
label = label,
400+
x = x,
401+
y = y,
402+
hjust = hjust,
403+
vjust = vjust,
404+
margin_x = margin_x,
405+
margin_y = margin_y
406+
)
407+
grob.label <- ggname("guide.label", grob.label)
373408
}
374409

375410
label_width <- width_cm(grob.label)
376411
label_height <- height_cm(grob.label)
377412

378-
# ticks
379-
grob.ticks <-
380-
if (!guide$ticks) zeroGrob()
381-
else {
382-
switch(guide$direction,
383-
"horizontal" = {
384-
x0 = rep(tick_pos, 2)
385-
y0 = c(rep(0, nbreak), rep(barheight * (4/5), nbreak))
386-
x1 = rep(tick_pos, 2)
387-
y1 = c(rep(barheight * (1/5), nbreak), rep(barheight, nbreak))
388-
},
389-
"vertical" = {
390-
x0 = c(rep(0, nbreak), rep(barwidth * (4/5), nbreak))
391-
y0 = rep(tick_pos, 2)
392-
x1 = c(rep(barwidth * (1/5), nbreak), rep(barwidth, nbreak))
393-
y1 = rep(tick_pos, 2)
394-
})
395-
segmentsGrob(
396-
x0 = x0, y0 = y0, x1 = x1, y1 = y1,
397-
default.units = "cm",
398-
gp = gpar(
399-
col = guide$ticks.colour,
400-
lwd = guide$ticks.linewidth,
401-
lineend = "butt")
402-
)
413+
# make the ticks grob (`grob.ticks`)
414+
if (!guide$ticks)
415+
grob.ticks <-zeroGrob()
416+
else {
417+
if (guide$direction == "horizontal") {
418+
x0 <- rep(tick_pos, 2)
419+
y0 <- c(rep(0, nbreak), rep(barheight * (4/5), nbreak))
420+
x1 <- rep(tick_pos, 2)
421+
y1 <- c(rep(barheight * (1/5), nbreak), rep(barheight, nbreak))
422+
} else { # guide$direction == "vertical"
423+
x0 <- c(rep(0, nbreak), rep(barwidth * (4/5), nbreak))
424+
y0 <- rep(tick_pos, 2)
425+
x1 <- c(rep(barwidth * (1/5), nbreak), rep(barwidth, nbreak))
426+
y1 <- rep(tick_pos, 2)
403427
}
428+
grob.ticks <- segmentsGrob(
429+
x0 = x0, y0 = y0, x1 = x1, y1 = y1,
430+
default.units = "cm",
431+
gp = gpar(
432+
col = guide$ticks.colour,
433+
lwd = guide$ticks.linewidth,
434+
lineend = "butt"
435+
)
436+
)
437+
}
404438

405439
# layout of bar and label
406-
switch(guide$direction,
407-
"horizontal" = {
408-
switch(label.position,
409-
"top" = {
410-
bl_widths <- barwidth
411-
bl_heights <- c(label_height, vgap, barheight)
412-
vps <- list(bar.row = 3, bar.col = 1,
413-
label.row = 1, label.col = 1)
414-
},
415-
"bottom" = {
416-
bl_widths <- barwidth
417-
bl_heights <- c(barheight, vgap, label_height)
418-
vps <- list(bar.row = 1, bar.col = 1,
419-
label.row = 3, label.col = 1)
420-
})
421-
},
422-
"vertical" = {
423-
switch(label.position,
424-
"left" = {
425-
bl_widths <- c(label_width, hgap, barwidth)
426-
bl_heights <- barheight
427-
vps <- list(bar.row = 1, bar.col = 3,
428-
label.row = 1, label.col = 1)
429-
},
430-
"right" = {
431-
bl_widths <- c(barwidth, hgap, label_width)
432-
bl_heights <- barheight
433-
vps <- list(bar.row = 1, bar.col = 1,
434-
label.row = 1, label.col = 3)
435-
})
436-
})
440+
if (guide$direction == "horizontal") {
441+
if (label.position == "top") {
442+
bl_widths <- barwidth
443+
bl_heights <- c(label_height, vgap, barheight)
444+
vps <- list(bar.row = 3, bar.col = 1,
445+
label.row = 1, label.col = 1)
446+
} else { # label.position == "bottom" or other
447+
bl_widths <- barwidth
448+
bl_heights <- c(barheight, vgap, label_height)
449+
vps <- list(bar.row = 1, bar.col = 1,
450+
label.row = 3, label.col = 1)
451+
}
452+
} else { # guide$direction == "vertical"
453+
if (label.position == "left") {
454+
bl_widths <- c(label_width, hgap, barwidth)
455+
bl_heights <- barheight
456+
vps <- list(bar.row = 1, bar.col = 3,
457+
label.row = 1, label.col = 1)
458+
} else { # label.position == "right" or other
459+
bl_widths <- c(barwidth, hgap, label_width)
460+
bl_heights <- barheight
461+
vps <- list(bar.row = 1, bar.col = 1,
462+
label.row = 1, label.col = 3)
463+
}
464+
}
437465

438466
# layout of title and bar+label
439467
switch(guide$title.position,
@@ -484,10 +512,18 @@ guide_gengrob.colorbar <- function(guide, theme) {
484512
gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off",
485513
t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col),
486514
b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col))
487-
gt <- gtable_add_grob(gt, grob.label, name = "label", clip = "off",
515+
gt <- gtable_add_grob(
516+
gt,
517+
grob.label,
518+
name = "label",
519+
clip = "off",
488520
t = 1 + min(vps$label.row), r = 1 + max(vps$label.col),
489521
b = 1 + max(vps$label.row), l = 1 + min(vps$label.col))
490-
gt <- gtable_add_grob(gt, grob.title, name = "title", clip = "off",
522+
gt <- gtable_add_grob(
523+
gt,
524+
justify_grobs(grob.title, hjust = title.hjust, vjust = title.vjust, debug = title.theme$debug),
525+
name = "title",
526+
clip = "off",
491527
t = 1 + min(vps$title.row), r = 1 + max(vps$title.col),
492528
b = 1 + max(vps$title.row), l = 1 + min(vps$title.col))
493529
gt <- gtable_add_grob(gt, grob.ticks, name = "ticks", clip = "off",
@@ -500,3 +536,25 @@ guide_gengrob.colorbar <- function(guide, theme) {
500536
#' @export
501537
#' @rdname guide_colourbar
502538
guide_colorbar <- guide_colourbar
539+
540+
#' Calculate the default hjust and vjust settings depending on legend
541+
#' direction and position.
542+
#'
543+
#' @noRd
544+
label_just_defaults.colorbar <- function(direction, position) {
545+
if (direction == "horizontal") {
546+
switch(
547+
position,
548+
"top" = list(hjust = 0.5, vjust = 0),
549+
list(hjust = 0.5, vjust = 1)
550+
)
551+
}
552+
else {
553+
switch(
554+
position,
555+
"left" = list(hjust = 1, vjust = 0.5),
556+
list(hjust = 0, vjust = 0.5)
557+
)
558+
}
559+
}
560+

0 commit comments

Comments
 (0)