Skip to content

Commit 484a220

Browse files
clauswilkeclauswilke
authored
Make graticule labeling configurable (#2849)
* draw graticule labels on all sides; not yet configurable. * Make graticule labeling configurable. Closes #2846. * update documentation * specify graticule labeling via string * graticule labeling via cardinal coordinates * allow labeling by graticules and panel sides at the same time * fix documentation * fix news bullet * remove outdated code * fix typo in documentation * rebase, fix documentation * update NEWS * update NEWS and documentation
1 parent a4d7d81 commit 484a220

File tree

3 files changed

+241
-27
lines changed

3 files changed

+241
-27
lines changed

‎NEWS.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,10 @@
66

77
* `coord_sf()` now respects manual setting of axis tick labels (@clauswilke,
88
#2857, #2881).
9+
10+
* `coord_sf()` now accepts two new parameters, `label_graticule` and `label_axes`,
11+
that can be used to specify which graticules to label on which side of the plot
12+
(@clauswilke, #2846).
913

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

‎R/sf.R

Lines changed: 210 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -493,10 +493,6 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
493493
}
494494
graticule$degree_label[graticule$type == "N"] <- y_labels
495495

496-
# remove tick labels not on axes 1 (bottom) and 2 (left)
497-
if (!is.null(graticule$plot12))
498-
graticule$degree_label[!graticule$plot12] <- NA
499-
500496
# Parse labels if requested/needed
501497
has_degree <- grepl("\\bdegree\\b", graticule$degree_label)
502498
needs_parsing <- needs_parsing | (needs_autoparsing & has_degree)
@@ -541,7 +537,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
541537
x_range = x_range,
542538
y_range = y_range,
543539
graticule = graticule,
544-
crs = params$crs
540+
crs = params$crs,
541+
label_axes = self$label_axes,
542+
label_graticule = self$label_graticule
545543
)
546544
},
547545

@@ -577,32 +575,158 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
577575

