Dodge stack for ggplot

R/position-dodge.R

@@ -18,6 +18,10 @@
 #'    (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.
+#' @param stack.overlap Specifies if and how to stack the dodged geoms. Possible
+#' values are `"no"` (default), `"by_extent"` or `"by_center"`. This parameter
+#' implements the dodge and stack functionality together. Use `"by_extent"` for 
+#' columns and `"by_center"` for errorbars.
 #' @family position adjustments
 #' @eval rd_aesthetics("position", "dodge")
 #'
@@ -87,12 +91,13 @@
 #' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) +
 #'   geom_bar(position = position_dodge2(preserve = "total"))
 position_dodge <- function(width = NULL, preserve = "total", orientation = "x",
-                           reverse = FALSE) {
+                           reverse = FALSE, stack.overlap = "no") {
   check_bool(reverse)
   ggproto(NULL, PositionDodge,
     width = width,
     preserve = arg_match0(preserve, c("total", "single")),
     orientation = arg_match0(orientation, c("x", "y")),
+    stack.overlap = arg_match0(stack.overlap, c("no","by_extent","by_center")),
     reverse = reverse
   )
 }
@@ -104,6 +109,7 @@
 PositionDodge <- ggproto("PositionDodge", Position,
   width = NULL,
   preserve = "total",
+  stack.overlap = "no",
   orientation = "x",
   reverse = NULL,
   default_aes = aes(order = NULL),
@@ -136,6 +142,7 @@
 
     list(
       width = self$width,
+      stack.overlap = self$stack.overlap,
       n = n,
       flipped_aes = flipped_aes,
       reverse = self$reverse %||% FALSE
@@ -172,6 +179,7 @@
       strategy = pos_dodge,
       n = params$n,
       check.width = FALSE,
+      stack.overlap = params$stack.overlap,
       reverse = !params$reverse # for consistency with `position_dodge2()`
     )
     flip_data(collided, params$flipped_aes)
@@ -180,13 +188,14 @@
 
 # Dodge overlapping interval.
 # Assumes that each set has the same horizontal position.
-pos_dodge <- function(df, width, n = NULL) {
+pos_dodge <- function(df, width, n = NULL, stack.overlap = "no") {
   if (is.null(n)) {
     n <- vec_unique_count(df$group)
   }
 
-  if (n == 1)
-    return(df)
+  # even if it's a single group we might need to dodge stack
+  #if (n == 1)
+  #  return(df) 
 
   if (!all(c("xmin", "xmax") %in% names(df))) {
     df$xmin <- df$x
@@ -203,6 +212,40 @@
   df$x <- df$x + width * ((groupidx - 0.5) / n - 0.5)
   df$xmin <- df$x - d_width / n / 2
   df$xmax <- df$x + d_width / n / 2
+
+  if (stack.overlap == "by_extent") {
+    # The code chunk below is just to implement the following line without tidyverse functions, as ggplot2 can be imported without that
+    # df %>% group_by(group) %>% mutate(ymaxx = cumsum(ymax)) %>% mutate(ymin = ymaxx-ymax, ymax = ymaxx)
+
+    df$ymaxx = NA # Initialize the variable. This will store the desired top of the group
+    group_ids = unique(df$group) # Collect the unique groupIDs. Thi
+    for (gid in group_ids) {
+      df$ymaxx[df$group == gid] = cumsum(df$ymax[df$group == gid])
+    }
+    # Create the new y placements
+    df$ymin = df$ymaxx-df$ymax
+    df$ymax = df$ymaxx
+
+    df$ymaxx = NULL # Remove the extra variable
+
+  } else if (stack.overlap == "by_center") {
+    # Similarly to above, the complicated code below is just to do the next line without tidyverse
+    # df %>% group_by(group) %>% mutate(extent = ymax-ymin, ymaxx = cumsum((ymax+ymin)/2)) %>% mutate(ymin = ymaxx-extent/2, ymax = ymaxx+extent/2)
+
+    df$ymaxx = NA # Initialize the variable. This will store the desired top of the group
+    df$extent = NA # Initialize the variable storing the extent of the geom
+    group_ids = unique(df$group) # Collect the unique groupIDs. Thi
+    for (gid in group_ids) {
+      df$ymaxx[df$group == gid] = cumsum((df$ymax[df$group == gid] + df$ymin[df$group == gid])/2)
+    }
+    df$extent = df$ymax - df$ymin
+    # Create the new y placements
+    df$ymin = df$ymaxx-df$extent/2
+    df$ymax = df$ymaxx+df$extent/2
+
+    df$ymaxx = NULL # Remove the extra variable
+    df$extent = NULL # Remove the extra variable
+  }
 
   df
 }