diff --git a/NEWS.md b/NEWS.md index c09cdda5fe..2b5adf6ad6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* New `stat_boxplot(min.group.n)` argument, which skips drawing the box and + whiskers for small groups (@teunbrand based on code by @dicook, #6776) * Fixed wording of warning emitted by `remove missing()` when non-finite values are removed: it now reads "non-finite values or values outside the scale range" instead of "non-finite outside the scale range" (@osorensen). diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R index 69aad3046c..b0850a7fd3 100644 --- a/R/geom-boxplot.R +++ b/R/geom-boxplot.R @@ -269,8 +269,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, out_max <- vapply(data$outliers, max, numeric(1)) }) - data$ymin_final <- pmin(out_min, data$ymin) - data$ymax_final <- pmax(out_max, data$ymax) + data$ymin_final <- pmin(out_min, data$ymin, na.rm = TRUE) + data$ymax_final <- pmax(out_max, data$ymax, na.rm = TRUE) } # if `varwidth` not requested or not available, don't use it @@ -304,6 +304,27 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, )) } + outliers_grob <- NULL + if (!is.null(data$outliers) && length(data$outliers[[1]]) >= 1) { + outliers <- data_frame0( + y = data$outliers[[1]], + x = data$x[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_gp$alpha %||% data$alpha[1], + .size = length(data$outliers[[1]]) + ) + outliers <- flip_data(outliers, flipped_aes) + outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord) + if (is.na(data$middle[1]) && is.na(data$lower[1]) && is.na(data$upper[1])) { + return(ggname("geom_boxplot", grobTree(outliers_grob))) + } + } + common <- list(fill = fill_alpha(data$fill, data$alpha), group = data$group) whiskers <- data_frame0( @@ -331,26 +352,6 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, ) box <- flip_data(box, flipped_aes) - if (!is.null(data$outliers) && length(data$outliers[[1]]) >= 1) { - outliers <- data_frame0( - y = data$outliers[[1]], - x = data$x[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_gp$alpha %||% data$alpha[1], - .size = length(data$outliers[[1]]) - ) - outliers <- flip_data(outliers, flipped_aes) - - outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord) - } else { - outliers_grob <- NULL - } - if (staplewidth != 0) { staples <- data_frame0( x = rep((data$xmin - data$x) * staplewidth + data$x, 2), diff --git a/R/stat-boxplot.R b/R/stat-boxplot.R index 5f199511f5..38696bda38 100644 --- a/R/stat-boxplot.R +++ b/R/stat-boxplot.R @@ -40,6 +40,11 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, } params$width <- params$width %||% (resolution(data$x %||% 0, discrete = TRUE) * 0.75) + check_number_whole( + params$min.group.n %||% 1L, + min = 1, allow_infinite = TRUE, + arg = "min.group.n" + ) if (!is_mapped_discrete(data$x) && is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { cli::cli_warn(c( @@ -53,7 +58,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, extra_params = c("na.rm", "orientation"), - compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5, flipped_aes = FALSE, quantile.type = 7) { + compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5, min.group.n = 1L, quantile.type = 7, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) qs <- c(0, 0.25, 0.5, 0.75, 1) @@ -67,9 +72,14 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, names(stats) <- c("ymin", "lower", "middle", "upper", "ymax") iqr <- diff(stats[c(2, 4)]) - outliers <- data$y < (stats[2] - coef * iqr) | data$y > (stats[4] + coef * iqr) - if (any(outliers)) { - stats[c(1, 5)] <- range(c(stats[2:4], data$y[!outliers]), na.rm = TRUE) + if (nrow(data) >= min.group.n) { + outliers <- data$y < (stats[2] - coef * iqr) | data$y > (stats[4] + coef * iqr) + if (any(outliers)) { + stats[c(1, 5)] <- range(c(stats[2:4], data$y[!outliers]), na.rm = TRUE) + } + } else { + stats[] <- NA + outliers <- rep(TRUE, nrow(data)) } if (length(data$width) > 0L) { width <- data$width[1L] @@ -100,6 +110,10 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, #' @rdname geom_boxplot #' @param coef Length of the whiskers as multiple of IQR. Defaults to 1.5. +#' @param min.group.n An integer setting the minimum size of a group to draw +#' the box and whiskers. Groups with less observations will be displayed as +#' points styled like outliers without box and whiskers. The default (1) draws +#' box and whiskers for all groups. #' @param quantile.type An integer between 1 and 9 setting the quantile algorithm #' per [`stats::quantile(type)`][stats::quantile]. Defaults to `7` #' @inheritParams shared_layer_parameters diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index f747628213..c62ef2f221 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -53,6 +53,7 @@ stat_boxplot( ..., orientation = NA, coef = 1.5, + min.group.n = 1L, quantile.type = 7, na.rm = FALSE, show.legend = NA, @@ -182,6 +183,11 @@ overriding these connections, see how the \link[=layer_stats]{stat} and \item{coef}{Length of the whiskers as multiple of IQR. Defaults to 1.5.} +\item{min.group.n}{An integer setting the minimum size of a group to draw +the box and whiskers. Groups with less observations will be displayed as +points styled like outliers without box and whiskers. The default (1) draws +box and whiskers for all groups.} + \item{quantile.type}{An integer between 1 and 9 setting the quantile algorithm per \code{\link[stats:quantile]{stats::quantile(type)}}. Defaults to \code{7}} } diff --git a/man/scale_date.Rd b/man/scale_date.Rd index 5879762720..821ef3b32a 100644 --- a/man/scale_date.Rd +++ b/man/scale_date.Rd @@ -186,10 +186,10 @@ expand the scale by 5\% on each side for continuous variables, and by \item Function that handles limits outside of the scale limits (out of bounds). Also accepts rlang \link[rlang:as_function]{lambda} function notation. -\item The default (\code{\link[scales:censor]{scales::censor()}}) replaces out of +\item The default (\code{\link[scales:oob]{scales::censor()}}) replaces out of bounds values with \code{NA}. -\item \code{\link[scales:squish]{scales::squish()}} for squishing out of bounds values into range. -\item \code{\link[scales:squish_infinite]{scales::squish_infinite()}} for squishing infinite values into range. +\item \code{\link[scales:oob]{scales::squish()}} for squishing out of bounds values into range. +\item \code{\link[scales:oob]{scales::squish_infinite()}} for squishing infinite values into range. }} \item{guide}{A function used to create a guide or its name. See @@ -240,9 +240,9 @@ The \href{https://ggplot2-book.org/scales-position#sec-date-scales}{date-time po The \link[=aes_position]{position documentation}. -Other position scales: -\code{\link[=scale_x_binned]{scale_x_binned()}}, -\code{\link[=scale_x_continuous]{scale_x_continuous()}}, -\code{\link[=scale_x_discrete]{scale_x_discrete()}} +Other position scales: +\code{\link{scale_x_binned}()}, +\code{\link{scale_x_continuous}()}, +\code{\link{scale_x_discrete}()} } \concept{position scales} diff --git a/tests/testthat/test-stat-boxplot.R b/tests/testthat/test-stat-boxplot.R index 7878a9eb34..40cf04e841 100644 --- a/tests/testthat/test-stat-boxplot.R +++ b/tests/testthat/test-stat-boxplot.R @@ -25,3 +25,12 @@ test_that("stat_boxplot errors with missing x/y aesthetics", { geom_boxplot() expect_snapshot_error(ggplot_build(p)) }) + +test_that("stat_boxplot respects the `min.group.n` setting", { + df <- data.frame(x = rep(c("A", "B"), c(3, 7)), y = c(1:10)) + ld <- layer_data( + ggplot(df, aes(x, y)) + geom_boxplot(min.group.n = 5) + ) + expect_equal(lengths(ld$outliers), c(3, 0)) + expect_equal(ld$middle, c(NA, 7)) +})