refactoring

R/crop.R

@@ -209,31 +209,35 @@ setMethod("crop", "SpatialDataArray", \(x, y, j=1, ...) {
     if (ii) x[, i, j] else x[i, j] 
 })
 
+#' @importFrom sf st_sf st_sfc st_as_sfc st_bbox st_polygon st_geometry<-
+.to_sf <- \(x) {
+    if (inherits(x, "sf")) {
+        y <- x
+        st_geometry(y) <- "geometry"
+    } else if (inherits(x, "sfc")) {
+        y <- st_sf(geometry=x)
+    } else if (inherits(x, "sfg")) {
+        y <- st_sf(geometry=st_sfc(x))
+    } else if (inherits(x, "bbox")) {
+        y <- st_sf(geometry=st_as_sfc(x))
+    } else if (is.matrix(x)) {
+        x <- .check_pol(x)
+        y <- st_sf(geometry=st_sfc(st_polygon(list(x))))
+    } else { 
+        .check_box(x)
+        y <- st_sf(geometry=st_as_sfc(st_bbox(unlist(x))))
+    }
+    return(y)
+}
+
 #' @export
 #' @rdname crop
 #' @importFrom dplyr pull .data
 #' @importFrom duckspatial ddbs_intersects
-#' @importFrom sf st_sf st_sfc st_as_sfc st_bbox st_polygon st_geometry<-
 setMethod("crop", "SpatialDataFrame", \(x, y, j=1, ...) {
-    if (inherits(y, "sf")) {
-        fd <- y
-        st_geometry(fd) <- "geometry"
-    } else if (inherits(y, "sfc")) {
-        fd <- st_sf(geometry=y)
-    } else if (inherits(y, "sfg")) {
-        fd <- st_sf(geometry=st_sfc(y))
-    } else if (inherits(y, "bbox")) {
-        fd <- st_sf(geometry=st_as_sfc(y))
-    } else if (is.matrix(y)) {
-        mx <- .check_pol(y)
-        fd <- st_sf(geometry=st_sfc(st_polygon(list(mx))))
-    } else {
-        # bounding box
-        .check_box(y)
-        fd <- st_sf(geometry=st_as_sfc(st_bbox(unlist(y))))
-    }
+    y <- .to_sf(y)
     df <- data(transform(x, j))
-    fd <- data(SpatialDataShape(fd))
+    fd <- data(SpatialDataShape(y))
     ok <- ddbs_intersects(df, fd, sparse=TRUE)
     x[pull(ok, .data$id_x), ]
 })

tests/testthat/test-crop.R

@@ -92,6 +92,26 @@ test_that("crop,sdLabel", {
     expect_equal(dim(m <- crop(l, y)), c(h, w))
 })
 
+test_that("crop input 'y' .to_sf()", {
+    ok <- \(x) {
+        expect_is(x, "sf")
+        expect_identical(names(x), "geometry")
+        expect_no_error(SpatialDataShape(x))
+        expect_equal(as.integer(st_bbox(x)), c(0,-1,2,1))
+    }
+    # from matrix
+    m <- matrix(c(0,-1, 2,-1, 2,1, 0,1, 0,-1), ncol=2, byrow=TRUE)
+    ok(.to_sf(m))
+    # from 'sf(c)'
+    y <- st_sfc(st_polygon(list(m)))
+    ok(.to_sf(st_sf(y)))
+    ok(.to_sf(y))
+    # from 'bbox'
+    y <- list(xmin=0, xmax=2, ymin=-1, ymax=1)
+    ok(.to_sf(st_bbox(unlist(y))))
+    ok(.to_sf(y))
+})
+
 test_that("crop-box,sdPoint", {
     n <- length(p <- point(x))
     # this shouldn't do anything