From 110d43e13f55d25ddd30b33cf8ff619f4596d309 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 14 Feb 2025 15:15:59 +0100 Subject: [PATCH 1/6] add helper --- R/geom-curve.R | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/R/geom-curve.R b/R/geom-curve.R index e1c38d1cd4..f9e1fc327a 100644 --- a/R/geom-curve.R +++ b/R/geom-curve.R @@ -79,3 +79,41 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, ) } ) + +# Helper function for swapping segment ends to keep curvature consistent over +# transformations +flip_segment <- 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 +} From 82d851bd143a720d8c897bfde666e18d371e22c0 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 14 Feb 2025 15:16:27 +0100 Subject: [PATCH 2/6] swap starts/ends when flipping --- R/geom-curve.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/geom-curve.R b/R/geom-curve.R index f9e1fc327a..1bb76aedc6 100644 --- a/R/geom-curve.R +++ b/R/geom-curve.R @@ -62,6 +62,11 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, trans <- coord$transform(data, panel_params) + flip <- flip_segment(trans, coord, panel_params) + if (flip) { + trans <- rename(trans, c(x = "xend", xend = "x", y = "yend", yend = "y")) + } + arrow.fill <- arrow.fill %||% trans$colour curveGrob( From 392e9a7c2646f8e770e2777cb1ef733d06fcf47e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 14 Feb 2025 15:21:27 +0100 Subject: [PATCH 3/6] flip arrows too --- R/geom-curve.R | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/R/geom-curve.R b/R/geom-curve.R index 1bb76aedc6..122a918707 100644 --- a/R/geom-curve.R +++ b/R/geom-curve.R @@ -62,9 +62,16 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, trans <- coord$transform(data, panel_params) - flip <- flip_segment(trans, coord, 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 + last_end <- arrow$ends == 2L + first_end <- arrow$ends == 1L + arrow$ends[last_end] <- 1L + arrow$ends[first_end] <- 2L + } } arrow.fill <- arrow.fill %||% trans$colour @@ -85,9 +92,9 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, } ) -# Helper function for swapping segment ends to keep curvature consistent over -# transformations -flip_segment <- function(data, coord, params) { +# 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 From db4a5f3a8f54678b44b7dadd5eb00664e8a916c5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 14 Feb 2025 15:42:58 +0100 Subject: [PATCH 4/6] simplify arrow flipping --- R/geom-curve.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/R/geom-curve.R b/R/geom-curve.R index 122a918707..2879fa51b0 100644 --- a/R/geom-curve.R +++ b/R/geom-curve.R @@ -66,11 +66,8 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, if (flip) { trans <- rename(trans, c(x = "xend", xend = "x", y = "yend", yend = "y")) if (!is.null(arrow)) { - # Flip end where arrow appears - last_end <- arrow$ends == 2L - first_end <- arrow$ends == 1L - arrow$ends[last_end] <- 1L - arrow$ends[first_end] <- 2L + # Flip end where arrow appears (2 = last, 1 = first, 3 = both) + arrow$ends <- match(arrow$ends, c(2, 1, 3)) } } From c37f789b969eb1d248977634fbaa6b85d2f97568 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 14 Feb 2025 15:45:46 +0100 Subject: [PATCH 5/6] add visual tests --- .../_snaps/geom-curve/flipped-geom-curve.svg | 61 +++++++++++++++++++ .../_snaps/geom-curve/standard-geom-curve.svg | 61 +++++++++++++++++++ tests/testthat/test-geom-curve.R | 11 ++++ 3 files changed, 133 insertions(+) create mode 100644 tests/testthat/_snaps/geom-curve/flipped-geom-curve.svg create mode 100644 tests/testthat/_snaps/geom-curve/standard-geom-curve.svg create mode 100644 tests/testthat/test-geom-curve.R 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.00 +1.25 +1.50 +1.75 +2.00 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y +flipped geom_curve + + 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.00 +1.25 +1.50 +1.75 +2.00 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y +standard geom_curve + + 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()) + +}) From 12de161d103f6b30b8aa9da5034698daad317617 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 14 Feb 2025 15:45:54 +0100 Subject: [PATCH 6/6] add news bullet --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 74b049ace5..fb3248c6d3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Improved consistency of curve direction in `geom_curve()` (@teunbrand, #5069) * New parameters for `geom_label()` (@teunbrand and @steveharoz, #5365): * The `linewidth` aesthetic is now applied and replaces the `label.size` argument.