578576
render_axis_h = function(self, panel_params, theme) {
579577
graticule <- panel_params$graticule
580-
east <- graticule[graticule$type == "E" & !is.na(graticule$degree_label), ]
581578

582-
list(
583-
top = nullGrob(),
584-
bottom = guide_axis(
585-
east$x_start,
586-
east$degree_label,
579+
# top axis
580+
id1 <- id2 <- integer(0)
581+
# labels based on panel side
582+
id1 <- c(id1, which(graticule$type == panel_params$label_axes$top & graticule$y_start > 0.999))
583+
id2 <- c(id2, which(graticule$type == panel_params$label_axes$top & graticule$y_end > 0.999))
584+
585+
# labels based on graticule direction
586+
if ("S" %in% panel_params$label_graticule) {
587+
id1 <- c(id1, which(graticule$type == "E" & graticule$y_start > 0.999))
588+
}
589+
if ("N" %in% panel_params$label_graticule) {
590+
id2 <- c(id2, which(graticule$type == "E" & graticule$y_end > 0.999))
591+
}
592+
if ("W" %in% panel_params$label_graticule) {
593+
id1 <- c(id1, which(graticule$type == "N" & graticule$y_start > 0.999))
594+
}
595+
if ("E" %in% panel_params$label_graticule) {
596+
id2 <- c(id2, which(graticule$type == "N" & graticule$y_end > 0.999))
597+
}
598+
599+
ticks1 <- graticule[unique(id1), ]
600+
ticks2 <- graticule[unique(id2), ]
601+
tick_positions <- c(ticks1$x_start, ticks2$x_end)
602+
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
603+
604+
if (length(tick_positions) > 0) {
605+
top <- guide_axis(
606+
tick_positions,
607+
tick_labels,
608+
position = "top",
609+
theme = theme
610+
)
611+
} else {
612+
top <- zeroGrob()
613+
}
614+
615+
# bottom axis
616+
id1 <- id2 <- integer(0)
617+
# labels based on panel side
618+
id1 <- c(id1, which(graticule$type == panel_params$label_axes$bottom & graticule$y_start < 0.001))
619+
id2 <- c(id2, which(graticule$type == panel_params$label_axes$bottom & graticule$y_end < 0.001))
620+
621+
# labels based on graticule direction
622+
if ("S" %in% panel_params$label_graticule) {
623+
id1 <- c(id1, which(graticule$type == "E" & graticule$y_start < 0.001))
624+
}
625+
if ("N" %in% panel_params$label_graticule) {
626+
id2 <- c(id2, which(graticule$type == "E" & graticule$y_end < 0.001))
627+
}
628+
if ("W" %in% panel_params$label_graticule) {
629+
id1 <- c(id1, which(graticule$type == "N" & graticule$y_start < 0.001))
630+
}
631+
if ("E" %in% panel_params$label_graticule) {
632+
id2 <- c(id2, which(graticule$type == "N" & graticule$y_end < 0.001))
633+
}
634+
635+
ticks1 <- graticule[unique(id1), ]
636+
ticks2 <- graticule[unique(id2), ]
637+
tick_positions <- c(ticks1$x_start, ticks2$x_end)
638+
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
639+
640+
if (length(tick_positions) > 0) {
641+
bottom <- guide_axis(
642+
tick_positions,
643+
tick_labels,
587644
position = "bottom",
588645
theme = theme
589646
)
590-
)
647+
} else {
648+
bottom <- zeroGrob()
649+
}
650+
651+
list(top = top, bottom = bottom)
591652
},
592653

593654
render_axis_v = function(self, panel_params, theme) {
594655
graticule <- panel_params$graticule
595-
north <- graticule[graticule$type == "N" & !is.na(graticule$degree_label), ]
596656

597-
list(
598-
left = guide_axis(
599-
north$y_start,
600-
north$degree_label,
657+
# right axis
658+
id1 <- id2 <- integer(0)
659+
# labels based on panel side
660+
id1 <- c(id1, which(graticule$type == panel_params$label_axes$right & graticule$x_end > 0.999))
661+
id2 <- c(id2, which(graticule$type == panel_params$label_axes$right & graticule$x_start > 0.999))
662+
663+
# labels based on graticule direction
664+
if ("N" %in% panel_params$label_graticule) {
665+
id1 <- c(id1, which(graticule$type == "E" & graticule$x_end > 0.999))
666+
}
667+
if ("S" %in% panel_params$label_graticule) {
668+
id2 <- c(id2, which(graticule$type == "E" & graticule$x_start > 0.999))
669+
}
670+
if ("E" %in% panel_params$label_graticule) {
671+
id1 <- c(id1, which(graticule$type == "N" & graticule$x_end > 0.999))
672+
}
673+
if ("W" %in% panel_params$label_graticule) {
674+
id2 <- c(id2, which(graticule$type == "N" & graticule$x_start > 0.999))
675+
}
676+
677+
ticks1 <- graticule[unique(id1), ]
678+
ticks2 <- graticule[unique(id2), ]
679+
tick_positions <- c(ticks1$y_end, ticks2$y_start)
680+
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
681+
682+
if (length(tick_positions) > 0) {
683+
right <- guide_axis(
684+
tick_positions,
685+
tick_labels,
686+
position = "right",
687+
theme = theme
688+
)
689+
} else {
690+
right <- zeroGrob()
691+
}
692+
693+
# left axis
694+
id1 <- id2 <- integer(0)
695+
# labels based on panel side
696+
id1 <- c(id1, which(graticule$type == panel_params$label_axes$left & graticule$x_end < 0.001))
697+
id2 <- c(id2, which(graticule$type == panel_params$label_axes$left & graticule$x_start < 0.001))
698+
699+
# labels based on graticule direction
700+
if ("N" %in% panel_params$label_graticule) {
701+
id1 <- c(id1, which(graticule$type == "E" & graticule$x_end < 0.001))
702+
}
703+
if ("S" %in% panel_params$label_graticule) {
704+
id2 <- c(id2, which(graticule$type == "E" & graticule$x_start < 0.001))
705+
}
706+
if ("E" %in% panel_params$label_graticule) {
707+
id1 <- c(id1, which(graticule$type == "N" & graticule$x_end < 0.001))
708+
}
709+
if ("W" %in% panel_params$label_graticule) {
710+
id2 <- c(id2, which(graticule$type == "N" & graticule$x_start < 0.001))
711+
}
712+
713+
ticks1 <- graticule[unique(id1), ]
714+
ticks2 <- graticule[unique(id2), ]
715+
tick_positions <- c(ticks1$y_end, ticks2$y_start)
716+
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
717+
718+
if (length(tick_positions) > 0) {
719+
left <- guide_axis(
720+
tick_positions,
721+
tick_labels,
601722
position = "left",
602723
theme = theme
603-
),
604-
right = nullGrob()
605-
)
724+
)
725+
} else {
726+
left <- zeroGrob()
727+
}
728+
729+
list(left = left, right = right)
606730
}
607731

608732
)
@@ -622,23 +746,85 @@ sf_rescale01_x <- function(x, range) {
622746
}
623747

