From 5bbca87782fb246c1e1c613d64770da48a25d044 Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Sat, 25 Aug 2018 18:23:48 -0500 Subject: [PATCH 1/2] enable manual formatting of tick labels for coord_sf(). closes #2857 --- R/sf.R | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/R/sf.R b/R/sf.R index f47808a316..833417ea22 100644 --- a/R/sf.R +++ b/R/sf.R @@ -437,6 +437,52 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, data }, + + # internal function used by setup_panel_params, + # overrides the graticule labels based on scale settings if necessary + get_graticule_labels = function(self, graticule, scale_x, scale_y, params = list()) { + # if sf coordinates are not available in degrees latitude and longitude, label + # as regular numbers + if (is.null(params$crs) || is.na(params$crs) || !isTRUE(sf::st_is_longlat(self$datum))) { + x_labeller <- base::format + y_labeller <- base::format + } + else { + x_labeller <- degree_labels_EW + y_labeller <- degree_labels_NS + } + + # if scales provide labeling functions override previous function choices + if (is.function(scale_x$labels)) { + x_labeller <- scale_x$labels + } + if (is.function(scale_y$labels)) { + y_labeller <- scale_y$labels + } + + x_breaks <- graticule[graticule$type == "E", ]$degree + 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 { + x_labels <- x_labeller(x_breaks) + } + + y_breaks <- graticule[graticule$type == "N", ]$degree + 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 { + y_labels <- y_labeller(y_breaks) + } + + # still to do: 1. check lengths of lables vs. breaks; 2. make sure order is correct + + c(x_labels, y_labels) + }, + setup_panel_params = function(self, scale_x, scale_y, params = list()) { # Bounding box of the data x_range <- scale_range(scale_x, self$limits$x, self$expand) @@ -456,6 +502,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, ndiscr = self$ndiscr ) + # override graticule labels provided by sf::st_graticule() + graticule$degree_label <- self$get_graticule_labels(graticule, scale_x, scale_y, params) + # remove tick labels not on axes 1 (bottom) and 2 (left) if (!is.null(graticule$plot12)) graticule$degree_label[!graticule$plot12] <- NA @@ -573,3 +622,23 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, default = default ) } + +# copied from sp +# move to scales package at some point? + +degree_labels_NS <- function(x) { + pos = sign(x) + 2 + dir = c("*S", "", "*N") + paste0(abs(x), "*degree", dir[pos]) +} + +degree_labels_EW <- function(x) { + x <- ifelse(x > 180, x - 360, x) + pos = sign(x) + 2 + if (any(x == -180)) + pos[x == -180] = 2 + if (any(x == 180)) + pos[x == 180] = 2 + dir = c("*W", "", "*E") + paste0(abs(x), "*degree", dir[pos]) +} From 1d03a5567796ed1cf2601b77d68f095d5b5c4e0d Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Sat, 25 Aug 2018 21:54:18 -0500 Subject: [PATCH 2/2] much simplified implementation --- NEWS.md | 3 +++ R/sf.R | 82 ++++++++++++++++++++------------------------------------- 2 files changed, 31 insertions(+), 54 deletions(-) diff --git a/NEWS.md b/NEWS.md index 538b27b69b..f846db73a8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,9 @@ * The error message in `compute_aesthetics()` now provides the names of only aesthetics with mismatched lengths, rather than all aesthetics (@karawoo, #2853). + +* `coord_sf()` now respects manual setting of axis tick labels (@clauswilke, + #2857). * `geom_sf()` now respects `lineend`, `linejoin`, and `linemitre` parameters for lines and polygons (@alistaire47, #2826) diff --git a/R/sf.R b/R/sf.R index 833417ea22..3d9ff0fae9 100644 --- a/R/sf.R +++ b/R/sf.R @@ -440,47 +440,47 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, # internal function used by setup_panel_params, # overrides the graticule labels based on scale settings if necessary - get_graticule_labels = function(self, graticule, scale_x, scale_y, params = list()) { - # if sf coordinates are not available in degrees latitude and longitude, label - # as regular numbers - if (is.null(params$crs) || is.na(params$crs) || !isTRUE(sf::st_is_longlat(self$datum))) { - x_labeller <- base::format - y_labeller <- base::format - } - else { - x_labeller <- degree_labels_EW - y_labeller <- degree_labels_NS - } - - # if scales provide labeling functions override previous function choices - if (is.function(scale_x$labels)) { - x_labeller <- scale_x$labels - } - if (is.function(scale_y$labels)) { - y_labeller <- scale_y$labels - } - - x_breaks <- graticule[graticule$type == "E", ]$degree + fixup_graticule_labels = function(self, graticule, scale_x, scale_y, params = list()) { + 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 { - x_labels <- x_labeller(x_breaks) + x_labels <- graticule$degree_label[graticule$type == "E"] + } + if (length(x_labels) != length(x_breaks)) { + stop("Breaks and labels along x direction are different lengths", call. = FALSE) } + graticule$degree_label[graticule$type == "E"] <- x_labels - y_breaks <- graticule[graticule$type == "N", ]$degree + + 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 { - y_labels <- y_labeller(y_breaks) + y_labels <- graticule$degree_label[graticule$type == "N"] + } + if (length(y_labels) != length(y_breaks)) { + stop("Breaks and labels along y direction are different lengths", call. = FALSE) } + 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 - # still to do: 1. check lengths of lables vs. breaks; 2. make sure order is correct + # parse labels into expressions if required + if (any(grepl("degree", graticule$degree_label))) + graticule$degree_label <- lapply(graticule$degree_label, function(x) parse(text = x)[[1]]) - c(x_labels, y_labels) + graticule }, setup_panel_params = function(self, scale_x, scale_y, params = list()) { @@ -502,20 +502,14 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, ndiscr = self$ndiscr ) - # override graticule labels provided by sf::st_graticule() - graticule$degree_label <- self$get_graticule_labels(graticule, scale_x, scale_y, params) - - # remove tick labels not on axes 1 (bottom) and 2 (left) - if (!is.null(graticule$plot12)) - graticule$degree_label[!graticule$plot12] <- NA + # override graticule labels provided by sf::st_graticule() if necessary + graticule <- self$fixup_graticule_labels(graticule, scale_x, scale_y, params) sf::st_geometry(graticule) <- sf_rescale01(sf::st_geometry(graticule), x_range, y_range) graticule$x_start <- sf_rescale01_x(graticule$x_start, x_range) graticule$x_end <- sf_rescale01_x(graticule$x_end, x_range) graticule$y_start <- sf_rescale01_x(graticule$y_start, y_range) graticule$y_end <- sf_rescale01_x(graticule$y_end, y_range) - if (any(grepl("degree", graticule$degree_label))) - graticule$degree_label <- lapply(graticule$degree_label, function(x) parse(text = x)[[1]]) list( x_range = x_range, @@ -622,23 +616,3 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, default = default ) } - -# copied from sp -# move to scales package at some point? - -degree_labels_NS <- function(x) { - pos = sign(x) + 2 - dir = c("*S", "", "*N") - paste0(abs(x), "*degree", dir[pos]) -} - -degree_labels_EW <- function(x) { - x <- ifelse(x > 180, x - 360, x) - pos = sign(x) + 2 - if (any(x == -180)) - pos[x == -180] = 2 - if (any(x == 180)) - pos[x == 180] = 2 - dir = c("*W", "", "*E") - paste0(abs(x), "*degree", dir[pos]) -}