Skip to content

Colorbar fixes; closes #2397 and #2398 #2415

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
May 2, 2018
Merged

Colorbar fixes; closes #2397 and #2398 #2415

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
c948e34
Fixes #2397
clauswilke Jan 20, 2018
fd7b13d
Consistenly use cm as units throughout. Fixes #2398
clauswilke Jan 20, 2018
d5d1f15
clean up code, use variable names similar to guide-legend.
clauswilke Jan 20, 2018
2d01bc7
update vdiffr templates
clauswilke May 2, 2018
59e256e
fix bug in guide-text spacing for guide_legend(), harmonize guide_leg…
clauswilke May 2, 2018
59020bd
make default hgap and vgap 0.5 * fontsize.
clauswilke May 2, 2018
ea16baf
update NEWS
clauswilke May 2, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -343,6 +343,11 @@ up correct aspect ratio, and draws a graticule.
output from `ggplot_build()`. Also, the object returned from
`ggplot_build()` now has the class `"ggplot_built"`. (#2034)

* `guide_colorbar()` now correctly uses `legend.spacing.x` and `legend.spacing.y`,
and it can handle multi-line titles. Minor tweaks were made to `guide_legend()`
to make sure the two legend functions behave as similarly as possible.
(@clauswilke, #2397 and #2398)

* `map_data()` now works when purrr is loaded (tidyverse#66)

* New functions `summarise_layout()`, `summarise_coord()`, and `summarise_layers()`
Expand Down
105 changes: 49 additions & 56 deletions R/guide-colorbar.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -239,47 +239,45 @@ guide_gengrob.colorbar <- function(guide, theme) {
label.position <- guide$label.position %||% "bottom"
if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid")

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

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

barwidth.c <- c(barwidth)
barheight.c <- c(barheight)
barlength.c <- switch(guide$direction, "horizontal" = barwidth.c, "vertical" = barheight.c)
barlength <- switch(guide$direction, "horizontal" = barwidth, "vertical" = barheight)
nbreak <- nrow(guide$key)

grob.bar <-
if (guide$raster) {
image <- switch(guide$direction, horizontal = t(guide$bar$colour), vertical = rev(guide$bar$colour))
rasterGrob(image = image, width = barwidth.c, height = barheight.c, default.units = "mm", gp = gpar(col = NA), interpolate = TRUE)
rasterGrob(image = image, width = barwidth, height = barheight, default.units = "cm", gp = gpar(col = NA), interpolate = TRUE)
} else {
switch(guide$direction,
horizontal = {
bw <- barwidth.c / nrow(guide$bar)
bw <- barwidth / nrow(guide$bar)
bx <- (seq(nrow(guide$bar)) - 1) * bw
rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight.c, default.units = "mm",
rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight, default.units = "cm",
gp = gpar(col = NA, fill = guide$bar$colour))
},
vertical = {
bh <- barheight.c / nrow(guide$bar)
bh <- barheight / nrow(guide$bar)
by <- (seq(nrow(guide$bar)) - 1) * bh
rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth.c, height = bh, default.units = "mm",
rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth, height = bh, default.units = "cm",
gp = gpar(col = NA, fill = guide$bar$colour))
})
}

# tick and label position
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
label_pos <- unit(tic_pos.c, "mm")
if (!guide$draw.ulim) tic_pos.c <- tic_pos.c[-1]
if (!guide$draw.llim) tic_pos.c <- tic_pos.c[-length(tic_pos.c)]
tick_pos <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength / guide$nbin
label_pos <- unit(tick_pos, "cm")
if (!guide$draw.ulim) tick_pos <- tick_pos[-1]
if (!guide$draw.llim) tick_pos <- tick_pos[-length(tick_pos)]

# title

Expand All @@ -296,19 +294,16 @@ guide_gengrob.colorbar <- function(guide, theme) {
)
)


title_width <- convertWidth(grobWidth(grob.title), "mm")
title_width.c <- c(title_width)
title_height <- convertHeight(grobHeight(grob.title), "mm")
title_height.c <- c(title_height)
title_width <- width_cm(grob.title)
title_height <- height_cm(grob.title)
title_fontsize <- title.theme$size
if (is.null(title_fontsize)) title_fontsize <- 0

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

# label
label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
Expand Down Expand Up @@ -338,60 +333,58 @@ guide_gengrob.colorbar <- function(guide, theme) {
}
}

label_width <- convertWidth(grobWidth(grob.label), "mm")
label_width.c <- c(label_width)
label_height <- convertHeight(grobHeight(grob.label), "mm")
label_height.c <- c(label_height)
label_width <- width_cm(grob.label)
label_height <- height_cm(grob.label)

