Skip alignment/stacking when possible (#5789)

* skip alignment if there is just one group

* add extra group to test

* skip stacking if every x position is unique

* add news bullets

Author: teunbrand

NEWS.md

@@ -49,6 +49,10 @@
   per layer (@teunbrand, #5740).
 * 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
+  alignment is not necessary (#5788).
+* `position_stack()` skips computation when all `x` values are unique and 
+  therefore stacking is not necessary (#5788).
 
 # ggplot2 3.5.1
 

R/position-stack.R

@@ -187,6 +187,10 @@ PositionStack <- ggproto("PositionStack", Position,
     if (is.null(params$var)) {
       return(data)
     }
+    if (!vec_duplicate_any(data$x)) {
+      # Every x is unique, nothing to stack here
+      return(flip_data(data, params$flipped_aes))
+    }
 
     negative <- data$ymax < 0
     negative[is.na(negative)] <- FALSE

R/stat-align.R

@@ -40,22 +40,19 @@ StatAlign <- ggproto("StatAlign", Stat,
     if (empty(data)) {
       return(data_frame0())
     }
-
+    if (is_unique(data$group)) {
+      return(data)
+    }
     names <- flipped_names(flipped_aes)
     x <- data[[names$x]]
     y <- data[[names$y]]
 
-    if (is_unique(data$group)) {
-      # No need for interpolation
-      cross <- x[0]
-    } else {
-      # Find positions where 0 is crossed
-      pivot <- vec_unrep(data_frame0(group = data$group, y = y < 0))
-      group_ends <- cumsum(vec_unrep(pivot$key$group)$times)
-      pivot <- cumsum(pivot$times)[-group_ends]
-      cross <- -y[pivot] * (x[pivot + 1] - x[pivot]) /
-        (y[pivot + 1] - y[pivot]) + x[pivot]
-    }
+    # Find positions where 0 is crossed
+    pivot <- vec_unrep(data_frame0(group = data$group, y = y < 0))
+    group_ends <- cumsum(vec_unrep(pivot$key$group)$times)
+    pivot <- cumsum(pivot$times)[-group_ends]
+    cross <- -y[pivot] * (x[pivot + 1] - x[pivot]) /
+      (y[pivot + 1] - y[pivot]) + x[pivot]
 
     unique_loc <- unique(sort(c(x, cross)))
     adjust     <- diff(range(unique_loc, na.rm = TRUE)) * 0.001

tests/testthat/test-stat-align.R

@@ -48,19 +48,20 @@ test_that("alignment adjusts per panel", {
   # data into account (#5227)
 
   df <- data_frame0(
-    x = c(0, 1, 1000, 1001),
-    y = c(-1, 1, -1, 1),
-    g = c("A", "A", "B", "B")
+    x = c(0, 1, 1000, 1001, 0, 1, 1000, 1001),
+    y = c(-1, 1, -1, 1, -1, 1, -1, 1),
+    f = c("A", "A", "B", "B", "A", "A", "B", "B"),
+    g = c("a", "a", "b", "b", "c", "c", "d", "d")
   )
-  p <- ggplot(df, aes(x, y))
+  p <- ggplot(df, aes(x, y, group = g))
 
   # Here, x-range is large, so adjustment should be larger
-  ld <- layer_data(p + geom_area(aes(fill = g)))
+  ld <- layer_data(p + geom_area(aes(fill = f)))
   expect_equal(diff(ld$x[1:2]), 1/6, tolerance = 1e-4)
 
   # Here, x-ranges are smaller, so adjustment should be smaller instead of
   # considering the data as a whole
-  ld <- layer_data(p + geom_area() + facet_wrap(vars(g), scales = "free_x"))
+  ld <- layer_data(p + geom_area() + facet_wrap(vars(f), scales = "free_x"))
   expect_equal(diff(ld$x[1:2]), 1e-3, tolerance = 1e-4)
 
 })