624748

625-
#' @param crs Use this to select a specific CRS. If not specified, will
626-
#' use the CRS defined in the first layer.
749+
#' @param crs Use this to select a specific coordinate reference system (CRS).
750+
#' If not specified, will use the CRS defined in the first layer.
627751
#' @param datum CRS that provides datum to use when generating graticules
752+
#' @param label_axes Character vector or named list of character values
753+
#' specifying which graticule lines (meridians or parallels) should be labeled on
754+
#' which side of the plot. Meridians are indicated by `"E"` (for East) and
755+
#' parallels by `"N"` (for North). Default is `"--EN"`, which specifies
756+
#' (clockwise from the top) no labels on the top, none on the right, meridians
757+
#' on the bottom, and parallels on the left. Alternatively, this setting could have been
758+
#' specified with `list(bottom = "E", left = "N")`.
759+
#'
760+
#' This parameter can be used alone or in combination with `label_graticule`.
761+
#' @param label_graticule Character vector indicating which graticule lines should be labeled
762+
#' where. Meridians run north-south, and the letters `"N"` and `"S"` indicate that
763+
#' they should be labeled on their north or south end points, respectively.
764+
#' Parallels run east-west, and the letters `"E"` and `"W"` indicate that they
765+
#' should be labeled on their east or west end points, respectively. Thus,
766+
#' `label_graticule = "SW"` would label meridians at their south end and parallels at
767+
#' their west end, whereas `label_graticule = "EW"` would label parallels at both
768+
#' ends and meridians not at all. Because meridians and parallels can in general
769+
#' intersect with any side of the plot panel, for any choice of `label_graticule` labels
770+
#' are not guaranteed to reside on only one particular side of the plot panel.
771+
#'
772+
#' This parameter can be used alone or in combination with `label_axes`.
628773
#' @param ndiscr number of segments to use for discretising graticule lines;
629774
#' try increasing this when graticules look unexpected
630775
#' @inheritParams coord_cartesian
631776
#' @export
632777
#' @rdname ggsf
633778
coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
634-
crs = NULL, datum = sf::st_crs(4326), ndiscr = 100,
635-
default = FALSE) {
779+
crs = NULL, datum = sf::st_crs(4326),
780+
label_graticule = waiver(),
781+
label_axes = waiver(),
782+
ndiscr = 100, default = FALSE) {
783+
784+
if (is.waive(label_graticule) && is.waive(label_axes)) {
785+
# if both `label_graticule` and `label_axes` are set to waive then we
786+
# use the default of labels on the left and at the bottom
787+
label_graticule <- ""
788+
label_axes <- "--EN"
789+
} else {
790+
# if at least one is set we ignore the other
791+
label_graticule <- label_graticule %|W|% ""
792+
label_axes <- label_axes %|W|% ""
793+
}
794+
795+
if (is.character(label_axes)) {
796+
label_axes <- parse_axes_labeling(label_axes)
797+
} else if (!is.list(label_axes)) {
798+
stop(
799+
"Panel labeling format not recognized.",
800+
call. = FALSE
801+
)
802+
label_axes <- list(left = "N", bottom = "E")
803+
}
804+
805+
if (is.character(label_graticule)) {
806+
label_graticule <- unlist(strsplit(label_graticule, ""))
807+
} else {
808+
stop(
809+
"Graticule labeling format not recognized.",
810+
call. = FALSE
811+
)
812+
label_graticule <- ""
813+
}
814+
636815
ggproto(NULL, CoordSf,
637816
limits = list(x = xlim, y = ylim),
638817
datum = datum,
639818
crs = crs,
819+
label_axes = label_axes,
820+
label_graticule = label_graticule,
640821
ndiscr = ndiscr,
641822
expand = expand,
642823
default = default
643824
)
644825
}
826+
827+
parse_axes_labeling <- function(x) {
828+
labs = unlist(strsplit(x, ""))
829+
list(top = labs[1], right = labs[2], bottom = labs[3], left = labs[4])
830+
}

‎man/ggsf.Rd

Lines changed: 27 additions & 3 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)