# ticks
grob.ticks <-
if (!guide$ticks) zeroGrob()
else {
switch(guide$direction,
"horizontal" = {
x0 = rep(tic_pos.c, 2)
y0 = c(rep(0, nbreak), rep(barheight.c * (4/5), nbreak))
x1 = rep(tic_pos.c, 2)
y1 = c(rep(barheight.c * (1/5), nbreak), rep(barheight.c, nbreak))
x0 = rep(tick_pos, 2)
y0 = c(rep(0, nbreak), rep(barheight * (4/5), nbreak))
x1 = rep(tick_pos, 2)
y1 = c(rep(barheight * (1/5), nbreak), rep(barheight, nbreak))
},
"vertical" = {
x0 = c(rep(0, nbreak), rep(barwidth.c * (4/5), nbreak))
y0 = rep(tic_pos.c, 2)
x1 = c(rep(barwidth.c * (1/5), nbreak), rep(barwidth.c, nbreak))
y1 = rep(tic_pos.c, 2)
x0 = c(rep(0, nbreak), rep(barwidth * (4/5), nbreak))
y0 = rep(tick_pos, 2)
x1 = c(rep(barwidth * (1/5), nbreak), rep(barwidth, nbreak))
y1 = rep(tick_pos, 2)
})
segmentsGrob(x0 = x0, y0 = y0, x1 = x1, y1 = y1,
default.units = "mm", gp = gpar(col = "white", lwd = 0.5, lineend = "butt"))
default.units = "cm", gp = gpar(col = "white", lwd = 0.5, lineend = "butt"))
}

