Merge pull request #165 from r-spatial/c-api

Extract simple features-like interface into a C++ only API

NAMESPACE

@@ -73,6 +73,7 @@ S3method(str,s2_cell_union)
 S3method(str,s2_xptr)
 S3method(unique,s2_cell)
 S3method(unlist,s2_cell_union)
+S3method(wk_handle,s2_geography)
 export(as_s2_cell)
 export(as_s2_cell_union)
 export(as_s2_geography)
@@ -202,4 +203,5 @@ importFrom(Rcpp,sourceCpp)
 importFrom(utils,str)
 importFrom(wk,as_wkb)
 importFrom(wk,as_wkt)
+importFrom(wk,wk_handle)
 useDynLib(s2, .registration = TRUE)

R/RcppExports.R

@@ -253,42 +253,10 @@ cpp_s2_cell_common_ancestor_level_agg <- function(cellId) {
     .Call(`_s2_cpp_s2_cell_common_ancestor_level_agg`, cellId)
 }
 
-cpp_s2_geog_point <- function(x, y) {
-    .Call(`_s2_cpp_s2_geog_point`, x, y)
-}
-
-cpp_s2_make_line <- function(x, y, featureId) {
-    .Call(`_s2_cpp_s2_make_line`, x, y, featureId)
-}
-
-cpp_s2_make_polygon <- function(x, y, featureId, ringId, oriented, check) {
-    .Call(`_s2_cpp_s2_make_polygon`, x, y, featureId, ringId, oriented, check)
-}
-
-s2_geography_from_wkb <- function(wkb, oriented, check) {
-    .Call(`_s2_s2_geography_from_wkb`, wkb, oriented, check)
-}
-
-s2_geography_from_wkt <- function(wkt, oriented, check) {
-    .Call(`_s2_s2_geography_from_wkt`, wkt, oriented, check)
-}
-
 s2_geography_full <- function(x) {
     .Call(`_s2_s2_geography_full`, x)
 }
 
-s2_geography_to_wkt <- function(s2_geography, precision, trim) {
-    .Call(`_s2_s2_geography_to_wkt`, s2_geography, precision, trim)
-}
-
-s2_geography_to_wkb <- function(s2_geography, endian) {
-    .Call(`_s2_s2_geography_to_wkb`, s2_geography, endian)
-}
-
-s2_geography_format <- function(s2_geography, maxCoords, precision, trim) {
-    .Call(`_s2_s2_geography_format`, s2_geography, maxCoords, precision, trim)
-}
-
 s2_lnglat_from_numeric <- function(lng, lat) {
     .Call(`_s2_s2_lnglat_from_numeric`, lng, lat)
 }

R/data.R

@@ -70,3 +70,10 @@ s2_data_cities <- function(name = NULL) {
 
   as_s2_geography(wkb)
 }
+
+#' Example Geometries
+#'
+#' These geometries are toy examples useful for testing various coordinate
+#' shuffling operations in the s2 package.
+#'
+"s2_data_example_wkt"

R/s2-constructors-formatters.R

