coord_sf() scale function breaks (#5442)

* Helper function for breaks

* Use new breaks

* NULL breaks discard gridlines

* Fix typo

* Add tests

* fallback for problematic crs

* Add news bullet

* Fix `breaks = NULL` case

* replace removed `len0_null()`

* remove duplicated news entry

Author: teunbrand

NEWS.md

@@ -1,5 +1,8 @@
 # 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).
 * (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

R/coord-sf.R

@@ -222,16 +222,25 @@ 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
     )
 
+    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)
 
@@ -580,6 +589,53 @@ 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) {
+
+  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)) {
+      # 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))) {
+      x_breaks <- scale_x$get_breaks(limits = bbox[c(1, 3)])
+      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)])
+      finite <- is.finite(y_breaks)
+      y_breaks <- if (any(finite)) y_breaks[finite] else NULL
+    }
+  }
+
+  list(x = x_breaks, y = y_breaks)
+}
 
 #' ViewScale from graticule
 #'

tests/testthat/_snaps/coord_sf/no-breaks.svg

@@ -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", {
   skip_if_not_installed("sf")
   polygon <- sf::st_sfc(