Infer dodge grouping from fill in position_jitterdodge()

NEWS.md

@@ -1,5 +1,9 @@
 # ggplot2 (development version)
 
+* `position_jitterdodge()` now infers dodge grouping from the `fill`
+  aesthetic when present, so points align correctly with dodged boxplots
+  even when additional discrete aesthetics like `colour` are mapped
+  (@Jesssullivan, #6824).
 * `geom_boxplot()`/`stat_boxplot()` gain a `quantile.type` parameter (default `7`) 
    to control the percentile definition used for hinges and median; set `quantile.type = 2` 
    to match SAS's default `PCTLDEF = 5`, enabling parity with SAS boxplots out-of-the-box. 

R/position-jitterdodge.R

@@ -12,13 +12,43 @@
 #'   the default `position_dodge()` width.
 #' @inheritParams position_jitter
 #' @inheritParams position_dodge
+#'
+#' @section Dodge grouping:
+#' When a `fill` aesthetic is present and discrete, `position_jitterdodge()`
+#' uses it to determine dodge grouping. This ensures points align with dodged
+#' boxplots even when additional discrete aesthetics like `colour` are mapped,
+#' which would otherwise inflate the implicit group (see [aes_group_order]).
+#'
+#' If no discrete `fill` is present, dodging falls back to the standard
+#' `group` aesthetic. You can always override grouping explicitly with
+#' `aes(group = ...)`.
+#'
 #' @export
 #' @examples
 #' set.seed(596)
 #' dsub <- diamonds[sample(nrow(diamonds), 1000), ]
 #' ggplot(dsub, aes(x = cut, y = carat, fill = clarity)) +
 #'   geom_boxplot(outlier.size = 0) +
 #'   geom_point(pch = 21, position = position_jitterdodge())
+#'
+#' # Additional discrete aesthetics like colour no longer misalign
+#' # points with boxes — dodge grouping is inferred from fill:
+#' \donttest{
+#' set.seed(596)
+#' df <- data.frame(
+#'   x = rep(c("A", "B"), each = 20),
+#'   y = rnorm(40),
+#'   fill_var = rep(c("g1", "g2"), 20),
+#'   colour_var = sample(c(TRUE, FALSE), 40, replace = TRUE)
+#' )
+#'
+#' ggplot(df, aes(x, y, fill = fill_var)) +
+#'   geom_boxplot(outlier.shape = NA) +
+#'   geom_point(
+#'     aes(colour = colour_var),
+#'     position = position_jitterdodge()
+#'   )
+#' }
 position_jitterdodge <- function(jitter.width = NULL, jitter.height = 0,
                                  dodge.width = 0.75, reverse = FALSE,
                                  preserve = "total",
@@ -38,6 +68,15 @@ position_jitterdodge <- function(jitter.width = NULL, jitter.height = 0,
   )
 }
 
+# Infer dodge grouping from fill when available, so points align with
+# dodged boxplots even when additional discrete aesthetics are present.
+jitterdodge_dodge_group <- function(data) {
+  if ("fill" %in% names(data) && is_discrete(data[["fill"]])) {
+    return(id(data["fill"], drop = TRUE))
+  }
+  data$group
+}
+
 #' @rdname Position
 #' @format NULL
 #' @usage NULL
@@ -57,10 +96,14 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
     data <- flip_data(data, flipped_aes)
     width <- self$jitter.width %||% (resolution(data$x, zero = FALSE, TRUE) * 0.4)
 
+    dodge_group <- jitterdodge_dodge_group(data)
+
     if (identical(self$preserve, "total")) {
       n <- NULL
     } else {
-      n <- vec_unique(data[c("group", "PANEL", "x")])
+      dodge_data <- data
+      dodge_data$group <- dodge_group
+      n <- vec_unique(dodge_data[c("group", "PANEL", "x")])
       n <- vec_group_id(n[c("PANEL", "x")])
       n <- max(tabulate(n, attr(n, "n")))
     }
@@ -77,11 +120,17 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
   },
 
   setup_data = function(self, data, params) {
-    PositionDodge$setup_data(data = data, params = params)
+    original_group <- data$group
+    data$group <- jitterdodge_dodge_group(data)
+    data <- PositionDodge$setup_data(data = data, params = params)
+    data$group <- original_group
+    data
   },
 
   compute_panel = function(data, params, scales) {
     data <- flip_data(data, params$flipped_aes)
+    original_group <- data$group
+    data$group <- jitterdodge_dodge_group(data)
     data <- collide(
       data,
       params$dodge.width,
@@ -91,6 +140,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
       check.width = FALSE,
       reverse = !params$reverse # for consistency with `position_dodge2()`
     )
+    data$group <- original_group
     data <- flip_data(data, params$flipped_aes)
     compute_jitter(data, params$jitter.width, params$jitter.height, params$seed)
   }

