diff --git a/NEWS.md b/NEWS.md
index b70816fd1f..ed626079f8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -327,6 +327,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
diff --git a/R/geom-curve.R b/R/geom-curve.R
index 23b2e551ed..6d6ec0027d 100644
--- a/R/geom-curve.R
+++ b/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
+}
diff --git a/tests/testthat/_snaps/geom-curve/flipped-geom-curve.svg b/tests/testthat/_snaps/geom-curve/flipped-geom-curve.svg
new file mode 100644
index 0000000000..0a82d0b2af
--- /dev/null
+++ b/tests/testthat/_snaps/geom-curve/flipped-geom-curve.svg
@@ -0,0 +1,61 @@
+
+
diff --git a/tests/testthat/_snaps/geom-curve/standard-geom-curve.svg b/tests/testthat/_snaps/geom-curve/standard-geom-curve.svg
new file mode 100644
index 0000000000..645b025c9d
--- /dev/null
+++ b/tests/testthat/_snaps/geom-curve/standard-geom-curve.svg
@@ -0,0 +1,61 @@
+
+
diff --git a/tests/testthat/test-geom-curve.R b/tests/testthat/test-geom-curve.R
new file mode 100644
index 0000000000..05f959916e
--- /dev/null
+++ b/tests/testthat/test-geom-curve.R
@@ -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())
+
+})