diff --git a/NEWS.md b/NEWS.md index 070c74dd40..3463908733 100644 --- a/NEWS.md +++ b/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 diff --git a/R/coord-sf.R b/R/coord-sf.R index 12f7371003..bb408b4126 100644 --- a/R/coord-sf.R +++ b/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 #' 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..67455011bb --- /dev/null +++ b/tests/testthat/_snaps/coord_sf/no-breaks.svg @@ -0,0 +1,48 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +no breaks + + diff --git a/tests/testthat/test-coord_sf.R b/tests/testthat/test-coord_sf.R index bbb90e0243..c668b3ec79 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", { skip_if_not_installed("sf") polygon <- sf::st_sfc(