quantile drawing is controlled by graphical params

Author: teunbrand

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,