Conditionnaly use lwgeom::st_as_text()

This accelerates conversion to WKT and incidentally makes priting much faster
* Integrates 90821d8 from @edzer

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)

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]])))
 }

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

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

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