From 03f2aa6f50a26bd581c9c2b4ab5dcf3135ed3751 Mon Sep 17 00:00:00 2001
From: "Etienne B. Racine" <etiennebr@gmail.com>
Date: Sat, 19 Jan 2019 15:22:49 -0600
Subject: [PATCH] accelerate printing

close #800, #947, #703, #747
---
 R/wkt.R                   | 25 ++++++++++---------------
 tests/testthat/test_sfg.R |  6 +++---
 2 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/R/wkt.R b/R/wkt.R
index 7fa9930d9..974f9e86d 100644
--- a/R/wkt.R
+++ b/R/wkt.R
@@ -17,13 +17,15 @@ WKT_name = function(x, EWKT = TRUE) {
 empty = "EMPTY"
 
 # skip leading white space; ... passes on digits:
-fmt = function(x, ...) sub("^[ ]+", "", sapply(unclass(x), format, ...))
+fmt = function(x, ..., na.encode = NULL, justify = NULL) {
+	sub("^[ ]+", "", formatC(x, ...))
+}
 
 # print helper functions
 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)
 }
@@ -83,10 +85,7 @@ st_as_text = function(x, ...) UseMethod("st_as_text")
 #' st_as_text(st_point(1:2))
 #' st_as_text(st_sfc(st_point(c(-90,40)), crs = 4326), EWKT = TRUE)
 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 
-	  switch(class(x)[2],
+	switch(class(x)[2],
 		POINT = prnt.POINT(x, ...),
 		MULTIPOINT =        prnt.MULTIPOINT(x, ...),
 		LINESTRING =        prnt.LINESTRING(x, ...),
@@ -111,16 +110,12 @@ st_as_text.sfg = function(x, ...) {
 #' @param EWKT logical; if TRUE, print SRID=xxx; before the WKT string if \code{epsg} is available
 #' @export
 st_as_text.sfc = function(x, ..., EWKT = FALSE) {
-	if (Sys.getenv("LWGEOM_WKT") == "true" && requireNamespace("lwgeom", quietly = TRUE) && utils::packageVersion("lwgeom") >= "0.1-5")
-		lwgeom::st_astext(x, ..., EWKT = EWKT)
-	else {
-		if (EWKT) {
-			epsg = attr(x, "crs")$epsg
-			if (!is.na(epsg) && epsg != 0)
-				x = lapply(x, function(sfg) structure(sfg, epsg = epsg))
-		}
-		vapply(x, st_as_text, "", ..., EWKT = EWKT)
+	if (EWKT) {
+		epsg = attr(x, "crs")$epsg
+		if (!is.na(epsg) && epsg != 0)
+			x = lapply(x, function(sfg) structure(sfg, epsg = epsg))
 	}
+	vapply(x, st_as_text, "", ..., EWKT = EWKT)
 }
 
 #' @name st_as_sfc
diff --git a/tests/testthat/test_sfg.R b/tests/testthat/test_sfg.R
index 32c2575fb..49abaef83 100644
--- a/tests/testthat/test_sfg.R
+++ b/tests/testthat/test_sfg.R
@@ -41,11 +41,11 @@ test_that("xx2multixx works", {
 test_that("format works", {
 	digits = options("digits")[[1]]
 	options(digits = 16)
-	expect_identical(format(st_multipoint(matrix(1:6/6,3))), "MULTIPOINT (0.1666666666666...")
-	expect_identical(format(st_sfc(st_multipoint(matrix(1:6/6,3)))), 
+	expect_identical(format(st_multipoint(matrix(1:6/6,3)), digits = 16), "MULTIPOINT (0.1666666666666...")
+	expect_identical(format(st_sfc(st_multipoint(matrix(1:6/6,3))), digits = 16),
 		"MULTIPOINT (0.1666666666666...")
 	options(digits = digits)
-	expect_identical(obj_sum.sfc(st_sfc(st_multipoint(matrix(1:6/6,3)))), 
+	expect_identical(obj_sum.sfc(st_sfc(st_multipoint(matrix(1:6/6,3)))),
 		"MULTIPOINT (...")
 	expect_identical(type_sum.sfc(st_sfc(st_multipoint(matrix(1:6/6,3)))), "MULTIPOINT")
 })