Skip to content

Commit d25ae78

Browse files
clauswilkehadley
clauswilke
authored and
hadley
committed
Colorbar fixes; closes #2397 and #2398 (#2415)
* Fixes #2397 * Consistenly use cm as units throughout. Fixes #2398 * clean up code, use variable names similar to guide-legend. * update vdiffr templates * fix bug in guide-text spacing for guide_legend(), harmonize guide_legend() and guide_colorbar(), tweak default spacings. * make default hgap and vgap 0.5 * fontsize. * update NEWS
1 parent 4635bbb commit d25ae78

File tree

53 files changed

+2290
-1975
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

53 files changed

+2290
-1975
lines changed

‎NEWS.md

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -343,6 +343,11 @@ up correct aspect ratio, and draws a graticule.
343343
output from `ggplot_build()`. Also, the object returned from
344344
`ggplot_build()` now has the class `"ggplot_built"`. (#2034)
345345

346+
* `guide_colorbar()` now correctly uses `legend.spacing.x` and `legend.spacing.y`,
347+
and it can handle multi-line titles. Minor tweaks were made to `guide_legend()`
348+
to make sure the two legend functions behave as similarly as possible.
349+
(@clauswilke, #2397 and #2398)
350+
346351
* `map_data()` now works when purrr is loaded (tidyverse#66)
347352

348353
* New functions `summarise_layout()`, `summarise_coord()`, and `summarise_layers()`

‎R/guide-colorbar.r

Lines changed: 49 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -239,47 +239,45 @@ guide_gengrob.colorbar <- function(guide, theme) {
239239
label.position <- guide$label.position %||% "bottom"
240240
if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid")
241241

242-
barwidth <- convertWidth(guide$barwidth %||% (theme$legend.key.width * 5), "mm")
243-
barheight <- convertHeight(guide$barheight %||% theme$legend.key.height, "mm")
242+
barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5))
243+
barheight <- height_cm(guide$barheight %||% theme$legend.key.height)
244244
},
245245
"vertical" = {
246246
label.position <- guide$label.position %||% "right"
247247
if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid")
248248

249-
barwidth <- convertWidth(guide$barwidth %||% theme$legend.key.width, "mm")
250-
barheight <- convertHeight(guide$barheight %||% (theme$legend.key.height * 5), "mm")
249+
barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width)
250+
barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5))
251251
})
252252

253-
barwidth.c <- c(barwidth)
254-
barheight.c <- c(barheight)
255-
barlength.c <- switch(guide$direction, "horizontal" = barwidth.c, "vertical" = barheight.c)
253+
barlength <- switch(guide$direction, "horizontal" = barwidth, "vertical" = barheight)
256254
nbreak <- nrow(guide$key)
257255

258256
grob.bar <-
259257
if (guide$raster) {
260258
image <- switch(guide$direction, horizontal = t(guide$bar$colour), vertical = rev(guide$bar$colour))
261-
rasterGrob(image = image, width = barwidth.c, height = barheight.c, default.units = "mm", gp = gpar(col = NA), interpolate = TRUE)
259+
rasterGrob(image = image, width = barwidth, height = barheight, default.units = "cm", gp = gpar(col = NA), interpolate = TRUE)
262260
} else {
263261
switch(guide$direction,
264262
horizontal = {
265-
bw <- barwidth.c / nrow(guide$bar)
263+
bw <- barwidth / nrow(guide$bar)
266264
bx <- (seq(nrow(guide$bar)) - 1) * bw
267-
rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight.c, default.units = "mm",
265+
rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight, default.units = "cm",
268266
gp = gpar(col = NA, fill = guide$bar$colour))
269267
},
270268
vertical = {
271-
bh <- barheight.c / nrow(guide$bar)
269+
bh <- barheight / nrow(guide$bar)
272270
by <- (seq(nrow(guide$bar)) - 1) * bh
273-
rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth.c, height = bh, default.units = "mm",
271+
rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth, height = bh, default.units = "cm",
274272
gp = gpar(col = NA, fill = guide$bar$colour))
275273
})
276274
}
277275

