Compute jitter width by panel (#6330)

* isolate jitter functionality

* postpone invoking resolution

* add test

* append to related news bullet

Author: teunbrand

NEWS.md

@@ -249,8 +249,8 @@
   and (non-text) margins inherit from (@teunbrand, #5622).
 * `geom_ribbon()` can have varying `fill` or `alpha` in linear coordinate
   systems (@teunbrand, #4690).
-* `geom_tile()` computes default widths and heights per panel instead of
-  per layer (@teunbrand, #5740).
+* `geom_tile()` and `position_jitter()` computes default widths and heights 
+  per panel instead of per layer (@teunbrand, #5740, #3722).
 * The `fill` of the `panel.border` theme setting is ignored and forced to be
   transparent (#5782).
 * `stat_align()` skips computation when there is only 1 group and therefore

R/position-jitter.R

@@ -68,30 +68,39 @@ PositionJitter <- ggproto("PositionJitter", Position,
       seed <- self$seed
     }
     list(
-      width = self$width %||% (resolution(data$x, zero = FALSE, TRUE) * 0.4),
-      height = self$height %||% (resolution(data$y, zero = FALSE, TRUE) * 0.4),
+      width = self$width,
+      height = self$height,
       seed = seed
     )
   },
 
-  compute_layer = function(self, data, params, layout) {
-    trans_x <- if (params$width > 0) function(x) jitter(x, amount = params$width)
-    trans_y <- if (params$height > 0) function(x) jitter(x, amount = params$height)
-
-    # Make sure x and y jitter is only calculated once for all position aesthetics
-    x_aes <- intersect(ggplot_global$x_aes, names(data))
-    x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]]
-    y_aes <- intersect(ggplot_global$y_aes, names(data))
-    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
-    # Avoid nan values, if x or y has Inf values
-    x_jit[is.infinite(x)] <- 0
-    y_jit[is.infinite(y)] <- 0
-
-    # Apply jitter
-    transform_position(data, function(x) x + x_jit, function(x) x + y_jit)
+  compute_panel = function(self, data, params, scales) {
+    compute_jitter(data, params$width, params$height, seed = params$seed)
   }
 )
+
+compute_jitter <- function(data, width = NULL, height = NULL, seed = NA) {
+
+  width  <- width  %||% (resolution(data$x, zero = FALSE, TRUE) * 0.4)
+  height <- height %||% (resolution(data$y, zero = FALSE, TRUE) * 0.4)
+
+  trans_x <- if (width > 0)  function(x) jitter(x, amount = width)
+  trans_y <- if (height > 0) function(x) jitter(x, amount = height)
+
+  x_aes <- intersect(ggplot_global$x_aes, names(data))
+  x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]]
+
+  y_aes <- intersect(ggplot_global$y_aes, names(data))
+  y <- if (length(y_aes) == 0) 0 else data[[y_aes[1]]]
+
+  jitter <- data_frame0(x = x, y = y, .size = nrow(data))
+  jitter <- with_seed_null(seed, transform_position(jitter, trans_x, trans_y))
+
+  x_jit <- jitter$x - x
+  x_jit[is.infinite(x)] <- 0
+
+  y_jit <- jitter$y - y
+  y_jit[is.infinite(y)] <- 0
+
+  transform_position(data, function(x) x + x_jit, function(x) x + y_jit)
+}

R/position-jitterdodge.R

@@ -77,22 +77,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
       check.width = FALSE,
       reverse = !params$reverse # for consistency with `position_dodge2()`
     )
-
-    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)
-
-    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)
+    data <- compute_jitter(data, params$jitter.width, params$jitter.height, params$seed)
     flip_data(data, params$flipped_aes)
   }
 )

tests/testthat/test-position-jitter.R

@@ -0,0 +1,15 @@
+test_that("automatic jitter width considers panels", {
+
+  df <- data.frame(x = c(1, 2, 100, 200), f = c("A", "A", "B", "B"))
+
+  auto  <- position_jitter(seed = 0)
+  fixed <- position_jitter(seed = 0, width = 0.5)
+
+  p <- ggplot(df, aes(x, 1)) + facet_wrap(vars(f))
+
+  fixed <- layer_data(p + geom_point(position = fixed))$x - df$x
+  auto  <- layer_data(p + geom_point(position = auto))$x - df$x
+
+  # Magic number 0.4 comes from default resolution multiplier
+  expect_equal(fixed / 0.5, auto / c(0.4, 0.4, 40, 40))
+})