Calculate stat_align() per panel (#5239)

* Apply alignment panel-wise instead of globally

* Add NEWS bullets

* Add unit test

Author: teunbrand

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `stat_align()` is now applied per panel instead of globally, preventing issues
+  when facets have different ranges (@teunbrand, #5227).
+* A stacking bug in `stat_align()` was fixed (@teunbrand, #5176).
 * `stat_contour()` and `stat_contour_filled()` now warn about and remove
   duplicated coordinates (@teunbrand, #5215).
 * `annotation_logticks()` skips drawing ticks when the scale range is non-finite

R/stat-align.R

@@ -33,27 +33,43 @@ StatAlign <- ggproto("StatAlign", Stat,
 
   setup_params = function(data, params) {
     params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE)
-    x_name <- flipped_names(params$flipped_aes)$x
-    y_name <- flipped_names(params$flipped_aes)$y
-    x_cross <- dapply(data, "group", function(d) {
-      pivots <- cumsum(rle(d[[y_name]] < 0)$lengths)
-      pivots <- pivots[-length(pivots)]
-      cross <- vapply(pivots, function(i) {
-        y <- d[[y_name]][c(i, i+1)]
-        x <- d[[x_name]][c(i, i+1)]
-        -y[1]*diff(x)/diff(y) + x[1]
-      }, numeric(1))
-      data_frame(cross = cross)
-    })
-    unique_loc <- unique(sort(c(data[[x_name]], x_cross$cross)))
-    adjust <- diff(range(unique_loc, na.rm = TRUE)) * 0.001
-    adjust <- min(adjust, min(diff(unique_loc))/3)
-    unique_loc <- sort(c(unique_loc - adjust, unique_loc, unique_loc + adjust))
-    params$unique_loc <- unique_loc
-    params$adjust <- adjust
     params
   },
 
+  compute_panel = function(self, data, scales, flipped_aes, ...) {
+    if (empty(data)) {
+      return(data_frame0())
+    }
+
+    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]
+    }
+
+    unique_loc <- unique(sort(c(x, cross)))
+    adjust     <- diff(range(unique_loc, na.rm = TRUE)) * 0.001
+    adjust     <- min(adjust, min(diff(unique_loc)) / 3)
+    unique_loc <- unique(sort(c(
+      unique_loc - adjust, unique_loc, unique_loc + adjust
+    )))
+
+    ggproto_parent(Stat, self)$compute_panel(
+      data, scales, flipped_aes = flipped_aes, unique_loc = unique_loc,
+      adjust = adjust, ...
+    )
+  },
+
   compute_group = function(data, scales, flipped_aes = NA, unique_loc = NULL, adjust = 0) {
     data <- flip_data(data, flipped_aes)
     if (is_unique(data$x)) {

tests/testthat/test-stat-align.R

@@ -42,3 +42,25 @@ test_that("alignment with negative and positive values works", {
   p <- ggplot(df, aes(x, y, fill = g)) + geom_area(color = "black")
   expect_doppelganger("align two areas with pos/neg y", p)
 })
+
+test_that("alignment adjusts per panel", {
+  # In particular, the adjustment (small offset used) should take panel-wise
+  # 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")
+  )
+  p <- ggplot(df, aes(x, y))
+
+  # Here, x-range is large, so adjustment should be larger
+  ld <- layer_data(p + geom_area(aes(fill = g)))
+  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"))
+  expect_equal(diff(ld$x[1:2]), 1e-3, tolerance = 1e-4)
+
+})