Make graticule labeling configurable

NEWS.md

@@ -6,6 +6,10 @@
 
 *   `coord_sf()` now respects manual setting of axis tick labels (@clauswilke,
     #2857, #2881).
+
+*   `coord_sf()` now accepts two new parameters, `label_graticule` and `label_axes`,
+    that can be used to specify which graticules to label on which side of the plot
+    (@clauswilke, #2846).
 
 *   `geom_sf()` now respects `lineend`, `linejoin`, and `linemitre` parameters 
     for lines and polygons (@alistaire47, #2826)

R/sf.R

@@ -493,10 +493,6 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     }
     graticule$degree_label[graticule$type == "N"] <- y_labels
 
-    # remove tick labels not on axes 1 (bottom) and 2 (left)
-    if (!is.null(graticule$plot12))
-      graticule$degree_label[!graticule$plot12] <- NA
-
     # Parse labels if requested/needed
     has_degree <- grepl("\\bdegree\\b", graticule$degree_label)
     needs_parsing <- needs_parsing | (needs_autoparsing & has_degree)
@@ -541,7 +537,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
       x_range = x_range,
       y_range = y_range,
       graticule = graticule,
-      crs = params$crs
+      crs = params$crs,
+      label_axes = self$label_axes,
+      label_graticule = self$label_graticule
     )
   },
 
@@ -577,32 +575,158 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
 
   render_axis_h = function(self, panel_params, theme) {
     graticule <- panel_params$graticule
-    east <- graticule[graticule$type == "E" & !is.na(graticule$degree_label), ]
 
-    list(
-      top = nullGrob(),
-      bottom = guide_axis(
-        east$x_start,
-        east$degree_label,
+    # top axis
+    id1 <- id2 <- integer(0)
+    # labels based on panel side
+    id1 <- c(id1, which(graticule$type == panel_params$label_axes$top & graticule$y_start > 0.999))
+    id2 <- c(id2, which(graticule$type == panel_params$label_axes$top & graticule$y_end > 0.999))
+
+    # labels based on graticule direction
+    if ("S" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "E" & graticule$y_start > 0.999))
+    }
+    if ("N" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "E" & graticule$y_end > 0.999))
+    }
+    if ("W" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "N" & graticule$y_start > 0.999))
+    }
+    if ("E" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "N" & graticule$y_end > 0.999))
+    }
+
+    ticks1 <- graticule[unique(id1), ]
+    ticks2 <- graticule[unique(id2), ]
+    tick_positions <- c(ticks1$x_start, ticks2$x_end)
+    tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
+
+    if (length(tick_positions) > 0) {
+      top <- guide_axis(
+        tick_positions,
+        tick_labels,
+        position = "top",
+        theme = theme
+      )
+    } else {
+      top <- zeroGrob()
+    }
+
+    # bottom axis
+    id1 <- id2 <- integer(0)
+    # labels based on panel side
+    id1 <- c(id1, which(graticule$type == panel_params$label_axes$bottom & graticule$y_start < 0.001))
+    id2 <- c(id2, which(graticule$type == panel_params$label_axes$bottom & graticule$y_end < 0.001))
+
+    # labels based on graticule direction
+    if ("S" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "E" & graticule$y_start < 0.001))
+    }
+    if ("N" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "E" & graticule$y_end < 0.001))
+    }
+    if ("W" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "N" & graticule$y_start < 0.001))
+    }
+    if ("E" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "N" & graticule$y_end < 0.001))
+    }
+
+    ticks1 <- graticule[unique(id1), ]
+    ticks2 <- graticule[unique(id2), ]
+    tick_positions <- c(ticks1$x_start, ticks2$x_end)
+    tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
+
+    if (length(tick_positions) > 0) {
+      bottom <- guide_axis(
+        tick_positions,
+        tick_labels,
         position = "bottom",
         theme = theme
       )
-    )
+    } else {
+      bottom <- zeroGrob()
+    }
+
+    list(top = top, bottom = bottom)
   },
 
   render_axis_v = function(self, panel_params, theme) {
     graticule <- panel_params$graticule
-    north <- graticule[graticule$type == "N" & !is.na(graticule$degree_label), ]
 
-    list(
-      left = guide_axis(
-        north$y_start,
-        north$degree_label,
+    # right axis
+    id1 <- id2 <- integer(0)
+    # labels based on panel side
+    id1 <- c(id1, which(graticule$type == panel_params$label_axes$right & graticule$x_end > 0.999))
+    id2 <- c(id2, which(graticule$type == panel_params$label_axes$right & graticule$x_start > 0.999))
+
+    # labels based on graticule direction
+    if ("N" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "E" & graticule$x_end > 0.999))
+    }
+    if ("S" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "E" & graticule$x_start > 0.999))
+    }
+    if ("E" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "N" & graticule$x_end > 0.999))
+    }
+    if ("W" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "N" & graticule$x_start > 0.999))
+    }
+
+    ticks1 <- graticule[unique(id1), ]
+    ticks2 <- graticule[unique(id2), ]
+    tick_positions <- c(ticks1$y_end, ticks2$y_start)
+    tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
+
+    if (length(tick_positions) > 0) {
+      right <- guide_axis(
+        tick_positions,
+        tick_labels,
+        position = "right",
+        theme = theme
+      )
+    } else {
+      right <- zeroGrob()
+    }
+
+    # left axis
+    id1 <- id2 <- integer(0)
+    # labels based on panel side
+    id1 <- c(id1, which(graticule$type == panel_params$label_axes$left & graticule$x_end < 0.001))
+    id2 <- c(id2, which(graticule$type == panel_params$label_axes$left & graticule$x_start < 0.001))
+
+    # labels based on graticule direction
+    if ("N" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "E" & graticule$x_end < 0.001))
+    }
+    if ("S" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "E" & graticule$x_start < 0.001))
+    }
+    if ("E" %in% panel_params$label_graticule) {
+      id1 <- c(id1, which(graticule$type == "N" & graticule$x_end < 0.001))
+    }
+    if ("W" %in% panel_params$label_graticule) {
+      id2 <- c(id2, which(graticule$type == "N" & graticule$x_start < 0.001))
+    }
+
+    ticks1 <- graticule[unique(id1), ]
+    ticks2 <- graticule[unique(id2), ]
+    tick_positions <- c(ticks1$y_end, ticks2$y_start)
+    tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
+
+    if (length(tick_positions) > 0) {
+      left <- guide_axis(
+        tick_positions,
+        tick_labels,
         position = "left",
         theme = theme
-      ),
-      right = nullGrob()
-    )
+      )
+    } else {
+      left <- zeroGrob()
+    }
+
+    list(left = left, right = right)
   }
 
 )
