From dd7887ff8c6c0dbc4fa58767d54219476edc63fc Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 14 Dec 2023 16:27:44 +0100 Subject: [PATCH] Gradient as colourbar (#5548) * deprecate `raster` in favour of `display` * Use 15 colours as default for gradient * Don't account for bins to offset labels * add gradient display * deal with old R versions * document options * use `arg_match0()` * Add news bullet --- NEWS.md | 2 ++ R/backports.R | 7 ++++- R/guide-colorbar.R | 61 +++++++++++++++++++++++++++++++----------- man/guide_colourbar.Rd | 28 +++++++++++++------ 4 files changed, 73 insertions(+), 25 deletions(-) diff --git a/NEWS.md b/NEWS.md index 942991d9dd..dd9ef05b30 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* New `display` argument in `guide_colourbar()` supplants the `raster` argument. + In R 4.1.0 and above, `display = "gradient"` will draw a gradient. * When using `geom_dotplot(binaxis = "x")` with a discrete y-variable, dots are now stacked from the y-position rather than from 0 (@teunbrand, #5462) diff --git a/R/backports.R b/R/backports.R index c19197e09b..a3d5eb9465 100644 --- a/R/backports.R +++ b/R/backports.R @@ -52,6 +52,9 @@ version_unavailable <- function(...) { viewport <- function(..., mask) grid::viewport(...) pattern <- version_unavailable as.mask <- version_unavailable +# Unavailable prior to R 4.1.0 +linearGradient <- version_unavailable + on_load({ if ("mask" %in% fn_fmls_names(grid::viewport)) { viewport <- grid::viewport @@ -63,5 +66,7 @@ on_load({ if ("as.mask" %in% getNamespaceExports("grid")) { as.mask <- grid::as.mask } + if ("linearGradient" %in% getNamespaceExports("grid")) { + linearGradient <- grid::linearGradient() + } }) - diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index 0baba64587..c0f2c15e7f 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -17,10 +17,18 @@ NULL #' @inheritParams guide_legend #' @param nbin A numeric specifying the number of bins for drawing the #' colourbar. A smoother colourbar results from a larger value. -#' @param raster A logical. If `TRUE` then the colourbar is rendered as a -#' raster object. If `FALSE` then the colourbar is rendered as a set of -#' rectangles. Note that not all graphics devices are capable of rendering -#' raster image. +#' @param display A string indicating a method to display the colourbar. Can be +#' one of the following: +#' +#' * `"raster"` to display as a bitmap image. +#' * `"rectangles"` to display as a series of rectangles. +#' * `"gradient"` to display as a linear gradient. +#' +#' Note that not all devices are able to render rasters and gradients. +#' @param raster `r lifecycle::badge("deprecated")` A logical. If `TRUE` then +#' the colourbar is rendered as a raster object. If `FALSE` then the colourbar +#' is rendered as a set of rectangles. Note that not all graphics devices are +#' capable of rendering raster image. #' @param alpha A numeric between 0 and 1 setting the colour transparency of #' the bar. Use `NA` to preserve the alpha encoded in the colour itself #' (default). @@ -108,8 +116,9 @@ NULL guide_colourbar <- function( title = waiver(), theme = NULL, - nbin = 300, - raster = TRUE, + nbin = NULL, + display = "raster", + raster = deprecated(), alpha = NA, draw.ulim = TRUE, draw.llim = TRUE, @@ -120,6 +129,13 @@ guide_colourbar <- function( available_aes = c("colour", "color", "fill"), ... ) { + if (lifecycle::is_present(raster)) { + deprecate_soft0("3.5.0", "guide_colourbar(raster)", "guide_colourbar(display)") + check_bool(raster) + display <- if (raster) "raster" else "rectangles" + } + display <- arg_match0(display, c("raster", "rectangles", "gradient")) + nbin <- nbin %||% switch(display, gradient = 15, 300) theme <- deprecated_guide_args(theme, ...) if (!is.null(position)) { @@ -131,7 +147,7 @@ guide_colourbar <- function( title = title, theme = theme, nbin = nbin, - raster = raster, + display = display, alpha = alpha, draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)), position = position, @@ -167,7 +183,7 @@ GuideColourbar <- ggproto( # bar nbin = 300, - raster = TRUE, + display = "raster", alpha = NA, draw_lim = c(TRUE, TRUE), @@ -232,13 +248,13 @@ GuideColourbar <- ggproto( extract_params = function(scale, params, title = waiver(), ...) { params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title) - limits <- params$decor$value[c(1L, nrow(params$decor))] - params$key$.value <- rescale( - params$key$.value, - c(0.5, params$nbin - 0.5) / params$nbin, - limits + to <- switch( + params$display, + gradient = c(0, 1), + c(0.5, params$nbin - 0.5) / params$nbin ) + params$key$.value <- rescale(params$key$.value, to = to, from = limits) params }, @@ -328,8 +344,7 @@ GuideColourbar <- ggproto( }, build_decor = function(decor, grobs, elements, params) { - - if (params$raster) { + if (params$display == "raster") { image <- switch( params$direction, "horizontal" = t(decor$colour), @@ -343,7 +358,7 @@ GuideColourbar <- ggproto( gp = gpar(col = NA), interpolate = TRUE ) - } else{ + } else if (params$display == "rectangles") { if (params$direction == "horizontal") { width <- 1 / nrow(decor) height <- 1 @@ -362,6 +377,20 @@ GuideColourbar <- ggproto( default.units = "npc", gp = gpar(col = NA, fill = decor$colour) ) + } else if (params$display == "gradient") { + check_device("gradients", call = expr(guide_colourbar())) + value <- if (isTRUE(params$reverse)) { + rescale(decor$value, to = c(1, 0)) + } else { + rescale(decor$value, to = c(0, 1)) + } + position <- switch( + params$direction, + horizontal = list(y1 = unit(0.5, "npc"), y2 = unit(0.5, "npc")), + vertical = list(x1 = unit(0.5, "npc"), x2 = unit(0.5, "npc")) + ) + gradient <- inject(linearGradient(decor$colour, value, !!!position)) + grob <- rectGrob(gp = gpar(fill = gradient, col = NA)) } frame <- element_grob(elements$frame, fill = NA) diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index ca78b8765e..f2e994bba9 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -8,8 +8,9 @@ guide_colourbar( title = waiver(), theme = NULL, - nbin = 300, - raster = TRUE, + nbin = NULL, + display = "raster", + raster = deprecated(), alpha = NA, draw.ulim = TRUE, draw.llim = TRUE, @@ -24,8 +25,9 @@ guide_colourbar( guide_colorbar( title = waiver(), theme = NULL, - nbin = 300, - raster = TRUE, + nbin = NULL, + display = "raster", + raster = deprecated(), alpha = NA, draw.ulim = TRUE, draw.llim = TRUE, @@ -50,10 +52,20 @@ guide overrides, and is combined with, the plot's theme.} \item{nbin}{A numeric specifying the number of bins for drawing the colourbar. A smoother colourbar results from a larger value.} -\item{raster}{A logical. If \code{TRUE} then the colourbar is rendered as a -raster object. If \code{FALSE} then the colourbar is rendered as a set of -rectangles. Note that not all graphics devices are capable of rendering -raster image.} +\item{display}{A string indicating a method to display the colourbar. Can be +one of the following: +\itemize{ +\item \code{"raster"} to display as a bitmap image. +\item \code{"rectangles"} to display as a series of rectangles. +\item \code{"gradient"} to display as a linear gradient. +} + +Note that not all devices are able to render rasters and gradients.} + +\item{raster}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} A logical. If \code{TRUE} then +the colourbar is rendered as a raster object. If \code{FALSE} then the colourbar +is rendered as a set of rectangles. Note that not all graphics devices are +capable of rendering raster image.} \item{alpha}{A numeric between 0 and 1 setting the colour transparency of the bar. Use \code{NA} to preserve the alpha encoded in the colour itself