Merge pull request #160 from paleolimbot/sf-coords

Optimize wk_coords() for xy
paleolimbot · Oct 10, 2022 · db3da49 · db3da49
2 parents 7c86afb + 02aaaf9
commit db3da49
Show file tree

Hide file tree

Showing 4 changed files with 38 additions and 0 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -228,6 +228,8 @@ S3method(vec_ptype2.wk_xyzm,wk_xyz)
 S3method(vec_ptype2.wk_xyzm,wk_xyzm)
 S3method(wk_bbox,default)
 S3method(wk_bbox,wk_grd)
+S3method(wk_coords,default)
+S3method(wk_coords,wk_xy)
 S3method(wk_count,default)
 S3method(wk_crs,data.frame)
 S3method(wk_crs,sf)

diff --git a/NEWS.md b/NEWS.md
@@ -29,6 +29,7 @@
 * Fixes warnings when compiling with `-Wstrict-prototypes` (#157, #158).
 * Removed `wk_chunk_map_feature()` in favour of using chunking strategies
   directly (#132, #159).
+* Optimized `wk_coords()` for `xy()` objects (#138, #160).
 
 # wk 0.6.0
 

diff --git a/R/vertex-filter.R b/R/vertex-filter.R
@@ -47,6 +47,11 @@ wk_vertices <- function(handleable, ...) {
 #' @rdname wk_vertices
 #' @export
 wk_coords <- function(handleable, ...) {
+  UseMethod("wk_coords")
+}
+
+#' @export
+wk_coords.default <- function(handleable, ...) {
   result <- wk_handle(
     handleable,
     wk_vertex_filter(xy_writer(), add_details = TRUE),
@@ -66,3 +71,25 @@ wk_vertex_filter <- function(handler, add_details = FALSE) {
     "wk_vertex_filter"
   )
 }
+
+#' @export
+wk_coords.wk_xy <- function(handleable, ...) {
+  feature_id <- seq_along(handleable)
+  not_empty <- !is.na(handleable)
+
+  if (!all(not_empty)) {
+    handleable <- handleable[not_empty]
+    feature_id <- feature_id[not_empty]
+  }
+
+  new_data_frame(
+    c(
+      list(
+        feature_id = feature_id,
+        part_id = feature_id,
+        ring_id = rep_len(0L, length(feature_id))
+      ),
+      unclass(handleable)
+    )
+  )
+}
diff --git a/tests/testthat/test-vertex-filter.R b/tests/testthat/test-vertex-filter.R
@@ -136,3 +136,11 @@ test_that("wk_vertices() communicates correct size and type", {
     list(geometry_type = 1L, size = NA_real_, has_z = FALSE, has_m = FALSE)
   )
 })
+
+test_that("optimized wk_coords() for xy() works", {
+  xys <- xy(1:5, 6:10)
+  expect_identical(wk_coords(xys), wk_coords.default(xys))
+
+  xys_with_empty <- c(xys, xy(NA, NA))
+  expect_identical(wk_coords(xys_with_empty), wk_coords.default(xys_with_empty))
+})