base R formatting sf to WKT (WIP)

wkt.R

``` r
  library(silicate)  ## just for data examples
#> 
#> Attaching package: 'silicate'
#> The following object is masked from 'package:stats':
#> 
#>     filter
library(sf)        ## just to verify the formatting
#> Linking to GEOS 3.7.1, GDAL 2.4.2, PROJ 5.2.0
## wicket:::sp_convert_ takes a list of coordinates and gives WKT

## sfzoo is list of sfg types (in silicate)

matrix_tuple <- function(x) {
  paste(unlist(lapply(split(t(x), rep(seq_len(dim(x)[1L]), each = dim(x)[2L])), paste0, collapse = " ")), 
        collapse = ", ")
}
paren <- function(x) {
  sprintf("(%s)", x)
}

#paren(matrix_tuple(cbind(0, 1:5)))

declare <- function(x, DECLARATION) {
  sprintf("%s %s", DECLARATION, x)
}
wkt <- function(x, ...) {
  UseMethod("wkt")
}

wkt_coords <- function(x) {
  paren(matrix_tuple(x))
}
wkt_polygon <- function(x) {
  paren(paste(unlist(lapply(unclass(x), function(m) wkt_coords(m))), collapse = ", "))
}
wkt.POINT <- function(x, ...) {
  if (!is.matrix(x)) x<- matrix(x, nrow = 1L)
  declare(wkt_coords(x), "POINT") 
}

wkt.MULTIPOINT <- function(x, ...) {
  declare(wkt_coords(x), "MULTIPOINT") 
}

wkt.LINESTRING <- function(x, ...) {
 declare(wkt_coords(x), "LINESTRING") 
}

wkt.MULTILINESTRING <- function(x, ...) {
  declare(wkt_polygon(x), "MULTILINESTRING")
}
wkt.POLYGON <- function(x, ...) {
  declare(wkt_polygon(x), 
          "POLYGON")
  
}

wkt.sfc <- function(x, ...) {
  unlist(lapply(unclass(x), wkt))
}

wkt.sf <- function(x, ...) {
  wkt(x[[attr(x, "sf_column")]])
}
wkt(sfzoo$polygon)
#> [1] "POLYGON ((0 0, 1 0, 3 2, 2 4, 1 4, 0 0), (1 1, 1 2, 2 2, 1 1))"
wkt(sfzoo$polygon) == st_as_text(sfzoo$polygon)
#> [1] TRUE
wkt(st_sfc(sfzoo$multipolygon, sfzoo$multipolygon + 10))
#> Error in UseMethod("wkt"): no applicable method for 'wkt' applied to an object of class "c('XY', 'MULTIPOLYGON', 'sfg')"
wkt(st_sf(a = 1, g = st_sfc(sfzoo$multipolygon)))
#> Error in UseMethod("wkt"): no applicable method for 'wkt' applied to an object of class "c('XY', 'MULTIPOLYGON', 'sfg')"
wkt(sfzoo$multilinestring)
#> [1] "MULTILINESTRING ((0 3, 0 4, 1 5, 2 5), (0.2 3, 0.2 4, 1 4.8, 2 4.8), (0 4.4, 0.6 5))"
wkt(sfzoo$multilinestring) == st_as_text(sfzoo$multilinestring)
#> [1] TRUE
wkt(sfzoo$linestring)
#> [1] "LINESTRING (0 3, 0 4, 1 5, 2 5)"
wkt(sfzoo$linestring) == st_as_text(sfzoo$linestring)
#> [1] TRUE
wkt(sfzoo$multipoint)
#> [1] "MULTIPOINT (3.2 4, 3 4.6, 3.8 4.4, 3.5 3.8, 3.4 3.6, 3.9 4.5)"
wkt(sfzoo$multipoint) == st_as_text(sfzoo$multipoint)
#> [1] TRUE
wkt(sfzoo$point)
#> [1] "POINT (1 2)"
wkt(sfzoo$point) == st_as_text(sfzoo$point)
#> [1] TRUE

wkt.MULTIPOLYGON <- function(x, ...) {
 declare(paren(paste0(unlist(lapply(unclass(x), wkt_polygon)), collapse = ", ")), 
         "MULTIPOLYGON")
}
wkt(sfzoo$multipolygon)
#> [1] "MULTIPOLYGON (((0 0, 1 0, 3 2, 2 4, 1 4, 0 0), (1 1, 1 2, 2 2, 1 1)), ((3 0, 4 0, 4 1, 3 1, 3 0), (3.3 0.3, 3.3 0.8, 3.8 0.8, 3.8 0.3, 3.3 0.3)), ((3 3, 4 2, 4 3, 3 3)))"
wkt(sfzoo$multipolygon) == st_as_text(sfzoo$multipolygon)
#> [1] TRUE
```

<sup>Created on 2019-11-02 by the [reprex package](https://reprex.tidyverse.org) (v0.3.0)</sup>