diff --git a/NEWS.md b/NEWS.md index 83e411a4dd..df9de4b689 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* `geom_boxplot()` gains additional arguments to style the colour, linetype and + linewidths of the box, whiskers, median line and staples (@teunbrand, #5126) * (internal) Using `after_scale()` in the `Geom*$default_aes()` field is now evaluated in the context of data (@teunbrand, #6135) * Fixed bug where binned scales wouldn't simultaneously accept transformations diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R index 1ac23ba80f..efb6dd14bd 100644 --- a/R/geom-boxplot.R +++ b/R/geom-boxplot.R @@ -43,11 +43,20 @@ #' needs to show the full data range, please use `outlier.shape = NA` instead. #' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha #' Default aesthetics for outliers. Set to `NULL` to inherit from the -#' aesthetics used for the box. -#' -#' In the unlikely event you specify both US and UK spellings of colour, the -#' US spelling will take precedence. -#' +#' data's aesthetics. +#' @param whisker.colour,whisker.color,whisker.linetype,whisker.linewidth +#' Default aesthetics for the whiskers. Set to `NULL` to inherit from the +#' data's aesthetics. +#' @param median.colour,median.color,median.linetype,median.linewidth +#' Default aesthetics for the median line. Set to `NULL` to inherit from the +#' data's aesthetics. +#' @param staple.colour,staple.color,staple.linetype,staple.linewidth +#' Default aesthetics for the staples. Set to `NULL` to inherit from the +#' data's aesthetics. Note that staples don't appear unless the `staplewidth` +#' argument is set to a non-zero size. +#' @param box.colour,box.color,box.linetype,box.linewidth +#' Default aesthetics for the boxes. Set to `NULL` to inherit from the +#' data's aesthetics. #' @param notch If `FALSE` (default) make a standard box plot. If #' `TRUE`, make a notched box plot. Notches are used to compare groups; #' if the notches of two boxes do not overlap, this suggests that the medians @@ -60,6 +69,9 @@ #' `TRUE`, boxes are drawn with widths proportional to the #' square-roots of the number of observations in the groups (possibly #' weighted, using the `weight` aesthetic). +#' @note In the unlikely event you specify both US and UK spellings of colour, +#' the US spelling will take precedence. +#' #' @export #' @references McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of #' box plots. The American Statistician 32, 12-16. @@ -121,6 +133,22 @@ geom_boxplot <- function(mapping = NULL, data = NULL, outlier.size = NULL, outlier.stroke = 0.5, outlier.alpha = NULL, + whisker.colour = NULL, + whisker.color = NULL, + whisker.linetype = NULL, + whisker.linewidth = NULL, + staple.colour = NULL, + staple.color = NULL, + staple.linetype = NULL, + staple.linewidth = NULL, + median.colour = NULL, + median.color = NULL, + median.linetype = NULL, + median.linewidth = NULL, + box.colour = NULL, + box.color = NULL, + box.linetype = NULL, + box.linewidth = NULL, notch = FALSE, notchwidth = 0.5, staplewidth = 0, @@ -140,6 +168,39 @@ geom_boxplot <- function(mapping = NULL, data = NULL, } } + outlier_gp <- list( + colour = outlier.color %||% outlier.colour, + fill = outlier.fill, + shape = outlier.shape, + size = outlier.size, + stroke = outlier.stroke, + alpha = outlier.alpha + ) + + whisker_gp <- list( + colour = whisker.color %||% whisker.colour, + linetype = whisker.linetype, + linewidth = whisker.linewidth + ) + + staple_gp <- list( + colour = staple.color %||% staple.colour, + linetype = staple.linetype, + linewidth = staple.linewidth + ) + + median_gp <- list( + colour = median.color %||% median.colour, + linetype = median.linetype, + linewidth = median.linewidth + ) + + box_gp <- list( + colour = box.color %||% box.colour, + linetype = box.linetype, + linewidth = box.linewidth + ) + check_number_decimal(staplewidth) check_bool(outliers) @@ -153,12 +214,11 @@ geom_boxplot <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list2( outliers = outliers, - outlier.colour = outlier.color %||% outlier.colour, - outlier.fill = outlier.fill, - outlier.shape = outlier.shape, - outlier.size = outlier.size, - outlier.stroke = outlier.stroke, - outlier.alpha = outlier.alpha, + outlier_gp = outlier_gp, + whisker_gp = whisker_gp, + staple_gp = staple_gp, + median_gp = median_gp, + box_gp = box_gp, notch = notch, notchwidth = notchwidth, staplewidth = staplewidth, @@ -222,10 +282,9 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, }, draw_group = function(self, data, panel_params, coord, lineend = "butt", - linejoin = "mitre", fatten = 2, outlier.colour = NULL, - outlier.fill = NULL, outlier.shape = NULL, - outlier.size = NULL, outlier.stroke = 0.5, - outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5, + linejoin = "mitre", fatten = 2, outlier_gp = NULL, + whisker_gp = NULL, staple_gp = NULL, median_gp = NULL, + box_gp = NULL, notch = FALSE, notchwidth = 0.5, staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) { data <- check_linewidth(data, snake_class(self)) data <- flip_data(data, flipped_aes) @@ -237,36 +296,30 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, )) } - common <- list( - colour = data$colour, - linewidth = data$linewidth, - linetype = data$linetype, - fill = fill_alpha(data$fill, data$alpha), - group = data$group - ) + common <- list(fill = fill_alpha(data$fill, data$alpha), group = data$group) whiskers <- data_frame0( x = c(data$x, data$x), xend = c(data$x, data$x), y = c(data$upper, data$lower), yend = c(data$ymax, data$ymin), + colour = rep(whisker_gp$colour %||% data$colour, 2), + linetype = rep(whisker_gp$linetype %||% data$linetype, 2), + linewidth = rep(whisker_gp$linewidth %||% data$linewidth, 2), alpha = c(NA_real_, NA_real_), !!!common, .size = 2 ) whiskers <- flip_data(whiskers, flipped_aes) - box <- data_frame0( - xmin = data$xmin, - xmax = data$xmax, - ymin = data$lower, - y = data$middle, - ymax = data$upper, - ynotchlower = ifelse(notch, data$notchlower, NA), - ynotchupper = ifelse(notch, data$notchupper, NA), - notchwidth = notchwidth, - alpha = data$alpha, - !!!common + box <- transform( + data, + y = middle, + ymax = upper, + ymin = lower, + ynotchlower = ifelse(notch, notchlower, NA), + ynotchupper = ifelse(notch, notchupper, NA), + notchwidth = notchwidth ) box <- flip_data(box, flipped_aes) @@ -274,13 +327,13 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, outliers <- data_frame0( y = data$outliers[[1]], x = data$x[1], - colour = outlier.colour %||% data$colour[1], - fill = outlier.fill %||% data$fill[1], - shape = outlier.shape %||% data$shape[1], - size = outlier.size %||% data$size[1], - stroke = outlier.stroke %||% data$stroke[1], + colour = outlier_gp$colour %||% data$colour[1], + fill = outlier_gp$fill %||% data$fill[1], + shape = outlier_gp$shape %||% data$shape[1] %||% 19, + size = outlier_gp$size %||% data$size[1] %||% 1.5, + stroke = outlier_gp$stroke %||% data$stroke[1] %||% 0.5, fill = NA, - alpha = outlier.alpha %||% data$alpha[1], + alpha = outlier_gp$alpha %||% data$alpha[1], .size = length(data$outliers[[1]]) ) outliers <- flip_data(outliers, flipped_aes) @@ -296,6 +349,9 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, xend = rep((data$xmax - data$x) * staplewidth + data$x, 2), y = c(data$ymax, data$ymin), yend = c(data$ymax, data$ymin), + linetype = rep(staple_gp$linetype %||% data$linetype, 2), + linewidth = rep(staple_gp$linewidth %||% data$linewidth, 2), + colour = rep(staple_gp$colour %||% data$colour, 2), alpha = c(NA_real_, NA_real_), !!!common, .size = 2 @@ -320,7 +376,9 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, coord, lineend = lineend, linejoin = linejoin, - flipped_aes = flipped_aes + flipped_aes = flipped_aes, + middle_gp = median_gp, + box_gp = box_gp ) )) }, diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R index 1f7c66f832..be7ce1f658 100644 --- a/R/geom-crossbar.R +++ b/R/geom-crossbar.R @@ -1,13 +1,40 @@ #' @export #' @rdname geom_linerange +#' @param middle.colour,middle.color,middle.linetype,middle.linewidth +#' Default aesthetics for the middle line. Set to `NULL` to inherit from the +#' data's aesthetics. +#' @param box.colour,box.color,box.linetype,box.linewidth +#' Default aesthetics for the boxes. Set to `NULL` to inherit from the +#' data's aesthetics. geom_crossbar <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., + middle.colour = NULL, + middle.color = NULL, + middle.linetype = NULL, + middle.linewidth = NULL, + box.colour = NULL, + box.color = NULL, + box.linetype = NULL, + box.linewidth = NULL, fatten = 2.5, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) { + + middle_gp <- list( + colour = middle.color %||% middle.colour, + linetype = middle.linetype, + linewidth = middle.linewidth + ) + + box_gp <- list( + colour = box.color %||% box.colour, + linetype = box.linetype, + linewidth = box.linewidth + ) + layer( data = data, mapping = mapping, @@ -17,6 +44,8 @@ geom_crossbar <- function(mapping = NULL, data = NULL, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( + middle_gp = middle_gp, + box_gp = box_gp, fatten = fatten, na.rm = na.rm, orientation = orientation, @@ -54,11 +83,13 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, draw_panel = function(self, data, panel_params, coord, lineend = "butt", linejoin = "mitre", fatten = 2.5, width = NULL, - flipped_aes = FALSE) { + flipped_aes = FALSE, middle_gp = NULL, box_gp = NULL) { + data <- check_linewidth(data, snake_class(self)) data <- flip_data(data, flipped_aes) middle <- transform(data, x = xmin, xend = xmax, yend = y, linewidth = linewidth * fatten, alpha = NA) + middle <- data_frame0(!!!defaults(compact(middle_gp), middle)) has_notch <- !is.null(data$ynotchlower) && !is.null(data$ynotchupper) && !is.na(data$ynotchlower) && !is.na(data$ynotchupper) @@ -87,9 +118,9 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, data$ymax ), alpha = rep(data$alpha, 11), - colour = rep(data$colour, 11), + colour = rep(data$colour, 11), linewidth = rep(data$linewidth, 11), - linetype = rep(data$linetype, 11), + linetype = rep(data$linetype, 11), fill = rep(data$fill, 11), group = rep(seq_len(nrow(data)), 11) ) @@ -99,13 +130,14 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, x = c(data$xmin, data$xmin, data$xmax, data$xmax, data$xmin), y = c(data$ymax, data$ymin, data$ymin, data$ymax, data$ymax), alpha = rep(data$alpha, 5), - colour = rep(data$colour, 5), + colour = rep(data$colour, 5), linewidth = rep(data$linewidth, 5), - linetype = rep(data$linetype, 5), + linetype = rep(data$linetype, 5), fill = rep(data$fill, 5), group = rep(seq_len(nrow(data)), 5) # each bar forms it's own group ) } + box <- data_frame0(!!!defaults(compact(box_gp), box)) box <- flip_data(box, flipped_aes) middle <- flip_data(middle, flipped_aes) diff --git a/R/legend-draw.R b/R/legend-draw.R index ccfb035872..0f734f8fea 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -110,20 +110,49 @@ draw_key_boxplot <- function(data, params, size) { linejoin = params$linejoin %||% "mitre" ) + whisker <- gg_par( + col = params$whisker_gp$colour, + lty = params$whisker_gp$linetype, + lwd = params$whisker_gp$linewidth + ) + + median <- gg_par( + col = params$median_gp$colour, + lty = params$median_gp$linetype, + lwd = params$median_gp$linewidth + ) + + box <- gg_par( + col = params$box_gp$colour, + lty = params$box_gp$linetype, + lwd = params$box_gp$linewidth + ) + + staple_size <- 0.5 + c(0.375, -0.375) * params$staplewidth + staple <- gg_par( + col = params$staple_gp$colour, + lty = params$staple_gp$linetype, + lwd = params$staple_gp$linewidth + ) + if (isTRUE(params$flipped_aes)) { grobTree( - linesGrob(c(0.1, 0.25), 0.5), - linesGrob(c(0.75, 0.9), 0.5), - rectGrob(width = 0.5, height = 0.75), - linesGrob(0.5, c(0.125, 0.875)), + linesGrob(c(0.1, 0.25), 0.5, gp = whisker), + linesGrob(c(0.75, 0.9), 0.5, gp = whisker), + rectGrob(width = 0.5, height = 0.75, gp = box), + linesGrob(0.5, c(0.125, 0.875), gp = median), + linesGrob(0.1, staple_size, gp = staple), + linesGrob(0.9, staple_size, gp = staple), gp = gp ) } else { grobTree( - linesGrob(0.5, c(0.1, 0.25)), - linesGrob(0.5, c(0.75, 0.9)), - rectGrob(height = 0.5, width = 0.75), - linesGrob(c(0.125, 0.875), 0.5), + linesGrob(0.5, c(0.1, 0.25), gp = whisker), + linesGrob(0.5, c(0.75, 0.9), gp = whisker), + rectGrob(height = 0.5, width = 0.75, gp = box), + linesGrob(c(0.125, 0.875), 0.5, gp = median), + linesGrob(staple_size, 0.1, gp = staple), + linesGrob(staple_size, 0.9, gp = staple), gp = gp ) } @@ -140,16 +169,30 @@ draw_key_crossbar <- function(data, params, size) { lineend = params$lineend %||% "butt", linejoin = params$linejoin %||% "mitre" ) + + middle <- gg_par( + col = params$middle_gp$colour, + lty = params$middle_gp$linetype, + lwd = params$middle_gp$linewidth + ) + + box <- gg_par( + col = params$box_gp$colour, + lty = params$box_gp$linetype, + lwd = params$box_gp$linewidth + ) + + if (isTRUE(params$flipped_aes)) { grobTree( - rectGrob(height = 0.75, width = 0.5), - linesGrob(0.5, c(0.125, 0.875)), + rectGrob(height = 0.75, width = 0.5, gp = box), + linesGrob(0.5, c(0.125, 0.875), gp = middle), gp = gp ) } else { grobTree( - rectGrob(height = 0.5, width = 0.75), - linesGrob(c(0.125, 0.875), 0.5), + rectGrob(height = 0.5, width = 0.75, gp = box), + linesGrob(c(0.125, 0.875), 0.5, gp = middle), gp = gp ) } diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 3fc39d212b..d5026c013f 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -19,6 +19,22 @@ geom_boxplot( outlier.size = NULL, outlier.stroke = 0.5, outlier.alpha = NULL, + whisker.colour = NULL, + whisker.color = NULL, + whisker.linetype = NULL, + whisker.linewidth = NULL, + staple.colour = NULL, + staple.color = NULL, + staple.linetype = NULL, + staple.linewidth = NULL, + median.colour = NULL, + median.color = NULL, + median.linetype = NULL, + median.linewidth = NULL, + box.colour = NULL, + box.color = NULL, + box.linetype = NULL, + box.linewidth = NULL, notch = FALSE, notchwidth = 0.5, staplewidth = 0, @@ -112,10 +128,20 @@ only, not the full data range. If outliers need to be hidden and the axes needs to show the full data range, please use \code{outlier.shape = NA} instead.} \item{outlier.colour, outlier.color, outlier.fill, outlier.shape, outlier.size, outlier.stroke, outlier.alpha}{Default aesthetics for outliers. Set to \code{NULL} to inherit from the -aesthetics used for the box. +data's aesthetics.} -In the unlikely event you specify both US and UK spellings of colour, the -US spelling will take precedence.} +\item{whisker.colour, whisker.color, whisker.linetype, whisker.linewidth}{Default aesthetics for the whiskers. Set to \code{NULL} to inherit from the +data's aesthetics.} + +\item{staple.colour, staple.color, staple.linetype, staple.linewidth}{Default aesthetics for the staples. Set to \code{NULL} to inherit from the +data's aesthetics. Note that staples don't appear unless the \code{staplewidth} +argument is set to a non-zero size.} + +\item{median.colour, median.color, median.linetype, median.linewidth}{Default aesthetics for the median line. Set to \code{NULL} to inherit from the +data's aesthetics.} + +\item{box.colour, box.color, box.linetype, box.linewidth}{Default aesthetics for the boxes. Set to \code{NULL} to inherit from the +data's aesthetics.} \item{notch}{If \code{FALSE} (default) make a standard box plot. If \code{TRUE}, make a notched box plot. Notches are used to compare groups; @@ -166,6 +192,10 @@ The boxplot compactly displays the distribution of a continuous variable. It visualises five summary statistics (the median, two hinges and two whiskers), and all "outlying" points individually. } +\note{ +In the unlikely event you specify both US and UK spellings of colour, +the US spelling will take precedence. +} \section{Orientation}{ This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 87bc5c8e75..e706dea94b 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -14,6 +14,14 @@ geom_crossbar( stat = "identity", position = "identity", ..., + middle.colour = NULL, + middle.color = NULL, + middle.linetype = NULL, + middle.linewidth = NULL, + box.colour = NULL, + box.color = NULL, + box.linetype = NULL, + box.linewidth = NULL, fatten = 2.5, na.rm = FALSE, orientation = NA, @@ -133,6 +141,12 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{middle.colour, middle.color, middle.linetype, middle.linewidth}{Default aesthetics for the middle line. Set to \code{NULL} to inherit from the +data's aesthetics.} + +\item{box.colour, box.color, box.linetype, box.linewidth}{Default aesthetics for the boxes. Set to \code{NULL} to inherit from the +data's aesthetics.} + \item{fatten}{A multiplicative factor used to increase the size of the middle bar in \code{geom_crossbar()} and the middle point in \code{geom_pointrange()}.} diff --git a/tests/testthat/_snaps/draw-key/horizontal-boxplot-and-crossbar.svg b/tests/testthat/_snaps/draw-key/horizontal-boxplot-and-crossbar.svg index d787461ca4..addbc59e92 100644 --- a/tests/testthat/_snaps/draw-key/horizontal-boxplot-and-crossbar.svg +++ b/tests/testthat/_snaps/draw-key/horizontal-boxplot-and-crossbar.svg @@ -71,11 +71,15 @@ + + + + a b diff --git a/tests/testthat/_snaps/geom-boxplot/customised-style.svg b/tests/testthat/_snaps/geom-boxplot/customised-style.svg new file mode 100644 index 0000000000..612ec93728 --- /dev/null +++ b/tests/testthat/_snaps/geom-boxplot/customised-style.svg @@ -0,0 +1,167 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2 +3 +4 +5 +6 +7 + + + + + + + + + + + + + +2seater +compact +midsize +minivan +pickup +subcompact +suv +class +displ + +class + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2seater +compact +midsize +minivan +pickup +subcompact +suv +customised style + + diff --git a/tests/testthat/_snaps/geom-boxplot/outlier-colours.svg b/tests/testthat/_snaps/geom-boxplot/outlier-colours.svg index c3fcba0018..309ffcc43d 100644 --- a/tests/testthat/_snaps/geom-boxplot/outlier-colours.svg +++ b/tests/testthat/_snaps/geom-boxplot/outlier-colours.svg @@ -72,16 +72,22 @@ + + + + + + 4 6 8 diff --git a/tests/testthat/_snaps/geom-boxplot/staples.svg b/tests/testthat/_snaps/geom-boxplot/staples.svg index b0bf785867..b2f4054294 100644 --- a/tests/testthat/_snaps/geom-boxplot/staples.svg +++ b/tests/testthat/_snaps/geom-boxplot/staples.svg @@ -78,16 +78,22 @@ + + + + + + 4 6 8 diff --git a/tests/testthat/test-geom-boxplot.R b/tests/testthat/test-geom-boxplot.R index dabcb6ddeb..81d37cc5a9 100644 --- a/tests/testthat/test-geom-boxplot.R +++ b/tests/testthat/test-geom-boxplot.R @@ -96,4 +96,16 @@ test_that("boxplot draws correctly", { expect_doppelganger("staples", ggplot(mtcars, aes(x = factor(cyl), y = drat, colour = factor(cyl))) + geom_boxplot(staplewidth = 0.5) ) + expect_doppelganger( + "customised style", + ggplot(mpg, aes(class, displ, colour = class)) + + geom_boxplot( + outlier.shape = 6, + whisker.linetype = 2, + median.colour = "red", + box.colour = "black", + staple.linewidth = 1, + staplewidth = 0.25 + ) + ) }) diff --git a/tests/testthat/test-patterns.R b/tests/testthat/test-patterns.R index 2f68904dbe..4939c393b0 100644 --- a/tests/testthat/test-patterns.R +++ b/tests/testthat/test-patterns.R @@ -62,6 +62,9 @@ test_that("geoms can use pattern fills", { skip_if_not_installed("grid", "4.2.0") skip_if_not_installed("svglite", "2.1.2") + # TODO: ideally we should test this on all platforms, but currently they + # don't all produce the same result + skip_if_not(.Platform$OS.type == "windows") # Workaround for vdiffr's lack of pattern support # See also https://github.com/r-lib/vdiffr/issues/132