Adds bounds to geom_violin() (#5494)

Closes #5493

Author: eliocamp

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `geom_violin()` gains a `bounds` argument analogous to `geom_density()`s (@eliocamp, #5493).
+
 * Legend titles no longer take up space if they've been removed by setting 
   `legend.title = element_blank()` (@teunbrand, #3587).
 

R/geom-violin.R

@@ -16,6 +16,11 @@
 #'   to the range of the data. If `FALSE`, don't trim the tails.
 #' @param geom,stat Use to override the default connection between
 #'   `geom_violin()` and `stat_ydensity()`.
+#' @param bounds Known lower and upper bounds for estimated data. Default
+#'   `c(-Inf, Inf)` means that there are no (finite) bounds. If any bound is
+#'   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.
 #' @export
 #' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box
 #' Plot-Density Trace Synergism. The American Statistician 52, 181-184.
@@ -86,6 +91,7 @@ geom_violin <- function(mapping = NULL, data = NULL,
                         ...,
                         draw_quantiles = NULL,
                         trim = TRUE,
+                        bounds = c(-Inf, Inf),
                         scale = "area",
                         na.rm = FALSE,
                         orientation = NA,
@@ -105,6 +111,7 @@ geom_violin <- function(mapping = NULL, data = NULL,
       draw_quantiles = draw_quantiles,
       na.rm = na.rm,
       orientation = orientation,
+      bounds = bounds,
       ...
     )
   )

R/stat-ydensity.R

@@ -35,7 +35,8 @@ stat_ydensity <- function(mapping = NULL, data = NULL,
                           na.rm = FALSE,
                           orientation = NA,
                           show.legend = NA,
-                          inherit.aes = TRUE) {
+                          inherit.aes = TRUE,
+                          bounds = c(-Inf, Inf)) {
   scale <- arg_match0(scale, c("area", "count", "width"))
 
   layer(
@@ -54,6 +55,7 @@ stat_ydensity <- function(mapping = NULL, data = NULL,
       scale = scale,
       drop  = drop,
       na.rm = na.rm,
+      bounds = bounds,
       ...
     )
   )
@@ -78,7 +80,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) {
+                       drop = TRUE, flipped_aes = FALSE, bounds = c(-Inf, Inf)) {
     if (nrow(data) < 2) {
       if (isTRUE(drop)) {
         cli::cli_warn(c(
@@ -98,7 +100,7 @@ StatYdensity <- ggproto("StatYdensity", Stat,
     dens <- compute_density(
       data$y, data[["weight"]],
       from = range[1] - modifier * bw, to = range[2] + modifier * bw,
-      bw = bw, adjust = adjust, kernel = kernel
+      bw = bw, adjust = adjust, kernel = kernel, bounds = bounds
     )
 
     dens$y <- dens$x
@@ -118,11 +120,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) {
+                           scale = "area", flipped_aes = FALSE, drop = TRUE,
+                           bounds = c(-Inf, Inf)) {
     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
+      trim = trim, na.rm = na.rm, drop = drop, bounds = bounds,
     )
     if (!drop && any(data$n < 2)) {
       cli::cli_warn(