Make position_dodge2() work for geom_violin() (#6664)

* add `group_row` parameter

* run-length encode data for violins

* document

* use dot.case for argument name

* lol at my incompetence

* add violin snapshot

* protect against missing columns

* add test for correctness

* add news bullet

* placate the older R versions

Author: teunbrand

NEWS.md

@@ -18,6 +18,9 @@
 * Added `preserve` argument to `position_jitterdodge()` (@teunbrand, #6584).
 * Fixed `position_jitterdodge(jitter.height, jitter.width)` applying to the 
   wrong dimension with flipped geoms (@teunbrand, #6535).
+* New `position_dodge2(group.row)` argument that can be set to `"many"` to
+  dodge groups with more than one row, such as in `geom_violin()` 
+  (@teunbrand, #6663)
 
 # ggplot2 4.0.1
 

R/position-dodge2.R

@@ -2,13 +2,18 @@
 #' @rdname position_dodge
 #' @param padding Padding between elements at the same position. Elements are
 #'   shrunk by this proportion to allow space between them. Defaults to 0.1.
+#' @param group.row Relationship between groups and rows. Can be `"single"` if
+#'   every row represents a single group, or `"many"` if many rows represent
+#'   a group.
 position_dodge2 <- function(width = NULL, preserve = "total",
-                            padding = 0.1, reverse = FALSE) {
+                            padding = 0.1, reverse = FALSE,
+                            group.row = "single") {
   ggproto(NULL, PositionDodge2,
     width = width,
     preserve = arg_match0(preserve, c("total", "single")),
     padding = padding,
-    reverse = reverse
+    reverse = reverse,
+    group_row = arg_match0(group.row, c("single", "many"))
   )
 }
 
@@ -20,6 +25,7 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge,
   preserve = "total",
   padding = 0.1,
   reverse = FALSE,
+  group_row = "single",
 
   setup_params = function(self, data) {
     flipped_aes <- has_flipped_aes(data)
@@ -48,14 +54,22 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge,
       n = n,
       padding = self$padding,
       reverse = self$reverse,
-      flipped_aes = flipped_aes
+      flipped_aes = flipped_aes,
+      group_row = self$group_row
     )
   },
 
   compute_panel = function(data, params, scales) {
     data <- flip_data(data, params$flipped_aes)
+    key <- NULL
+    columns <- intersect(c("group", "x", "xmin", "xmax"), names(data))
+    if (isTRUE(params$group_row == "many") && length(columns) > 0) {
+      # Run-length encode (RLE) relevant variables
+      key <- vec_unrep(data[columns])
+    }
+
     collided <- collide2(
-      data,
+      key$key %||% data,
       params$width,
       name = "position_dodge2",
       strategy = pos_dodge2,
@@ -64,7 +78,15 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge,
       check.width = FALSE,
       reverse = params$reverse
     )
-    flip_data(collided, params$flipped_aes)
+
+    if (!is.null(key)) {
+      # Decode RLE to full data
+      data[columns] <- vec_rep_each(collided[columns], key$times)
+    } else {
+      data <- collided
+    }
+
+    flip_data(data, params$flipped_aes)
   }
 )
 

man/position_dodge.Rd

@@ -125,6 +125,10 @@ test_that("geom_violin draws correctly", {
         quantile.linewidth = 2
       )
   )
+  expect_doppelganger("dodge2", {
+    ggplot(dat, aes(x = "foo", y = y, fill = x)) +
+      geom_violin(position = position_dodge2(group.row = "many"))
+  })
 
   dat2 <- data_frame(x = rep(factor(LETTERS[1:3]), 30), y = rnorm(90), g = rep(factor(letters[5:6]), 45))
   expect_doppelganger("grouping on x and fill",

tests/testthat/_snaps/geom-violin/dodge2.svg

@@ -35,6 +35,34 @@ test_that("rectangles are dodged", {
   expect_false(any(duplicated(find_x_overlaps(get_layer_data(p)))))
 })
 
+test_that("groups with multiple rows are dodged", {
+
+  n_per_group <- function(x, g) {
+    vapply(split(x, g), vec_unique_count, integer(1), USE.NAMES = FALSE)
+  }
+
+  p <- ggplot(
+    data_frame(
+      x = "x",
+      y = 1:6,
+      g = rep(LETTERS[1:3], 3:1)
+    ),
+    aes(x, y, colour = g)
+  )
+
+  singles <- get_layer_data(
+    p + geom_point(position = position_dodge2(width = 1, group.row = "single"))
+  )
+
+  expect_equal(n_per_group(singles$x, singles$group), 3:1)
+
+  multi <- get_layer_data(
+    p + geom_point(position = position_dodge2(width = 1, group.row = "many"))
+  )
+
+  expect_all_equal(n_per_group(multi$x, multi$group), 1)
+})
+
 test_that("cols at the same x position are dodged", {
   df <- data_frame(
     x = c("a", "a", "b"),