Gradients in ribbons (#5699)

* support alpha/fill gradients in `geom_ribbon()`

* add test

* Add news bullet

* Fix error messages

* More aggressively enforce device capabilities

* add missing newline

Author: teunbrand

NEWS.md

@@ -37,6 +37,8 @@
   calculated as the density times the sum of weights (@teunbrand, #4176).
 * `theme()` gets new `spacing` and `margins` arguments that all other spacings
   and (non-text) margins inherit from (@teunbrand, #5622).
+* `geom_ribbon()` can have varying `fill` or `alpha` in linear coordinate
+  systems (@teunbrand, #4690)
 
 # ggplot2 3.5.1
 

R/geom-ribbon.R

@@ -135,11 +135,44 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
     data <- data[order(data$group), ]
 
     # Check that aesthetics are constant
-    aes <- unique0(data[names(data) %in% c("colour", "fill", "linewidth", "linetype", "alpha")])
-    if (nrow(aes) > 1) {
-      cli::cli_abort("Aesthetics can not vary along a ribbon.")
+    aes <- lapply(
+      data[names(data) %in% c("colour", "fill", "linewidth", "linetype", "alpha")],
+      unique0
+    )
+    non_constant <- names(aes)[lengths(aes) > 1]
+    if (coord$is_linear()) {
+      if (any(c("fill", "alpha") %in% non_constant)) {
+        check_device("gradients", action = "abort", maybe = TRUE)
+      }
+      # For linear coords, we can make a fill/alpha gradient, so we allow
+      # these to vary
+      non_constant <- setdiff(non_constant, c("fill", "alpha"))
+    }
+    if (length(non_constant) > 0) {
+      cli::cli_abort(
+        "Aesthetics can not vary along a ribbon: {.and {.field {non_constant}}}."
+      )
+    }
+    if ((length(aes$fill) > 1 || length(aes$alpha) > 1)) {
+      transformed <- coord$transform(flip_data(data, flipped_aes), panel_params)
+      if (flipped_aes) {
+        keep <- is.finite(tranformed$y)
+        args <- list(
+          colours = alpha(data$fill, data$alpha)[keep],
+          stops = rescale(transformed$y)[keep],
+          y1 = 0, y2 = 1, x1 = 0.5, x2 = 0.5
+        )
+      } else {
+        keep <- is.finite(transformed$x)
+        args <- list(
+          colours = alpha(data$fill, data$alpha)[keep],
+          stops = rescale(transformed$x)[keep],
+          x1 = 0, x2 = 1, y1 = 0.5, y2 = 0.5
+        )
+      }
+      aes$fill <- inject(linearGradient(!!!args))
+      aes$alpha <- NA
     }
-    aes <- as.list(aes)
 
     # Instead of removing NA values from the data and plotting a single
     # polygon, we want to "stop" plotting the polygon whenever we're

tests/testthat/_snaps/geom-ribbon.md

@@ -17,7 +17,7 @@
     Problem while converting geom to grob.
     i Error occurred in the 1st layer.
     Caused by error in `draw_group()`:
-    ! Aesthetics can not vary along a ribbon.
+    ! Aesthetics can not vary along a ribbon: linewidth.
 
 ---
 

tests/testthat/test-geom-ribbon.R

@@ -7,7 +7,7 @@ test_that("geom_ribbon() checks the aesthetics", {
     geom_ribbon(aes(y = year, xmin = level - 5, xmax = level + 5), orientation = "x")
   expect_snapshot_error(ggplotGrob(p))
   p <- ggplot(huron) +
-    geom_ribbon(aes(year, ymin = level - 5, ymax = level + 5, fill = year))
+    geom_ribbon(aes(year, ymin = level - 5, ymax = level + 5, linewidth = year))
   expect_snapshot_error(ggplotGrob(p))
 
   expect_snapshot_error(geom_ribbon(aes(year, ymin = level - 5, ymax = level + 5), outline.type = "test"))
@@ -74,3 +74,19 @@ test_that("outline.type option works", {
   expect_s3_class(g_area_default$children[[1]]$children[[2]], "polyline")
   expect_equal(g_area_default$children[[1]]$children[[2]]$id, rep(1L, each = 4))
 })
+
+test_that("ribbons can have gradients", {
+  skip_if_not(
+    check_device("gradients", action = "test"),
+    "graphics device does not support gradients."
+  )
+
+  df <- data.frame(x = 1:2, ymin = c(-1:-2), ymax = 1:2)
+  p <- ggplot(df, aes(x, ymin = ymin, ymax = ymax, fill = x)) +
+    geom_ribbon(outline.type = "full") +
+    scale_fill_gradientn(colours = c("red", "blue"))
+  fill <- layer_grob(p)[[1]]$children[[1]]$gp$fill
+
+  expect_s3_class(fill, "GridLinearGradient")
+  expect_equal(fill$colours, alpha(c("red", "blue"), NA))
+})