tests/testthat/test-position-jitterdodge.R

@@ -30,3 +30,74 @@ test_that("position_jitterdodge can preserve total or single width", {
     ))
   expect_equal(get_layer_data(p)$x, new_mapped_discrete(c(0.75, 1.75, 2.25)))
 })
+
+test_that("position_jitterdodge aligns with boxplot when extra colour present", {
+  df <- data_frame(
+    x    = rep(c("a", "b"), each = 4),
+    y    = 1:8,
+    fill = rep(c("f1", "f2"), 4),
+    col  = rep(c("c1", "c2"), each = 4)
+  )
+
+  p <- ggplot(df, aes(x, y, fill = fill)) +
+    geom_boxplot(width = 0.75) +
+    geom_point(
+      aes(colour = col),
+      position = position_jitterdodge(
+        jitter.width = 0, jitter.height = 0, dodge.width = 0.75
+      )
+    )
+
+  box_data <- get_layer_data(p, 1)
+  point_data <- get_layer_data(p, 2)
+
+  # With zero jitter, point x positions should exactly match box centers
+  box_centers <- sort(unique(as.numeric(box_data$x)))
+  point_xs    <- sort(unique(as.numeric(point_data$x)))
+  expect_equal(point_xs, box_centers)
+})
+
+test_that("position_jitterdodge is unchanged when fill is only discrete aes", {
+  df <- data_frame(
+    x    = rep(c("a", "b"), each = 4),
+    y    = 1:8,
+    fill = rep(c("f1", "f2"), 4)
+  )
+
+  p <- ggplot(df, aes(x, y, fill = fill)) +
+    geom_point(position = position_jitterdodge(
+      jitter.width = 0, jitter.height = 0
+    ))
+
+  ld <- get_layer_data(p)
+  expect_true(all(!is.na(ld$x)))
+  # Two fill groups per x-category should produce 4 distinct x positions total
+  expect_equal(length(unique(as.numeric(ld$x))), 4)
+})
+
+test_that("position_jitterdodge falls back to group when no fill", {
+  df <- data_frame(x = c("a", "a"), y = 1:2, g = c("g1", "g2"))
+
+  p <- ggplot(df, aes(x, y, group = g)) +
+    geom_point(position = position_jitterdodge(
+      jitter.width = 0, jitter.height = 0, dodge.width = 1
+    ))
+
+  ld <- get_layer_data(p)
+  expect_equal(length(unique(ld$x)), 2)
+})
+
+test_that("position_jitterdodge ignores continuous fill", {
+  df <- data_frame(
+    x    = c("a", "a"),
+    y    = 1:2,
+    fill = c(0.5, 1.5)
+  )
+
+  p <- ggplot(df, aes(x, y, fill = fill)) +
+    geom_point(position = position_jitterdodge(
+      jitter.width = 0, jitter.height = 0, dodge.width = 1
+    ))
+
+  expect_no_error(get_layer_data(p))
+})