278276
# tick and label position
279-
tic_pos.c <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength.c / guide$nbin
280-
label_pos <- unit(tic_pos.c, "mm")
281-
if (!guide$draw.ulim) tic_pos.c <- tic_pos.c[-1]
282-
if (!guide$draw.llim) tic_pos.c <- tic_pos.c[-length(tic_pos.c)]
277+
tick_pos <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength / guide$nbin
278+
label_pos <- unit(tick_pos, "cm")
279+
if (!guide$draw.ulim) tick_pos <- tick_pos[-1]
280+
if (!guide$draw.llim) tick_pos <- tick_pos[-length(tick_pos)]
283281

284282
# title
285283

@@ -296,19 +294,16 @@ guide_gengrob.colorbar <- function(guide, theme) {
296294
)
297295
)
298296

299-
300-
title_width <- convertWidth(grobWidth(grob.title), "mm")
301-
title_width.c <- c(title_width)
302-
title_height <- convertHeight(grobHeight(grob.title), "mm")
303-
title_height.c <- c(title_height)
297+
title_width <- width_cm(grob.title)
298+
title_height <- height_cm(grob.title)
304299
title_fontsize <- title.theme$size
305300
if (is.null(title_fontsize)) title_fontsize <- 0
306301

307302
# gap between keys etc
308-
hgap <- width_cm(theme$legend.spacing.x %||% unit(0.3, "line"))
309-
# multiply by 5 instead of 0.5 due to unit error below. this needs to be fixed
310-
# separately (pull request pending).
311-
vgap <- height_cm(theme$legend.spacing.y %||% (5 * unit(title_fontsize, "pt")))
303+
# the default horizontal and vertical gap need to be the same to avoid strange
304+
# effects for certain guide layouts
305+
hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt")))
306+
vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt")))
312307

313308
# label
314309
label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
@@ -338,60 +333,58 @@ guide_gengrob.colorbar <- function(guide, theme) {
338333
}
339334
}
340335

341-
label_width <- convertWidth(grobWidth(grob.label), "mm")
342-
label_width.c <- c(label_width)
343-
label_height <- convertHeight(grobHeight(grob.label), "mm")
344-
label_height.c <- c(label_height)
336+
label_width <- width_cm(grob.label)
337+
label_height <- height_cm(grob.label)
345338

346339
# ticks
347340
grob.ticks <-
348341
if (!guide$ticks) zeroGrob()
349342
else {
350343
switch(guide$direction,
351344
"horizontal" = {
352-
x0 = rep(tic_pos.c, 2)
353-
y0 = c(rep(0, nbreak), rep(barheight.c * (4/5), nbreak))
354-
x1 = rep(tic_pos.c, 2)
355-
y1 = c(rep(barheight.c * (1/5), nbreak), rep(barheight.c, nbreak))
345+
x0 = rep(tick_pos, 2)
346+
y0 = c(rep(0, nbreak), rep(barheight * (4/5), nbreak))
347+
x1 = rep(tick_pos, 2)
348+
y1 = c(rep(barheight * (1/5), nbreak), rep(barheight, nbreak))
356349
},
357350
"vertical" = {
358-
x0 = c(rep(0, nbreak), rep(barwidth.c * (4/5), nbreak))
359-
y0 = rep(tic_pos.c, 2)
360-
x1 = c(rep(barwidth.c * (1/5), nbreak), rep(barwidth.c, nbreak))
361-
y1 = rep(tic_pos.c, 2)
351+
x0 = c(rep(0, nbreak), rep(barwidth * (4/5), nbreak))
352+
y0 = rep(tick_pos, 2)
353+
x1 = c(rep(barwidth * (1/5), nbreak), rep(barwidth, nbreak))
354+
y1 = rep(tick_pos, 2)
362355
})
363356
segmentsGrob(x0 = x0, y0 = y0, x1 = x1, y1 = y1,
364-
default.units = "mm", gp = gpar(col = "white", lwd = 0.5, lineend = "butt"))
357+
default.units = "cm", gp = gpar(col = "white", lwd = 0.5, lineend = "butt"))
365358
}
366359