@@ -622,23 +746,85 @@ sf_rescale01_x <- function(x, range) {
 }
 
 
-#' @param crs Use this to select a specific CRS. If not specified, will
-#'   use the CRS defined in the first layer.
+#' @param crs Use this to select a specific coordinate reference system (CRS).
+#'   If not specified, will use the CRS defined in the first layer.
 #' @param datum CRS that provides datum to use when generating graticules
+#' @param label_axes Character vector or named list of character values
+#'   specifying which graticule lines (meridians or parallels) should be labeled on
+#'   which side of the plot. Meridians are indicated by `"E"` (for East) and
+#'   parallels by `"N"` (for North). Default is `"--EN"`, which specifies
+#'   (clockwise from the top) no labels on the top, none on the right, meridians
+#'   on the bottom, and parallels on the left. Alternatively, this setting could have been
+#'   specified with `list(bottom = "E", left = "N")`.
+#'
+#'   This parameter can be used alone or in combination with `label_graticule`.
+#' @param label_graticule Character vector indicating which graticule lines should be labeled
+#'   where. Meridians run north-south, and the letters `"N"` and `"S"` indicate that
+#'   they should be labeled on their north or south end points, respectively.
+#'   Parallels run east-west, and the letters `"E"` and `"W"` indicate that they
+#'   should be labeled on their east or west end points, respectively. Thus,
+#'   `label_graticule = "SW"` would label meridians at their south end and parallels at
+#'   their west end, whereas `label_graticule = "EW"` would label parallels at both
+#'   ends and meridians not at all. Because meridians and parallels can in general
+#'   intersect with any side of the plot panel, for any choice of `label_graticule` labels
+#'   are not guaranteed to reside on only one particular side of the plot panel.
+#'
+#'   This parameter can be used alone or in combination with `label_axes`.
 #' @param ndiscr number of segments to use for discretising graticule lines;
 #'   try increasing this when graticules look unexpected
 #' @inheritParams coord_cartesian
 #' @export
 #' @rdname ggsf
 coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
-                     crs = NULL, datum = sf::st_crs(4326), ndiscr = 100,
-                     default = FALSE) {
+                     crs = NULL, datum = sf::st_crs(4326),
+                     label_graticule = waiver(),
+                     label_axes = waiver(),
+                     ndiscr = 100, default = FALSE) {
+
+  if (is.waive(label_graticule) && is.waive(label_axes)) {
+    # if both `label_graticule` and `label_axes` are set to waive then we
+    # use the default of labels on the left and at the bottom
+    label_graticule <- ""
+    label_axes <- "--EN"
+  } else {
+    # if at least one is set we ignore the other
+    label_graticule <- label_graticule %|W|% ""
+    label_axes <- label_axes %|W|% ""
+  }
+
+  if (is.character(label_axes)) {
+    label_axes <- parse_axes_labeling(label_axes)
+  } else if (!is.list(label_axes)) {
+    stop(
+      "Panel labeling format not recognized.",
+      call. = FALSE
+    )
+    label_axes <- list(left = "N", bottom = "E")
+  }
+
+  if (is.character(label_graticule)) {
+    label_graticule <- unlist(strsplit(label_graticule, ""))
+  } else {
+    stop(
+      "Graticule labeling format not recognized.",
+      call. = FALSE
+    )
+    label_graticule <- ""
+  }
+
   ggproto(NULL, CoordSf,
     limits = list(x = xlim, y = ylim),
     datum = datum,
     crs = crs,
+    label_axes = label_axes,
+    label_graticule = label_graticule,
     ndiscr = ndiscr,
     expand = expand,
     default = default
   )
 }
+
+parse_axes_labeling <- function(x) {
+  labs = unlist(strsplit(x, ""))
+  list(top = labs[1], right = labs[2], bottom = labs[3], left = labs[4])
+}