From b0bf6531b6110b31baad2717e970ccd586510c7b Mon Sep 17 00:00:00 2001 From: Carl Suster Date: Fri, 26 May 2023 10:48:51 +1000 Subject: [PATCH] Revert "Remove coord_automap_zoom()" This reverts commit c62c79939463fee001619ba8980d01a480d0cda7. --- DESCRIPTION | 1 + NAMESPACE | 2 + R/coord_automap.R | 1 + R/coord_automap_zoom.R | 105 +++++++++++++++++++++++++++++++++++ R/position_circle_repel.R | 2 +- man/coord_automap.Rd | 3 + man/coord_automap_zoom.Rd | 54 ++++++++++++++++++ man/position_circle_repel.Rd | 2 +- vignettes/ggautomap.Rmd | 4 +- 9 files changed, 171 insertions(+), 3 deletions(-) create mode 100644 R/coord_automap_zoom.R create mode 100644 man/coord_automap_zoom.Rd diff --git a/DESCRIPTION b/DESCRIPTION index e48deb4..08616a9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,6 +40,7 @@ Collate: 'choropleth.R' 'configure_inset.R' 'coord_automap.R' + 'coord_automap_zoom.R' 'crs.R' 'geom_boundaries.R' 'geom_centroids.R' diff --git a/NAMESPACE b/NAMESPACE index 2dfc20d..30173a4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(ggplot_add,ggautomap_zoom_spec) export(GeomSfInset) export(PositionCircleRepel) export(PositionCircleRepelSf) @@ -11,6 +12,7 @@ export(StatSfCoordinatesInset) export(StatSfInset) export(configure_inset) export(coord_automap) +export(coord_automap_zoom) export(crs_eqc) export(geom_boundaries) export(geom_centroids) diff --git a/R/coord_automap.R b/R/coord_automap.R index 60c15aa..a137e58 100644 --- a/R/coord_automap.R +++ b/R/coord_automap.R @@ -10,6 +10,7 @@ #' @param ... Arguments passed to [ggmapinset::coord_sf_inset()] #' #' @returns A ggplot coordinate +#' @seealso [coord_automap_zoom()] #' @export #' @examples #' library(ggplot2) diff --git a/R/coord_automap_zoom.R b/R/coord_automap_zoom.R new file mode 100644 index 0000000..25e4970 --- /dev/null +++ b/R/coord_automap_zoom.R @@ -0,0 +1,105 @@ +#' Zoom a map to show only certain features +#' +#' This is a wrapper around [coord_automap()] that automatically calculates +#' coordinate limits based on the data and/or any additional locations. The +#' bounding box will be calculated to encompass all of the \code{include}d +#' locations. +#' +#' This should be added to the plot _after_ the call to one of the ggautomap +#' geoms. It will copy the \code{location} aethetic mapping from the first such +#' layer in the plot. If there is no such layer, it will attempt to use the data +#' and \code{location} mapping found at the top level \code{ggplot()} call. +#' +#' @param include Vector of feature names that should be shown on the map. +#' @param include_data Scalar logical, if true then all features with data are +#' also included. +#' @inheritParams coord_automap +#' @param ... Additional arguments passed to [coord_automap()]. +#' +#' @returns A zoom specification that can be added to a ggplot object with [ggplot2::%+%]. +#' @seealso [coord_automap()] +#' @export +#' +#' @examples +#' library(ggplot2) +#' +#' # zoom in on locations that have data: +#' cartographer::nc_type_example_2 |> +#' ggplot(aes(location = county)) + +#' geom_boundaries(feature_type = "sf.nc") + +#' geom_choropleth() + +#' coord_automap_zoom(feature_type = "sf.nc") +#' +#' # or just zoom in on specific locations regardless of the data: +#' cartographer::nc_type_example_2 |> +#' ggplot(aes(location = county)) + +#' geom_boundaries(feature_type = "sf.nc") + +#' coord_automap_zoom(include = c("Rowan", "Polk"), include_data = FALSE, feature_type = "sf.nc") +coord_automap_zoom <- function(include = NULL, include_data = TRUE, feature_type = NA, ...) { + structure( + list( + include = include, include_data = include_data, + feature_type = feature_type, + coord_automap_args = rlang::list2(...) + ), + class = "ggautomap_zoom_spec" + ) +} + +#' @export +ggplot_add.ggautomap_zoom_spec <- function(object, plot, object_name) { + spec <- object + data_location <- NA + + # find the first ggautomap layer with a mapping for location + for (layer in plot$layers) { + if (is_ggautomap_stat(layer$stat)) { + mapping <- layer$mapping + if (!("location" %in% names(mapping))) { + mapping <- plot$mapping + } + if (!("location" %in% names(mapping))) { + cli::cli_warn("unable to find {.val location} aesthetic in layer") + } + data <- layer$layer_data(plot$data) + data_location <- dplyr::pull(data, !!mapping$location) + break + } + } + + if (any(is.na(data_location))) { + if (inherits(plot$data, "data.frame") && ("location" %in% names(plot$mapping))) { + data_location <- dplyr::pull(plot$data, !!plot$mapping$location) + } + } + + if (any(is.na(data_location))) { + cli::cli_abort(c("{.fn coord_automap_zoom} unable to find plot data", + "i" = "add {.emph after} a {.pkg ggautomap} layer like {.fn geom_geoscatter} or {.fn geom_centroids}", + "i" = "alternatively, define the {.arg data} and the {.field location} aesthetic in the top level {.fn ggplot} call" + )) + } + + feature_type <- get_feature_type(spec$feature_type, list(), data_location) + + include <- cartographer::resolve_feature_names(spec$include, feature_type) + if (spec$include_data) { + include <- unique(c(include, data_location)) + } + + geoms <- cartographer::map_sf(feature_type) + geom_locations <- cartographer::feature_names(feature_type) + bbox <- sf::st_bbox(geoms[geom_locations %in% include, ]) + + args <- spec$coord_automap_args + args$feature_type <- feature_type + args$xlim <- c(bbox[[1]], bbox[[3]]) + args$ylim <- c(bbox[[2]], bbox[[4]]) + + plot + do.call(coord_automap, args) +} + +is_ggautomap_stat <- function(stat) { + # these need to have a location aesthetic and a feature_type param + inherits(stat, "StatAutomap") || inherits(stat, "StatAutomapCoords") +} diff --git a/R/position_circle_repel.R b/R/position_circle_repel.R index c629d49..11ae647 100644 --- a/R/position_circle_repel.R +++ b/R/position_circle_repel.R @@ -34,7 +34,7 @@ #' ggplot(aes(location = county)) + #' geom_boundaries(feature_type = "sf.nc") + #' geom_centroids(aes(colour = type), position = position_circle_repel_sf(scale = 4), size = 0.2) + -#' coord_automap(feature_type = "sf.nc") +#' coord_automap_zoom() # # FIXME: points <- data.frame(county = counties, s = ifelse(counties == nc$NAME[[1]], 5, 10)) position_circle_repel <- function(scale = 1 / 4) { diff --git a/man/coord_automap.Rd b/man/coord_automap.Rd index 83cc62a..ae3063f 100644 --- a/man/coord_automap.Rd +++ b/man/coord_automap.Rd @@ -33,3 +33,6 @@ ggplot(nc_type_example_2, aes(location = county)) + geom_sf_label_inset(aes(label = county), stat = "automap_coords", size = 3) + coord_automap(feature_type = "sf.nc") } +\seealso{ +\code{\link[=coord_automap_zoom]{coord_automap_zoom()}} +} diff --git a/man/coord_automap_zoom.Rd b/man/coord_automap_zoom.Rd new file mode 100644 index 0000000..23ac620 --- /dev/null +++ b/man/coord_automap_zoom.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coord_automap_zoom.R +\name{coord_automap_zoom} +\alias{coord_automap_zoom} +\title{Zoom a map to show only certain features} +\usage{ +coord_automap_zoom(include = NULL, include_data = TRUE, feature_type = NA, ...) +} +\arguments{ +\item{include}{Vector of feature names that should be shown on the map.} + +\item{include_data}{Scalar logical, if true then all features with data are +also included.} + +\item{feature_type}{Type of map feature. See \code{\link[cartographer:feature_types]{feature_types()}} for a list of +registered types. If \code{NA}, the type is guessed based on the values in +\code{feature_names}.} + +\item{...}{Additional arguments passed to \code{\link[=coord_automap]{coord_automap()}}.} +} +\value{ +A zoom specification that can be added to a ggplot object with \link[ggplot2:gg-add]{ggplot2::\%+\%}. +} +\description{ +This is a wrapper around \code{\link[=coord_automap]{coord_automap()}} that automatically calculates +coordinate limits based on the data and/or any additional locations. The +bounding box will be calculated to encompass all of the \code{include}d +locations. +} +\details{ +This should be added to the plot \emph{after} the call to one of the ggautomap +geoms. It will copy the \code{location} aethetic mapping from the first such +layer in the plot. If there is no such layer, it will attempt to use the data +and \code{location} mapping found at the top level \code{ggplot()} call. +} +\examples{ +library(ggplot2) + +# zoom in on locations that have data: +cartographer::nc_type_example_2 |> + ggplot(aes(location = county)) + + geom_boundaries(feature_type = "sf.nc") + + geom_choropleth() + + coord_automap_zoom(feature_type = "sf.nc") + +# or just zoom in on specific locations regardless of the data: +cartographer::nc_type_example_2 |> + ggplot(aes(location = county)) + + geom_boundaries(feature_type = "sf.nc") + + coord_automap_zoom(include = c("Rowan", "Polk"), include_data = FALSE, feature_type = "sf.nc") +} +\seealso{ +\code{\link[=coord_automap]{coord_automap()}} +} diff --git a/man/position_circle_repel.Rd b/man/position_circle_repel.Rd index 8702e66..2cda14a 100644 --- a/man/position_circle_repel.Rd +++ b/man/position_circle_repel.Rd @@ -49,6 +49,6 @@ cartographer::nc_type_example_2 |> ggplot(aes(location = county)) + geom_boundaries(feature_type = "sf.nc") + geom_centroids(aes(colour = type), position = position_circle_repel_sf(scale = 4), size = 0.2) + - coord_automap(feature_type = "sf.nc") + coord_automap_zoom() } \keyword{datasets} diff --git a/vignettes/ggautomap.Rmd b/vignettes/ggautomap.Rmd index 55c8222..463ffe1 100644 --- a/vignettes/ggautomap.Rmd +++ b/vignettes/ggautomap.Rmd @@ -48,12 +48,14 @@ covid_cases_nsw %>% ggplot(aes(location = lga)) + geom_boundaries(feature_type = "nswgeo.lga") + geom_geoscatter(aes(colour = type), sample_type = "random", size = 0.5) + - coord_automap(feature_type = "nswgeo.lga", xlim = c(147, 153), ylim = c(-33.7, -29)) + + coord_automap_zoom(feature_type = "nswgeo.lga") + guides(colour = guide_legend(override.aes = list(size = 1))) + theme_void() ``` Points are drawn at random within the boundaries of their location. +This example also uses `coord_automap_zoom()` as a replacement for `coord_automap()` +that automatically crops the map around your data points. ## Insets