#32 added wicket stuff here

.gitignore

@@ -6,4 +6,4 @@
 revdep/checks.noindex/
 revdep/data.sqlite
 revdep/library.noindex/
-
+*.Rproj

DESCRIPTION

@@ -16,9 +16,13 @@ VignetteBuilder: knitr
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
+LinkingTo:
+    Rcpp,
+    BH
 Imports:
     jsonlite,
-    wk
+    wk,
+    Rcpp
 Suggests:
     knitr,
     rmarkdown,

Makefile

@@ -7,6 +7,12 @@ install: doc build
 build:
 	R CMD build .
 
+clean:
+	rm -f src/*.o src/*.so
+
+attributes:
+	${RSCRIPT} -e 'library(methods); Rcpp::compileAttributes()'
+
 doc:
 	${RSCRIPT} -e "devtools::document()"
 
@@ -31,4 +37,3 @@ vign:
 	cd vignettes;\
 	${RSCRIPT} -e "Sys.setenv(NOT_CRAN='true'); knitr::knit('wellknown.Rmd.og', output = 'wellknown.Rmd')";\
 	cd ..
-

NAMESPACE

@@ -40,9 +40,14 @@ S3method(polygon,data.frame)
 S3method(polygon,list)
 S3method(polygon,matrix)
 S3method(polygon,numeric)
+S3method(sf_convert,MULTIPOLYGON)
+S3method(sf_convert,POLYGON)
+S3method(sf_convert,sf)
+S3method(sf_convert,sfc)
 S3method(wktview,character)
 export(as_featurecollection)
 export(as_json)
+export(bounding_wkt)
 export(circularstring)
 export(geojson2wkt)
 export(geometrycollection)
@@ -55,9 +60,19 @@ export(multipolygon)
 export(point)
 export(polygon)
 export(properties)
+export(sf_convert)
+export(sp_convert)
+export(validate_wkt)
 export(wkb_wkt)
 export(wkt2geojson)
+export(wkt_bounding)
+export(wkt_centroid)
+export(wkt_coords)
+export(wkt_correct)
+export(wkt_reverse)
 export(wkt_wkb)
 export(wktview)
+importFrom(Rcpp,sourceCpp)
 importFrom(wk,wkb_translate_wkt)
 importFrom(wk,wkt_translate_wkb)
+useDynLib(wellknown, .registration = TRUE)

R/RcppExports.R

@@ -0,0 +1,142 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+bounding_wkt_points <- function(min_x, max_x, min_y, max_y) {
+    .Call(`_wellknown_bounding_wkt_points`, min_x, max_x, min_y, max_y)
+}
+
+bounding_wkt_list <- function(x) {
+    .Call(`_wellknown_bounding_wkt_list`, x)
+}
+
+#' @title Extract Centroid
+#' @description \code{get_centroid} identifies the 2D centroid
+#' in a WKT object (or vector of WKT objects). Note that it assumes
+#' cartesian values.
+#' @export
+#' @param wkt a character vector of WKT objects, represented as strings
+#' @return a data.frame of two columns, \code{lat} and \code{lng},
+#' with each row containing the centroid from the corresponding wkt
+#' object. In the case that the object is NA (or cannot be decoded)
+#' the resulting values will also be NA
+#' @seealso \code{\link{wkt_coords}} to extract all coordinates, and
+#' \code{\link{wkt_bounding}} to extract a bounding box.
+#' @examples
+#' wkt_centroid("POLYGON((2 1.3,2.4 1.7))")
+#' #  lng lat
+#' #1 2   1.3
+wkt_centroid <- function(wkt) {
+    .Call(`_wellknown_wkt_centroid`, wkt)
+}
+
+#' @title Reverses the points within a geometry.
+#' @description `wkt_reverse` reverses the points in any of
+#' point, multipoint, linestring, multilinestring, polygon, or
+#' multipolygon
+#' @export
+#' @param x a character vector of WKT objects, represented as strings
+#' @return a string, same length as given
+#' @details segment, box, and ring types not supported
+#' @examples
+#' wkt_reverse("POLYGON((42 -26,42 -13,52 -13,52 -26,42 -26))")
+wkt_reverse <- function(x) {
+    .Call(`_wellknown_wkt_reverse`, x)
+}
+
+sp_convert_ <- function(x, group) {
+    .Call(`_wellknown_sp_convert_`, x, group)
+}
+
+#' @title Validate WKT objects
+#' @description \code{validate_wkt} takes a vector of WKT objects and validates them,
+#' returning a data.frame containing the status of each entry and
+#' (in the case it cannot be parsed) any comments as to what, in particular, may be
+#' wrong with it. It does not, unfortunately, check whether the object meets the WKT
+#' spec - merely that it is formatted correctly.
+#' @export
+#' @param x a character vector of WKT objects.
+#' @return a data.frame of two columns, \code{is_valid} (containing TRUE or FALSE values
+#' for whether the WKT object is parseable and valid) and \code{comments} (containing any error messages
+#' in the case that the WKT object is not). If the objects are simply NA,
+#' both fields will contain NA.
+#' @seealso \code{\link{sp_convert}} for generating valid WKT objects from SpatialPolygons
+#' and SpatialPolygonDataFrames, or \code{\link{wkt_correct}} for correcting WKT objects
+#' that fail validity checks due to having a non-default orientation.
+#' @examples
+#' wkt <- c("POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))",
+#'          "ARGHLEFLARFDFG",
+#'          "LINESTRING (30 10, 10 90, 40 out of cheese error redo universe from start)")
+#' validate_wkt(wkt)
+validate_wkt <- function(x) {
+    .Call(`_wellknown_validate_wkt`, x)
+}
+
+#' @title Convert WKT Objects into Bounding Boxes
+#' @description \code{\link{wkt_bounding}} turns WKT objects
+#' (specifically points, linestrings, polygons, and multi-points/linestrings/polygons)
+#' into bounding boxes.
+#' @export
+#' @param wkt a character vector of WKT objects.
+#' @param as_matrix whether to return the results as a matrix (TRUE) or data.frame (FALSE). Set
+#' to FALSE by default.
+#' @return either a data.frame or matrix, depending on the value of \code{as_matrix}, containing
+#' four columns - \code{min_x}, \code{min_y}, \code{max_x} and \code{max_y} - representing the
+#' various points of the bounding box. In the event that a valid bounding box cannot be generated
+#' (due to the invalidity or incompatibility of the WKT object), NAs will be returned.
+#' @seealso \code{\link{bounding_wkt}}, to turn R-size bounding boxes into WKT objects.
+#' @examples
+#' wkt_bounding("POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))")
+wkt_bounding <- function(wkt, as_matrix = FALSE) {
+    .Call(`_wellknown_wkt_bounding`, wkt, as_matrix)
+}
+
+#' @title Extract Latitude and Longitude from WKT polygons
+#' @description \code{wkt_coords} extracts lat/long values from WKT polygons,
+#' specifically the outer shell of those polygons (working on the assumption that
+#' said outer edge is what you want).
+#' 
+#' Because it assumes \emph{coordinates}, it also assumes a sphere - say, the earth -
+#' and uses spherical coordinate values.
+#' @export
+#' @param wkt a character vector of WKT objects
+#' @return a data.frame of four columns; \code{object} (containing which object
+#' the row refers to), \code{ring} containing which layer of the object the row
+#' refers to, \code{lng} and \code{lat}.
+#' @seealso \code{\link{wkt_bounding}} to extract a bounding box,
+#' and \code{\link{wkt_centroid}} to extract the centroid.
+#' @examples
+#' wkt_coords("POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))")
+#' # object  ring lng lat
+#' # 1    1 outer  30  10
+#' # 2    1 outer  40  40
+#' # 3    1 outer  20  40
+#' # 4    1 outer  10  20
+#' # 5    1 outer  30  10
+wkt_coords <- function(wkt) {
+    .Call(`_wellknown_wkt_coords`, wkt)
+}
+
+#' @title Correct Incorrectly Oriented WKT Objects
+#' @description \code{wkt_correct} does precisely what it says on the tin,
+#' correcting the orientation of WKT objects that are improperly oriented
+#' (say, back to front). It can be applied to WKT objects that,
+#' when validated with \code{\link{validate_wkt}}, fail for that reason.
+#' @export
+#' @param x a character vector of WKT objects to correct
+#' @return a character vector, the same length as \code{x}, containing
+#' either the original value (if there was no correction to make, or if
+#' the object was invalid for other reasons) or the corrected WKT
+#' value.
+#' @examples
+#' # A WKT object
+#' wkt <- "POLYGON((30 20, 10 40, 45 40, 30 20), (15 5, 5 10, 10 20, 40 10, 15 5))"
+#' 
+#' # That's invalid due to a non-default orientation
+#' validate_wkt(wkt)
+#' 
+#' # And suddenly isn't!
+#' wkt_correct(wkt)
+wkt_correct <- function(x) {
+    .Call(`_wellknown_wkt_correct`, x)
+}
+

R/bounding_wkt.R

@@ -0,0 +1,33 @@
+#' @title Generate Bounding Boxes
+#' @description `bounding_wkt` takes bounding boxes, in various formats,
+#' and turns them into WKT POLYGONs.
+#' @export
+#' @param min_x a numeric vector of the minimum value for `x` coordinates.
+#' @param min_y a numeric vector of the minimum value for `y` coordinates.
+#' @param max_x a numeric vector of the maximum value for `x` coordinates.
+#' @param max_y a numeric vector of the maximum value for `y` coordinates.
+#' @param values as an alternative to specifying the various values as vectors,
+#' a list of length-4 numeric vectors containing min and max x and y values, or
+#' just a single vector fitting that spec. NULL (meaning that the other
+#' parameters will be expected) by default.
+#' @return a character vector of WKT POLYGON objects
+#' @seealso [wkt_bounding()], to turn WKT objects of various types into
+#' a matrix or data.frame of bounding boxes.
+#' @examples
+#' # With individual columns
+#' bounding_wkt(10, 12, 14, 16)
+#' 
+#' # With a list
+#' bounding_wkt(values = list(c(10, 12, 14, 16)))
+bounding_wkt <- function(min_x, min_y, max_x, max_y, values = NULL) {
+  if (is.null(values)) {
+    return(bounding_wkt_points(min_x, max_x, min_y, max_y))
+  }
+  if (is.list(values)) {
+    return(bounding_wkt_list(values))
+  }
+  if (is.vector(values) && length(values) == 4) {
+    return(bounding_wkt_list(list(values)))
+  }
+  stop("values must be NULL, a list or a length-4 vector")
+}

R/sp_convert.R

@@ -0,0 +1,97 @@
+get_coords <- function(sp_single){
+  unlist(lapply(sp_single@polygons, function(ss){
+    lapply(ss@Polygons, function(ss_i){
+      return(ss_i@coords)
+    })
+  }), recursive = FALSE)
+}
+get_coords_sf <- function(sf_single){
+  unlist(unclass(sf_single), recursive = FALSE)
+}
+
+#' @title Convert spatial objects to WKT
+#' @description `sp_convert` turns objects from the `sp` package
+#' (SpatialPolygons, SpatialPolygonDataFrames) or the `sf` package
+#' (sf, sfc, POLYGON, MULTIPOLYGON) - into WKT POLYGONs or MULTIPOLYGONs
+#'
+#' @param x for `sp_convert()`, a list of SP/SPDF objects (or a single object)
+#' for `sf_convert()`, an sf, sfc, POLYGON, or MULTIPOLYGON sf object
+#'
+#' @param group whether or not to group coordinates together in the case
+#' that an object in `x` has multiple sets of coordinates. If `TRUE`
+#' (the default), such objects will be returned as `MULTIPOLYGON`'s
+#' - if `FALSE`, as a vector of `POLYGON`'s
+#'
+#' @return either a character vector of WKT objects - one per sp object -
+#' if `group` is `TRUE`, or a list of vectors if `group` is `FALSE`
+#'
+#' @seealso [bounding_wkt()], for turning bounding boxes within
+#' `sp` objects into WKT objects.
+#'
+#' @examples \dontrun{
+#' library(sp)
+#' library(sf)
+#' s1 <- SpatialPolygons(list(Polygons(list(Polygon(cbind(c(2,4,4,1,2),c(2,3,5,4,2)))), "s1")))
+#' sp_convert(s1)
+#' x = st_as_sf(s1)
+#' sf_convert(x)
+#'
+#' library(sf)
+#' one = Polygon(cbind(c(91,90,90,91), c(30,30,32,30)))
+#' two = Polygon(cbind(c(94,92,92,94), c(40,40,42,40)))
+#' spone = Polygons(list(one), "s1")
+#' sptwo = Polygons(list(two), "s2")
+#' z = SpatialPolygons(list(spone, sptwo), as.integer(1:2))
+#' x = st_as_sf(z)
+#' sp_convert(z)
+#' # class: sf
+#' sf_convert(x)
+#' # class: sfc
+#' sf_convert(x = x[[1]])
+#' # class: polygon
+#' sf_convert(x = unclass(x[[1]])[[1]])
+#' sf_convert(x = unclass(x[[1]])[[2]])
+#'
+#' library(silicate)
+#' x <- sfzoo$multipolygon
+#' class(x)
+#' x_sp <- as(x, "Spatial")
+#' st_as_text(x)
+#' sp_convert(x_sp)
+#' sf_convert(x)
+#' }
+#' @export
+sp_convert <- function(x, group = TRUE){
+  if(!is.list(x)){
+    x <- list(x)
+  }
+  coords <- lapply(x, get_coords)
+  return(sp_convert_(coords, group))
+}
+
+#' @export
+#' @rdname sp_convert
+sf_convert <- function(x, group = TRUE){
+  UseMethod("sf_convert")
+}
+#' @export
+sf_convert.POLYGON <- function(x, group = TRUE) {
+  coords <- list(lapply(x, get_coords_sf))
+  return(sp_convert_(coords, group))
+}
+#' @export
+sf_convert.MULTIPOLYGON <- function(x, group = TRUE) {
+  sp_convert_(list(get_coords_sf(unclass(x))), group)
+}
+#' @export
+sf_convert.sfc <- function(x, group = TRUE) {
+  x <- unclass(x)
+  x <- list(x)
+  coords <- lapply(x, get_coords_sf)
+  return(sp_convert_(coords, group))
+}
+#' @export
+sf_convert.sf <- function(x, group = TRUE) {
+  x <- x[[attr(x, "sf_column")]]
+  sf_convert(x)
+}

R/wellknown-package.R

@@ -6,6 +6,8 @@
 #' @author Scott Chamberlain
 #' @keywords package
 #' @importFrom wk wkt_translate_wkb wkb_translate_wkt
+#' @useDynLib wellknown, .registration = TRUE
+#' @importFrom Rcpp sourceCpp
 #' @examples
 #' # GeoJSON to WKT
 #' point <- list(Point = c(116.4, 45.2, 11.1))