@@ -70,72 +70,77 @@
 #' s2_as_binary(geog)
 #'
 s2_geog_point <- function(longitude, latitude) {
-  recycled <- recycle_common(longitude, latitude)
-  new_s2_xptr(cpp_s2_geog_point(recycled[[1]], recycled[[2]]), "s2_geography")
+  wk::wk_handle(wk::xy(longitude, latitude), s2_geography_writer())
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_make_line <- function(longitude, latitude, feature_id = 1L) {
-  recycled <- recycle_common(longitude, latitude, feature_id)
-  new_s2_xptr(cpp_s2_make_line(recycled[[1]], recycled[[2]], featureId = recycled[[3]]), "s2_geography")
+  wk::wk_handle(
+    wk::xy(longitude, latitude),
+    wk::wk_linestring_filter(
+      s2_geography_writer(),
+      feature_id = as.integer(feature_id)
+    )
+  )
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_make_polygon <- function(longitude, latitude, feature_id = 1L, ring_id = 1L,
                             oriented = FALSE, check = TRUE) {
-  recycled <- recycle_common(longitude, latitude, feature_id, ring_id)
-  new_s2_xptr(
-    cpp_s2_make_polygon(
-      recycled[[1]], recycled[[2]],
-      featureId = recycled[[3]],
-      ringId = recycled[[4]],
-      oriented = oriented,
-      check = check
-    ),
-    "s2_geography"
+  wk::wk_handle(
+    wk::xy(longitude, latitude),
+    wk::wk_polygon_filter(
+      s2_geography_writer(oriented = oriented, check = check),
+      feature_id = as.integer(feature_id),
+      ring_id = as.integer(ring_id)
+    )
   )
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_geog_from_text <- function(wkt_string, oriented = FALSE, check = TRUE) {
   attributes(wkt_string) <- NULL
-  wk::validate_wk_wkt(wk::new_wk_wkt(wkt_string))
-  new_s2_xptr(
-    s2_geography_from_wkt(
-      wkt_string,
-      oriented = oriented,
-      check = check
-    ),
-    "s2_geography"
+  wkt <- wk::new_wk_wkt(wkt_string, geodesic = TRUE)
+  wk::validate_wk_wkt(wkt)
+
+  wk::wk_handle(
+    wkt,
+    s2_geography_writer(oriented = oriented, check = check)
   )
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_geog_from_wkb <- function(wkb_bytes, oriented = FALSE, check = TRUE) {
   attributes(wkb_bytes) <- NULL
-  wk::validate_wk_wkb(wk::new_wk_wkb(wkb_bytes))
-  new_s2_xptr(
-    s2_geography_from_wkb(
-      wkb_bytes,
-      oriented = oriented,
-      check = check
-    ),
-    "s2_geography"
+  wkb <- wk::new_wk_wkb(wkb_bytes)
+  wk::validate_wk_wkb(wkb)
+  wk::wk_handle(
+    wkb,
+    s2_geography_writer(oriented = oriented, check = check)
   )
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_as_text <- function(x, precision = 16, trim = TRUE) {
-  s2_geography_to_wkt(as_s2_geography(x), precision = precision, trim = trim)
+  wkt <- wk::wk_handle(
+    as_s2_geography(x),
+    wk::wkt_writer(precision = precision, trim = trim)
+  )
+
+  attributes(wkt) <- NULL
+  wkt
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_as_binary <- function(x, endian = wk::wk_platform_endian()) {
-  structure(s2_geography_to_wkb(as_s2_geography(x), endian = endian), class = "blob")
+  structure(
+    wk::wk_handle(as_s2_geography(x), wk::wkb_writer(endian = endian)),
+    class = "blob"
+  )
 }

R/s2-geography.R

@@ -48,7 +48,7 @@ as_s2_geography.s2_geography <- function(x, ...) {
 #' @export
 as_s2_geography.s2_lnglat <- function(x, ...) {
   df <- data_frame_from_s2_lnglat(x)
-  new_s2_xptr(cpp_s2_geog_point(df[[1]], df[[2]]), "s2_geography")
+  s2_geog_point(df[[1]], df[[2]])
 }
 
 #' @rdname as_s2_geography
@@ -76,28 +76,22 @@ as_s2_geography.wk_wkb <- function(x, ..., oriented = FALSE, check = TRUE) {
     }
   }
 
-  new_s2_xptr(
-    s2_geography_from_wkb(x, oriented = oriented, check = check),
-    "s2_geography"
+  wk::wk_handle(
+    x,
+    s2_geography_writer(oriented = oriented, check = check)
   )
 }
 
 #' @rdname as_s2_geography
 #' @export
 as_s2_geography.WKB <- function(x, ..., oriented = FALSE, check = TRUE) {
-  new_s2_xptr(
-    s2_geography_from_wkb(x, oriented = oriented, check = check),
-    "s2_geography"
-  )
+  s2_geog_from_wkb(x, oriented = oriented, check = check)
 }
 
 #' @rdname as_s2_geography
 #' @export
 as_s2_geography.blob <- function(x, ..., oriented = FALSE, check = TRUE) {
-  new_s2_xptr(
-    s2_geography_from_wkb(x, oriented = oriented, check = check),
-    "s2_geography"
-  )
+  s2_geog_from_wkb(x, oriented = oriented, check = check)
 }
 
 #' @rdname as_s2_geography
@@ -119,19 +113,16 @@ as_s2_geography.wk_wkt <- function(x, ..., oriented = FALSE, check = TRUE) {
     }
   }
 
-  new_s2_xptr(
-    s2_geography_from_wkt(x, oriented = oriented, check = check),
-    "s2_geography"
+  wk::wk_handle(
+    x,
+    s2_geography_writer(oriented = oriented, check = check)
   )
 }
 
 #' @rdname as_s2_geography
 #' @export
 as_s2_geography.character <- function(x, ..., oriented = FALSE, check = TRUE) {
-  new_s2_xptr(
-    s2_geography_from_wkt(x, oriented = oriented, check = check),
-    "s2_geography"
-  )
+  s2_geog_from_text(x, oriented = oriented, check = check)
 }
 
 #' @rdname as_s2_geography
@@ -145,22 +136,20 @@ as_s2_geography.logical <- function(x, ...) {
 #' @rdname as_s2_geography
 #' @export
 as_wkb.s2_geography <- function(x, ...) {
-  wk::new_wk_wkb(
-    s2_geography_to_wkb(x, wk::wk_platform_endian()),
-    crs = wk::wk_crs_longlat("WGS84"),
-    geodesic = TRUE
-  )
+  wkb <- wk::wk_handle(x, wk::wkb_writer())
+  wk::wk_is_geodesic(wkb) <- TRUE
+  wk::wk_crs(wkb) <- wk::wk_crs_longlat()
+  wkb
 }
 
 #' @importFrom wk as_wkt
 #' @rdname as_s2_geography
 #' @export
 as_wkt.s2_geography <- function(x, ...) {
-  wk::new_wk_wkt(
-    s2_geography_to_wkt(x, precision = 16, trim = TRUE),
-    crs = wk::wk_crs_longlat(),
-    geodesic = TRUE
-  )
+  wkt <- wk::wk_handle(x, wk::wkt_writer())
+  wk::wk_is_geodesic(wkt) <- TRUE
+  wk::wk_crs(wkt) <- wk::wk_crs_longlat()
+  wkt
 }
 
 
@@ -180,7 +169,7 @@ as_wkt.s2_geography <- function(x, ...) {
 
 #' @export
 format.s2_geography <- function(x, ..., max_coords = 5, precision = 9, trim = TRUE) {
-  paste0("<", s2_geography_format(x, max_coords, precision, trim), ">")
+  wk::wk_format(x, precision = precision, max_coords = max_coords, trim = trim)
 }
 
 # this is what gets called by the RStudio viewer, for which

R/utils.R

@@ -68,8 +68,18 @@ stop_problems <- function(feature_id, problem, header) {
 
 expect_wkt_equal <- function(x, y, precision = 16) {
   testthat::expect_equal(
-    s2_geography_to_wkt(as_s2_geography(x), precision = precision, trim = TRUE),
-    s2_geography_to_wkt(as_s2_geography(y), precision = precision, trim = TRUE)
+    wk::wk_format(
+      as_s2_geography(x),
+      precision = precision,
+      trim = TRUE,
+      max_coords = .Machine$integer.max
+    ),
+    wk::wk_format(
+      as_s2_geography(y),
+      precision = precision,
+      trim = TRUE,
+      max_coords = .Machine$integer.max
+    )
   )
 }
 

R/wk-utils.R

@@ -65,6 +65,23 @@ s2_projection_filter <- function(handler, projection = s2_projection_plate_carre
   )
 }
 
+#' @importFrom wk wk_handle
+#' @export
+wk_handle.s2_geography <- function(geog, handler, ...)  {
+  .Call(c_s2_handle_geography, geog, wk::as_wk_handler(handler))
+}
+
+s2_geography_writer <- function(oriented = FALSE, check = TRUE) {
+  wk::new_wk_handler(
+    .Call(
+      c_s2_geography_writer_new,
+      as.logical(oriented)[1],
+      as.logical(check)[1]
+    ),
+    "s2_geography_writer"
+  )
+}
+
 #' @rdname s2_unprojection_filter
 #' @export
 s2_projection_plate_carree <- function() {