From cac3a950f2d2ca78a78c16dfd5a79042a127b87e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Fri, 24 Aug 2018 21:59:34 +0900 Subject: [PATCH] Implement geom_sf_label() and geom_sf_text() (#2761) Closes #2742 * Add geom_sf_label() and geom_sf_text() * Add a missing parenthesis * Add tests for stat_sf_coordinates() * Fix a typo * Fix a typo in examples * Add visual tests for geom_sf_label() and geom_sf_text() * Match args for stat_sf_coordinates() and StatSfCoordinates$compute_group() * Document stat_sf_coordinates()'s na.rm * Add documents about stat_sf_coordinats() * Set the default of fun.geometry to NULL When sf package is not installed, test-function-args fails. * Set more fun.geometry to NULL * Fix mistakenly passed sf::point_on_surface * Stop cross-referencing sf functions * Ignore Z and M dimension * Fix the example of stat_sf_coordinates() * Remove Rplot001.png * Fix doc of stat_sf_coordinates() * Fix an example of stat_sf_coordinates() * Fix default fun.geometry and tests * Fix a typo in doc * Add reference images for vdiffr tests * Disable stat-sf-coordinates test * Fix "texts" to "text", and move seealso * Add () to functions in ggsf.Rd for consitency * Add a news bullet --- DESCRIPTION | 1 + NAMESPACE | 4 + NEWS.md | 5 + R/sf.R | 125 +++++++++++++++++- R/stat-sf-coordinates.R | 112 ++++++++++++++++ man/ggsf.Rd | 56 +++++++- man/stat_sf_coordinates.Rd | 115 ++++++++++++++++ .../geom-sf/labels-for-north-carolina.svg | 59 +++++++++ .../figs/geom-sf/texts-for-north-carolina.svg | 56 ++++++++ tests/testthat/test-geom-sf.R | 27 ++++ tests/testthat/test-stat-sf-coordinates.R | 47 +++++++ 11 files changed, 597 insertions(+), 10 deletions(-) create mode 100644 R/stat-sf-coordinates.R create mode 100644 man/stat_sf_coordinates.Rd create mode 100644 tests/figs/geom-sf/labels-for-north-carolina.svg create mode 100644 tests/figs/geom-sf/texts-for-north-carolina.svg create mode 100644 tests/testthat/test-stat-sf-coordinates.R diff --git a/DESCRIPTION b/DESCRIPTION index 9cbbd67a3e..a4c42caa52 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -212,6 +212,7 @@ Collate: 'stat-qq-line.R' 'stat-qq.r' 'stat-quantile.r' + 'stat-sf-coordinates.R' 'stat-smooth-methods.r' 'stat-smooth.r' 'stat-sum.r' diff --git a/NAMESPACE b/NAMESPACE index e14b3233d1..efac71dcab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -217,6 +217,7 @@ export(StatQq) export(StatQqLine) export(StatQuantile) export(StatSf) +export(StatSfCoordinates) export(StatSmooth) export(StatSum) export(StatSummary) @@ -335,6 +336,8 @@ export(geom_ribbon) export(geom_rug) export(geom_segment) export(geom_sf) +export(geom_sf_label) +export(geom_sf_text) export(geom_smooth) export(geom_spoke) export(geom_step) @@ -527,6 +530,7 @@ export(stat_qq) export(stat_qq_line) export(stat_quantile) export(stat_sf) +export(stat_sf_coordinates) export(stat_smooth) export(stat_spoke) export(stat_sum) diff --git a/NEWS.md b/NEWS.md index 520dc1e6ee..baf9a42262 100644 --- a/NEWS.md +++ b/NEWS.md @@ -41,6 +41,11 @@ is now always internally converted to "colour", even when part of a longer aesthetic name (e.g., `point_color`) (@clauswilke, #2649). +* New `geom_sf_label()` and `geom_sf_text()` draw labels and text on sf objects. + Under the hood, new `stat_sf_coordinates()` calculates the x and y from the + coordinates of the geometries. You can customize the calculation method via + `fun.geometry` argument (@yutannihilation, #2761). + # ggplot2 3.0.0 ## Breaking changes diff --git a/R/sf.R b/R/sf.R index e88fc733f8..f47808a316 100644 --- a/R/sf.R +++ b/R/sf.R @@ -1,18 +1,19 @@ #' Visualise sf objects #' #' This set of geom, stat, and coord are used to visualise simple feature (sf) -#' objects. For simple plots, you will only need `geom_sf` as it -#' uses `stat_sf` and adds `coord_sf` for you. `geom_sf` is +#' objects. For simple plots, you will only need `geom_sf()` as it +#' uses `stat_sf()` and adds `coord_sf()` for you. `geom_sf()` is #' an unusual geom because it will draw different geometric objects depending #' on what simple features are present in the data: you can get points, lines, #' or polygons. +#' For text and labels, you can use `geom_sf_text()` and `geom_sf_label()`. #' #' @section Geometry aesthetic: -#' `geom_sf` uses a unique aesthetic: `geometry`, giving an +#' `geom_sf()` uses a unique aesthetic: `geometry`, giving an #' column of class `sfc` containing simple features data. There #' are three ways to supply the `geometry` aesthetic: #' -#' - Do nothing: by default `geom_sf` assumes it is stored in +#' - Do nothing: by default `geom_sf()` assumes it is stored in #' the `geometry` column. #' - Explicitly pass an `sf` object to the `data` argument. #' This will use the primary geometry column, no matter what it's called. @@ -23,7 +24,7 @@ #' #' @section CRS: #' `coord_sf()` ensures that all layers use a common CRS. You can -#' either specify it using the `CRS` param, or `coord_sf` will +#' either specify it using the `CRS` param, or `coord_sf()` will #' take it from the first layer that defines a CRS. #' #' @param show.legend logical. Should this layer be included in the legends? @@ -32,6 +33,7 @@ #' #' You can also set this to one of "polygon", "line", and "point" to #' override the default legend. +#' @seealso [stat_sf_coordinates()] #' @examples #' if (requireNamespace("sf", quietly = TRUE)) { #' nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) @@ -70,6 +72,11 @@ #' "+proj=laea +y_0=0 +lon_0=155 +lat_0=-90 +ellps=WGS84 +no_defs" #' ) #' ggplot() + geom_sf(data = world2) +#' +#' # To add labels, use geom_sf_label(). +#' ggplot(nc_3857[1:3, ]) + +#' geom_sf(aes(fill = AREA)) + +#' geom_sf_label(aes(label = NAME)) #' } #' @name ggsf NULL @@ -257,6 +264,114 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf", ) } +#' @export +#' @rdname ggsf +#' @inheritParams geom_label +#' @inheritParams stat_sf_coordinates +geom_sf_label <- function(mapping = aes(), data = NULL, + stat = "sf_coordinates", position = "identity", + ..., + parse = FALSE, + nudge_x = 0, + nudge_y = 0, + label.padding = unit(0.25, "lines"), + label.r = unit(0.15, "lines"), + label.size = 0.25, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE, + fun.geometry = NULL) { + + # Automatically determin name of geometry column + if (!is.null(data) && is_sf(data)) { + geometry_col <- attr(data, "sf_column") + } else { + geometry_col <- "geometry" + } + if (is.null(mapping$geometry)) { + mapping$geometry <- as.name(geometry_col) + } + + if (!missing(nudge_x) || !missing(nudge_y)) { + if (!missing(position)) { + stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) + } + + position <- position_nudge(nudge_x, nudge_y) + } + + layer( + data = data, + mapping = mapping, + stat = stat, + geom = GeomLabel, + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list( + parse = parse, + label.padding = label.padding, + label.r = label.r, + label.size = label.size, + na.rm = na.rm, + fun.geometry = fun.geometry, + ... + ) + ) +} + +#' @export +#' @rdname ggsf +#' @inheritParams geom_text +#' @inheritParams stat_sf_coordinates +geom_sf_text <- function(mapping = aes(), data = NULL, + stat = "sf_coordinates", position = "identity", + ..., + parse = FALSE, + nudge_x = 0, + nudge_y = 0, + check_overlap = FALSE, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE, + fun.geometry = NULL) { + # Automatically determin name of geometry column + if (!is.null(data) && is_sf(data)) { + geometry_col <- attr(data, "sf_column") + } else { + geometry_col <- "geometry" + } + if (is.null(mapping$geometry)) { + mapping$geometry <- as.name(geometry_col) + } + + if (!missing(nudge_x) || !missing(nudge_y)) { + if (!missing(position)) { + stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) + } + + position <- position_nudge(nudge_x, nudge_y) + } + + layer( + data = data, + mapping = mapping, + stat = stat, + geom = GeomText, + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list( + parse = parse, + check_overlap = check_overlap, + na.rm = na.rm, + fun.geometry = fun.geometry, + ... + ) + ) +} + + #' @export scale_type.sfc <- function(x) "identity" diff --git a/R/stat-sf-coordinates.R b/R/stat-sf-coordinates.R new file mode 100644 index 0000000000..4893829d6f --- /dev/null +++ b/R/stat-sf-coordinates.R @@ -0,0 +1,112 @@ +#' 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, + ...) { + # Automatically determin name of geometry column + if (!is.null(data) && is_sf(data)) { + geometry_col <- attr(data, "sf_column") + } else { + geometry_col <- "geometry" + } + if (is.null(mapping$geometry)) { + mapping$geometry <- as.name(geometry_col) + } + + 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, + ... + ) + ) +} + +#' @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") +) diff --git a/man/ggsf.Rd b/man/ggsf.Rd index c9222848f7..9bb16eb742 100644 --- a/man/ggsf.Rd +++ b/man/ggsf.Rd @@ -7,6 +7,8 @@ \alias{stat_sf} \alias{GeomSf} \alias{geom_sf} +\alias{geom_sf_label} +\alias{geom_sf_text} \alias{CoordSf} \alias{coord_sf} \title{Visualise sf objects} @@ -19,6 +21,17 @@ geom_sf(mapping = aes(), data = NULL, stat = "sf", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) +geom_sf_label(mapping = aes(), data = NULL, stat = "sf_coordinates", + position = "identity", ..., parse = FALSE, nudge_x = 0, + nudge_y = 0, label.padding = unit(0.25, "lines"), + label.r = unit(0.15, "lines"), label.size = 0.25, na.rm = FALSE, + show.legend = NA, inherit.aes = TRUE, fun.geometry = NULL) + +geom_sf_text(mapping = aes(), data = NULL, stat = "sf_coordinates", + position = "identity", ..., parse = FALSE, nudge_x = 0, + nudge_y = 0, check_overlap = FALSE, na.rm = FALSE, + show.legend = NA, inherit.aes = TRUE, fun.geometry = NULL) + coord_sf(xlim = NULL, ylim = NULL, expand = TRUE, crs = NULL, datum = sf::st_crs(4326), ndiscr = 100, default = FALSE) } @@ -70,6 +83,30 @@ to the paired geom/stat.} \item{stat}{The statistical transformation to use on the data for this layer, as a string.} +\item{parse}{If \code{TRUE}, the labels will be parsed into expressions and +displayed as described in \code{?plotmath}.} + +\item{nudge_x}{Horizontal and vertical adjustment to nudge labels by. +Useful for offsetting text from points, particularly on discrete scales.} + +\item{nudge_y}{Horizontal and vertical adjustment to nudge labels by. +Useful for offsetting text from points, particularly on discrete scales.} + +\item{label.padding}{Amount of padding around label. Defaults to 0.25 lines.} + +\item{label.r}{Radius of rounded corners. Defaults to 0.15 lines.} + +\item{label.size}{Size of label border, in mm.} + +\item{fun.geometry}{A function that takes a \code{sfc} object and returns a \code{sfc_POINT} with the +same length as the input. If \code{NULL}, \code{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.} + +\item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the +same layer will not be plotted.} + \item{xlim}{Limits for the x and y axes.} \item{ylim}{Limits for the x and y axes.} @@ -93,19 +130,20 @@ is suppressed.} } \description{ This set of geom, stat, and coord are used to visualise simple feature (sf) -objects. For simple plots, you will only need \code{geom_sf} as it -uses \code{stat_sf} and adds \code{coord_sf} for you. \code{geom_sf} is +objects. For simple plots, you will only need \code{geom_sf()} as it +uses \code{stat_sf()} and adds \code{coord_sf()} for you. \code{geom_sf()} is an unusual geom because it will draw different geometric objects depending on what simple features are present in the data: you can get points, lines, or polygons. +For text and labels, you can use \code{geom_sf_text()} and \code{geom_sf_label()}. } \section{Geometry aesthetic}{ -\code{geom_sf} uses a unique aesthetic: \code{geometry}, giving an +\code{geom_sf()} uses a unique aesthetic: \code{geometry}, giving an column of class \code{sfc} containing simple features data. There are three ways to supply the \code{geometry} aesthetic: \itemize{ -\item Do nothing: by default \code{geom_sf} assumes it is stored in +\item Do nothing: by default \code{geom_sf()} assumes it is stored in the \code{geometry} column. \item Explicitly pass an \code{sf} object to the \code{data} argument. This will use the primary geometry column, no matter what it's called. @@ -119,7 +157,7 @@ the plot. \section{CRS}{ \code{coord_sf()} ensures that all layers use a common CRS. You can -either specify it using the \code{CRS} param, or \code{coord_sf} will +either specify it using the \code{CRS} param, or \code{coord_sf()} will take it from the first layer that defines a CRS. } @@ -161,6 +199,14 @@ world2 <- sf::st_transform( "+proj=laea +y_0=0 +lon_0=155 +lat_0=-90 +ellps=WGS84 +no_defs" ) ggplot() + geom_sf(data = world2) + +# To add labels, use geom_sf_label(). +ggplot(nc_3857[1:3, ]) + + geom_sf(aes(fill = AREA)) + + geom_sf_label(aes(label = NAME)) +} } +\seealso{ +\code{\link[=stat_sf_coordinates]{stat_sf_coordinates()}} } \keyword{datasets} diff --git a/man/stat_sf_coordinates.Rd b/man/stat_sf_coordinates.Rd new file mode 100644 index 0000000000..e658ffefb0 --- /dev/null +++ b/man/stat_sf_coordinates.Rd @@ -0,0 +1,115 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stat-sf-coordinates.R +\docType{data} +\name{stat_sf_coordinates} +\alias{stat_sf_coordinates} +\alias{StatSfCoordinates} +\title{Extract coordinates from 'sf' objects} +\usage{ +stat_sf_coordinates(mapping = aes(), data = NULL, geom = "point", + position = "identity", na.rm = FALSE, show.legend = NA, + inherit.aes = TRUE, fun.geometry = NULL, ...) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or +\code{\link[=aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the +default), it is combined with the default mapping at the top level of the +plot. You must supply \code{mapping} if there is no plot mapping.} + +\item{data}{The data to be displayed in this layer. There are three +options: + +If \code{NULL}, the default, the data is inherited from the plot +data as specified in the call to \code{\link[=ggplot]{ggplot()}}. + +A \code{data.frame}, or other object, will override the plot +data. All objects will be fortified to produce a data frame. See +\code{\link[=fortify]{fortify()}} for which variables will be created. + +A \code{function} will be called with a single argument, +the plot data. The return value must be a \code{data.frame}, and +will be used as the layer data.} + +\item{geom}{The geometric object to use display the data} + +\item{position}{Position adjustment, either as a string, or the result of +a call to a position adjustment function.} + +\item{na.rm}{If \code{FALSE}, the default, missing values are removed with +a warning. If \code{TRUE}, missing values are silently removed.} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes. +It can also be a named logical vector to finely select the aesthetics to +display.} + +\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +rather than combining with them. This is most useful for helper functions +that define both data and aesthetics and shouldn't inherit behaviour from +the default plot specification, e.g. \code{\link[=borders]{borders()}}.} + +\item{fun.geometry}{A function that takes a \code{sfc} object and returns a \code{sfc_POINT} with the +same length as the input. If \code{NULL}, \code{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.} + +\item{...}{Other arguments passed on to \code{\link[=layer]{layer()}}. These are +often aesthetics, used to set an aesthetic to a fixed value, like +\code{colour = "red"} or \code{size = 3}. They may also be parameters +to the paired geom/stat.} +} +\description{ +\code{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 +\code{\link[=geom_sf_text]{geom_sf_text()}} and \code{\link[=geom_sf_label]{geom_sf_label()}} relies on this). +} +\details{ +coordinates of an \code{sf} object can be retrieved by \code{sf::st_coordinates()}. +But, we cannot simply use \code{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: +\enumerate{ +\item Choose one point per geometry by some function like \code{sf::st_centroid()} +or \code{sf::st_point_on_surface()}. +\item Retrieve coordinates from the points by \code{sf::st_coordinates()}. +} + +For the first step, you can use an arbitrary function via \code{fun.geometry}. +By default, \code{function(x) sf::st_point_on_surface(sf::st_zm(x))} is used; +\code{sf::st_point_on_surface()} seems more appropriate than \code{sf::st_centroid()} +since lables and text usually are intended to be put within the polygon or +the line. \code{sf::st_zm()} is needed to drop Z and M dimension beforehand, +otherwise \code{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" + ) +} + +} +\keyword{datasets} diff --git a/tests/figs/geom-sf/labels-for-north-carolina.svg b/tests/figs/geom-sf/labels-for-north-carolina.svg new file mode 100644 index 0000000000..c1643d8b1a --- /dev/null +++ b/tests/figs/geom-sf/labels-for-north-carolina.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + +Ashe + +Alleghany + +Surry + + + + + + +4354000 +4356000 +4358000 +4360000 +4362000 +4364000 +4366000 + + + + + + + + + + + +-9075000 +-9050000 +-9025000 +-9000000 +x +y +Labels for North Carolina + diff --git a/tests/figs/geom-sf/texts-for-north-carolina.svg b/tests/figs/geom-sf/texts-for-north-carolina.svg new file mode 100644 index 0000000000..633254ec86 --- /dev/null +++ b/tests/figs/geom-sf/texts-for-north-carolina.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + +Ashe +Alleghany +Surry + + + + + + +4354000 +4356000 +4358000 +4360000 +4362000 +4364000 +4366000 + + + + + + + + + + + +-9075000 +-9050000 +-9025000 +-9000000 +x +y +Texts for North Carolina + diff --git a/tests/testthat/test-geom-sf.R b/tests/testthat/test-geom-sf.R index d2abdd3426..c46d6a2e82 100644 --- a/tests/testthat/test-geom-sf.R +++ b/tests/testthat/test-geom-sf.R @@ -31,3 +31,30 @@ test_that("geom_sf draws correctly", { ggplot() + geom_sf(data = pts) ) }) + +test_that("geom_sf_text() and geom_sf_label() draws correctly", { + skip_if_not_installed("sf") + if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3") + + f <- system.file("gpkg/nc.gpkg", package="sf") + nc <- sf::read_sf(f) + # In order to avoid warning, trnasform to a projected coordinate system + nc_3857 <- sf::st_transform(nc, "+init=epsg:3857") + + # Perform minimal tests as long as vdiffr tests are disabled + plot <- ggplot() + geom_sf_text(data = nc_3857[1:3, ], aes(label = NAME)) + expect_error(regexp = NA, ggplot_build(plot)) + + plot <- ggplot() + geom_sf_label(data = nc_3857[1:3, ], aes(label = NAME)) + expect_error(regexp = NA, ggplot_build(plot)) + + skip("sf tests are currently unstable") + + expect_doppelganger("Texts for North Carolina", + ggplot() + geom_sf_text(data = nc_3857[1:3, ], aes(label = NAME)) + ) + + expect_doppelganger("Labels for North Carolina", + ggplot() + geom_sf_label(data = nc_3857[1:3, ], aes(label = NAME)) + ) +}) diff --git a/tests/testthat/test-stat-sf-coordinates.R b/tests/testthat/test-stat-sf-coordinates.R new file mode 100644 index 0000000000..6c56c213b7 --- /dev/null +++ b/tests/testthat/test-stat-sf-coordinates.R @@ -0,0 +1,47 @@ +context("stat_sf_coordinates") + +comp_sf_coord <- function(df, ...) { + plot <- ggplot(df) + stat_sf_coordinates(...) + layer_data(plot) +} + +test_that("stat_sf_coordinates() retrieves coordinates from sf objects", { + skip_if_not_installed("sf") + + # point + df_point <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(c(0, 0)))) + expect_identical(comp_sf_coord(df_point)[, c("x", "y")], data.frame(x = 0, y = 0)) + + # line + c_line <- rbind(c(-1, -1), c(1, 1)) + df_line <- sf::st_sf(geometry = sf::st_sfc(sf::st_linestring(c_line))) + expect_identical( + # Note that st_point_on_surface() does not return the centroid for + # `df_line`, which may be a bit confusing. So, use st_centroid() here. + comp_sf_coord(df_line, fun.geometry = sf::st_centroid)[, c("x", "y")], + data.frame(x = 0, y = 0) + ) + + # polygon + c_polygon <- list(rbind(c(-1, -1), c(-1, 1), c(1, 1), c(1, -1), c(-1, -1))) + df_polygon <- sf::st_sf(geometry = sf::st_sfc(sf::st_polygon(c_polygon))) + expect_identical(comp_sf_coord(df_point)[, c("x", "y")], data.frame(x = 0, y = 0)) + + # computed variables (x and y) + df_point <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(c(1, 2)))) + expect_identical( + comp_sf_coord(df_point, aes(x = stat(x) + 10, y = stat(y) * 10))[, c("x", "y")], + data.frame(x = 11, y = 20) + ) +}) + +test_that("stat_sf_coordinates() ignores Z and M coordinates", { + skip_if_not_installed("sf") + + # XYM + c_polygon <- list(rbind(c(-1, -1, 0), c(-1, 1, 0), c(1, 1, 0), c(1, -1, 0), c(-1, -1, 0))) + df_xym <- sf::st_sf(geometry = sf::st_sfc(sf::st_polygon(c_polygon, dim = "XYM"))) + # Note that st_centroid() and st_point_on_surface() cannot handle M dimension since + # GEOS does not support it. The default fun.geometry should drop M. + expect_identical(comp_sf_coord(df_xym)[, c("x", "y")], data.frame(x = 0, y = 0)) +})