diff --git a/NEWS.md b/NEWS.md index 3e92547b2a..ce66110264 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ### Bug fixes +* New `geom_smooth(band.colour, band.linetype, band.linewidth)` arguments + control graphical parameters of the (confidence) band (@teunbrand, #6551) * Fixed regression where `draw_key_rect()` stopped using `fill` colours (@mitchelloharawild, #6609). * Fixed regression where `scale_{x,y}_*()` threw an error when an expression diff --git a/R/geom-smooth.R b/R/geom-smooth.R index a022807b16..62c3112276 100644 --- a/R/geom-smooth.R +++ b/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 %||% NA, + linetype = band_gp$linetype %||% 1L, + linewidth = band_gp$linewidth %||% 0.5 + ) path <- transform(data, alpha = NA) ymin <- flipped_names(flipped_aes)$ymin @@ -83,6 +88,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 @@ -152,15 +159,25 @@ geom_smooth <- function(mapping = NULL, data = NULL, method = NULL, formula = NULL, se = TRUE, + band.colour = NULL, + band.color = NULL, + band.linetype = NULL, + 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")) { diff --git a/R/legend-draw.R b/R/legend-draw.R index 621cde0aa2..daa8d315a2 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -279,17 +279,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 } diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 2ce488a9d1..5d2931b74b 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -14,6 +14,10 @@ geom_smooth( method = NULL, formula = NULL, se = TRUE, + band.colour = NULL, + band.color = NULL, + band.linetype = NULL, + band.linewidth = NULL, na.rm = FALSE, orientation = NA, show.legend = NA, @@ -128,6 +132,9 @@ observations and \code{formula = y ~ s(x, bs = "cs")} otherwise.} \item{se}{Display confidence band around smooth? (\code{TRUE} by default, see \code{level} to control.)} +\item{band.colour, band.color, band.linetype, band.linewidth}{Graphical +parameters for controlling the display of the confidence band outline.} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} diff --git a/tests/testthat/_snaps/geom-smooth/custom-ribbon-properties.svg b/tests/testthat/_snaps/geom-smooth/custom-ribbon-properties.svg new file mode 100644 index 0000000000..f49e742da5 --- /dev/null +++ b/tests/testthat/_snaps/geom-smooth/custom-ribbon-properties.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 + + + + + + + + + +1.00 +1.25 +1.50 +1.75 +2.00 +x +x + +fill + + + +A +custom ribbon properties + + diff --git a/tests/testthat/_snaps/geom-smooth/ribbon-turned-on-in-geom-smooth.svg b/tests/testthat/_snaps/geom-smooth/ribbon-turned-on-in-geom-smooth.svg index 429004d485..b044d1b818 100644 --- a/tests/testthat/_snaps/geom-smooth/ribbon-turned-on-in-geom-smooth.svg +++ b/tests/testthat/_snaps/geom-smooth/ribbon-turned-on-in-geom-smooth.svg @@ -28,12 +28,12 @@ - - + + - - + + @@ -63,10 +63,10 @@ fill - + - + A B diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index 3632054440..c66cf4cfa6 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/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) +})