Use lwgeom::st_astext()

This accelerates conversion to WKT and incidentally makes priting (which uses wkt wuite a lot) much faster
r-spatial · Jul 19, 2018 · 95edae7 · 95edae7
1 parent 28be450
commit 95edae7
Show file tree

Hide file tree

Showing 6 changed files with 295 additions and 295 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -372,6 +372,7 @@ importFrom(grid,pointsGrob)
 importFrom(grid,polylineGrob)
 importFrom(grid,unit)
 importFrom(grid,viewport)
+importFrom(lwgeom,st_astext)
 importFrom(magrittr,"%>%")
 importFrom(methods,as)
 importFrom(methods,new)

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -5,74 +5,6 @@ CPL_get_bbox <- function(sf, depth = 0L) {
     .Call('_sf_CPL_get_bbox', PACKAGE = 'sf', sf, depth)
 }
 
-CPL_area <- function(sfc) {
-    .Call('_sf_CPL_area', PACKAGE = 'sf', sfc)
-}
-
-CPL_gdal_dimension <- function(sfc, NA_if_empty = TRUE) {
-    .Call('_sf_CPL_gdal_dimension', PACKAGE = 'sf', sfc, NA_if_empty)
-}
-
-CPL_length <- function(sfc) {
-    .Call('_sf_CPL_length', PACKAGE = 'sf', sfc)
-}
-
-CPL_gdal_segmentize <- function(sfc, dfMaxLength = 0.0) {
-    .Call('_sf_CPL_gdal_segmentize', PACKAGE = 'sf', sfc, dfMaxLength)
-}
-
-CPL_gdal_linestring_sample <- function(sfc, distLst) {
-    .Call('_sf_CPL_gdal_linestring_sample', PACKAGE = 'sf', sfc, distLst)
-}
-
-CPL_get_layers <- function(datasource, options, do_count = FALSE) {
-    .Call('_sf_CPL_get_layers', PACKAGE = 'sf', datasource, options, do_count)
-}
-
-CPL_read_ogr <- function(datasource, layer, options, quiet, toTypeUser, promote_to_multi = TRUE, int64_as_string = FALSE) {
-    .Call('_sf_CPL_read_ogr', PACKAGE = 'sf', datasource, layer, options, quiet, toTypeUser, promote_to_multi, int64_as_string)
-}
-
-CPL_gdalinfo <- function(obj, options) {
-    .Call('_sf_CPL_gdalinfo', PACKAGE = 'sf', obj, options)
-}
-
-CPL_gdalwarp <- function(src, dst, options) {
-    .Call('_sf_CPL_gdalwarp', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_gdalrasterize <- function(src, dst, options) {
-    .Call('_sf_CPL_gdalrasterize', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_gdaltranslate <- function(src, dst, options) {
-    .Call('_sf_CPL_gdaltranslate', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_gdalvectortranslate <- function(src, dst, options) {
-    .Call('_sf_CPL_gdalvectortranslate', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_gdalbuildvrt <- function(src, dst, options) {
-    .Call('_sf_CPL_gdalbuildvrt', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_gdaldemprocessing <- function(src, dst, options, processing, colorfilename) {
-    .Call('_sf_CPL_gdaldemprocessing', PACKAGE = 'sf', src, dst, options, processing, colorfilename)
-}
-
-CPL_gdalnearblack <- function(src, dst, options) {
-    .Call('_sf_CPL_gdalnearblack', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_gdalgrid <- function(src, dst, options) {
-    .Call('_sf_CPL_gdalgrid', PACKAGE = 'sf', src, dst, options)
-}
-
-CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, quiet = FALSE, update = FALSE, delete_dsn = FALSE, delete_layer = FALSE) {
-    .Call('_sf_CPL_write_ogr', PACKAGE = 'sf', obj, dsn, layer, driver, dco, lco, geom, dim, quiet, update, delete_dsn, delete_layer)
-}
-
 CPL_gdal_init <- function() {
     invisible(.Call('_sf_CPL_gdal_init', PACKAGE = 'sf'))
 }
@@ -145,6 +77,74 @@ CPL_gdal_with_geos <- function() {
     .Call('_sf_CPL_gdal_with_geos', PACKAGE = 'sf')
 }
 
+CPL_area <- function(sfc) {
+    .Call('_sf_CPL_area', PACKAGE = 'sf', sfc)
+}
+
+CPL_gdal_dimension <- function(sfc, NA_if_empty = TRUE) {
+    .Call('_sf_CPL_gdal_dimension', PACKAGE = 'sf', sfc, NA_if_empty)
+}
+
+CPL_length <- function(sfc) {
+    .Call('_sf_CPL_length', PACKAGE = 'sf', sfc)
+}
+
+CPL_gdal_segmentize <- function(sfc, dfMaxLength = 0.0) {
+    .Call('_sf_CPL_gdal_segmentize', PACKAGE = 'sf', sfc, dfMaxLength)
+}
+
+CPL_gdal_linestring_sample <- function(sfc, distLst) {
+    .Call('_sf_CPL_gdal_linestring_sample', PACKAGE = 'sf', sfc, distLst)
+}
+
+CPL_get_layers <- function(datasource, options, do_count = FALSE) {
+    .Call('_sf_CPL_get_layers', PACKAGE = 'sf', datasource, options, do_count)
+}
+
+CPL_read_ogr <- function(datasource, layer, options, quiet, toTypeUser, promote_to_multi = TRUE, int64_as_string = FALSE) {
+    .Call('_sf_CPL_read_ogr', PACKAGE = 'sf', datasource, layer, options, quiet, toTypeUser, promote_to_multi, int64_as_string)
+}
+
+CPL_gdalinfo <- function(obj, options) {
+    .Call('_sf_CPL_gdalinfo', PACKAGE = 'sf', obj, options)
+}
+
+CPL_gdalwarp <- function(src, dst, options) {
+    .Call('_sf_CPL_gdalwarp', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_gdalrasterize <- function(src, dst, options) {
+    .Call('_sf_CPL_gdalrasterize', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_gdaltranslate <- function(src, dst, options) {
+    .Call('_sf_CPL_gdaltranslate', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_gdalvectortranslate <- function(src, dst, options) {
+    .Call('_sf_CPL_gdalvectortranslate', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_gdalbuildvrt <- function(src, dst, options) {
+    .Call('_sf_CPL_gdalbuildvrt', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_gdaldemprocessing <- function(src, dst, options, processing, colorfilename) {
+    .Call('_sf_CPL_gdaldemprocessing', PACKAGE = 'sf', src, dst, options, processing, colorfilename)
+}
+
+CPL_gdalnearblack <- function(src, dst, options) {
+    .Call('_sf_CPL_gdalnearblack', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_gdalgrid <- function(src, dst, options) {
+    .Call('_sf_CPL_gdalgrid', PACKAGE = 'sf', src, dst, options)
+}
+
+CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, quiet = FALSE, update = FALSE, delete_dsn = FALSE, delete_layer = FALSE) {
+    .Call('_sf_CPL_write_ogr', PACKAGE = 'sf', obj, dsn, layer, driver, dco, lco, geom, dim, quiet, update, delete_dsn, delete_layer)
+}
+
 CPL_geos_binop <- function(sfc0, sfc1, op, par = 0.0, pattern = "", prepared = FALSE) {
     .Call('_sf_CPL_geos_binop', PACKAGE = 'sf', sfc0, sfc1, op, par, pattern, prepared)
 }

diff --git 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)
 }
@@ -105,15 +105,12 @@ st_as_text.sfg = function(x, ...) {
 }
 
 #' @name st_as_text
+#' @param precision integer; Number of digits to use.
 #' @param EWKT logical; if TRUE, print SRID=xxx; before the WKT string if \code{epsg} is available
+#' @importFrom lwgeom st_astext
 #' @export
-st_as_text.sfc = function(x, ..., EWKT = FALSE) {
-	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)
+st_as_text.sfc = function(x, precision = 7, EWKT = FALSE) {
+    lwgeom::st_astext(x, precision = precision, EWKT = EWKT)
 }
 
 #' @name st_as_sfc

diff --git a/man/st_as_text.Rd b/man/st_as_text.Rd