Zoom to data

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'

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)

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)

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")
+}

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) {

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