Fixed bug in geom-violin.r when quantiles requested but data have no range. (#1687)

* Fixed bug in geom-violin.r when quantiles requested but data have
no range.

* Updated NEWS.md and added unit test.

Author: DanRuderman

NEWS.md

@@ -46,6 +46,9 @@
 * Fix bug that resulted in several annotation_x function not getting drawn when
   global data was lacking (#1655)
 
+* Fixed problem with `geom_violin()` when quantiles requested but data
+  have no range. Added unit test. (#1687)
+
 # ggplot2 2.1.0
 
 ## New features
@@ -81,9 +84,9 @@
 
     * `bins = n` now gives a histogram with `n` bins, not `n + 1` (#1487).
 
-## Bug fixes
+## Bug fixes 
 
-* All `\donttest{}` examples run.
+* All `\donttest{}` examples run. 
 
 * All `geom_()` and `stat_()` functions now have consistent argument order:
   data + mapping, then geom/stat/position, then `...`, then specific arguments, 

R/geom-violin.r

@@ -126,8 +126,8 @@ GeomViolin <- ggproto("GeomViolin", Geom,
     # Needed for coord_polar and such
     newdata <- rbind(newdata, newdata[1,])
 
-    # Draw quantiles if requested
-    if (length(draw_quantiles) > 0) {
+    # Draw quantiles if requested, so long as there is non-zero y range
+    if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {
       stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))
 
       # Compute the quantile segments and combine with existing aesthetics
@@ -163,11 +163,11 @@ create_quantile_segment_frame <- function(data, draw_quantiles) {
   ecdf <- stats::approxfun(dens, data$y)
   ys <- ecdf(draw_quantiles) # these are all the y-values for quantiles
 
-  # Get the violin bounds for the requested quantiles
+  # Get the violin bounds for the requested quantiles.
   violin.xminvs <- (stats::approxfun(data$y, data$xminv))(ys)
   violin.xmaxvs <- (stats::approxfun(data$y, data$xmaxv))(ys)
 
-  # We have two rows per segment drawn. Each segments gets its own group.
+  # We have two rows per segment drawn. Each segment gets its own group.
   data.frame(
     x = interleave(violin.xminvs, violin.xmaxvs),
     y = rep(ys, each = 2),

tests/testthat/test-geom-violin.R

@@ -18,10 +18,26 @@ test_that("", {
 # create_quantile_segment_frame -------------------------------------------------
 
 test_that("create_quantile_segment_frame functions for 3 quantiles", {
-  density.data <- data.frame(y=(1:256)/256, density=1/256) # uniform density
+  density.data <- data.frame(y = (1:256)/256, density = 1/256) # uniform density
 
   qs <- c(0.25, 0.5, 0.75) # 3 quantiles
   expect_equal(create_quantile_segment_frame(density.data, qs)$y,
-               rep(qs, each=2))
+               rep(qs, each = 2))
+})
+
+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)
+
+  # This should return without error and have length one
+  expect_equal(length(layer_grob(p)), 1)
+
+  # All rows should be identical in layer_data, with some specific values
+  unique.layer.data <- unique(layer_data(p))
+  expect_equal(nrow(unique.layer.data), 1)
+  expect_equal(unique.layer.data$density, 0.55216039)
+  expect_equal(unique.layer.data$count, 1.65648117)
+  expect_equal(unique.layer.data$xmin, 0.55)
+  expect_equal(unique.layer.data$xmax, 1.45)
 })