diff --git a/NAMESPACE b/NAMESPACE index e388b880..172fb364 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -347,6 +347,7 @@ export(wk_drop_m) export(wk_drop_z) export(wk_envelope) export(wk_envelope_handler) +export(wk_example) export(wk_flatten) export(wk_flatten_filter) export(wk_format) diff --git a/NEWS.md b/NEWS.md index 4ebfbb11..422e4492 100644 --- a/NEWS.md +++ b/NEWS.md @@ -24,6 +24,8 @@ (#139, #153). * The `xy_writer()` now opportunistically avoids allocating vectors for Z or M values unless they are actually needed (#131, #154). +* Added example WKT for all geometry types and dimensions plus helper + `wk_example()` to access them and set various properties (#155). # wk 0.6.0 diff --git a/R/data.R b/R/data.R index 390d6d82..6f687c84 100644 --- a/R/data.R +++ b/R/data.R @@ -13,3 +13,38 @@ #' @rdname wk_proj_crs_view "wk_proj_crs_json" + +#' Create example geometry objects +#' +#' @param which An example name. Valid example names are +#' - "nc" +#' - "point", "linestring", "polygon", "multipoint", +#' "multilinestring", "multipolygon", "geometrycollection" +#' - One of the above with the "_z", "_m", or "_zm" suffix. +#' @inheritParams wk_crs +#' @inheritParams wk_is_geodesic +#' +#' @return A [wkt()] with the specified example. +#' @export +#' +#' @examples +#' wk_example("polygon") +#' +wk_example <- function(which = "nc", + crs = NA, + geodesic = FALSE) { + all_examples <- wk::wk_example_wkt + match.arg(which, names(all_examples)) + + handleable <- all_examples[[which]] + + if (!identical(crs, NA)) { + wk::wk_crs(handleable) <- crs + } + + wk::wk_is_geodesic(handleable) <- geodesic + handleable +} + +#' @rdname wk_example +"wk_example_wkt" diff --git a/R/plot.R b/R/plot.R index e01c1bde..f069c261 100644 --- a/R/plot.R +++ b/R/plot.R @@ -134,6 +134,10 @@ wk_plot_point_or_multipoint <- function(x, dots) { wk_plot_line_or_multiline <- function(x, dots) { coords <- wk_coords(x) + if (nrow(coords) == 0) { + return() + } + geom_id <- coords$part_id geom_id_lag <- c(-1L, geom_id[-length(geom_id)]) new_geom <- geom_id != geom_id_lag @@ -152,6 +156,9 @@ wk_plot_line_or_multiline <- function(x, dots) { wk_plot_poly_or_multi_poly <- function(x, dots) { coords <- wk_coords(x) + if (nrow(coords) == 0) { + return() + } # for polygons we can use the coord vectors directly # because the graphics device expects open loops diff --git a/data-raw/example_wkt.R b/data-raw/example_wkt.R new file mode 100644 index 00000000..4977640e --- /dev/null +++ b/data-raw/example_wkt.R @@ -0,0 +1,164 @@ + +nc_wkt <- wk::as_wkt(sf::read_sf(system.file("shape/nc.shp", package = "sf"))) +wk::wk_crs(nc_wkt) <- wk::wk_crs_projjson(wk::wk_crs(nc_wkt)) + +wk_example_wkt <- list( + nc = nc_wkt, + point = c("POINT (30 10)", "POINT EMPTY", NA), + linestring = c( + "LINESTRING (30 10, 10 30, 40 40)", "LINESTRING EMPTY", + NA + ), + polygon = c( + "POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))", + "POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10), (20 30, 35 35, 30 20, 20 30))", + "POLYGON EMPTY", NA + ), + multipoint = c( + "MULTIPOINT ((30 10))", + "MULTIPOINT ((10 40), (40 30), (20 20), (30 10))", "MULTIPOINT ((10 40), (40 30), (20 20), (30 10))", + "MULTIPOINT EMPTY", NA + ), + multilinestring = c( + "MULTILINESTRING ((30 10, 10 30, 40 40))", + "MULTILINESTRING ((10 10, 20 20, 10 40), (40 40, 30 30, 40 20, 30 10))", + "MULTILINESTRING EMPTY", NA + ), + multipolygon = c( + "MULTIPOLYGON (((30 10, 40 40, 20 40, 10 20, 30 10)))", + "MULTIPOLYGON (((30 20, 45 40, 10 40, 30 20)), ((15 5, 40 10, 10 20, 5 10, 15 5)))", + "MULTIPOLYGON (((40 40, 20 45, 45 30, 40 40)), ((20 35, 10 30, 10 10, 30 5, 45 20, 20 35), (30 20, 20 15, 20 25, 30 20)))", + "MULTIPOLYGON EMPTY", NA + ), + geometrycollection = c( + "GEOMETRYCOLLECTION (POINT (30 10))", + "GEOMETRYCOLLECTION (LINESTRING (30 10, 10 30, 40 40))", "GEOMETRYCOLLECTION (POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10)))", + "GEOMETRYCOLLECTION (POINT (30 10), LINESTRING (30 10, 10 30, 40 40), POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10)))", + "GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (30 10)))", "GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (LINESTRING (30 10, 10 30, 40 40)))", + "GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))))", + "GEOMETRYCOLLECTION EMPTY", NA + ), + point_z = c( + "POINT Z (30 10 40)", + "POINT Z EMPTY", NA + ), + linestring_z = c( + "LINESTRING Z (30 10 40, 10 30 40, 40 40 80)", + "LINESTRING Z EMPTY", NA + ), + polygon_z = c( + "POLYGON Z ((30 10 40, 40 40 80, 20 40 60, 10 20 30, 30 10 40))", + "POLYGON Z ((35 10 45, 45 45 90, 15 40 55, 10 20 30, 35 10 45), (20 30 50, 35 35 70, 30 20 50, 20 30 50))", + "POLYGON Z EMPTY", NA + ), + multipoint_z = c( + "MULTIPOINT Z ((30 10 40))", + "MULTIPOINT Z ((10 40 50), (40 30 70), (20 20 40), (30 10 40))", + "MULTIPOINT Z ((10 40 50), (40 30 70), (20 20 40), (30 10 40))", + "MULTIPOINT Z EMPTY", NA + ), + multilinestring_z = c( + "MULTILINESTRING Z ((30 10 40, 10 30 40, 40 40 80))", + "MULTILINESTRING Z ((10 10 20, 20 20 40, 10 40 50), (40 40 80, 30 30 60, 40 20 60, 30 10 40))", + "MULTILINESTRING Z EMPTY", NA + ), + multipolygon_z = c( + "MULTIPOLYGON Z (((30 10 40, 40 40 80, 20 40 60, 10 20 30, 30 10 40)))", + "MULTIPOLYGON Z (((30 20 50, 45 40 85, 10 40 50, 30 20 50)), ((15 5 20, 40 10 50, 10 20 30, 5 10 15, 15 5 20)))", + "MULTIPOLYGON Z (((40 40 80, 20 45 65, 45 30 75, 40 40 80)), ((20 35 55, 10 30 40, 10 10 20, 30 5 35, 45 20 65, 20 35 55), (30 20 50, 20 15 35, 20 25 45, 30 20 50)))", + "MULTIPOLYGON Z EMPTY", NA + ), + geometrycollection_z = c( + "GEOMETRYCOLLECTION Z (POINT Z (30 10 40))", + "GEOMETRYCOLLECTION Z (LINESTRING Z (30 10 40, 10 30 40, 40 40 80))", + "GEOMETRYCOLLECTION Z (POLYGON Z ((30 10 40, 40 40 80, 20 40 60, 10 20 30, 30 10 40)))", + "GEOMETRYCOLLECTION Z (POINT Z (30 10 40), LINESTRING Z (30 10 40, 10 30 40, 40 40 80), POLYGON Z ((30 10 40, 40 40 80, 20 40 60, 10 20 30, 30 10 40)))", + "GEOMETRYCOLLECTION Z (GEOMETRYCOLLECTION Z (POINT Z (30 10 40)))", + "GEOMETRYCOLLECTION Z (GEOMETRYCOLLECTION Z (LINESTRING Z (30 10 40, 10 30 40, 40 40 80)))", + "GEOMETRYCOLLECTION Z (GEOMETRYCOLLECTION Z (POLYGON Z ((30 10 40, 40 40 80, 20 40 60, 10 20 30, 30 10 40))))", + "GEOMETRYCOLLECTION Z EMPTY", NA + ), + point_m = c( + "POINT M (30 10 300)", + "POINT M EMPTY", NA + ), linestring_m = c( + "LINESTRING M (30 10 300, 10 30 300, 40 40 1600)", + "LINESTRING M EMPTY", NA + ), + polygon_m = c( + "POLYGON M ((30 10 300, 40 40 1600, 20 40 800, 10 20 200, 30 10 300))", + "POLYGON M ((35 10 350, 45 45 2025, 15 40 600, 10 20 200, 35 10 350), (20 30 600, 35 35 1225, 30 20 600, 20 30 600))", + "POLYGON M EMPTY", NA + ), + multipoint_m = c( + "MULTIPOINT M ((30 10 300))", + "MULTIPOINT M ((10 40 400), (40 30 1200), (20 20 400), (30 10 300))", + "MULTIPOINT M ((10 40 400), (40 30 1200), (20 20 400), (30 10 300))", + "MULTIPOINT M EMPTY", NA + ), + multilinestring_m = c( + "MULTILINESTRING M ((30 10 300, 10 30 300, 40 40 1600))", + "MULTILINESTRING M ((10 10 100, 20 20 400, 10 40 400), (40 40 1600, 30 30 900, 40 20 800, 30 10 300))", + "MULTILINESTRING M EMPTY", NA + ), + multipolygon_m = c( + "MULTIPOLYGON M (((30 10 300, 40 40 1600, 20 40 800, 10 20 200, 30 10 300)))", + "MULTIPOLYGON M (((30 20 600, 45 40 1800, 10 40 400, 30 20 600)), ((15 5 75, 40 10 400, 10 20 200, 5 10 50, 15 5 75)))", + "MULTIPOLYGON M (((40 40 1600, 20 45 900, 45 30 1350, 40 40 1600)), ((20 35 700, 10 30 300, 10 10 100, 30 5 150, 45 20 900, 20 35 700), (30 20 600, 20 15 300, 20 25 500, 30 20 600)))", + "MULTIPOLYGON M EMPTY", NA + ), + geometrycollection_m = c( + "GEOMETRYCOLLECTION M (POINT M (30 10 300))", + "GEOMETRYCOLLECTION M (LINESTRING M (30 10 300, 10 30 300, 40 40 1600))", + "GEOMETRYCOLLECTION M (POLYGON M ((30 10 300, 40 40 1600, 20 40 800, 10 20 200, 30 10 300)))", + "GEOMETRYCOLLECTION M (POINT M (30 10 300), LINESTRING M (30 10 300, 10 30 300, 40 40 1600), POLYGON M ((30 10 300, 40 40 1600, 20 40 800, 10 20 200, 30 10 300)))", + "GEOMETRYCOLLECTION M (GEOMETRYCOLLECTION M (POINT M (30 10 300)))", + "GEOMETRYCOLLECTION M (GEOMETRYCOLLECTION M (LINESTRING M (30 10 300, 10 30 300, 40 40 1600)))", + "GEOMETRYCOLLECTION M (GEOMETRYCOLLECTION M (POLYGON M ((30 10 300, 40 40 1600, 20 40 800, 10 20 200, 30 10 300))))", + "GEOMETRYCOLLECTION M EMPTY", NA + ), + point_zm = c( + "POINT ZM (30 10 40 300)", + "POINT ZM EMPTY", NA + ), + linestring_zm = c( + "LINESTRING ZM (30 10 40 300, 10 30 40 300, 40 40 80 1600)", + "LINESTRING ZM EMPTY", NA + ), + polygon_zm = c( + "POLYGON ZM ((30 10 40 300, 40 40 80 1600, 20 40 60 800, 10 20 30 200, 30 10 40 300))", + "POLYGON ZM ((35 10 45 350, 45 45 90 2025, 15 40 55 600, 10 20 30 200, 35 10 45 350), (20 30 50 600, 35 35 70 1225, 30 20 50 600, 20 30 50 600))", + "POLYGON ZM EMPTY", NA + ), + multipoint_zm = c( + "MULTIPOINT ZM ((30 10 40 300))", + "MULTIPOINT ZM ((10 40 50 400), (40 30 70 1200), (20 20 40 400), (30 10 40 300))", + "MULTIPOINT ZM ((10 40 50 400), (40 30 70 1200), (20 20 40 400), (30 10 40 300))", + "MULTIPOINT ZM EMPTY", NA + ), + multilinestring_zm = c( + "MULTILINESTRING ZM ((30 10 40 300, 10 30 40 300, 40 40 80 1600))", + "MULTILINESTRING ZM ((10 10 20 100, 20 20 40 400, 10 40 50 400), (40 40 80 1600, 30 30 60 900, 40 20 60 800, 30 10 40 300))", + "MULTILINESTRING ZM EMPTY", NA + ), + multipolygon_zm = c( + "MULTIPOLYGON ZM (((30 10 40 300, 40 40 80 1600, 20 40 60 800, 10 20 30 200, 30 10 40 300)))", + "MULTIPOLYGON ZM (((30 20 50 600, 45 40 85 1800, 10 40 50 400, 30 20 50 600)), ((15 5 20 75, 40 10 50 400, 10 20 30 200, 5 10 15 50, 15 5 20 75)))", + "MULTIPOLYGON ZM (((40 40 80 1600, 20 45 65 900, 45 30 75 1350, 40 40 80 1600)), ((20 35 55 700, 10 30 40 300, 10 10 20 100, 30 5 35 150, 45 20 65 900, 20 35 55 700), (30 20 50 600, 20 15 35 300, 20 25 45 500, 30 20 50 600)))", + "MULTIPOLYGON ZM EMPTY", NA + ), + geometrycollection_zm = c( + "GEOMETRYCOLLECTION ZM (POINT ZM (30 10 40 300))", + "GEOMETRYCOLLECTION ZM (LINESTRING ZM (30 10 40 300, 10 30 40 300, 40 40 80 1600))", + "GEOMETRYCOLLECTION ZM (POLYGON ZM ((30 10 40 300, 40 40 80 1600, 20 40 60 800, 10 20 30 200, 30 10 40 300)))", + "GEOMETRYCOLLECTION ZM (POINT ZM (30 10 40 300), LINESTRING ZM (30 10 40 300, 10 30 40 300, 40 40 80 1600), POLYGON ZM ((30 10 40 300, 40 40 80 1600, 20 40 60 800, 10 20 30 200, 30 10 40 300)))", + "GEOMETRYCOLLECTION ZM (GEOMETRYCOLLECTION ZM (POINT ZM (30 10 40 300)))", + "GEOMETRYCOLLECTION ZM (GEOMETRYCOLLECTION ZM (LINESTRING ZM (30 10 40 300, 10 30 40 300, 40 40 80 1600)))", + "GEOMETRYCOLLECTION ZM (GEOMETRYCOLLECTION ZM (POLYGON ZM ((30 10 40 300, 40 40 80 1600, 20 40 60 800, 10 20 30 200, 30 10 40 300))))", + "GEOMETRYCOLLECTION ZM EMPTY", NA + ) +) + +wk_example_wkt <- lapply(wk_example_wkt, wk::as_wkt) + +usethis::use_data(wk_example_wkt, overwrite = TRUE) diff --git a/data/wk_example_wkt.rda b/data/wk_example_wkt.rda new file mode 100644 index 00000000..df9a3a61 Binary files /dev/null and b/data/wk_example_wkt.rda differ diff --git a/man/wk_example.Rd b/man/wk_example.Rd new file mode 100644 index 00000000..1f7ea85d --- /dev/null +++ b/man/wk_example.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{wk_example} +\alias{wk_example} +\alias{wk_example_wkt} +\title{Create example geometry objects} +\format{ +An object of class \code{list} of length 29. +} +\usage{ +wk_example(which = "nc", crs = NA, geodesic = FALSE) + +wk_example_wkt +} +\arguments{ +\item{which}{An example name. Valid example names are +\itemize{ +\item "nc" +\item "point", "linestring", "polygon", "multipoint", +"multilinestring", "multipolygon", "geometrycollection" +\item One of the above with the "_z", "_m", or "_zm" suffix. +}} + +\item{crs}{An object that can be interpreted as a CRS} + +\item{geodesic}{\code{TRUE} if edges must be interpolated as geodesics when +coordinates are spherical, \code{FALSE} otherwise.} +} +\value{ +A \code{\link[=wkt]{wkt()}} with the specified example. +} +\description{ +Create example geometry objects +} +\examples{ +wk_example("polygon") + +} +\keyword{datasets} diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R new file mode 100644 index 00000000..b2d3bb97 --- /dev/null +++ b/tests/testthat/test-data.R @@ -0,0 +1,18 @@ + +test_that("all examples can be created with default arguments", { + for (which in names(wk::wk_example_wkt)) { + expect_s3_class(wk_example(!! which), "wk_wkt") + } +}) + +test_that("requested example crs is respected", { + expect_identical( + wk::wk_crs(wk_example(crs = "EPSG:1234")), + "EPSG:1234" + ) +}) + +test_that("requested example edges field is respected", { + spherical <- wk_example(geodesic = TRUE) + expect_true(wk::wk_is_geodesic(spherical)) +}) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 08c66843..532f0784 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -60,3 +60,9 @@ test_that("xy and rect plot methods work", { test_that("crc plot method works", { expect_identical(plot(crc(1, 2, 3)), crc(1, 2, 3)) }) + +test_that("plot can plot all examples", { + for (which in names(wk_example_wkt)) { + expect_silent(wk_plot(wk_example_wkt[[!!which]], xlab = which)) + } +}) diff --git a/tests/testthat/test-sfc-writer.R b/tests/testthat/test-sfc-writer.R index b72d91ad..b0a1fc47 100644 --- a/tests/testthat/test-sfc-writer.R +++ b/tests/testthat/test-sfc-writer.R @@ -434,3 +434,14 @@ test_that("sfc_writer() propagates precision", { sf::st_precision(sfc_prec) <- 0.01 expect_identical(sf::st_precision(wk_handle(sfc_prec, sfc_writer())), 0.01) }) + +test_that("sfc_writer() can roundtrip examples", { + skip_if_not_installed("sf") + + for (which in names(wk_example_wkt)) { + expect_identical( + wk_handle(sf::st_as_sfc(wk_example(!!which, crs = NULL)), sfc_writer()), + sf::st_as_sfc(wk_example(!!which, crs = NULL)) + ) + } +}) diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index 73c2a5e2..80c447e6 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -99,3 +99,12 @@ test_that("as_wkb() propagates geodesic", { expect_true(wk_is_geodesic(x)) expect_true(wk_is_geodesic(as_wkb(wkt("POINT (1 2)", geodesic = TRUE)))) }) + +test_that("examples as wkb roundtrip", { + for (which in names(wk_example_wkt)) { + expect_identical( + wk_handle(as_wkb(wk_example(!!which, crs = NULL)), wkb_writer()), + as_wkb(wk_example(!!which, crs = NULL)) + ) + } +}) diff --git a/tests/testthat/test-wkt.R b/tests/testthat/test-wkt.R index 8a453a83..2798c279 100644 --- a/tests/testthat/test-wkt.R +++ b/tests/testthat/test-wkt.R @@ -91,3 +91,12 @@ test_that("as_wkt() propagates geodesic", { expect_true(wk_is_geodesic(x)) expect_true(wk_is_geodesic(as_wkt(as_wkb(wkt("POINT (1 2)", geodesic = TRUE))))) }) + +test_that("examples as wkt roundtrip", { + for (which in names(wk_example_wkt)) { + expect_identical( + wk_handle(wk_example(!!which, crs = NULL), wkt_writer()), + wk_example(!!which, crs = NULL) + ) + } +}) diff --git a/tests/testthat/test-xy-writer.R b/tests/testthat/test-xy-writer.R index adb157e4..d74ccca0 100644 --- a/tests/testthat/test-xy-writer.R +++ b/tests/testthat/test-xy-writer.R @@ -71,3 +71,26 @@ test_that("xy_writer() fills unused dimensions with NA", { ) ) }) + +test_that("xy_writer() can roundtrip point examples", { + # NA point doesn't roundtrip + expect_identical( + wk_handle(wk_example_wkt$point, xy_writer()), + xy(c(30, NA, NA), c(10, NA, NA)) + ) + + expect_identical( + wk_handle(wk_example_wkt$point_z, xy_writer()), + xyz(c(30, NA, NA), c(10, NA, NA), c(40, NA, NA)) + ) + + expect_identical( + wk_handle(wk_example_wkt$point_m, xy_writer()), + xym(c(30, NA, NA), c(10, NA, NA), c(300, NA, NA)) + ) + + expect_identical( + wk_handle(wk_example_wkt$point_zm, xy_writer()), + xyzm(c(30, NA, NA), c(10, NA, NA), c(40, NA, NA), c(300, NA, NA)) + ) +})