Compute overlapping groups by panel (#2562)

In position_dodge and position_dodge2

Fixes #2493

Author: hadley

R/position-dodge.r

@@ -67,10 +67,10 @@
 #'
 #' ggplot(data = iris, aes(Species, Sepal.Length)) +
 #'   geom_boxplot(aes(colour = Sepal.Width < 3.2), varwidth = TRUE)
-#' 
+#'
 #' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
 #'   geom_bar(position = position_dodge2(preserve = "single"))
-#' 
+#'
 #' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
 #'   geom_bar(position = position_dodge2(preserve = "total"))
 position_dodge <- function(width = NULL, preserve = c("total", "single")) {
@@ -96,7 +96,9 @@ PositionDodge <- ggproto("PositionDodge", Position,
     if (identical(self$preserve, "total")) {
       n <- NULL
     } else {
-      n <- max(table(data$xmin))
+      panels <- unname(split(data, data$PANEL))
+      ns <- vapply(panels, function(panel) max(table(panel$xmin)), double(1))
+      n <- max(ns)
     }
 
     list(
@@ -111,7 +113,7 @@ PositionDodge <- ggproto("PositionDodge", Position,
     }
     data
   },
-  
+
   compute_panel = function(data, params, scales) {
     collide(
       data,

R/position-dodge2.r

@@ -31,10 +31,17 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge,
 
     if (identical(self$preserve, "total")) {
       n <- NULL
-    } else if ("x" %in% names(data)){
-      n <- max(table(data$x))
     } else {
-      n <- max(table(find_x_overlaps(data)))
+      panels <- unname(split(data, data$PANEL))
+      if ("x" %in% names(data)) {
+        # Point geom
+        groups <- lapply(panels, function(panel) table(panel$x))
+      } else {
+        # Interval geom
+        groups <- lapply(panels, find_x_overlaps)
+      }
+      n_groups <- vapply(groups, max, double(1))
+      n <- max(n_groups)
     }
 
     list(

tests/testthat/test-position-dodge2.R

@@ -82,3 +82,23 @@ test_that("boxes in facetted plots keep the correct width", {
   expect_true(all(d$xmax - d$xmin == 0.75))
 
 })
+
+test_that("width of groups computed per facet", {
+  df <- tibble::tribble(
+    ~g1, ~g2,  ~y,
+    "x", "a",  1,
+    "x", "b",  2,
+    "y", "a",  3,
+    "y", "b",  4,
+    "y", "c",  3,
+  )
+
+  p <- ggplot(df, aes("x", y, fill = g2)) +
+    geom_col(position = position_dodge2(preserve = "single")) +
+    facet_wrap(vars(g1))
+
+  d <- layer_data(p)
+  width <- d$xmax - d$xmin
+
+  expect_true(all(width == (0.9 / 3) * 0.9))
+})