Graphical parameters for geom_smooth() band

NEWS.md

@@ -18,6 +18,9 @@
 * Added `preserve` argument to `position_jitterdodge()` (@teunbrand, #6584).
 * Fixed `position_jitterdodge(jitter.height, jitter.width)` applying to the 
   wrong dimension with flipped geoms (@teunbrand, #6535).
+* New `geom_smooth(band.colour, band.linetype, band.linewidth)` arguments 
+  control graphical parameters of the (confidence) band (@teunbrand, #6551)
+
 * New `position_dodge2(group.row)` argument that can be set to `"many"` to
   dodge groups with more than one row, such as in `geom_violin()` 
   (@teunbrand, #6663)

R/geom-smooth.R

@@ -30,8 +30,13 @@ GeomSmooth <- ggproto(
   # behavior predictable and sensible. The user will realize that they
   # need to set `se = TRUE` to obtain the ribbon and the legend key.
   draw_group = function(data, panel_params, coord, lineend = "butt", linejoin = "round",
-                        linemitre = 10, se = FALSE, flipped_aes = FALSE) {
-    ribbon <- transform(data, colour = NA)
+                        linemitre = 10, se = FALSE, band_gp = list(), flipped_aes = FALSE) {
+    ribbon <- transform(
+      data,
+      colour    = band_gp$colour    %||% data$colour    %||% NA,
+      linetype  = band_gp$linetype  %||% data$linetype  %||% 1L,
+      linewidth = band_gp$linewidth %||% data$linewidth %||% 0.5
+    )
     path <- transform(data, alpha = NA)
 
     ymin <- flipped_names(flipped_aes)$ymin
@@ -82,6 +87,8 @@ GeomSmooth <- ggproto(
 #'   `geom_smooth()` and `stat_smooth()`. For more information about overriding
 #'   these connections, see how the [stat][layer_stats] and [geom][layer_geoms]
 #'   arguments work.
+#' @param band.colour,band.color,band.linetype,band.linewidth Graphical
+#'   parameters for controlling the display of the confidence band outline.
 #' @seealso See individual modelling functions for more details:
 #'   [lm()] for linear smooths,
 #'   [glm()] for generalised linear smooths, and
@@ -151,15 +158,25 @@ geom_smooth <- function(mapping = NULL, data = NULL,
                         method = NULL,
                         formula = NULL,
                         se = TRUE,
+                        band.colour = NULL,
+                        band.color = NULL,
+                        band.linetype = "blank",
+                        band.linewidth = NULL,
                         na.rm = FALSE,
                         orientation = NA,
                         show.legend = NA,
                         inherit.aes = TRUE) {
+  band_gp <- list(
+    colour    = band.color %||% band.colour,
+    linetype  = band.linetype,
+    linewidth = band.linewidth
+  )
 
   params <- list2(
     na.rm = na.rm,
     orientation = orientation,
     se = se,
+    band_gp = band_gp,
     ...
   )
   if (identical(stat, "smooth")) {

R/legend-draw.R

@@ -285,17 +285,39 @@ draw_key_pointrange <- function(data, params, size) {
 #' @export
 #' @rdname draw_key
 draw_key_smooth <- function(data, params, size) {
-  data$fill <- alpha(data$fill %||% "grey60", data$alpha)
-  data$alpha <- 1
+  # Pre-apply fill alpha
+  data$fill <- fill_alpha(data$fill %||% "grey60", data$alpha)
+  data$alpha <- NA
 
-  path <- draw_key_path(data, params, size)
+  grob <- draw_key_path(data, params, size)
+  width  <- attr(grob, "width")
+  height <- attr(grob, "height")
 
-  grob <- grobTree(
-    if (isTRUE(params$se)) rectGrob(gp = gg_par(col = NA, fill = data$fill)),
-    path
-  )
-  attr(grob, "width") <- attr(path, "width")
-  attr(grob, "height") <- attr(path, "height")
+  if (isTRUE(params$se)) {
+
+    band <- params$band_gp
+    has_outline <- !(
+      all(is.na(band$colour)) ||
+      all((band$linetype %||% 1L) %in% c(NA, 0, "blank")) ||
+      all((band$linewidth %||% 0.5) <= 0)
+    )
+    if (!has_outline) {
+      # `draw_key_polygon()` cares about linewidth
+      band$linewidth <- 0
+    }
+
+    data <- transform(
+      data,
+      colour    = band$colour    %||% NA,
+      linetype  = band$linetype  %||% 1L,
+      linewidth = band$linewidth %||% 0.5
+    )
+    ribbon <- draw_key_polygon(data, params, size)
+    grob <- grobTree(ribbon, grob)
+  }
+
+  attr(grob, "width")  <- width
+  attr(grob, "height") <- height
   grob
 }
 

tests/testthat/test-geom-smooth.R

@@ -126,3 +126,17 @@ test_that("geom_smooth() works with alternative stats", {
       geom_smooth(stat = "summary", se = FALSE, fun.data = mean_se) # ribbon is turned off via `se = FALSE`
   })
 })
+
+test_that("geom_smooth() band properties can be tweaked", {
+  df <- data.frame(x = 1:2)
+
+  p <- ggplot(df, aes(x, x, ymin = x - 1, ymax = x + 1, fill = "A")) +
+    geom_smooth(
+      stat = "identity",
+      band.colour = "red",
+      band.linetype = 2,
+      band.linewidth = 0.25
+    )
+
+  expect_doppelganger("custom ribbon properties", p)
+})