Apply jitter in position_jitterdodge() once (#5819)

* Follow #4403

* add test

* add news bullet

NEWS.md

@@ -79,6 +79,8 @@
  returns input unaltered (@teunbrand, #5800).
 * `width` is implemented as aesthetic instead of parameter in `geom_col()` and
  `geom_bar()` (#3142).
+* Fix a bug in `position_jitterdodge()` where different jitters would be applied
+ to different position aesthetics of the same axis (@teunbrand, #5818).
 
 # ggplot2 3.5.1
 

R/position-jitterdodge.R

@@ -76,7 +76,18 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
  trans_x <- if (params$jitter.width > 0) function(x) jitter(x, amount = params$jitter.width)
  trans_y <- if (params$jitter.height > 0) function(x) jitter(x, amount = params$jitter.height)
 
- data <- with_seed_null(params$seed, transform_position(data, trans_x, trans_y))
+ x_aes <- intersect(ggplot_global$x_aes, names(data))
+ y_aes <- intersect(ggplot_global$y_aes, names(data))
+
+ x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]]
+ y <- if (length(y_aes) == 0) 0 else data[[y_aes[1]]]
+ dummy_data <- data_frame0(x = x, y = y, .size = nrow(data))
+
+ fixed_jitter <- with_seed_null(params$seed, transform_position(dummy_data, trans_x, trans_y))
+ x_jit <- fixed_jitter$x - x
+ y_jit <- fixed_jitter$y - y
+
+ data <- transform_position(data, function(x) x + x_jit, function(x) x + y_jit)
  flip_data(data, params$flipped_aes)
  }
 )

tests/testthat/test-position-jitterdodge.R

@@ -2,3 +2,15 @@ test_that("position_jitterdodge() fails with meaningful error", {
  p <- ggplot(mtcars) + geom_point(aes(disp, mpg), position = 'jitterdodge')
  expect_snapshot_error(ggplot_build(p))
 })
+
+test_that("position_jitterdodge preserves widths", {
+ ld <- layer_data(
+ ggplot(mtcars, aes(factor(cyl), fill = factor(am))) +
+ geom_bar(position = position_jitterdodge())
+ )
+
+ expect_equal(
+ as.numeric(ld$xmax - ld$xmin),
+ rep(0.45, nrow(ld))
+ )
+})