Reverse dodging (#5923)

* `reverse` plumbing for `position_dodge()

* `reverse` plumbing in `position_jitterdodge()`

* do not internally sort groups in `position_dodge()`

* add test

* add news bullet

* Align interpretation with `position_dodge2()`

* document

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `position_dodge()` and `position_jitterdodge()` now have a `reverse` argument 
+  (@teunbrand, #3610)
 * `coord_radial(r.axis.inside)` can now take a numeric value to control 
   placement of internally placed radius axes (@teunbrand, #5805).
 * (internal) default labels are derived in `ggplot_build()` rather than

R/position-dodge.R

@@ -16,6 +16,8 @@
 #' @param orientation Fallback orientation when the layer or the data does not
 #'    indicate an explicit orientation, like `geom_point()`. Can be `"x"`
 #'    (default) or `"y"`.
+#' @param reverse If `TRUE`, will reverse the default stacking order.
+#'   This is useful if you're rotating both the plot and legend.
 #' @family position adjustments
 #' @export
 #' @examples
@@ -82,11 +84,14 @@
 #'
 #' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
 #'   geom_bar(position = position_dodge2(preserve = "total"))
-position_dodge <- function(width = NULL, preserve = "total", orientation = "x") {
+position_dodge <- function(width = NULL, preserve = "total", orientation = "x",
+                           reverse = FALSE) {
+  check_bool(reverse)
   ggproto(NULL, PositionDodge,
     width = width,
     preserve = arg_match0(preserve, c("total", "single")),
-    orientation = arg_match0(orientation, c("x", "y"))
+    orientation = arg_match0(orientation, c("x", "y")),
+    reverse = reverse
   )
 }
 
@@ -98,6 +103,7 @@ PositionDodge <- ggproto("PositionDodge", Position,
   width = NULL,
   preserve = "total",
   orientation = "x",
+  reverse = NULL,
   setup_params = function(self, data) {
     flipped_aes <- has_flipped_aes(data, default = self$orientation == "y")
     data <- flip_data(data, flipped_aes)
@@ -119,7 +125,8 @@ PositionDodge <- ggproto("PositionDodge", Position,
     list(
       width = self$width,
       n = n,
-      flipped_aes = flipped_aes
+      flipped_aes = flipped_aes,
+      reverse = self$reverse %||% FALSE
     )
   },
 
@@ -139,7 +146,8 @@ PositionDodge <- ggproto("PositionDodge", Position,
       name = "position_dodge",
       strategy = pos_dodge,
       n = params$n,
-      check.width = FALSE
+      check.width = FALSE,
+      reverse = !params$reverse # for consistency with `position_dodge2()`
     )
     flip_data(collided, params$flipped_aes)
   }
@@ -164,7 +172,7 @@ pos_dodge <- function(df, width, n = NULL) {
 
   # Have a new group index from 1 to number of groups.
   # This might be needed if the group numbers in this set don't include all of 1:n
-  groupidx <- match(df$group, sort(unique0(df$group)))
+  groupidx <- match(df$group, unique0(df$group))
 
   # Find the center for each group, then use that to calculate xmin and xmax
   df$x <- df$x + width * ((groupidx - 0.5) / n - .5)

R/position-dodge2.R

@@ -2,8 +2,6 @@
 #' @rdname position_dodge
 #' @param padding Padding between elements at the same position. Elements are
 #'   shrunk by this proportion to allow space between them. Defaults to 0.1.
-#' @param reverse If `TRUE`, will reverse the default stacking order.
-#'   This is useful if you're rotating both the plot and legend.
 position_dodge2 <- function(width = NULL, preserve = "total",
                             padding = 0.1, reverse = FALSE) {
   ggproto(NULL, PositionDodge2,

R/position-jitterdodge.R

@@ -11,6 +11,7 @@
 #' @param dodge.width the amount to dodge in the x direction. Defaults to 0.75,
 #'   the default `position_dodge()` width.
 #' @inheritParams position_jitter
+#' @inheritParams position_dodge
 #' @export
 #' @examples
 #' set.seed(596)
@@ -19,15 +20,18 @@
 #'   geom_boxplot(outlier.size = 0) +
 #'   geom_point(pch = 21, position = position_jitterdodge())
 position_jitterdodge <- function(jitter.width = NULL, jitter.height = 0,
-                                 dodge.width = 0.75, seed = NA) {
+                                 dodge.width = 0.75, reverse = FALSE,
+                                 seed = NA) {
   if (!is.null(seed) && is.na(seed)) {
     seed <- sample.int(.Machine$integer.max, 1L)
   }
+  check_bool(reverse)
 
   ggproto(NULL, PositionJitterdodge,
     jitter.width = jitter.width,
     jitter.height = jitter.height,
     dodge.width = dodge.width,
+    reverse = reverse,
     seed = seed
   )
 }
@@ -40,6 +44,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
   jitter.width = NULL,
   jitter.height = NULL,
   dodge.width = NULL,
+  reverse = NULL,
 
   required_aes = c("x", "y"),
 
@@ -57,14 +62,21 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
       jitter.height = self$jitter.height %||% 0,
       jitter.width = width / (ndodge + 2),
       seed = self$seed,
-      flipped_aes = flipped_aes
+      flipped_aes = flipped_aes,
+      reverse = self$reverse %||% FALSE
     )
   },
 
   compute_panel = function(data, params, scales) {
     data <- flip_data(data, params$flipped_aes)
-    data <- collide(data, params$dodge.width, "position_jitterdodge", pos_dodge,
-      check.width = FALSE)
+    data <- collide(
+      data,
+      params$dodge.width,
+      "position_jitterdodge",
+      strategy = pos_dodge,
+      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)

man/position_dodge.Rd

@@ -23,3 +23,17 @@ test_that("position_dodge() can dodge points vertically", {
   expect_equal(layer_data(vertical)$y,   c(0.75, 1.25, 1.75, 2.25), ignore_attr = "class")
 
 })
+
+test_that("position_dodge() can reverse the dodge order", {
+
+  df <- data.frame(x = c(1, 2, 2, 3, 3), group = c("A", "A", "B", "B", "C"))
+
+  # Use label as easy to track identifier
+  p <- ggplot(df, aes(x, y = 1, fill = group, label = group))
+
+  ld <- get_layer_data(p + geom_col(position = position_dodge(reverse = TRUE)))
+  expect_equal(ld$label[order(ld$x)], c("A", "B", "A", "C", "B"))
+
+  ld <- get_layer_data(p + geom_col(position = position_dodge(reverse = FALSE)))
+  expect_equal(ld$label[order(ld$x)], c("A", "A", "B", "B", "C"))
+})