# layout of bar and label
switch(guide$direction,
"horizontal" = {
switch(label.position,
"top" = {
bl_widths <- barwidth.c
bl_heights <- c(label_height.c, vgap, barheight.c)
bl_widths <- barwidth
bl_heights <- c(label_height, vgap, barheight)
vps <- list(bar.row = 3, bar.col = 1,
label.row = 1, label.col = 1)
},
"bottom" = {
bl_widths <- barwidth.c
bl_heights <- c(barheight.c, vgap, label_height.c)
bl_widths <- barwidth
bl_heights <- c(barheight, vgap, label_height)
vps <- list(bar.row = 1, bar.col = 1,
label.row = 3, label.col = 1)
})
},
"vertical" = {
switch(label.position,
"left" = {
bl_widths <- c(label_width.c, vgap, barwidth.c)
bl_heights <- barheight.c
bl_widths <- c(label_width, hgap, barwidth)
bl_heights <- barheight
vps <- list(bar.row = 1, bar.col = 3,
label.row = 1, label.col = 1)
},
"right" = {
bl_widths <- c(barwidth.c, vgap, label_width.c)
bl_heights <- barheight.c
bl_widths <- c(barwidth, hgap, label_width)
bl_heights <- barheight
vps <- list(bar.row = 1, bar.col = 1,
label.row = 1, label.col = 3)
})
Expand All @@ -400,32 +393,32 @@ guide_gengrob.colorbar <- function(guide, theme) {
# layout of title and bar+label
switch(guide$title.position,
"top" = {
widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths)))
heights <- c(title_height.c, vgap, bl_heights)
widths <- c(bl_widths, max(0, title_width - sum(bl_widths)))
heights <- c(title_height, vgap, bl_heights)
vps <- with(vps,
list(bar.row = bar.row + 2, bar.col = bar.col,
label.row = label.row + 2, label.col = label.col,
title.row = 1, title.col = 1:length(widths)))
},
"bottom" = {
widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths)))
heights <- c(bl_heights, vgap, title_height.c)
widths <- c(bl_widths, max(0, title_width - sum(bl_widths)))
heights <- c(bl_heights, vgap, title_height)
vps <- with(vps,
list(bar.row = bar.row, bar.col = bar.col,
label.row = label.row, label.col = label.col,
title.row = length(heights), title.col = 1:length(widths)))
},
"left" = {
widths <- c(title_width.c, hgap, bl_widths)
heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights)))
widths <- c(title_width, hgap, bl_widths)
heights <- c(bl_heights, max(0, title_height - sum(bl_heights)))
vps <- with(vps,
list(bar.row = bar.row, bar.col = bar.col + 2,
label.row = label.row, label.col = label.col + 2,
title.row = 1:length(heights), title.col = 1))
},
"right" = {
widths <- c(bl_widths, hgap, title_width.c)
heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights)))
widths <- c(bl_widths, hgap, title_width)
heights <- c(bl_heights, max(0, title_height - sum(bl_heights)))
vps <- with(vps,
list(bar.row = bar.row, bar.col = bar.col,
label.row = label.row, label.col = label.col,
Expand All @@ -436,11 +429,11 @@ guide_gengrob.colorbar <- function(guide, theme) {
grob.background <- element_render(theme, "legend.background")

# padding
padding <- convertUnit(theme$legend.margin %||% margin(), "mm")
padding <- convertUnit(theme$legend.margin %||% margin(), "cm")
widths <- c(padding[4], widths, padding[2])
heights <- c(padding[1], heights, padding[3])

gt <- gtable(widths = unit(widths, "mm"), heights = unit(heights, "mm"))
gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm"))
gt <- gtable_add_grob(gt, grob.background, name = "background", clip = "off",
t = 1, r = -1, b = -1, l = 1)
gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off",
Expand Down
28 changes: 15 additions & 13 deletions R/guide-legend.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -346,7 +346,9 @@ guide_gengrob.legend <- function(guide, theme) {
if (is.null(title_fontsize)) title_fontsize <- 0

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

# Labels
Expand Down Expand Up @@ -460,7 +462,7 @@ guide_gengrob.legend <- function(guide, theme) {
"top" = {
kl_widths <- pmax(label_widths, key_widths)
kl_heights <- utils::head(
interleave(label_heights, vgap / 2, key_heights, vgap / 2),
interleave(label_heights, vgap, key_heights, vgap),
-1
)
vps <- transform(
Expand All @@ -474,7 +476,7 @@ guide_gengrob.legend <- function(guide, theme) {
"bottom" = {
kl_widths <- pmax(label_widths, key_widths)
kl_heights <- utils::head(
interleave(key_heights, vgap / 2, label_heights, vgap / 2),
interleave(key_heights, vgap, label_heights, vgap),
-1
)
vps <- transform(
Expand All @@ -487,11 +489,11 @@ guide_gengrob.legend <- function(guide, theme) {
},
"left" = {
kl_widths <- utils::head(
interleave(label_widths, hgap / 2, key_widths, hgap / 2),
interleave(label_widths, hgap, key_widths, hgap),
-1
)
kl_heights <- utils::head(
interleave(pmax(label_heights, key_heights), vgap / 2),
interleave(pmax(label_heights, key_heights), vgap),
-1
)
vps <- transform(
Expand All @@ -504,11 +506,11 @@ guide_gengrob.legend <- function(guide, theme) {
},
"right" = {
kl_widths <- utils::head(
interleave(key_widths, hgap / 2, label_widths, hgap / 2),
interleave(key_widths, hgap, label_widths, hgap),
-1
)
kl_heights <- utils::head(
interleave(pmax(label_heights, key_heights), vgap / 2),
interleave(pmax(label_heights, key_heights), vgap),
-1
)
vps <- transform(
Expand All @@ -524,11 +526,11 @@ guide_gengrob.legend <- function(guide, theme) {
label.position,
"top" = {
kl_widths <- utils::head(
interleave(pmax(label_widths, key_widths), hgap/2),
interleave(pmax(label_widths, key_widths), hgap),
-1
)
kl_heights <- utils::head(
interleave(label_heights, vgap / 2, key_heights, vgap / 2),
interleave(label_heights, vgap, key_heights, vgap),
-1
)
vps <- transform(
Expand All @@ -541,11 +543,11 @@ guide_gengrob.legend <- function(guide, theme) {
},
"bottom" = {
kl_widths <- utils::head(
interleave(pmax(label_widths, key_widths), hgap / 2),
interleave(pmax(label_widths, key_widths), hgap),
-1
)
kl_heights <- utils::head(
interleave(key_heights, vgap / 2, label_heights, vgap / 2),
interleave(key_heights, vgap, label_heights, vgap),
-1
)
vps <- transform(
Expand All @@ -558,7 +560,7 @@ guide_gengrob.legend <- function(guide, theme) {
},
"left" = {
kl_widths <- utils::head(
interleave(label_widths, hgap / 2, key_widths, hgap / 2),
interleave(label_widths, hgap, key_widths, hgap),
-1
)
kl_heights <- pmax(key_heights, label_heights)
Expand All @@ -572,7 +574,7 @@ guide_gengrob.legend <- function(guide, theme) {
},
"right" = {
kl_widths <- utils::head(
interleave(key_widths, hgap / 2, label_widths, hgap / 2),
interleave(key_widths, hgap, label_widths, hgap),
-1
)
kl_heights <- pmax(key_heights, label_heights)
Expand Down
6 changes: 3 additions & 3 deletions tests/figs/geom-boxplot/outlier-colours.svg
View file
Open in desktop
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading