From 34038115a5b36e1d846564f8ace482ac4ef60541 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:08:45 +0200 Subject: [PATCH 01/14] plumbing for `draw_quantiles` in `stat_ydensity()` --- R/stat-ydensity.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 4eadd8ca58..8ad3b0d78f 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -26,6 +26,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL, geom = "violin", position = "dodge", ..., + draw_quantiles = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", @@ -56,6 +57,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL, drop = drop, na.rm = na.rm, bounds = bounds, + draw_quantiles = draw_quantiles, ... ) ) @@ -80,7 +82,8 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_group = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, - drop = TRUE, flipped_aes = FALSE, bounds = c(-Inf, Inf)) { + drop = TRUE, flipped_aes = FALSE, bounds = c(-Inf, Inf), + draw_quantiles = NULL) { if (nrow(data) < 2) { if (isTRUE(drop)) { cli::cli_warn(c( @@ -121,11 +124,12 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_panel = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, scale = "area", flipped_aes = FALSE, drop = TRUE, - bounds = c(-Inf, Inf)) { + bounds = c(-Inf, Inf), draw_quantiles = NULL) { data <- flip_data(data, flipped_aes) data <- ggproto_parent(Stat, self)$compute_panel( data, scales, width = width, bw = bw, adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm, drop = drop, bounds = bounds, + draw_quantiles = draw_quantiles ) if (!drop && any(data$n < 2)) { cli::cli_warn( From d17427c8cee511649c4046f9c1d6b19a8a9faae7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:27:12 +0200 Subject: [PATCH 02/14] stat computes quantiles --- R/stat-ydensity.R | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 8ad3b0d78f..3f56b77edf 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -118,6 +118,31 @@ StatYdensity <- ggproto("StatYdensity", Stat, } dens$width <- width + if (!is.null(draw_quantiles)) { + if (!(all(draw_quantiles >= 0) && all(draw_quantiles <= 1))) { + cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1.") + } + if (!is.null(data[["weight"]]) || !all(data[["weight"]] == 1)) { + cli::cli_warn( + "{.arg draw_quantiles} for weighted data is not implemented." + ) + } + quants <- quantile(data$y, probs = draw_quantiles) + quants <- data_frame0( + y = unname(quants), + quantile = draw_quantiles + ) + + # Interpolate other metrics + for (var in setdiff(names(dens), names(quants))) { + quants[[var]] <- + approx(dens$y, dens[[var]], xout = quants$y, ties = "ordered")$y + } + + dens <- vec_slice(dens, !dens$y %in% quants$y) + dens <- vec_c(dens, quants) + } + dens }, From f1dda8c890805417a634d2615d16e17e6aad9db5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:28:10 +0200 Subject: [PATCH 03/14] geom draws quantiles, not compute them --- R/geom-violin.R | 27 +++++++-------------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/R/geom-violin.R b/R/geom-violin.R index 0ac6cd29df..a980395ad1 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -91,7 +91,6 @@ geom_violin <- function(mapping = NULL, data = NULL, stat = "ydensity", position = "dodge", ..., - draw_quantiles = NULL, trim = TRUE, bounds = c(-Inf, Inf), scale = "area", @@ -110,7 +109,6 @@ geom_violin <- function(mapping = NULL, data = NULL, params = list2( trim = trim, scale = scale, - draw_quantiles = draw_quantiles, na.rm = na.rm, orientation = orientation, bounds = bounds, @@ -144,7 +142,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, flip_data(data, params$flipped_aes) }, - draw_group = function(self, data, ..., draw_quantiles = NULL, flipped_aes = FALSE) { + draw_group = function(self, data, ..., flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) # Find the points for the line to go all the way around data <- transform(data, @@ -164,26 +162,15 @@ GeomViolin <- ggproto("GeomViolin", Geom, newdata <- flip_data(newdata, flipped_aes) # Draw quantiles if requested, so long as there is non-zero y range - if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { - if (!(all(draw_quantiles >= 0) && all(draw_quantiles <= 1))) { - cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1.") - } + if ("quantile" %in% names(newdata)) { + + quantiles <- newdata[!is.na(newdata$quantile),] + quantiles$group <- match(quantiles$quantile, unique(quantiles$quantile)) - # Compute the quantile segments and combine with existing aesthetics - quantiles <- create_quantile_segment_frame(data, draw_quantiles) - aesthetics <- data[ - rep(1, nrow(quantiles)), - setdiff(names(data), c("x", "y", "group")), - drop = FALSE - ] - aesthetics$alpha <- rep(1, nrow(quantiles)) - both <- vec_cbind(quantiles, aesthetics) - both <- both[!is.na(both$group), , drop = FALSE] - both <- flip_data(both, flipped_aes) - quantile_grob <- if (nrow(both) == 0) { + quantile_grob <- if (nrow(quantiles) == 0) { zeroGrob() } else { - GeomPath$draw_panel(both, ...) + GeomPath$draw_panel(quantiles, ...) } ggname("geom_violin", grobTree( From b323ede3a277c88108394dee2fac2352be3337ca Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:47:19 +0200 Subject: [PATCH 04/14] migrate docs --- R/geom-violin.R | 2 -- R/stat-ydensity.R | 5 ++++- man/geom_violin.Rd | 9 +++++---- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/R/geom-violin.R b/R/geom-violin.R index a980395ad1..42ce085fac 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -10,8 +10,6 @@ #' @eval rd_aesthetics("geom", "violin") #' @inheritParams layer #' @inheritParams geom_bar -#' @param draw_quantiles If `not(NULL)` (default), draw horizontal lines -#' at the given quantiles of the density estimate. #' @param trim If `TRUE` (default), trim the tails of the violins #' to the range of the data. If `FALSE`, don't trim the tails. #' @param geom,stat Use to override the default connection between diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 3f56b77edf..582b528ca7 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -7,6 +7,8 @@ #' @param drop Whether to discard groups with less than 2 observations #' (`TRUE`, default) or keep such groups for position adjustment purposes #' (`FALSE`). +#' @param draw_quantiles If not `NULL` (default), compute the `quantile` variable +#' and draw horizontal lines at the given quantiles in `geom_violin()`. #' #' @eval rd_computed_vars( #' density = "Density estimate.", @@ -16,7 +18,8 @@ #' violinwidth = "Density scaled for the violin plot, according to area, #' counts or to a constant maximum width.", #' n = "Number of points.", -#' width = "Width of violin bounding box." +#' width = "Width of violin bounding box.", +#' quantile = "Whether the row is part of the `draw_quantiles` computation." #' ) #' #' @seealso [geom_violin()] for examples, and [stat_density()] diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 4041d770c7..9ff824914c 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -11,7 +11,6 @@ geom_violin( stat = "ydensity", position = "dodge", ..., - draw_quantiles = NULL, trim = TRUE, bounds = c(-Inf, Inf), scale = "area", @@ -27,6 +26,7 @@ stat_ydensity( geom = "violin", position = "dodge", ..., + draw_quantiles = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", @@ -102,9 +102,6 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} -\item{draw_quantiles}{If \code{not(NULL)} (default), draw horizontal lines -at the given quantiles of the density estimate.} - \item{trim}{If \code{TRUE} (default), trim the tails of the violins to the range of the data. If \code{FALSE}, don't trim the tails.} @@ -142,6 +139,9 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} overriding these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} +\item{draw_quantiles}{If not \code{NULL} (default), compute the \code{quantile} variable +and draw horizontal lines at the given quantiles in \code{geom_violin()}.} + \item{bw}{The smoothing bandwidth to be used. If numeric, the standard deviation of the smoothing kernel. If character, a rule to choose the bandwidth, as listed in @@ -196,6 +196,7 @@ These are calculated by the 'stat' part of layers and can be accessed with \link \item \code{after_stat(violinwidth)}\cr Density scaled for the violin plot, according to area, counts or to a constant maximum width. \item \code{after_stat(n)}\cr Number of points. \item \code{after_stat(width)}\cr Width of violin bounding box. +\item \code{after_stat(quantile)}\cr Whether the row is part of the \code{draw_quantiles} computation. } } From 7cf89671055f544bc74a60cf177e3124fcf2db54 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:53:09 +0200 Subject: [PATCH 05/14] add test --- tests/testthat/test-stat-ydensity.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test-stat-ydensity.R b/tests/testthat/test-stat-ydensity.R index d9f39b4708..81da9339aa 100644 --- a/tests/testthat/test-stat-ydensity.R +++ b/tests/testthat/test-stat-ydensity.R @@ -41,3 +41,15 @@ test_that("mapped_discrete class is preserved", { expect_s3_class(ld$x, "mapped_discrete") expect_equal(unique(ld$x), c(1, 3)) }) + +test_that("quantiles are based on actual data (#4120)", { + + df <- data.frame(y = 0:10) + q <- seq(0.1, 0.9, by = 0.1) + + p <- ggplot(df, aes("X", y)) + + stat_ydensity(draw_quantiles = q) + ld <- get_layer_data(p) + + expect_equal(ld$y[!is.na(ld$quantile)], 1:9) +}) From c82999e00022fadeb6fc3b930bfd324426117ac4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:58:59 +0200 Subject: [PATCH 06/14] accept snapshot changes --- tests/testthat/_snaps/geom-violin.md | 10 ++++---- .../testthat/_snaps/geom-violin/quantiles.svg | 24 +++++++++---------- tests/testthat/_snaps/prohibited-functions.md | 6 ++--- 3 files changed, 19 insertions(+), 21 deletions(-) diff --git a/tests/testthat/_snaps/geom-violin.md b/tests/testthat/_snaps/geom-violin.md index 80da5aad02..f23f058936 100644 --- a/tests/testthat/_snaps/geom-violin.md +++ b/tests/testthat/_snaps/geom-violin.md @@ -1,14 +1,12 @@ # quantiles fails outside 0-1 bound - Problem while converting geom to grob. - i Error occurred in the 1st layer. - Caused by error in `draw_group()`: + Computation failed in `stat_ydensity()`. + Caused by error in `compute_group()`: ! `draw_quantiles` must be between 0 and 1. --- - Problem while converting geom to grob. - i Error occurred in the 1st layer. - Caused by error in `draw_group()`: + Computation failed in `stat_ydensity()`. + Caused by error in `compute_group()`: ! `draw_quantiles` must be between 0 and 1. diff --git a/tests/testthat/_snaps/geom-violin/quantiles.svg b/tests/testthat/_snaps/geom-violin/quantiles.svg index 8bec1ac1a6..a1cebbd9c6 100644 --- a/tests/testthat/_snaps/geom-violin/quantiles.svg +++ b/tests/testthat/_snaps/geom-violin/quantiles.svg @@ -27,18 +27,18 @@ - - - - - - - - - - - - + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/prohibited-functions.md b/tests/testthat/_snaps/prohibited-functions.md index f2aa9bf4d2..22ea95803d 100644 --- a/tests/testthat/_snaps/prohibited-functions.md +++ b/tests/testthat/_snaps/prohibited-functions.md @@ -55,9 +55,6 @@ $geom_text [1] "nudge_x" "nudge_y" "check_overlap" - $geom_violin - [1] "draw_quantiles" - $ggplot_add [1] "object_name" @@ -183,6 +180,9 @@ $stat_density_2d_filled [1] "contour_var" + $stat_ydensity + [1] "draw_quantiles" + $theme_bw [1] "base_size" "base_family" "base_line_size" "base_rect_size" From 7eeb0018a7feb1cbca3efd76836c4dd5877ca25c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 28 May 2024 17:59:32 +0200 Subject: [PATCH 07/14] add news bullet --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index de3e87cee3..9ef8743996 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 (development version) +* (breaking) `geom_violin(draw_quantiles)` now has actual quantiles based on + the data, rather than inferred quantiles based on the computed density. The + `draw_quantiles` parameter now belongs to `stat_ydensity()` instead of + `geom_violin()`. (@teunbrand, #4120) * The `arrow.fill` parameter is now applied to more line-based functions: `geom_path()`, `geom_line()`, `geom_step()` `geom_function()`, line geometries in `geom_sf()` and `element_line()`. From 2fec60eef8ca41617fa2bc481b41ccf4df0e1b90 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Dec 2024 13:28:48 +0100 Subject: [PATCH 08/14] stat param is named `quantiles` --- R/stat-ydensity.R | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 582b528ca7..e49ca2ccb4 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -7,7 +7,7 @@ #' @param drop Whether to discard groups with less than 2 observations #' (`TRUE`, default) or keep such groups for position adjustment purposes #' (`FALSE`). -#' @param draw_quantiles If not `NULL` (default), compute the `quantile` variable +#' @param quantiles If not `NULL` (default), compute the `quantile` variable #' and draw horizontal lines at the given quantiles in `geom_violin()`. #' #' @eval rd_computed_vars( @@ -19,7 +19,7 @@ #' counts or to a constant maximum width.", #' n = "Number of points.", #' width = "Width of violin bounding box.", -#' quantile = "Whether the row is part of the `draw_quantiles` computation." +#' quantile = "Whether the row is part of the `quantiles` computation." #' ) #' #' @seealso [geom_violin()] for examples, and [stat_density()] @@ -29,7 +29,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL, geom = "violin", position = "dodge", ..., - draw_quantiles = NULL, + quantiles = c(0.25, 0.50, 0.75), bw = "nrd0", adjust = 1, kernel = "gaussian", @@ -60,7 +60,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL, drop = drop, na.rm = na.rm, bounds = bounds, - draw_quantiles = draw_quantiles, + quantiles = quantiles, ... ) ) @@ -86,7 +86,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_group = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, drop = TRUE, flipped_aes = FALSE, bounds = c(-Inf, Inf), - draw_quantiles = NULL) { + quantiles = c(0.25, 0.50, 0.75)) { if (nrow(data) < 2) { if (isTRUE(drop)) { cli::cli_warn(c( @@ -121,19 +121,19 @@ StatYdensity <- ggproto("StatYdensity", Stat, } dens$width <- width - if (!is.null(draw_quantiles)) { - if (!(all(draw_quantiles >= 0) && all(draw_quantiles <= 1))) { - cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1.") + if (!is.null(quantiles)) { + if (!(all(quantiles >= 0) && all(quantiles <= 1))) { + cli::cli_abort("{.arg quantiles} must be between 0 and 1.") } if (!is.null(data[["weight"]]) || !all(data[["weight"]] == 1)) { cli::cli_warn( - "{.arg draw_quantiles} for weighted data is not implemented." + "{.arg quantiles} for weighted data is not implemented." ) } - quants <- quantile(data$y, probs = draw_quantiles) + quants <- quantile(data$y, probs = quantiles) quants <- data_frame0( y = unname(quants), - quantile = draw_quantiles + quantile = quantiles ) # Interpolate other metrics @@ -152,12 +152,12 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_panel = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, scale = "area", flipped_aes = FALSE, drop = TRUE, - bounds = c(-Inf, Inf), draw_quantiles = NULL) { + bounds = c(-Inf, Inf), quantiles = c(0.25, 0.50, 0.75)) { data <- flip_data(data, flipped_aes) data <- ggproto_parent(Stat, self)$compute_panel( data, scales, width = width, bw = bw, adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm, drop = drop, bounds = bounds, - draw_quantiles = draw_quantiles + quantiles = quantiles ) if (!drop && any(data$n < 2)) { cli::cli_warn( From 6464aad1e2a96c8e227bf20574f6018a1a433e29 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Dec 2024 13:29:58 +0100 Subject: [PATCH 09/14] quantile drawing is controlled by graphical params --- R/geom-violin.R | 71 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 56 insertions(+), 15 deletions(-) diff --git a/R/geom-violin.R b/R/geom-violin.R index 6864dec2ec..b6a5107f44 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -21,6 +21,9 @@ #' finite, boundary effect of default density estimation will be corrected by #' reflecting tails outside `bounds` around their closest edge. Data points #' outside of bounds are removed with a warning. +#' @param quantile.colour,quantile.color,quantile.linewidth,quantile.linetype +#' Default aesthetics for the quantile lines. Set to `NULL` to inherit from +#' the data's aesthetics. Set `quantile.linetype = 1` for regular quantiles. #' @export #' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box #' Plot-Density Trace Synergism. The American Statistician 52, 181-184. @@ -91,11 +94,44 @@ geom_violin <- function(mapping = NULL, data = NULL, ..., trim = TRUE, bounds = c(-Inf, Inf), + quantile.colour = NULL, + quantile.color = NULL, + quantile.linetype = 0L, + quantile.linewidth = NULL, + draw_quantiles = deprecated(), scale = "area", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) { + + extra <- list() + if (lifecycle::is_present(draw_quantiles)) { + deprecate_soft0( + "3.6.0", + what = "geom_violin(draw_quantiles)", + with = "geom_violin(quantiles.linetype)" + ) + check_numeric(draw_quantiles) + + # Pass on to stat when stat accepts 'quantiles' + stat <- check_subclass(stat, "Stat", current_call(), caller_env()) + if ("quantiles" %in% stat$parameters()) { + extra$quantiles <- draw_quantiles + } + + # Turn on quantile lines + if (!is.null(quantile.linetype)) { + quantile.linetype <- max(quantile.linetype, 1) + } + } + + quantile_gp <- list( + colour = quantile.color %||% quantile.colour, + linetype = quantile.linetype, + linewidth = quantile.linewidth + ) + layer( data = data, mapping = mapping, @@ -110,6 +146,8 @@ geom_violin <- function(mapping = NULL, data = NULL, na.rm = na.rm, orientation = orientation, bounds = bounds, + quantile_gp = quantile_gp, + !!!extra, ... ) ) @@ -140,7 +178,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, flip_data(data, params$flipped_aes) }, - draw_group = function(self, data, ..., flipped_aes = FALSE) { + draw_group = function(self, data, ..., quantile_gp = list(linetype = 0), flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) # Find the points for the line to go all the way around data <- transform(data, @@ -159,25 +197,28 @@ GeomViolin <- ggproto("GeomViolin", Geom, newdata <- vec_rbind0(newdata, newdata[1,]) newdata <- flip_data(newdata, flipped_aes) - # Draw quantiles if requested, so long as there is non-zero y range - if ("quantile" %in% names(newdata)) { + violin_grob <- GeomPolygon$draw_panel(newdata, ...) - quantiles <- newdata[!is.na(newdata$quantile),] - quantiles$group <- match(quantiles$quantile, unique(quantiles$quantile)) + if (!"quantile" %in% names(newdata) || + all(quantile_gp$linetype == 0) || + all(quantile_gp$linetype == "blank")) { + return(ggname("geom_violin", violin_grob)) + } - quantile_grob <- if (nrow(quantiles) == 0) { - zeroGrob() - } else { - GeomPath$draw_panel(quantiles, ...) - } + # Draw quantiles if requested, so long as there is non-zero y range + quantiles <- newdata[!is.na(newdata$quantile),] + quantiles$group <- match(quantiles$quantile, unique(quantiles$quantile)) + quantiles$linetype <- quantile_gp$linetype %||% quantiles$linetype + quantiles$linewidth <- quantile_gp$linewidth %||% quantiles$linewidth + quantiles$colour <- quantile_gp$colour %||% quantiles$colour - ggname("geom_violin", grobTree( - GeomPolygon$draw_panel(newdata, ...), - quantile_grob) - ) + quantile_grob <- if (nrow(quantiles) == 0) { + zeroGrob() } else { - ggname("geom_violin", GeomPolygon$draw_panel(newdata, ...)) + GeomPath$draw_panel(quantiles, ...) } + + ggname("geom_violin", grobTree(violin_grob, quantile_grob)) }, draw_key = draw_key_polygon, From dfe4db00f18ac5eea0c040cb91653546475a3767 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Dec 2024 13:41:35 +0100 Subject: [PATCH 10/14] adapt tests --- tests/testthat/_snaps/geom-violin.md | 4 ++-- tests/testthat/_snaps/geom-violin/basic.svg | 6 +++--- ...is-many-groups-center-should-be-at-2-0.svg | 2 +- ...s-single-group-center-should-be-at-1-0.svg | 2 +- .../_snaps/geom-violin/coord-flip.svg | 6 +++--- .../_snaps/geom-violin/coord-polar.svg | 6 +++--- .../geom-violin/dodging-and-coord-flip.svg | 6 +++--- tests/testthat/_snaps/geom-violin/dodging.svg | 6 +++--- ...grouping-on-x-and-fill-dodge-width-0-5.svg | 12 +++++------ .../geom-violin/grouping-on-x-and-fill.svg | 12 +++++------ .../_snaps/geom-violin/narrower-width-5.svg | 6 +++--- ...scale-area-to-sample-size-c-is-smaller.svg | 6 +++--- .../{quantiles.svg => styled-quantiles.svg} | 20 +++++++++---------- .../with-smaller-bandwidth-and-points.svg | 6 +++--- .../geom-violin/with-tails-and-points.svg | 6 +++--- tests/testthat/_snaps/prohibited-functions.md | 6 +++--- tests/testthat/test-geom-violin.R | 18 +++++++++++------ tests/testthat/test-stat-ydensity.R | 2 +- 18 files changed, 69 insertions(+), 63 deletions(-) rename tests/testthat/_snaps/geom-violin/{quantiles.svg => styled-quantiles.svg} (98%) diff --git a/tests/testthat/_snaps/geom-violin.md b/tests/testthat/_snaps/geom-violin.md index f23f058936..68cc4c1c5a 100644 --- a/tests/testthat/_snaps/geom-violin.md +++ b/tests/testthat/_snaps/geom-violin.md @@ -2,11 +2,11 @@ Computation failed in `stat_ydensity()`. Caused by error in `compute_group()`: - ! `draw_quantiles` must be between 0 and 1. + ! `quantiles` must be between 0 and 1. --- Computation failed in `stat_ydensity()`. Caused by error in `compute_group()`: - ! `draw_quantiles` must be between 0 and 1. + ! `quantiles` must be between 0 and 1. diff --git a/tests/testthat/_snaps/geom-violin/basic.svg b/tests/testthat/_snaps/geom-violin/basic.svg index 206a6b4626..16e7518c21 100644 --- a/tests/testthat/_snaps/geom-violin/basic.svg +++ b/tests/testthat/_snaps/geom-violin/basic.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/continuous-x-axis-many-groups-center-should-be-at-2-0.svg b/tests/testthat/_snaps/geom-violin/continuous-x-axis-many-groups-center-should-be-at-2-0.svg index f737690144..611f73f969 100644 --- a/tests/testthat/_snaps/geom-violin/continuous-x-axis-many-groups-center-should-be-at-2-0.svg +++ b/tests/testthat/_snaps/geom-violin/continuous-x-axis-many-groups-center-should-be-at-2-0.svg @@ -27,7 +27,7 @@ - + diff --git a/tests/testthat/_snaps/geom-violin/continuous-x-axis-single-group-center-should-be-at-1-0.svg b/tests/testthat/_snaps/geom-violin/continuous-x-axis-single-group-center-should-be-at-1-0.svg index f11a934abb..74fc5ed64e 100644 --- a/tests/testthat/_snaps/geom-violin/continuous-x-axis-single-group-center-should-be-at-1-0.svg +++ b/tests/testthat/_snaps/geom-violin/continuous-x-axis-single-group-center-should-be-at-1-0.svg @@ -27,7 +27,7 @@ - + diff --git a/tests/testthat/_snaps/geom-violin/coord-flip.svg b/tests/testthat/_snaps/geom-violin/coord-flip.svg index 434afe96c8..59f095248a 100644 --- a/tests/testthat/_snaps/geom-violin/coord-flip.svg +++ b/tests/testthat/_snaps/geom-violin/coord-flip.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/coord-polar.svg b/tests/testthat/_snaps/geom-violin/coord-polar.svg index e70e3b11f3..02ae1107df 100644 --- a/tests/testthat/_snaps/geom-violin/coord-polar.svg +++ b/tests/testthat/_snaps/geom-violin/coord-polar.svg @@ -36,9 +36,9 @@ - - - + + + A B C diff --git a/tests/testthat/_snaps/geom-violin/dodging-and-coord-flip.svg b/tests/testthat/_snaps/geom-violin/dodging-and-coord-flip.svg index 86a328e5b5..6af10a6faa 100644 --- a/tests/testthat/_snaps/geom-violin/dodging-and-coord-flip.svg +++ b/tests/testthat/_snaps/geom-violin/dodging-and-coord-flip.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/dodging.svg b/tests/testthat/_snaps/geom-violin/dodging.svg index c1ccf480ce..d1d537e3b2 100644 --- a/tests/testthat/_snaps/geom-violin/dodging.svg +++ b/tests/testthat/_snaps/geom-violin/dodging.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill-dodge-width-0-5.svg b/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill-dodge-width-0-5.svg index 17142781de..fcf5700ada 100644 --- a/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill-dodge-width-0-5.svg +++ b/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill-dodge-width-0-5.svg @@ -27,12 +27,12 @@ - - - - - - + + + + + + diff --git a/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill.svg b/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill.svg index 56049d8ef6..477f9a02c5 100644 --- a/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill.svg +++ b/tests/testthat/_snaps/geom-violin/grouping-on-x-and-fill.svg @@ -27,12 +27,12 @@ - - - - - - + + + + + + diff --git a/tests/testthat/_snaps/geom-violin/narrower-width-5.svg b/tests/testthat/_snaps/geom-violin/narrower-width-5.svg index d7a23e057b..d233183697 100644 --- a/tests/testthat/_snaps/geom-violin/narrower-width-5.svg +++ b/tests/testthat/_snaps/geom-violin/narrower-width-5.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/scale-area-to-sample-size-c-is-smaller.svg b/tests/testthat/_snaps/geom-violin/scale-area-to-sample-size-c-is-smaller.svg index 1c0bf845b4..ca9f1bf889 100644 --- a/tests/testthat/_snaps/geom-violin/scale-area-to-sample-size-c-is-smaller.svg +++ b/tests/testthat/_snaps/geom-violin/scale-area-to-sample-size-c-is-smaller.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/quantiles.svg b/tests/testthat/_snaps/geom-violin/styled-quantiles.svg similarity index 98% rename from tests/testthat/_snaps/geom-violin/quantiles.svg rename to tests/testthat/_snaps/geom-violin/styled-quantiles.svg index a1cebbd9c6..0b8d55329f 100644 --- a/tests/testthat/_snaps/geom-violin/quantiles.svg +++ b/tests/testthat/_snaps/geom-violin/styled-quantiles.svg @@ -28,17 +28,17 @@ - - - + + + - - - + + + - - - + + + @@ -64,6 +64,6 @@ C x y -quantiles +styled quantiles diff --git a/tests/testthat/_snaps/geom-violin/with-smaller-bandwidth-and-points.svg b/tests/testthat/_snaps/geom-violin/with-smaller-bandwidth-and-points.svg index 1494c6bd08..3dc573d465 100644 --- a/tests/testthat/_snaps/geom-violin/with-smaller-bandwidth-and-points.svg +++ b/tests/testthat/_snaps/geom-violin/with-smaller-bandwidth-and-points.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/geom-violin/with-tails-and-points.svg b/tests/testthat/_snaps/geom-violin/with-tails-and-points.svg index 1db22dd441..d109c20fbc 100644 --- a/tests/testthat/_snaps/geom-violin/with-tails-and-points.svg +++ b/tests/testthat/_snaps/geom-violin/with-tails-and-points.svg @@ -27,9 +27,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/prohibited-functions.md b/tests/testthat/_snaps/prohibited-functions.md index 996355113c..007e6521c4 100644 --- a/tests/testthat/_snaps/prohibited-functions.md +++ b/tests/testthat/_snaps/prohibited-functions.md @@ -55,6 +55,9 @@ $geom_text [1] "nudge_x" "nudge_y" "check_overlap" + $geom_violin + [1] "draw_quantiles" + $ggplot_add [1] "object_name" @@ -180,9 +183,6 @@ $stat_density_2d_filled [1] "contour_var" - $stat_ydensity - [1] "draw_quantiles" - $theme_bw [1] "base_size" "base_family" "header_family" "base_line_size" [5] "base_rect_size" diff --git a/tests/testthat/test-geom-violin.R b/tests/testthat/test-geom-violin.R index a93a534b40..ff3cae8de8 100644 --- a/tests/testthat/test-geom-violin.R +++ b/tests/testthat/test-geom-violin.R @@ -40,7 +40,8 @@ test_that("create_quantile_segment_frame functions for 3 quantiles", { test_that("quantiles do not fail on zero-range data", { zero.range.data <- data_frame(y = rep(1,3)) - p <- ggplot(zero.range.data) + geom_violin(aes(1, y), draw_quantiles = 0.5) + p <- ggplot(zero.range.data) + + geom_violin(aes(1, y), quantiles = 0.5, quantile.linetype = NULL) # This should return without error and have length one expect_length(get_layer_grob(p), 1) @@ -48,10 +49,10 @@ test_that("quantiles do not fail on zero-range data", { test_that("quantiles fails outside 0-1 bound", { p <- ggplot(mtcars) + - geom_violin(aes(as.factor(gear), mpg), draw_quantiles = c(-1, 0.5)) + geom_violin(aes(as.factor(gear), mpg), quantiles = c(-1, 0.5)) expect_snapshot_error(ggplotGrob(p)) p <- ggplot(mtcars) + - geom_violin(aes(as.factor(gear), mpg), draw_quantiles = c(0.5, 2)) + geom_violin(aes(as.factor(gear), mpg), quantiles = c(0.5, 2)) expect_snapshot_error(ggplotGrob(p)) }) @@ -70,7 +71,7 @@ test_that("quantiles do not issue warning", { data <- data_frame(x = 1, y = c(0, 0.25, 0.5, 0.75, 5)) p <- ggplot(data, aes(x = x, y = y)) + - geom_violin(draw_quantiles = 0.5) + geom_violin(quantiles = 0.5, quantile.linetype = NULL) expect_silent(plot(p)) }) @@ -116,8 +117,13 @@ test_that("geom_violin draws correctly", { expect_doppelganger("continuous x axis, single group (center should be at 1.0)", ggplot(dat, aes(x = as.numeric(1), y = y)) + geom_violin() ) - expect_doppelganger("quantiles", - ggplot(dat, aes(x=x, y=y)) + geom_violin(draw_quantiles=c(0.25,0.5,0.75)) + expect_doppelganger("styled quantiles", + ggplot(dat, aes(x=x, y=y)) + + geom_violin( + quantile.colour = "red", + quantile.linetype = "dotted", + quantile.linewidth = 2 + ) ) dat2 <- data_frame(x = rep(factor(LETTERS[1:3]), 30), y = rnorm(90), g = rep(factor(letters[5:6]), 45)) diff --git a/tests/testthat/test-stat-ydensity.R b/tests/testthat/test-stat-ydensity.R index c3ff4f57da..fb5d39c036 100644 --- a/tests/testthat/test-stat-ydensity.R +++ b/tests/testthat/test-stat-ydensity.R @@ -46,7 +46,7 @@ test_that("quantiles are based on actual data (#4120)", { q <- seq(0.1, 0.9, by = 0.1) p <- ggplot(df, aes("X", y)) + - stat_ydensity(draw_quantiles = q) + stat_ydensity(quantiles = q) ld <- get_layer_data(p) expect_equal(ld$y[!is.na(ld$quantile)], 1:9) From a1e33b0244f7699aa6d13190f265383a5675334e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Dec 2024 13:45:49 +0100 Subject: [PATCH 11/14] document --- R/geom-violin.R | 5 ++++- man/geom_violin.Rd | 18 +++++++++++++++--- 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/R/geom-violin.R b/R/geom-violin.R index b6a5107f44..9d26439179 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -23,7 +23,10 @@ #' outside of bounds are removed with a warning. #' @param quantile.colour,quantile.color,quantile.linewidth,quantile.linetype #' Default aesthetics for the quantile lines. Set to `NULL` to inherit from -#' the data's aesthetics. Set `quantile.linetype = 1` for regular quantiles. +#' the data's aesthetics. By default, quantile lines are hidden and can be +#' turned on by changing `quantile.linetype`. +#' @param draw_quantiles `r lifecycle::badge("deprecated")` Previous +#' specification of drawing quantiles. #' @export #' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box #' Plot-Density Trace Synergism. The American Statistician 52, 181-184. diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 4df2564e44..244a7ac7ea 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -13,6 +13,11 @@ geom_violin( ..., trim = TRUE, bounds = c(-Inf, Inf), + quantile.colour = NULL, + quantile.color = NULL, + quantile.linetype = 0L, + quantile.linewidth = NULL, + draw_quantiles = deprecated(), scale = "area", na.rm = FALSE, orientation = NA, @@ -26,7 +31,7 @@ stat_ydensity( geom = "violin", position = "dodge", ..., - draw_quantiles = NULL, + quantiles = c(0.25, 0.5, 0.75), bw = "nrd0", adjust = 1, kernel = "gaussian", @@ -111,6 +116,13 @@ finite, boundary effect of default density estimation will be corrected by reflecting tails outside \code{bounds} around their closest edge. Data points outside of bounds are removed with a warning.} +\item{quantile.colour, quantile.color, quantile.linewidth, quantile.linetype}{Default aesthetics for the quantile lines. Set to \code{NULL} to inherit from +the data's aesthetics. By default, quantile lines are hidden and can be +turned on by changing \code{quantile.linetype}.} + +\item{draw_quantiles}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previous +specification of drawing quantiles.} + \item{scale}{if "area" (default), all violins have the same area (before trimming the tails). If "count", areas are scaled proportionally to the number of observations. If "width", all violins have the same maximum width.} @@ -141,7 +153,7 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} overriding these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} -\item{draw_quantiles}{If not \code{NULL} (default), compute the \code{quantile} variable +\item{quantiles}{If not \code{NULL} (default), compute the \code{quantile} variable and draw horizontal lines at the given quantiles in \code{geom_violin()}.} \item{bw}{The smoothing bandwidth to be used. @@ -198,7 +210,7 @@ These are calculated by the 'stat' part of layers and can be accessed with \link \item \code{after_stat(violinwidth)}\cr Density scaled for the violin plot, according to area, counts or to a constant maximum width. \item \code{after_stat(n)}\cr Number of points. \item \code{after_stat(width)}\cr Width of violin bounding box. -\item \code{after_stat(quantile)}\cr Whether the row is part of the \code{draw_quantiles} computation. +\item \code{after_stat(quantile)}\cr Whether the row is part of the \code{quantiles} computation. } } From 2446c5837631d0cdc9cc7e63202e87089501c8d9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Dec 2024 13:53:28 +0100 Subject: [PATCH 12/14] add news bullets --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index 6aa0e8ad7e..88e7284c2c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -46,6 +46,11 @@ (@teunbrand, #4320) * `geom_boxplot()` gains additional arguments to style the colour, linetype and linewidths of the box, whiskers, median line and staples (@teunbrand, #5126) +* `geom_violin()` gains additional arguments to style the colour, linetype and + linewidths of the quantiles, which replace the now-deprecated `draw_quantiles` + argument (#5912). +* (breaking) `stat_ydensity(quantiles)` now draws observation-based quantiles + instead of estimates (@teunbrand, #4120). * (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 From e86ce7fd3320cbaed0f51b92f3344b5934efcd30 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Dec 2024 14:00:53 +0100 Subject: [PATCH 13/14] dedup news bullets --- NEWS.md | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/NEWS.md b/NEWS.md index 88e7284c2c..e0990a184f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,5 @@ # ggplot2 (development version) -* (breaking) `geom_violin(draw_quantiles)` now has actual quantiles based on - the data, rather than inferred quantiles based on the computed density. The - `draw_quantiles` parameter now belongs to `stat_ydensity()` instead of - `geom_violin()`. (@teunbrand, #4120) * `guide_*()` can now accept two inside legend theme elements: `legend.position.inside` and `legend.justification.inside`, allowing inside legends to be placed at different positions. Only inside legends with the same @@ -49,8 +45,10 @@ * `geom_violin()` gains additional arguments to style the colour, linetype and linewidths of the quantiles, which replace the now-deprecated `draw_quantiles` argument (#5912). -* (breaking) `stat_ydensity(quantiles)` now draws observation-based quantiles - instead of estimates (@teunbrand, #4120). +* (breaking) `geom_violin(quantiles)` now has actual quantiles based on + the data, rather than inferred quantiles based on the computed density. The + `quantiles` parameter that replaces `draw_quantiles` now belongs to + `stat_ydensity()` instead of `geom_violin()` (@teunbrand, #4120). * (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 From 7cabd35b9cf51ebdb787cad55608aa225aad3991 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 27 Jan 2025 12:04:00 +0100 Subject: [PATCH 14/14] Deprecation of the `draw_quantiles` parameter coming from `geom_violin()` parity --- R/stat-ydensity.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index e49ca2ccb4..6b0e4f0ff8 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -78,10 +78,21 @@ StatYdensity <- ggproto("StatYdensity", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) + if (!is.null(params$draw_quantiles)) { + deprecate_soft0( + "3.6.0", + what = "stat_ydensity(draw_quantiles)", + with = "stat_ydensity(quantiles)" + ) + params$quantiles <- params$draw_quantiles + check_numeric(params$quantiles, arg = "quantiles") + } + params }, - extra_params = c("na.rm", "orientation"), + # `draw_quantiles` is here for deprecation repair reasons + extra_params = c("na.rm", "orientation", "draw_quantiles"), compute_group = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE,