Skip to content

Commit 1e01e68

Browse files
clauswilkeclauswilke
authored
add explicit parsing option to labels in coord_sf() (#2881)
* add explicit parsing option to labels in coord_sf() * improved parsing logic, add regression tests * remove option for explicit parsing, not needed * handle factors correctly * simplify code
1 parent a4a54ee commit 1e01e68

File tree

3 files changed

+183
-15
lines changed

3 files changed

+183
-15
lines changed

‎NEWS.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
#2853).
66

77
* `coord_sf()` now respects manual setting of axis tick labels (@clauswilke,
8-
#2857).
8+
#2857, #2881).
99

1010
* `geom_sf()` now respects `lineend`, `linejoin`, and `linemitre` parameters
1111
for lines and polygons (@alistaire47, #2826)

‎R/sf.R

Lines changed: 36 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -441,16 +441,28 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
441441
# internal function used by setup_panel_params,
442442
# overrides the graticule labels based on scale settings if necessary
443443
fixup_graticule_labels = function(self, graticule, scale_x, scale_y, params = list()) {
444+
needs_parsing <- rep(FALSE, nrow(graticule))
445+
needs_autoparsing <- rep(FALSE, nrow(graticule))
446+
444447
x_breaks <- graticule$degree[graticule$type == "E"]
445448
if (is.null(scale_x$labels)) {
446449
x_labels <- rep(NA, length(x_breaks))
447-
} else if (is.character(scale_x$labels)) {
448-
x_labels <- scale_x$labels
449-
} else if (is.function(scale_x$labels)){
450-
x_labels <- scale_x$labels(x_breaks)
451-
} else {
450+
} else if (is.waive(scale_x$labels)) {
452451
x_labels <- graticule$degree_label[graticule$type == "E"]
452+
needs_autoparsing[graticule$type == "E"] <- TRUE
453+
} else {
454+
if (is.function(scale_x$labels)) {
455+
x_labels <- scale_x$labels(x_breaks)
456+
} else {
457+
x_labels <- scale_x$labels
458+
}
459+
460+
# all labels need to be temporarily stored as character vectors,
461+
# but expressions need to be parsed afterwards
462+
needs_parsing[graticule$type == "E"] <- !(is.character(x_labels) || is.factor(x_labels))
463+
x_labels <- as.character(x_labels)
453464
}
465+
454466
if (length(x_labels) != length(x_breaks)) {
455467
stop("Breaks and labels along x direction are different lengths", call. = FALSE)
456468
}
@@ -460,13 +472,22 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
460472
y_breaks <- graticule$degree[graticule$type == "N"]
461473
if (is.null(scale_y$labels)) {
462474
y_labels <- rep(NA, length(y_breaks))
463-
} else if (is.character(scale_y$labels)) {
464-
y_labels <- scale_y$labels
465-
} else if (is.function(scale_y$labels)){
466-
y_labels <- scale_y$labels(y_breaks)
467-
} else {
475+
} else if (is.waive(scale_y$labels)) {
468476
y_labels <- graticule$degree_label[graticule$type == "N"]
477+
needs_autoparsing[graticule$type == "N"] <- TRUE
478+
} else {
479+
if (is.function(scale_y$labels)) {
480+
y_labels <- scale_y$labels(y_breaks)
481+
} else {
482+
y_labels <- scale_y$labels
483+
}
484+
485+
# all labels need to be temporarily stored as character vectors,
486+
# but expressions need to be parsed afterwards
487+
needs_parsing[graticule$type == "N"] <- !(is.character(y_labels) || is.factor(y_labels))
488+
y_labels <- as.character(y_labels)
469489
}
490+
470491
if (length(y_labels) != length(y_breaks)) {
471492
stop("Breaks and labels along y direction are different lengths", call. = FALSE)
472493
}
@@ -476,11 +497,12 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
476497
if (!is.null(graticule$plot12))
477498
graticule$degree_label[!graticule$plot12] <- NA
478499

479-
# Convert the string 'degree' to the degree symbol
500+
# Parse labels if requested/needed
480501
has_degree <- grepl("\\bdegree\\b", graticule$degree_label)
481-
if (any(has_degree)) {
502+
needs_parsing <- needs_parsing | (needs_autoparsing & has_degree)
503+
if (any(needs_parsing)) {
482504
labels <- as.list(graticule$degree_label)
483-
labels[has_degree] <- parse_safe(graticule$degree_label[has_degree])
505+
labels[needs_parsing] <- parse_safe(graticule$degree_label[needs_parsing])
484506
graticule$degree_label <- labels
485507
}
486508

@@ -604,7 +626,7 @@ sf_rescale01_x <- function(x, range) {
604626
#' use the CRS defined in the first layer.
605627
#' @param datum CRS that provides datum to use when generating graticules
606628
#' @param ndiscr number of segments to use for discretising graticule lines;
607-
#' try increasing this when graticules look unexpected
629+
#' try increasing this when graticules look unexpected
608630
#' @inheritParams coord_cartesian
609631
#' @export
610632
#' @rdname ggsf

‎tests/testthat/test-coord_sf.R

Lines changed: 146 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,3 +14,149 @@ test_that("multiplication works", {
1414
skip("sf tests are currently unstable")
1515
expect_doppelganger("sf-polygons", plot)
1616
})
17+
18+
19+
test_that("axis labels can be set manually", {
20+
skip_if_not_installed("sf")
21+
22+
plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) +
23+
geom_sf()
24+
25+
# autogenerated labels
26+
b <- ggplot_build(
27+
plot +
28+
scale_x_continuous(breaks = c(1000, 2000, 3000)) +
29+
scale_y_continuous(breaks = c(1000, 1500, 2000))
30+
)
31+
graticule <- b$layout$panel_params[[1]]$graticule
32+
expect_identical(
33+
graticule[graticule$type == "E", ]$degree_label,
34+
c("1000", "2000", "3000")
35+
)
36+
expect_identical(
37+
graticule[graticule$type == "N", ]$degree_label,
38+
c("1000", "1500", "2000")
39+
)
40+
41+
# character labels
42+
b <- ggplot_build(
43+
plot +
44+
scale_x_continuous(
45+
breaks = c(1000, 2000, 3000),
46+
labels = c("A", "B", "C")
47+
) +
48+
scale_y_continuous(
49+
breaks = c(1000, 1500, 2000),
50+
labels = c("D", "E", "F")
51+
)
52+
)
53+
graticule <- b$layout$panel_params[[1]]$graticule
54+
expect_identical(
55+
graticule[graticule$type == "E", ]$degree_label,
56+
c("A", "B", "C")
57+
)
58+
expect_identical(
59+
graticule[graticule$type == "N", ]$degree_label,
60+
c("D", "E", "F")
61+
)
62+
63+
# factors are treated like character labels
64+
# and are not parsed
65+
b <- ggplot_build(
66+
plot +
67+
scale_x_continuous(
68+
breaks = c(1000, 2000, 3000),
69+
labels = factor(c("A", "B", "C"))
70+
) +
71+
scale_y_continuous(
72+
breaks = c(1000, 1500, 2000),
73+
labels = factor(c("1 * degree * N", "1.5 * degree * N", "2 * degree * N"))
74+
)
75+
)
76+
graticule <- b$layout$panel_params[[1]]$graticule
77+
expect_identical(
78+
graticule[graticule$type == "E", ]$degree_label,
79+
c("A", "B", "C")
80+
)
81+
expect_identical(
82+
graticule[graticule$type == "N", ]$degree_label,
83+
c("1 * degree * N", "1.5 * degree * N", "2 * degree * N")
84+
)
85+
86+
87+
# expressions mixed with character labels
88+
b <- ggplot_build(
89+
plot +
90+
scale_x_continuous(
91+
breaks = c(1000, 2000, 3000),
92+
labels = c("A", "B", "C")
93+
) +
94+
scale_y_continuous(
95+
breaks = c(1000, 1500, 2000),
96+
labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
97+
)
98+
)
99+
graticule <- b$layout$panel_params[[1]]$graticule
100+
expect_identical(
101+
graticule[graticule$type == "E", ]$degree_label,
102+
as.list(c("A", "B", "C"))
103+
)
104+
parsed <- vector("list", 3)
105+
parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
106+
expect_identical(
107+
graticule[graticule$type == "N", ]$degree_label,
108+
parsed
109+
)
110+
111+
# reverse x and y from previous test
112+
b <- ggplot_build(
113+
plot +
114+
scale_y_continuous(
115+
breaks = c(1000, 2000, 3000),
116+
labels = c("A", "B", "C")
117+
) +
118+
scale_x_continuous(
119+
breaks = c(1000, 1500, 2000),
120+
labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
121+
)
122+
)
123+
graticule <- b$layout$panel_params[[1]]$graticule
124+
expect_identical(
125+
graticule[graticule$type == "N", ]$degree_label,
126+
as.list(c("A", "B", "C"))
127+
)
128+
parsed <- vector("list", 3)
129+
parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
130+
expect_identical(
131+
graticule[graticule$type == "E", ]$degree_label,
132+
parsed
133+
)
134+
135+
# autoparsing of degree labels
136+
data <- sf::st_sfc(
137+
sf::st_polygon(list(matrix(1e1*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2))),
138+
crs = 4326 # basic long-lat crs
139+
)
140+
141+
plot <- ggplot(data) + geom_sf()
142+
143+
b <- ggplot_build(
144+
plot +
145+
scale_x_continuous(breaks = c(10, 20, 30)) +
146+
scale_y_continuous(breaks = c(10, 15, 20))
147+
)
148+
graticule <- b$layout$panel_params[[1]]$graticule
149+
parsed <- vector("list", 3)
150+
parsed[1:3] <- parse(text = c("10*degree*E", "20*degree*E", "30*degree*E"))
151+
expect_identical(
152+
graticule[graticule$type == "E", ]$degree_label,
153+
parsed
154+
)
155+
parsed[1:3] <- parse(text = c("10*degree*N", "15*degree*N", "20*degree*N"))
156+
expect_identical(
157+
graticule[graticule$type == "N", ]$degree_label,
158+
parsed
159+
)
160+
161+
})
162+

0 commit comments

Comments
 (0)