R/stat-sf-coordinates.R

In TomeTiger/ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics

#' Extract coordinates from 'sf' objects
#'
#' `stat_sf_coordinates()` extracts the coordinates from 'sf' objects and
#' summarises them to one pair of coordinates (x and y) per geometry. This is
#' convenient when you draw an sf object as geoms like text and labels (so
#' [geom_sf_text()] and [geom_sf_label()] relies on this).
#'
#' @rdname stat_sf_coordinates
#' @details
#' coordinates of an `sf` object can be retrieved by `sf::st_coordinates()`.
#' But, we cannot simply use `sf::st_coordinates()` because, whereas text and
#' labels require exactly one coordinate per geometry, it returns multiple ones
#' for a polygon or a line. Thus, these two steps are needed:
#'
#' 1. Choose one point per geometry by some function like `sf::st_centroid()`
#'    or `sf::st_point_on_surface()`.
#' 2. Retrieve coordinates from the points by `sf::st_coordinates()`.
#'
#' For the first step, you can use an arbitrary function via `fun.geometry`.
#' By default, `function(x) sf::st_point_on_surface(sf::st_zm(x))` is used;
#' `sf::st_point_on_surface()` seems more appropriate than `sf::st_centroid()`
#' since lables and text usually are intended to be put within the polygon or
#' the line. `sf::st_zm()` is needed to drop Z and M dimension beforehand,
#' otherwise `sf::st_point_on_surface()` may fail when the geometries have M
#' dimension.
#'
#' @section Computed variables:
#' \describe{
#'   \item{x}{X dimension of the simple feature}
#'   \item{y}{Y dimension of the simple feature}
#' }
#'
#' @examples
#' if (requireNamespace("sf", quietly = TRUE)) {
#' nc <- sf::st_read(system.file("shape/nc.shp", package="sf"))
#'
#' ggplot(nc) +
#'   stat_sf_coordinates()
#'
#' ggplot(nc) +
#'   geom_errorbarh(
#'     aes(geometry = geometry,
#'         xmin = stat(x) - 0.1,
#'         xmax = stat(x) + 0.1,
#'         y = stat(y),
#'         height = 0.04),
#'     stat = "sf_coordinates"
#'   )
#' }
#'
#' @export
#' @inheritParams stat_identity
#' @inheritParams geom_point
#' @param fun.geometry
#'   A function that takes a `sfc` object and returns a `sfc_POINT` with the
#'   same length as the input. If `NULL`, `function(x) sf::st_point_on_surface(sf::st_zm(x))`
#'   will be used. Note that the function may warn about the incorrectness of
#'   the result if the data is not projected, but you can ignore this except
#'   when you really care about the exact locations.
stat_sf_coordinates <- function(mapping = aes(), data = NULL, geom = "point",
                                position = "identity", na.rm = FALSE,
                                show.legend = NA, inherit.aes = TRUE,
                                fun.geometry = NULL,
                                ...) {
  layer(
    stat = StatSfCoordinates,
    data = data,
    mapping = mapping,
    geom = geom,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      fun.geometry = fun.geometry,
      ...
    ),
    layer_class = LayerSf
  )
}

#' @rdname stat_sf_coordinates
#' @usage NULL
#' @format NULL
#' @export
StatSfCoordinates <- ggproto(
  "StatSfCoordinates", Stat,
  compute_group = function(data, scales, fun.geometry = NULL) {
    if (is.null(fun.geometry)) {
      fun.geometry <- function(x) sf::st_point_on_surface(sf::st_zm(x))
    }

    points_sfc <- fun.geometry(data$geometry)
    coordinates <- sf::st_coordinates(points_sfc)
    data$x <- coordinates[, "X"]
    data$y <- coordinates[, "Y"]

    data
  },

  default_aes = aes(x = stat(x), y = stat(y)),
  required_aes = c("geometry")
)