add explicit parsing option to labels in coord_sf()

NEWS.md

@@ -5,7 +5,7 @@
     #2853).
 
 *   `coord_sf()` now respects manual setting of axis tick labels (@clauswilke,
-    #2857).
+    #2857, #2881).
 
 *   `geom_sf()` now respects `lineend`, `linejoin`, and `linemitre` parameters 
     for lines and polygons (@alistaire47, #2826)

R/sf.R

@@ -441,16 +441,28 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
   # internal function used by setup_panel_params,
   # overrides the graticule labels based on scale settings if necessary
   fixup_graticule_labels = function(self, graticule, scale_x, scale_y, params = list()) {
+    needs_parsing <- rep(FALSE, nrow(graticule))
+    needs_autoparsing <- rep(FALSE, nrow(graticule))
+
     x_breaks <- graticule$degree[graticule$type == "E"]
     if (is.null(scale_x$labels)) {
       x_labels <- rep(NA, length(x_breaks))
-    } else if (is.character(scale_x$labels)) {
-      x_labels <- scale_x$labels
-    } else if (is.function(scale_x$labels)){
-      x_labels <- scale_x$labels(x_breaks)
-    } else {
+    } else if (is.waive(scale_x$labels)) {
       x_labels <- graticule$degree_label[graticule$type == "E"]
+      needs_autoparsing[graticule$type == "E"] <- TRUE
+    } else {
+      if (is.function(scale_x$labels)) {
+        x_labels <- scale_x$labels(x_breaks)
+      } else {
+        x_labels <- scale_x$labels
+      }
+
+      # all labels need to be temporarily stored as character vectors,
+      # but expressions need to be parsed afterwards
+      needs_parsing[graticule$type == "E"] <- !(is.character(x_labels) || is.factor(x_labels))
+      x_labels <- as.character(x_labels)
     }
+
     if (length(x_labels) != length(x_breaks)) {
       stop("Breaks and labels along x direction are different lengths", call. = FALSE)
     }
@@ -460,13 +472,22 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     y_breaks <- graticule$degree[graticule$type == "N"]
     if (is.null(scale_y$labels)) {
       y_labels <- rep(NA, length(y_breaks))
-    } else if (is.character(scale_y$labels)) {
-      y_labels <- scale_y$labels
-    } else if (is.function(scale_y$labels)){
-      y_labels <- scale_y$labels(y_breaks)
-    } else {
+    } else if (is.waive(scale_y$labels)) {
       y_labels <- graticule$degree_label[graticule$type == "N"]
+      needs_autoparsing[graticule$type == "N"] <- TRUE
+    } else {
+      if (is.function(scale_y$labels)) {
+        y_labels <- scale_y$labels(y_breaks)
+      } else {
+        y_labels <- scale_y$labels
+      }
+
+      # all labels need to be temporarily stored as character vectors,
+      # but expressions need to be parsed afterwards
+      needs_parsing[graticule$type == "N"] <- !(is.character(y_labels) || is.factor(y_labels))
+      y_labels <- as.character(y_labels)
     }
+
     if (length(y_labels) != length(y_breaks)) {
       stop("Breaks and labels along y direction are different lengths", call. = FALSE)
     }
@@ -476,11 +497,12 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     if (!is.null(graticule$plot12))
       graticule$degree_label[!graticule$plot12] <- NA
 
-    # Convert the string 'degree' to the degree symbol
+    # Parse labels if requested/needed
     has_degree <- grepl("\\bdegree\\b", graticule$degree_label)
-    if (any(has_degree)) {
+    needs_parsing <- needs_parsing | (needs_autoparsing & has_degree)
+    if (any(needs_parsing)) {
       labels <- as.list(graticule$degree_label)
-      labels[has_degree] <- parse_safe(graticule$degree_label[has_degree])
+      labels[needs_parsing] <- parse_safe(graticule$degree_label[needs_parsing])
       graticule$degree_label <- labels
     }
 
@@ -604,7 +626,7 @@ sf_rescale01_x <- function(x, range) {
 #'   use the CRS defined in the first layer.
 #' @param datum CRS that provides datum to use when generating graticules
 #' @param ndiscr number of segments to use for discretising graticule lines;
-#' try increasing this when graticules look unexpected
+#'   try increasing this when graticules look unexpected
 #' @inheritParams coord_cartesian
 #' @export
 #' @rdname ggsf

tests/testthat/test-coord_sf.R

@@ -14,3 +14,149 @@ test_that("multiplication works", {
   skip("sf tests are currently unstable")
   expect_doppelganger("sf-polygons", plot)
 })
+
+
+test_that("axis labels can be set manually", {
+  skip_if_not_installed("sf")
+
+  plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) +
+    geom_sf()
+
+  # autogenerated labels
+  b <- ggplot_build(
+    plot +
+      scale_x_continuous(breaks = c(1000, 2000, 3000)) +
+      scale_y_continuous(breaks = c(1000, 1500, 2000))
+  )
+  graticule <- b$layout$panel_params[[1]]$graticule
+  expect_identical(
+    graticule[graticule$type == "E", ]$degree_label,
+    c("1000", "2000", "3000")
+  )
+  expect_identical(
+    graticule[graticule$type == "N", ]$degree_label,
+    c("1000", "1500", "2000")
+  )
+
+  # character labels
+  b <- ggplot_build(
+    plot +
+      scale_x_continuous(
+        breaks = c(1000, 2000, 3000),
+        labels = c("A", "B", "C")
+      ) +
+      scale_y_continuous(
+        breaks = c(1000, 1500, 2000),
+        labels = c("D", "E", "F")
+      )
+  )
+  graticule <- b$layout$panel_params[[1]]$graticule
+  expect_identical(
+    graticule[graticule$type == "E", ]$degree_label,
+    c("A", "B", "C")
+  )
+  expect_identical(
+    graticule[graticule$type == "N", ]$degree_label,
+    c("D", "E", "F")
+  )
+
+  # factors are treated like character labels
+  # and are not parsed
+  b <- ggplot_build(
+    plot +
+      scale_x_continuous(
+        breaks = c(1000, 2000, 3000),
+        labels = factor(c("A", "B", "C"))
+      ) +
+      scale_y_continuous(
+        breaks = c(1000, 1500, 2000),
+        labels = factor(c("1 * degree * N", "1.5 * degree * N", "2 * degree * N"))
+      )
+  )
+  graticule <- b$layout$panel_params[[1]]$graticule
+  expect_identical(
+    graticule[graticule$type == "E", ]$degree_label,
+    c("A", "B", "C")
+  )
+  expect_identical(
+    graticule[graticule$type == "N", ]$degree_label,
+    c("1 * degree * N", "1.5 * degree * N", "2 * degree * N")
+  )
+
+
+  # expressions mixed with character labels
+  b <- ggplot_build(
+    plot +
+      scale_x_continuous(
+        breaks = c(1000, 2000, 3000),
+        labels = c("A", "B", "C")
+      ) +
+      scale_y_continuous(
+        breaks = c(1000, 1500, 2000),
+        labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
+      )
+  )
+  graticule <- b$layout$panel_params[[1]]$graticule
+  expect_identical(
+    graticule[graticule$type == "E", ]$degree_label,
+    as.list(c("A", "B", "C"))
+  )
+  parsed <- vector("list", 3)
+  parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
+  expect_identical(
+    graticule[graticule$type == "N", ]$degree_label,
+    parsed
+  )
+
+  # reverse x and y from previous test
+  b <- ggplot_build(
+    plot +
+      scale_y_continuous(
+        breaks = c(1000, 2000, 3000),
+        labels = c("A", "B", "C")
+      ) +
+      scale_x_continuous(
+        breaks = c(1000, 1500, 2000),
+        labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
+      )
+  )
+  graticule <- b$layout$panel_params[[1]]$graticule
+  expect_identical(
+    graticule[graticule$type == "N", ]$degree_label,
+    as.list(c("A", "B", "C"))
+  )
+  parsed <- vector("list", 3)
+  parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
+  expect_identical(
+    graticule[graticule$type == "E", ]$degree_label,
+    parsed
+  )
+
+  # autoparsing of degree labels
+  data <- sf::st_sfc(
+    sf::st_polygon(list(matrix(1e1*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2))),
+    crs = 4326 # basic long-lat crs
+  )
+
+  plot <- ggplot(data) + geom_sf()
+
+  b <- ggplot_build(
+    plot +
+      scale_x_continuous(breaks = c(10, 20, 30)) +
+      scale_y_continuous(breaks = c(10, 15, 20))
+  )
+  graticule <- b$layout$panel_params[[1]]$graticule
+  parsed <- vector("list", 3)
+  parsed[1:3] <- parse(text = c("10*degree*E", "20*degree*E", "30*degree*E"))
+  expect_identical(
+    graticule[graticule$type == "E", ]$degree_label,
+    parsed
+  )
+  parsed[1:3] <- parse(text = c("10*degree*N", "15*degree*N", "20*degree*N"))
+  expect_identical(
+    graticule[graticule$type == "N", ]$degree_label,
+    parsed
+  )
+
+})
+