Make nudging more robust (#2874)

* make nudging more robust. closes #2733.

* add regression tests for position_nudge()

* simplify position_nudge, remove required aesthetics

Author: clauswilke

NEWS.md

@@ -56,6 +56,10 @@
 *   `labs()` now has named arguments `title`, `subtitle`, `caption`, and `tag`.
     Also, `labs()` now accepts tidyeval (@yutannihilation, #2669).
 
+*   `position_nudge()` is now more robust and nudges only in the direction
+    requested. This enables, for example, the horizontal nudging of boxplots
+    (@clauswilke, #2733).
+
 # ggplot2 3.0.0
 
 ## Breaking changes

R/position-nudge.R

@@ -41,13 +41,22 @@ PositionNudge <- ggproto("PositionNudge", Position,
   x = 0,
   y = 0,
 
-  required_aes = c("x", "y"),
-
   setup_params = function(self, data) {
     list(x = self$x, y = self$y)
   },
 
   compute_layer = function(data, params, panel) {
-    transform_position(data, function(x) x + params$x, function(y) y + params$y)
+    # transform only the dimensions for which non-zero nudging is requested
+    if (params$x != 0) {
+      if (params$y != 0) {
+        transform_position(data, function(x) x + params$x, function(y) y + params$y)
+      } else {
+        transform_position(data, function(x) x + params$x, NULL)
+      }
+    } else if (params$y != 0) {
+      transform_position(data, NULL, function(y) y + params$y)
+    } else {
+      data # if both x and y are 0 we don't need to transform
+    }
   }
 )

tests/testthat/test-position-nudge.R

@@ -0,0 +1,43 @@
+context("position_nudge")
+
+test_that("nudging works in both dimensions simultaneously", {
+  df <- data.frame(x = 1:3)
+
+  p <- ggplot(df, aes(x, x, xmax = x, xmin = x, ymax = x, ymin = x)) +
+    geom_point(position = position_nudge(x = 1, y = 2))
+
+  data <- layer_data(p)
+
+  expect_equal(data$x, 2:4)
+  expect_equal(data$xmin, 2:4)
+  expect_equal(data$xmax, 2:4)
+  expect_equal(data$y, 3:5)
+  expect_equal(data$ymin, 3:5)
+  expect_equal(data$ymax, 3:5)
+})
+
+test_that("nudging works in individual dimensions", {
+  df <- data.frame(x = 1:3)
+
+  # nudging in x
+  # use an empty layer so can test individual aesthetics
+  p <- ggplot(df, aes(x = x, xmax = x, xmin = x)) +
+    layer(geom = Geom, stat = StatIdentity, position = position_nudge(x = 1))
+
+  data <- layer_data(p)
+
+  expect_equal(data$x, 2:4)
+  expect_equal(data$xmin, 2:4)
+  expect_equal(data$xmax, 2:4)
+
+  # nudging in y
+  # use an empty layer so can test individual aesthetics
+  p <- ggplot(df, aes(y = x, ymax = x, ymin = x)) +
+    layer(geom = Geom, stat = StatIdentity, position = position_nudge(y = 2))
+
+  data <- layer_data(p)
+
+  expect_equal(data$y, 3:5)
+  expect_equal(data$ymin, 3:5)
+  expect_equal(data$ymax, 3:5)
+})