From a118bb815e7ff5cda78b0d5728f5f72231fc798f Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:03:54 +0200
Subject: [PATCH 01/10] Helper function for breaks
---
R/coord-sf.R | 36 ++++++++++++++++++++++++++++++++++++
1 file changed, 36 insertions(+)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index 81207f2ce1..509f29c0e9 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -582,6 +582,42 @@ parse_axes_labeling <- function(x) {
list(top = labs[1], right = labs[2], bottom = labs[3], left = labs[4])
}
+# This function does two things differently from standard breaks:
+# 1. It does not resolve `waiver()`, unless `n.breaks` is given. In the case
+# that breaks are `waiver()`, we use the default graticule breaks.
+# 2. It discards non-finite breaks because they are invalid input to the
+# graticule. This may cause atomic `labels` to be out-of-sync.
+sf_breaks <- function(scale_x, scale_y, bbox, crs) {
+
+ x_breaks <- y_breaks <- waiver()
+
+ has_x <- !is.null(scale_x$breaks) || !is.null(scale_x$n.breaks)
+ has_y <- !is.null(scale_y$breaks) || !is.null(sclae_y$n.breaks)
+
+
+ if (has_x || has_y) {
+ if (!is.null(crs)) {
+ if (!is_named(bbox)) {
+ names(bbox) <- c("xmin", "ymin", "xmax", "ymax")
+ }
+ # Convert bounding box to long/lat coordinates
+ bbox <- sf::st_as_sfc(sf::st_bbox(bbox, crs = crs))
+ bbox <- sf::st_bbox(sf::st_transform(bbox, 4326))
+ }
+
+ if (!(is.waive(scale_x$breaks) && is.null(scale_x$n.breaks))) {
+ x_breaks <- scale_x$get_breaks(limits = bbox[c(1, 3)])
+ x_breaks <- len0_null(x_breaks[is.finite(x_breaks)])
+ }
+
+ if (!(is.waive(scale_y$breaks) && is.null(scale_y$n.breaks))) {
+ y_breaks <- scale_y$get_breaks(limits = bbox[c(2, 4)])
+ y_breaks <- len0_null(y_breaks[is.finite(y_breaks)])
+ }
+ }
+
+ list(x = x_breaks, y = y_breaks)
+}
#' ViewScale from graticule
#'
From f070f462645194d7fe3beb4bc07753037e051c2f Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:04:17 +0200
Subject: [PATCH 02/10] Use new breaks
---
R/coord-sf.R | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index 509f29c0e9..384ef184cd 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -222,12 +222,14 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
x_range[2], y_range[2]
)
+ breaks <- sf_breaks(scale_x, scale_y, bbox, params$crs)
+
# Generate graticule and rescale to plot coords
graticule <- sf::st_graticule(
bbox,
crs = params$crs,
- lat = scale_y$breaks %|W|% NULL,
- lon = scale_x$breaks %|W|% NULL,
+ lat = breaks$y %|W|% NULL,
+ lon = breaks$x %|W|% NULL,
datum = self$datum,
ndiscr = self$ndiscr
)
From bc50154fe6365aae93746eaa659848a8de46598e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:04:46 +0200
Subject: [PATCH 03/10] NULL breaks discard gridlines
---
R/coord-sf.R | 7 +++++++
1 file changed, 7 insertions(+)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index 384ef184cd..acb213ea34 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -234,6 +234,13 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
ndiscr = self$ndiscr
)
+ if (is.null(breaks$x)) {
+ graticule <- vec_slice(graticule, graticule$type != "E")
+ }
+ if (is.null(breaks$y)) {
+ graticule <- vec_slice(graticule, graticule$type != "N")
+ }
+
# override graticule labels provided by sf::st_graticule() if necessary
graticule <- self$fixup_graticule_labels(graticule, scale_x, scale_y, params)
From a78fb00c073b3ee7d2c5e77e476eea9f8f368a1a Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:11:49 +0200
Subject: [PATCH 04/10] Fix typo
---
R/coord-sf.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index acb213ea34..bc4a20a714 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -601,7 +601,7 @@ sf_breaks <- function(scale_x, scale_y, bbox, crs) {
x_breaks <- y_breaks <- waiver()
has_x <- !is.null(scale_x$breaks) || !is.null(scale_x$n.breaks)
- has_y <- !is.null(scale_y$breaks) || !is.null(sclae_y$n.breaks)
+ has_y <- !is.null(scale_y$breaks) || !is.null(scale_y$n.breaks)
if (has_x || has_y) {
From 793eb6ef50b06d0b39eaec893fd33b91a1d9c602 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:12:35 +0200
Subject: [PATCH 05/10] Add tests
---
tests/testthat/_snaps/coord_sf/no-breaks.svg | 78 ++++++++++++++++++++
tests/testthat/test-coord_sf.R | 39 ++++++++++
2 files changed, 117 insertions(+)
create mode 100644 tests/testthat/_snaps/coord_sf/no-breaks.svg
diff --git a/tests/testthat/_snaps/coord_sf/no-breaks.svg b/tests/testthat/_snaps/coord_sf/no-breaks.svg
new file mode 100644
index 0000000000..08ce8aa82b
--- /dev/null
+++ b/tests/testthat/_snaps/coord_sf/no-breaks.svg
@@ -0,0 +1,78 @@
+
+
diff --git a/tests/testthat/test-coord_sf.R b/tests/testthat/test-coord_sf.R
index 90fbcb333b..908b655045 100644
--- a/tests/testthat/test-coord_sf.R
+++ b/tests/testthat/test-coord_sf.R
@@ -30,6 +30,20 @@ test_that("graticule lines can be removed via theme", {
expect_doppelganger("no panel grid", plot)
})
+test_that("graticule lines and axes can be removed via scales", {
+ skip_if_not_installed("sf")
+
+ df <- data_frame(x = c(1, 2, 3), y = c(1, 2, 3))
+ plot <- ggplot(df, aes(x, y)) +
+ geom_point() +
+ coord_sf() +
+ theme_gray() +
+ scale_x_continuous(breaks = NULL) +
+ scale_y_continuous(breaks = NULL)
+
+ expect_doppelganger("no breaks", plot)
+})
+
test_that("axis labels are correct for manual breaks", {
skip_if_not_installed("sf")
@@ -300,6 +314,31 @@ test_that("sf_transform_xy() works", {
})
+test_that("coord_sf() can use function breaks and n.breaks", {
+
+ polygon <- sf::st_sfc(
+ sf::st_polygon(list(matrix(c(-80, -76, -76, -80, -80, 35, 35, 40, 40, 35), ncol = 2))),
+ crs = 4326 # basic long-lat crs
+ )
+ polygon <- sf::st_transform(polygon, crs = 3347)
+
+ p <- ggplot(polygon) + geom_sf(fill = NA) +
+ scale_x_continuous(breaks = breaks_width(0.5)) +
+ scale_y_continuous(n.breaks = 4)
+
+ b <- ggplot_build(p)
+ grat <- b$layout$panel_params[[1]]$graticule
+
+ expect_equal(
+ vec_slice(grat$degree, grat$type == "E"),
+ seq(-81, -74.5, by = 0.5)
+ )
+ expect_equal(
+ vec_slice(grat$degree, grat$type == "N"),
+ seq(34, 40, by = 2)
+ )
+})
+
test_that("coord_sf() uses the guide system", {
polygon <- sf::st_sfc(
sf::st_polygon(list(matrix(c(-80, -76, -76, -80, -80, 35, 35, 40, 40, 35), ncol = 2))),
From a6dbc9ee9b4712acb24fe8c5c000ce479d8c5fa2 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:37:54 +0200
Subject: [PATCH 06/10] fallback for problematic crs
---
R/coord-sf.R | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index bc4a20a714..34260de06d 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -606,12 +606,20 @@ sf_breaks <- function(scale_x, scale_y, bbox, crs) {
if (has_x || has_y) {
if (!is.null(crs)) {
+ # Atomic breaks input are assumed to be in long/lat coordinates.
+ # To preserve that assumption for function breaks, the bounding box
+ # needs to be translated to long/lat coordinates.
if (!is_named(bbox)) {
names(bbox) <- c("xmin", "ymin", "xmax", "ymax")
}
# Convert bounding box to long/lat coordinates
bbox <- sf::st_as_sfc(sf::st_bbox(bbox, crs = crs))
bbox <- sf::st_bbox(sf::st_transform(bbox, 4326))
+ bbox <- as.numeric(bbox)
+
+ # If any bbox is NA the transformation has probably failed.
+ # (.e.g from IGH to long/lat). In this case, just provide full long/lat.
+ bbox[is.na(bbox)] <- c(-180, -90, 180, 90)[is.na(bbox)]
}
if (!(is.waive(scale_x$breaks) && is.null(scale_x$n.breaks))) {
From 8a2ea9d0ad4f1de0d74449d8a432f413b27c9322 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:38:06 +0200
Subject: [PATCH 07/10] Add news bullet
---
NEWS.md | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/NEWS.md b/NEWS.md
index 1d95e88137..c15ea550db 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,9 @@
# ggplot2 (development version)
+* Position scales combined with `coord_sf()` can now use functions in the
+ `breaks` argument. In addition, `n.breaks` works as intended and
+ `breaks = NULL` removes grid lines and axes (@teunbrand, #4622).
+
* `labeller()` now handles unspecified entries from lookup tables
(@92amartins, #4599).
From 4cd5018ae16ccf87ae0dc88f0b30a86527373e3e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Wed, 27 Sep 2023 11:55:00 +0200
Subject: [PATCH 08/10] Fix `breaks = NULL` case
---
R/coord-sf.R | 5 +-
tests/testthat/_snaps/coord_sf/no-breaks.svg | 58 +++++---------------
2 files changed, 17 insertions(+), 46 deletions(-)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index 34260de06d..04ddfc574a 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -598,11 +598,12 @@ parse_axes_labeling <- function(x) {
# graticule. This may cause atomic `labels` to be out-of-sync.
sf_breaks <- function(scale_x, scale_y, bbox, crs) {
- x_breaks <- y_breaks <- waiver()
-
has_x <- !is.null(scale_x$breaks) || !is.null(scale_x$n.breaks)
has_y <- !is.null(scale_y$breaks) || !is.null(scale_y$n.breaks)
+ x_breaks <- if (has_x) waiver() else NULL
+ y_breaks <- if (has_y) waiver() else NULL
+
if (has_x || has_y) {
if (!is.null(crs)) {
diff --git a/tests/testthat/_snaps/coord_sf/no-breaks.svg b/tests/testthat/_snaps/coord_sf/no-breaks.svg
index 08ce8aa82b..67455011bb 100644
--- a/tests/testthat/_snaps/coord_sf/no-breaks.svg
+++ b/tests/testthat/_snaps/coord_sf/no-breaks.svg
@@ -20,59 +20,29 @@
-
-
+
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
-x
-y
-no breaks
+x
+y
+no breaks
From 296597bc8db1e1d47744aa50f87d17f9081a86f9 Mon Sep 17 00:00:00 2001
From: Teun van den Brand
Date: Mon, 20 May 2024 09:21:32 +0200
Subject: [PATCH 09/10] replace removed `len0_null()`
---
R/coord-sf.R | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/R/coord-sf.R b/R/coord-sf.R
index 2f86f4b456..bb408b4126 100644
--- a/R/coord-sf.R
+++ b/R/coord-sf.R
@@ -623,12 +623,14 @@ sf_breaks <- function(scale_x, scale_y, bbox, crs) {
if (!(is.waive(scale_x$breaks) && is.null(scale_x$n.breaks))) {
x_breaks <- scale_x$get_breaks(limits = bbox[c(1, 3)])
- x_breaks <- len0_null(x_breaks[is.finite(x_breaks)])
+ finite <- is.finite(x_breaks)
+ x_breaks <- if (any(finite)) x_breaks[finite] else NULL
}
if (!(is.waive(scale_y$breaks) && is.null(scale_y$n.breaks))) {
y_breaks <- scale_y$get_breaks(limits = bbox[c(2, 4)])
- y_breaks <- len0_null(y_breaks[is.finite(y_breaks)])
+ finite <- is.finite(y_breaks)
+ y_breaks <- if (any(finite)) y_breaks[finite] else NULL
}
}
From 7ddc6c33d578ab6bc8b2da295de33d821f9609b1 Mon Sep 17 00:00:00 2001
From: Teun van den Brand
Date: Mon, 20 May 2024 09:28:10 +0200
Subject: [PATCH 10/10] remove duplicated news entry
---
NEWS.md | 2 --
1 file changed, 2 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index 935ff6b0cf..3463908733 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -3,8 +3,6 @@
* Position scales combined with `coord_sf()` can now use functions in the
`breaks` argument. In addition, `n.breaks` works as intended and
`breaks = NULL` removes grid lines and axes (@teunbrand, #4622).
-* `labeller()` now handles unspecified entries from lookup tables
- (@92amartins, #4599).
* (Internal) Applying defaults in `geom_sf()` has moved from the internal
`sf_grob()` to `GeomSf$use_defaults()` (@teunbrand).
* `facet_wrap()` has new options for the `dir` argument to more precisely