Fix warning in geom_violin with draw_quantiles (#4654)

Fixes #4455

Author: bersbersbers

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `geom_violin()` no longer issues "collapsing to unique 'x' values" warning
+  (@bersbersbers, #4455)
+
 * `annotate()` now documents unsupported geoms (`geom_abline()`, `geom_hline()`
   and `geom_vline()`), and warns when they are requested (@mikmart, #4719)
 

R/geom-violin.r

@@ -197,7 +197,7 @@ GeomViolin <- ggproto("GeomViolin", Geom,
 # Returns a data.frame with info needed to draw quantile segments.
 create_quantile_segment_frame <- function(data, draw_quantiles) {
   dens <- cumsum(data$density) / sum(data$density)
-  ecdf <- stats::approxfun(dens, data$y)
+  ecdf <- stats::approxfun(dens, data$y, ties = "ordered")
   ys <- ecdf(draw_quantiles) # these are all the y-values for quantiles
 
   # Get the violin bounds for the requested quantiles.

tests/testthat/test-geom-violin.R

@@ -46,6 +46,26 @@ test_that("quantiles do not fail on zero-range data", {
   expect_equal(length(layer_grob(p)), 1)
 })
 
+test_that("quantiles are at expected positions at zero width", {
+  # Symmetric density with n components and zero middle:
+  # 50% quantile can be drawn anywhere as long as there is density 0
+  n <- 256
+  density <- c(rep(2, n / 4), rep(0, n / 2), rep(2, n / 4)) / n
+  density.data <- data_frame(y = (1:n) / n, density = density)
+  line <- create_quantile_segment_frame(density.data, 0.5)
+  y_idx <- which.min(abs(density.data$y - line$y[1]))
+  expect_equal(density[y_idx], 0)
+})
+
+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)
+
+  expect_warning(plot(p), regexp = NA)
+})
+
 
 # Visual tests ------------------------------------------------------------