Flip geom_curve() direction in some circumstances (#6332)

* add helper

* swap starts/ends when flipping

* flip arrows too

* simplify arrow flipping

* add visual tests

* add news bullet

Author: teunbrand

NEWS.md

@@ -329,6 +329,7 @@
   to retrieve the class via constructor functions (@teunbrand).
 * (internal) The ViewScale class has a `make_fixed_copy()` method to permit 
   copying trained position scales (#3441).
+* Improved consistency of curve direction in `geom_curve()` (@teunbrand, #5069)
 
 # ggplot2 3.5.1
 

R/geom-curve.R

@@ -55,6 +55,15 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment,
 
     trans <- coord$transform(data, panel_params)
 
+    flip <- flip_curve(trans, coord, panel_params)
+    if (flip) {
+      trans <- rename(trans, c(x = "xend", xend = "x", y = "yend", yend = "y"))
+      if (!is.null(arrow)) {
+        # Flip end where arrow appears (2 = last, 1 = first, 3 = both)
+        arrow$ends <- match(arrow$ends, c(2, 1, 3))
+      }
+    }
+
     arrow.fill <- arrow.fill %||% trans$colour
 
     curveGrob(
@@ -72,3 +81,41 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment,
     )
   }
 )
+
+# Helper function for determining whether curves should swap segment ends to
+# keep curvature consistent over transformations
+flip_curve <- function(data, coord, params) {
+  flip <- FALSE
+
+  # Figure implicit flipping transformations in coords
+  if (inherits(coord, "CoordFlip")) {
+    flip <- !flip
+  } else if (inherits(coord, "CoordTrans")) {
+    if (identical(coord$trans$x$name, "reverse")) {
+      flip <- !flip
+    }
+    if (identical(coord$trans$y$name, "reverse")) {
+      flip <- !flip
+    }
+  }
+
+  # We don't flip when none or both directions are reversed
+  if ((coord$reverse %||% "none") %in% c("x", "y")) {
+    flip <- !flip
+  }
+
+  # Check scales for reverse transforms
+  # Note that polar coords do not have x/y scales, but these are unsupported
+  # anyway
+  fn <- params$x$get_transformation
+  if (is.function(fn) && identical(fn()$name, "reverse")) {
+    flip <- !flip
+  }
+
+  fn <- params$y$get_transformation
+  if (is.function(fn) && identical(fn()$name, "reverse")) {
+    flip <- !flip
+  }
+
+  flip
+}

tests/testthat/_snaps/geom-curve/flipped-geom-curve.svg

@@ -0,0 +1,11 @@
+test_that("geom_curve flipping works", {
+
+  df <- data.frame(x = c(1, 2), xend = c(2, 3), y = 1, yend = c(2, 1.5))
+
+  p <- ggplot(df, aes(x, y, xend = xend, yend = yend)) +
+    geom_curve(arrow = arrow())
+
+  expect_doppelganger("standard geom_curve", p)
+  expect_doppelganger("flipped geom_curve", p + scale_y_reverse())
+
+})