From df917a030ab37b763e51673c6b55124cafc356d8 Mon Sep 17 00:00:00 2001 From: "Etienne B. Racine" Date: Thu, 13 Dec 2018 21:21:05 -0500 Subject: [PATCH 1/2] Conditionnaly use lwgeom::st_as_text() This accelerates conversion to WKT and incidentally makes priting much faster * Integrates 90821d82e3770a47cdbeda9248e3589997594a09 from @edzer --- NAMESPACE | 1 + R/sfc.R | 6 +++--- R/wkt.R | 15 +++++++++------ man/st_as_text.Rd | 4 +++- tests/testthat/test_wkb.R | 11 ----------- tests/testthat/test_wkt.R | 6 +++--- 6 files changed, 19 insertions(+), 24 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2f4b54240..74925d753 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -382,6 +382,7 @@ importFrom(grid,pointsGrob) importFrom(grid,polylineGrob) importFrom(grid,unit) importFrom(grid,viewport) +importFrom(lwgeom,"`st_as_text.sfg`") importFrom(magrittr,"%>%") importFrom(methods,as) importFrom(methods,new) diff --git a/R/sfc.R b/R/sfc.R index 482eee389..86f0c4b01 100644 --- a/R/sfc.R +++ b/R/sfc.R @@ -491,15 +491,15 @@ st_as_sfc.list = function(x, ..., crs = NA_crs_) { return(st_sfc(crs = crs)) if (is.raw(x[[1]])) - st_as_sfc.WKB(as_wkb(x), ..., crs = crs) + st_as_sfc(structure(x, class = "WKB"), ...) else if (inherits(x[[1]], "sfg")) st_sfc(x, crs = crs) else if (is.character(x[[1]])) { # hex wkb or wkt: ch12 = substr(x[[1]], 1, 2) if (ch12 == "0x" || ch12 == "00" || ch12 == "01") # hex wkb - st_as_sfc.WKB(as_wkb(x), ..., crs = crs) + st_as_sfc(structure(x, class = "WKB"), ...) else - st_as_sfc(unlist(x), ..., crs = crs) # wkt + st_as_sfc(unlist(x), ...) # wkt } else stop(paste("st_as_sfc.list: don't know what to do with list with elements of class", class(x[[1]]))) } diff --git a/R/wkt.R b/R/wkt.R index 7fa9930d9..37ab4bd42 100644 --- a/R/wkt.R +++ b/R/wkt.R @@ -5,7 +5,7 @@ WKT_name = function(x, EWKT = TRUE) { retval = if (zm == "") cls[2] - else + else paste(cls[2], substr(cls[1], 3, 4)) if (EWKT && !is.null(attr(x, "epsg")) && !is.na(attr(x, "epsg"))) @@ -23,7 +23,7 @@ fmt = function(x, ...) sub("^[ ]+", "", sapply(unclass(x), format, ...)) prnt.POINT = function(x, ..., EWKT = TRUE) { pt = if (any(!is.finite(x))) empty - else + else paste0("(", paste0(fmt(x, ...), collapse = " "), ")") paste(WKT_name(x, EWKT = EWKT), pt) } @@ -85,7 +85,7 @@ st_as_text = function(x, ...) UseMethod("st_as_text") st_as_text.sfg = function(x, ...) { if (Sys.getenv("LWGEOM_WKT") == "true" && requireNamespace("lwgeom", quietly = TRUE) && utils::packageVersion("lwgeom") >= "0.1-5") lwgeom::st_astext(x, ...) - else + else switch(class(x)[2], POINT = prnt.POINT(x, ...), MULTIPOINT = prnt.MULTIPOINT(x, ...), @@ -108,11 +108,14 @@ st_as_text.sfg = function(x, ...) { } #' @name st_as_text -#' @param EWKT logical; if TRUE, print SRID=xxx; before the WKT string if \code{epsg} is available +#' @param digits integer; Number of digits to use. +#' @param EWKT logical; if TRUE, print SRID=xxx; before the WKT string if `epsg` is available +#' @importFrom lwgeom `st_as_text.sfg` +#' @md #' @export -st_as_text.sfc = function(x, ..., EWKT = FALSE) { +st_as_text.sfc = function(x, digits, ..., EWKT = FALSE) { if (Sys.getenv("LWGEOM_WKT") == "true" && requireNamespace("lwgeom", quietly = TRUE) && utils::packageVersion("lwgeom") >= "0.1-5") - lwgeom::st_astext(x, ..., EWKT = EWKT) + lwgeom::st_astext(x, digits = digits, ..., EWKT = EWKT) else { if (EWKT) { epsg = attr(x, "crs")$epsg diff --git a/man/st_as_text.Rd b/man/st_as_text.Rd index d9bb66543..0059be486 100644 --- a/man/st_as_text.Rd +++ b/man/st_as_text.Rd @@ -13,7 +13,7 @@ st_as_text(x, ...) \method{st_as_text}{sfg}(x, ...) -\method{st_as_text}{sfc}(x, ..., EWKT = FALSE) +\method{st_as_text}{sfc}(x, digits, ..., EWKT = FALSE) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{crs}} @@ -22,6 +22,8 @@ st_as_text(x, ...) \item{pretty}{logical; if TRUE, print human-readable well-known-text representation of a coordinate reference system} +\item{digits}{integer; Number of digits to use.} + \item{EWKT}{logical; if TRUE, print SRID=xxx; before the WKT string if \code{epsg} is available} } \description{ diff --git a/tests/testthat/test_wkb.R b/tests/testthat/test_wkb.R index c3b5d76df..27d1171d0 100644 --- a/tests/testthat/test_wkb.R +++ b/tests/testthat/test_wkb.R @@ -50,14 +50,3 @@ test_that("Reading of truncated buffers results in a proper error", { expect_error(st_as_sfc(wkb, EWKB = TRUE), "WKB buffer too small. Input file corrupt?") }) -test_that("st_as_sfc() honors crs argument", { - raw = st_as_binary(st_point(c(26e5, 12e5))) - - list = list(raw) - blob = blob::blob(raw) - wkb = as_wkb(list) - - expect_identical(st_as_sfc(raw, crs = 2056), st_as_sfc(wkb, crs = 2056)) - expect_identical(st_as_sfc(list, crs = 2056), st_as_sfc(wkb, crs = 2056)) - expect_identical(st_as_sfc(blob, crs = 2056), st_as_sfc(wkb, crs = 2056)) -}) diff --git a/tests/testthat/test_wkt.R b/tests/testthat/test_wkt.R index e3a9b7bd0..6ecad4d62 100644 --- a/tests/testthat/test_wkt.R +++ b/tests/testthat/test_wkt.R @@ -2,14 +2,14 @@ context("sf: wkt") test_that("well-known text", { gcol <- st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:4,2)))) - expect_message(x <- print(gcol), + expect_message(x <- print(gcol), "GEOMETRYCOLLECTION \\(POINT \\(1 2\\), LINESTRING \\(1 3, 2 4\\)\\)", all = TRUE) expect_equal(x, "GEOMETRYCOLLECTION (POINT (1 2), LINESTRING (1 3, 2 4))") - + p1 = st_point(1:3) p2 = st_point(5:7) sfc = st_sfc(p1,p2) - expect_identical(st_as_text(sfc), c("POINT Z (1 2 3)", "POINT Z (5 6 7)")) + expect_identical(st_as_text(sfc), c("POINT(1 2 3)", "POINT(5 6 7)")) expect_equal(st_sfc(gcol), st_as_sfc(list("GEOMETRYCOLLECTION (POINT (1 2), LINESTRING (1 3, 2 4))"))) }) From 9d093bd6eac2732cab64f966c414352c5a3c188a Mon Sep 17 00:00:00 2001 From: "Etienne B. Racine" Date: Thu, 13 Dec 2018 21:48:15 -0500 Subject: [PATCH 2/2] fix lwgeom import --- NAMESPACE | 2 +- R/wkt.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 74925d753..04cf211e4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -382,7 +382,7 @@ importFrom(grid,pointsGrob) importFrom(grid,polylineGrob) importFrom(grid,unit) importFrom(grid,viewport) -importFrom(lwgeom,"`st_as_text.sfg`") +importFrom(lwgeom,st_astext) importFrom(magrittr,"%>%") importFrom(methods,as) importFrom(methods,new) diff --git a/R/wkt.R b/R/wkt.R index 37ab4bd42..56f77ce7e 100644 --- a/R/wkt.R +++ b/R/wkt.R @@ -110,7 +110,7 @@ st_as_text.sfg = function(x, ...) { #' @name st_as_text #' @param digits integer; Number of digits to use. #' @param EWKT logical; if TRUE, print SRID=xxx; before the WKT string if `epsg` is available -#' @importFrom lwgeom `st_as_text.sfg` +#' @importFrom lwgeom st_astext #' @md #' @export st_as_text.sfc = function(x, digits, ..., EWKT = FALSE) {