Boxplot staples (#5372)

* Implement staples

* Document

* Add test

* Add check for staplewidth

* Fix typo

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `geom_boxplot()` gains a new argument, `staplewidth` that can draw staples
+ at the ends of whiskers (@teunbrand, #5126)
+
 * The `size` argument in `annotation_logticks()` has been deprecated in favour
  of the `linewidth` argument (#5292).
 

R/geom-boxplot.R

@@ -52,6 +52,8 @@
 #' are significantly different.
 #' @param notchwidth For a notched box plot, width of the notch relative to
 #' the body (defaults to `notchwidth = 0.5`).
+#' @param staplewidth The relative width of staples to the width of the box.
+#' Staples mark the ends of the whiskers with a line.
 #' @param varwidth If `FALSE` (default) make a standard box plot. If
 #' `TRUE`, boxes are drawn with widths proportional to the
 #' square-roots of the number of observations in the groups (possibly
@@ -119,6 +121,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
  outlier.alpha = NULL,
  notch = FALSE,
  notchwidth = 0.5,
+ staplewidth = 0,
  varwidth = FALSE,
  na.rm = FALSE,
  orientation = NA,
@@ -134,6 +137,8 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
  position$preserve <- "single"
  }
  }
+
+ check_number_decimal(staplewidth)
  check_bool(outliers)
 
  layer(
@@ -154,6 +159,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
  outlier.alpha = outlier.alpha,
  notch = notch,
  notchwidth = notchwidth,
+ staplewidth = staplewidth,
  varwidth = varwidth,
  na.rm = na.rm,
  orientation = orientation,
@@ -218,7 +224,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
  outlier.fill = NULL, outlier.shape = 19,
  outlier.size = 1.5, outlier.stroke = 0.5,
  outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5,
- varwidth = FALSE, flipped_aes = FALSE) {
+ staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
  data <- check_linewidth(data, snake_class(self))
  data <- flip_data(data, flipped_aes)
  # this may occur when using geom_boxplot(stat = "identity")
@@ -282,8 +288,28 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
  outliers_grob <- NULL
  }
 
+ if (staplewidth != 0) {
+ staples <- data_frame0(
+ x = rep((data$xmin - data$x) * staplewidth + data$x, 2),
+ xend = rep((data$xmax - data$x) * staplewidth + data$x, 2),
+ y = c(data$ymax, data$ymin),
+ yend = c(data$ymax, data$ymin),
+ alpha = c(NA_real_, NA_real_),
+ !!!common,
+ .size = 2
+ )
+ staples <- flip_data(staples, flipped_aes)
+ staple_grob <- GeomSegment$draw_panel(
+ staples, panel_params, coord,
+ lineend = lineend
+ )
+ } else {
+ staple_grob <- NULL
+ }
+
  ggname("geom_boxplot", grobTree(
  outliers_grob,
+ staple_grob,
  GeomSegment$draw_panel(whiskers, panel_params, coord, lineend = lineend),
  GeomCrossbar$draw_panel(
  box,

tests/testthat/test-geom-boxplot.R

@@ -93,4 +93,7 @@ test_that("boxplot draws correctly", {
  expect_doppelganger("outlier colours",
  ggplot(mtcars, aes(x = factor(cyl), y = drat, colour = factor(cyl))) + geom_boxplot(outlier.size = 5)
  )
+ expect_doppelganger("staples",
+ ggplot(mtcars, aes(x = factor(cyl), y = drat, colour = factor(cyl))) + geom_boxplot(staplewidth = 0.5)
+ )
 })