Colourbar transparency (#5550)

* Add `alpha` to set colourbar/steps transparency

* incorporate `alpha` in tests

* document `alpha`

* add news bullet

* resolve merge conflict

* add alpha to coloursteps (constructors were separated)

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `guide_colourbar()` and `guide_coloursteps()` gain an `alpha` argument to
+  set the transparency of the bar (#5085).
+
 * `stat_count()` treats `x` as unique in the same manner `unique()` does 
   (#4609).
 

R/guide-colorbar.R

@@ -21,6 +21,9 @@ NULL
 #'   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).
 #' @param draw.ulim A logical specifying if the upper limit tick marks should
 #'   be visible.
 #' @param draw.llim A logical specifying if the lower limit tick marks should
@@ -107,6 +110,7 @@ guide_colourbar <- function(
   theme = NULL,
   nbin = 300,
   raster = TRUE,
+  alpha = NA,
   draw.ulim = TRUE,
   draw.llim = TRUE,
   position = NULL,
@@ -121,12 +125,14 @@ guide_colourbar <- function(
   if (!is.null(position)) {
     position <- arg_match0(position, c(.trbl, "inside"))
   }
+  check_number_decimal(alpha, min = 0, max = 1, allow_na = TRUE)
 
   new_guide(
     title = title,
     theme = theme,
     nbin = nbin,
     raster = raster,
+    alpha = alpha,
     draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)),
     position = position,
     direction = direction,
@@ -162,6 +168,7 @@ GuideColourbar <- ggproto(
     # bar
     nbin = 300,
     raster = TRUE,
+    alpha = NA,
 
     draw_lim = c(TRUE, TRUE),
 
@@ -204,15 +211,15 @@ GuideColourbar <- ggproto(
     Guide$extract_key(scale, aesthetic, ...)
   },
 
-  extract_decor = function(scale, aesthetic, nbin = 300, reverse = FALSE, ...) {
+  extract_decor = function(scale, aesthetic, nbin = 300, reverse = FALSE, alpha = NA, ...) {
 
     limits <- scale$get_limits()
     bar <- seq(limits[1], limits[2], length.out = nbin)
     if (length(bar) == 0) {
       bar <- unique0(limits)
     }
     bar <- data_frame0(
-      colour = scale$map(bar),
+      colour = alpha(scale$map(bar), alpha),
       value  = bar,
       .size  = length(bar)
     )

R/guide-colorsteps.R

@@ -46,6 +46,7 @@
 guide_coloursteps <- function(
   title = waiver(),
   theme = NULL,
+  alpha = NA,
   even.steps  = TRUE,
   show.limits = NULL,
   direction = NULL,
@@ -56,10 +57,12 @@ guide_coloursteps <- function(
 ) {
 
   theme <- deprecated_guide_args(theme, ...)
+  check_number_decimal(alpha, min = 0, max = 1, allow_na = TRUE)
 
   new_guide(
     title = title,
     theme = theme,
+    alpha = alpha,
     even.steps  = even.steps,
     show.limits = show.limits,
     direction = direction,
@@ -120,11 +123,11 @@ GuideColoursteps <- ggproto(
 
   extract_decor = function(scale, aesthetic, key,
                            reverse = FALSE, even.steps = TRUE,
-                           nbin = 100, ...) {
+                           nbin = 100, alpha = NA,...) {
     if (even.steps) {
       bin_at <- attr(key, "bin_at", TRUE)
       bar <- data_frame0(
-        colour = scale$map(bin_at),
+        colour = alpha(scale$map(bin_at), alpha),
         min    = seq_along(bin_at) - 1,
         max    = seq_along(bin_at),
         .size  = length(bin_at)
@@ -134,7 +137,7 @@ GuideColoursteps <- ggproto(
       n <- length(breaks)
       bin_at <- (breaks[-1] + breaks[-n]) / 2
       bar <- data_frame0(
-        colour = scale$map(bin_at),
+        colour = alpha(scale$map(bin_at), alpha),
         min    = head(breaks, -1),
         max    = tail(breaks, -1),
         .size  = length(bin_at)

tests/testthat/test-guides.R

@@ -900,15 +900,15 @@ test_that("colorbar can be styled", {
     p + scale_color_gradient(low = 'white', high = 'red')
   )
 
-  expect_doppelganger("white-to-red colorbar, long thick black ticks, green frame",
+  expect_doppelganger("white-to-red semitransparent colorbar, long thick black ticks, green frame",
     p + scale_color_gradient(
       low = 'white', high = 'red',
       guide = guide_colorbar(
         theme = theme(
           legend.frame = element_rect(colour = "green", linewidth = 1.5 / .pt),
           legend.ticks = element_line("black", linewidth = 2.5 / .pt),
           legend.ticks.length = unit(0.4, "npc")
-        )
+        ), alpha = 0.75
       )
     )
   )
@@ -977,8 +977,9 @@ test_that("coloursteps guide can be styled correctly", {
   expect_doppelganger("guide_coloursteps can have bins relative to binsize",
     p + guides(colour = guide_coloursteps(even.steps = FALSE))
   )
-  expect_doppelganger("guide_bins can show ticks",
+  expect_doppelganger("guide_bins can show ticks and transparancy",
     p + guides(colour = guide_coloursteps(
+      alpha = 0.75,
       theme = theme(legend.ticks = element_line(linewidth = 0.5 / .pt, colour = "white"))
     ))
   )