367360
# layout of bar and label
368361
switch(guide$direction,
369362
"horizontal" = {
370363
switch(label.position,
371364
"top" = {
372-
bl_widths <- barwidth.c
373-
bl_heights <- c(label_height.c, vgap, barheight.c)
365+
bl_widths <- barwidth
366+
bl_heights <- c(label_height, vgap, barheight)
374367
vps <- list(bar.row = 3, bar.col = 1,
375368
label.row = 1, label.col = 1)
376369
},
377370
"bottom" = {
378-
bl_widths <- barwidth.c
379-
bl_heights <- c(barheight.c, vgap, label_height.c)
371+
bl_widths <- barwidth
372+
bl_heights <- c(barheight, vgap, label_height)
380373
vps <- list(bar.row = 1, bar.col = 1,
381374
label.row = 3, label.col = 1)
382375
})
383376
},
384377
"vertical" = {
385378
switch(label.position,
386379
"left" = {
387-
bl_widths <- c(label_width.c, vgap, barwidth.c)
388-
bl_heights <- barheight.c
380+
bl_widths <- c(label_width, hgap, barwidth)
381+
bl_heights <- barheight
389382
vps <- list(bar.row = 1, bar.col = 3,
390383
label.row = 1, label.col = 1)
391384
},
392385
"right" = {
393-
bl_widths <- c(barwidth.c, vgap, label_width.c)
394-
bl_heights <- barheight.c
386+
bl_widths <- c(barwidth, hgap, label_width)
387+
bl_heights <- barheight
395388
vps <- list(bar.row = 1, bar.col = 1,
396389
label.row = 1, label.col = 3)
397390
})
@@ -400,32 +393,32 @@ guide_gengrob.colorbar <- function(guide, theme) {
400393
# layout of title and bar+label
401394
switch(guide$title.position,
402395
"top" = {
403-
widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths)))
404-
heights <- c(title_height.c, vgap, bl_heights)
396+
widths <- c(bl_widths, max(0, title_width - sum(bl_widths)))
397+
heights <- c(title_height, vgap, bl_heights)
405398
vps <- with(vps,
406399
list(bar.row = bar.row + 2, bar.col = bar.col,
407400
label.row = label.row + 2, label.col = label.col,
408401
title.row = 1, title.col = 1:length(widths)))
409402
},
410403
"bottom" = {
411-
widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths)))
412-
heights <- c(bl_heights, vgap, title_height.c)
404+
widths <- c(bl_widths, max(0, title_width - sum(bl_widths)))
405+
heights <- c(bl_heights, vgap, title_height)
413406
vps <- with(vps,
414407
list(bar.row = bar.row, bar.col = bar.col,
415408
label.row = label.row, label.col = label.col,
416409
title.row = length(heights), title.col = 1:length(widths)))
417410
},
418411
"left" = {
419-
widths <- c(title_width.c, hgap, bl_widths)
420-
heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights)))
412+
widths <- c(title_width, hgap, bl_widths)
413+
heights <- c(bl_heights, max(0, title_height - sum(bl_heights)))
421414
vps <- with(vps,
422415
list(bar.row = bar.row, bar.col = bar.col + 2,
423416
label.row = label.row, label.col = label.col + 2,
424417
title.row = 1:length(heights), title.col = 1))
425418
},
426419
"right" = {
427-
widths <- c(bl_widths, hgap, title_width.c)
428-
heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights)))
420+
widths <- c(bl_widths, hgap, title_width)
421+
heights <- c(bl_heights, max(0, title_height - sum(bl_heights)))
429422
vps <- with(vps,
430423
list(bar.row = bar.row, bar.col = bar.col,
431424
label.row = label.row, label.col = label.col,
@@ -436,11 +429,11 @@ guide_gengrob.colorbar <- function(guide, theme) {
436429
grob.background <- element_render(theme, "legend.background")
437430

438431
# padding
439-
padding <- convertUnit(theme$legend.margin %||% margin(), "mm")
432+
padding <- convertUnit(theme$legend.margin %||% margin(), "cm")
440433
widths <- c(padding[4], widths, padding[2])
441434
heights <- c(padding[1], heights, padding[3])
442435

443-
gt <- gtable(widths = unit(widths, "mm"), heights = unit(heights, "mm"))
436+
gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm"))
444437
gt <- gtable_add_grob(gt, grob.background, name = "background", clip = "off",
445438
t = 1, r = -1, b = -1, l = 1)
446439
gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off",

‎R/guide-legend.r

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -346,7 +346,9 @@ guide_gengrob.legend <- function(guide, theme) {
346346
if (is.null(title_fontsize)) title_fontsize <- 0
347347

348348
# gap between keys etc
349-
hgap <- width_cm(theme$legend.spacing.x %||% unit(0.3, "line"))
349+
# the default horizontal and vertical gap need to be the same to avoid strange
350+
# effects for certain guide layouts
351+
hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt")))
350352
vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt")))
351353

352354
# Labels
@@ -460,7 +462,7 @@ guide_gengrob.legend <- function(guide, theme) {
460462
"top" = {
461463
kl_widths <- pmax(label_widths, key_widths)
462464
kl_heights <- utils::head(
463-
interleave(label_heights, vgap / 2, key_heights, vgap / 2),
465+
interleave(label_heights, vgap, key_heights, vgap),
464466
-1
465467
)
466468
vps <- transform(
@@ -474,7 +476,7 @@ guide_gengrob.legend <- function(guide, theme) {
474476
"bottom" = {
475477
kl_widths <- pmax(label_widths, key_widths)
476478
kl_heights <- utils::head(
477-
interleave(key_heights, vgap / 2, label_heights, vgap / 2),
479+
interleave(key_heights, vgap, label_heights, vgap),
478480
-1
479481
)
480482
vps <- transform(
@@ -487,11 +489,11 @@ guide_gengrob.legend <- function(guide, theme) {
487489
},
488490
"left" = {
489491
kl_widths <- utils::head(
490-
interleave(label_widths, hgap / 2, key_widths, hgap / 2),
492+
interleave(label_widths, hgap, key_widths, hgap),
491493
-1
492494
)
493495
kl_heights <- utils::head(
494-
interleave(pmax(label_heights, key_heights), vgap / 2),
496+
interleave(pmax(label_heights, key_heights), vgap),
495497
-1
496498
)
497499
vps <- transform(
@@ -504,11 +506,11 @@ guide_gengrob.legend <- function(guide, theme) {
504506
},
505507
"right" = {
506508
kl_widths <- utils::head(
507-
interleave(key_widths, hgap / 2, label_widths, hgap / 2),
509+
interleave(key_widths, hgap, label_widths, hgap),
508510
-1
509511
)
510512
kl_heights <- utils::head(
511-
interleave(pmax(label_heights, key_heights), vgap / 2),
513+
interleave(pmax(label_heights, key_heights), vgap),
512514
-1
513515
)
514516
vps <- transform(
@@ -524,11 +526,11 @@ guide_gengrob.legend <- function(guide, theme) {
524526
label.position,
525527
"top" = {
526528
kl_widths <- utils::head(
527-
interleave(pmax(label_widths, key_widths), hgap/2),
529+
interleave(pmax(label_widths, key_widths), hgap),
528530
-1
529531
)
530532
kl_heights <- utils::head(
531-
interleave(label_heights, vgap / 2, key_heights, vgap / 2),
533+
interleave(label_heights, vgap, key_heights, vgap),
532534
-1
533535
)
534536
vps <- transform(
@@ -541,11 +543,11 @@ guide_gengrob.legend <- function(guide, theme) {
541543
},
542544
"bottom" = {
543545
kl_widths <- utils::head(
544-
interleave(pmax(label_widths, key_widths), hgap / 2),
546+
interleave(pmax(label_widths, key_widths), hgap),
545547
-1
546548
)
547549
kl_heights <- utils::head(
548-
interleave(key_heights, vgap / 2, label_heights, vgap / 2),
550+
interleave(key_heights, vgap, label_heights, vgap),
549551
-1
550552
)
551553
vps <- transform(
@@ -558,7 +560,7 @@ guide_gengrob.legend <- function(guide, theme) {
558560
},
559561
"left" = {
560562
kl_widths <- utils::head(
561-
interleave(label_widths, hgap / 2, key_widths, hgap / 2),
563+
interleave(label_widths, hgap, key_widths, hgap),
562564
-1
563565
)
564566
kl_heights <- pmax(key_heights, label_heights)
@@ -572,7 +574,7 @@ guide_gengrob.legend <- function(guide, theme) {
572574
},
573575
"right" = {
574576
kl_widths <- utils::head(
575-
interleave(key_widths, hgap / 2, label_widths, hgap / 2),
577+
interleave(key_widths, hgap, label_widths, hgap),
576578
-1
577579
)
578580
kl_heights <- pmax(key_heights, label_heights)

‎tests/figs/geom-boxplot/outlier-colours.svg

Lines changed: 3 additions & 3 deletions
Loading

0 commit comments

Comments
 (0)