#17 new function geojson2wkt_ with new interface

both geojson2wkt fxns now expect the new format well go with for geojson as a list

R/geojson2wkt.R

@@ -7,12 +7,12 @@
 #' MultiPolygon, etc.
 #' @param ... Further args passed on to \code{\link[jsonlite]{fromJSON}} only
 #' in the event of json passed as a character string.
-#' @seealso \code{\link{wkt2geojson}}
+#' @seealso \code{\link{geojson2wkt_}}, \code{\link{wkt2geojson}}
 #' @references \url{https://tools.ietf.org/html/rfc7946}
 #' \url{https://en.wikipedia.org/wiki/Well-known_text}
 #' @examples
 #' # point
-#' point <- list('type' = 'Point', 'coordinates' = c(116.4, 45.2))
+#' point <- list(type = 'Point', coordinates = c(116.4, 45.2))
 #' geojson2wkt(point)
 #'
 #' # multipoint
@@ -162,15 +162,15 @@ dump_point <- function(obj, fmt = 16){
 
 dump_multipoint <- function(obj, fmt = 16){
   coords <- obj$coordinates
-  str <- paste0(lapply(coords, function(z){
+  str <- paste0(apply(coords, 1, function(z){
     sprintf("(%s)", paste0(str_trim_(format(z, nsmall = fmt)), collapse = " "))
   }), collapse = ", ")
   sprintf('MULTIPOINT (%s)', str)
 }
 
 dump_linestring <- function(obj, fmt = 16){
   coords <- obj$coordinates
-  str <- paste0(lapply(coords, function(z){
+  str <- paste0(apply(coords, 1, function(z){
     paste0(gsub("\\s", "", format(z, nsmall = fmt)), collapse = " ")
   }), collapse = ", ")
   sprintf('LINESTRING (%s)', str)
@@ -179,15 +179,16 @@ dump_linestring <- function(obj, fmt = 16){
 dump_multilinestring <- function(obj, fmt = 16){
   coords <- obj$coordinates
   str <- paste0(lapply(coords, function(z){
-    sprintf("(%s)", paste0(gsub(",", "", unname(sapply(str_trim_(format(z, nsmall = fmt)), paste0, collapse = " "))), collapse = ", "))
+    sprintf("(%s)", paste0(gsub(",", "",
+                                apply(str_trim_(format(z, nsmall = fmt)), 1, paste0, collapse = " ")), collapse = ", "))
   }), collapse = ", ")
   sprintf('MULTILINESTRING (%s)', str)
 }
 
 dump_polygon <- function(obj, fmt = 16){
   coords <- obj$coordinates
   str <- paste0(lapply(coords, function(z){
-    sprintf("(%s)", paste0(lapply(z, function(w){
+    sprintf("(%s)", paste0(apply(z, 1, function(w){
       paste0(gsub("\\s", "", format(w, nsmall = fmt)), collapse = " ")
     }), collapse = ", "))
   }), collapse = ", ")
@@ -196,11 +197,11 @@ dump_polygon <- function(obj, fmt = 16){
 
 dump_multipolygon <- function(obj, fmt = 16){
   coords <- obj$coordinates
-  str <- paste0(lapply(coords, function(z){
+  str <- paste0(lapply(coords, function(z) {
     sprintf("(%s)", paste0(sprintf("(%s)", lapply(z, function(w){
-      paste0(gsub(",", "", unname(sapply(str_trim_(format(w, nsmall = fmt)), paste0, collapse = " "))), collapse = ", ")
-    })), collapse=", "))
-  }), collapse=", ")
+      paste0(gsub(",", "", unname(apply(str_trim_(format(w, nsmall = fmt)), 1, paste0, collapse = " "))), collapse = ", ")
+    })), collapse = ", "))
+  }), collapse = ", ")
   sprintf('MULTIPOLYGON (%s)', str)
 }
 

R/geojson2wkt_.R

@@ -0,0 +1,161 @@
+#' Convert GeoJSON-like objects to WKT
+#'
+#' @export
+#'
+#' @template fmt
+#' @param obj A GeoJSON-like object representing a Point, LineString, Polygon,
+#' MultiPolygon, etc.
+#' @param ... Further args passed on to \code{\link[jsonlite]{fromJSON}} only
+#' in the event of json passed as a character string.
+#' @seealso \code{\link{geojson2wkt}}, \code{\link{wkt2geojson}}
+#' @references \url{https://tools.ietf.org/html/rfc7946}
+#' \url{https://en.wikipedia.org/wiki/Well-known_text}
+#' @details Similar to \code{\link{geojson2wkt}}, but simpler construction.
+#' However, input to this function is not proper GeoJSON. If you want to
+#' input GeoJSON format (as either list or JSON) use \code{\link{geojson2wkt}}
+#' @examples
+#' # point
+#' geojson2wkt_(list(Point = c(116.4, 45.2)))
+#'
+#' # multipoint
+#' mp <- list(MultiPoint = matrix(c(100, 101, 3.14, 3.101, 2.1, 2.18),
+#'    ncol = 2))
+#' geojson2wkt_(mp)
+#'
+#'
+#' # linestring
+#' ## 2D
+#' st <- list(LineString = matrix(c(0.0, 2.0, 4.0, 5.0,
+#'                                0.0, 1.0, 2.0, 4.0),
+#'                                ncol = 2))
+#' geojson2wkt_(st)
+#' ## 3D
+#' st <- list(LineString = matrix(c(0.0, 2.0, 4.0, 5.0,
+#'                                0.0, 1.0, 2.0, 4.0,
+#'                                10, 20, 30, 40),
+#'                                ncol = 3))
+#' geojson2wkt_(st, fmt = 2)
+#'
+#' ## 4D
+#' st <- list(LineString = matrix(c(0.0, 2.0, 4.0, 5.0,
+#'                                0.0, 1.0, 2.0, 4.0,
+#'                                10, 20, 30, 40,
+#'                                1, 2, 3, 4),
+#'                                ncol = 4))
+#' geojson2wkt_(st, fmt = 2)
+#'
+#'
+#' # multilinestring
+#' ## 2D
+#' multist <- list(MultiLineString = list(
+#'    matrix(c(0, -2, -4, -1, -3, -5), ncol = 2),
+#'    matrix(c(1.66, 10.9999, 10.9, 0, -31.5, 3.0, 1.1, 0), ncol = 2)
+#'  )
+#' )
+#' geojson2wkt_(multist)
+#'
+#'
+#' # polygon
+#' ## 2D
+#' poly <- list(Polygon = list(
+#'    matrix(c(100.001, 101.1, 101.001, 100.001, 0.001, 0.001, 1.001, 0.001), ncol = 2),
+#'    matrix(c(100.201, 100.801, 100.801, 100.201, 0.201, 0.201, 0.801, 0.201), ncol = 2)
+#' ))
+#' geojson2wkt_(poly)
+#' geojson2wkt_(poly, fmt=6)
+#'
+#'
+#' # multipolygon
+#' ## 2D
+#' mpoly <- list(MultiPolygon = list(
+#'   list(
+#'     matrix(c(100, 101, 101, 100, 0.001, 0.001, 1.001, 0.001), ncol = 2),
+#'     matrix(c(100.2, 100.8, 100.8, 100.2, 0.2, 0.2, 0.8, 0.2), ncol = 2)
+#'   ),
+#'   list(
+#'     matrix(c(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 1.0), ncol = 2),
+#'     matrix(c(9.0, 10.0, 11.0, 12.0, 1.0, 2.0, 3.0, 4.0, 9.0), ncol = 2)
+#'   )
+#' ))
+#' geojson2wkt_(obj = mpoly, fmt=2)
+#'
+#' mpoly2 <- list(MultiPolygon = list(
+#'   list(
+#'     matrix(c(30, 45, 10, 30, 20, 40, 40, 20), ncol = 2)
+#'   ),
+#'   list(
+#'     matrix(c(15, 40, 10, 5, 15, 5, 10, 20, 10, 5), ncol = 2)
+#'   )
+#' ))
+#' geojson2wkt_(mpoly2, fmt=1)
+#' geojson2wkt_(mpoly2, fmt=3)
+#'
+#'
+#' # geometrycollection
+#' gmcoll <- list(GeometryCollection = list(
+#'  list(Point = c(0.0, 1.0)),
+#'  list(LineString = matrix(c(0.0, 2.0, 4.0, 5.0,
+#'                            0.0, 1.0, 2.0, 4.0),
+#'                            ncol = 2)),
+#'  list(Polygon = list(
+#'    matrix(c(100.001, 101.1, 101.001, 100.001, 0.001, 0.001, 1.001, 0.001),
+#'      ncol = 2),
+#'    matrix(c(100.201, 100.801, 100.801, 100.201, 0.201, 0.201, 0.801, 0.201),
+#'      ncol = 2)
+#'   ))
+#' ))
+#' geojson2wkt_(gmcoll, fmt=0)
+#'
+#' # Convert geojson as character string to WKT
+#' str <- '{
+#'  "Point": [
+#'    -105.01621,
+#'    39.57422
+#'  ]
+#' }'
+#' geojson2wkt_(str)
+#'
+#' str <- '{"LineString":[[0,0,10],[2,1,20],[4,2,30],[5,4,40]]}'
+#' geojson2wkt_(str)
+#'
+#' # From a jsonlite json object
+#' library("jsonlite")
+#' json <- toJSON(list(Point = c(-105,39)))
+#' geojson2wkt_(json)
+#'
+geojson2wkt_ <- function(obj, fmt = 16, ...) {
+  UseMethod("geojson2wkt_")
+}
+
+#' @export
+geojson2wkt_.character <- function(obj, fmt = 16, ...) {
+  geojson2wkt_(jsonlite::fromJSON(obj, FALSE, ...), fmt)
+}
+
+#' @export
+geojson2wkt_.json <- function(obj, fmt = 16, ...) {
+  geojson2wkt_(jsonlite::fromJSON(obj, FALSE, ...), fmt)
+}
+
+#' @export
+geojson2wkt_.list <- function(obj, fmt = 16, ...) {
+  switch(
+    tolower(names(obj)),
+    point = dump_point(list(coordinates = obj[[1]]), fmt),
+    multipoint = dump_multipoint(list(coordinates = obj[[1]]), fmt),
+    linestring = dump_linestring(list(coordinates = obj[[1]]), fmt),
+    multilinestring = dump_multilinestring(list(coordinates = obj[[1]]), fmt),
+    polygon = dump_polygon(list(coordinates = obj[[1]]), fmt),
+    multipolygon = dump_multipolygon(list(coordinates = obj[[1]]), fmt),
+    geometrycollection = dump_geometrycollection_(list(geometries = obj[[1]]), fmt),
+    stop("only point, multipoint, linestring, multilinestring, polygon, and multipolygon supported", call. = FALSE)
+  )
+}
+
+dump_geometrycollection_ <- function(obj, fmt = 16){
+  geoms <- obj$geometries
+  str <- paste0(lapply(geoms, function(z){
+    get_fxn(tolower(names(z)))(list(coordinates = z[[1]]), fmt)
+  }), collapse = ", ")
+  sprintf('GEOMETRYCOLLECTION (%s)', str)
+}