simplified point/shape subsetting

NAMESPACE

@@ -177,7 +177,6 @@ importFrom(methods,setClassUnion)
 importFrom(methods,setReplaceMethod)
 importFrom(reticulate,import)
 importFrom(rlang,"!!")
-importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(sf,"st_geometry<-")
 importFrom(sf,st_as_sf)

R/PointFrame.R

@@ -86,66 +86,6 @@ setMethod("[[", "PointFrame", \(x, i, ...) {
 #' @exportMethod $
 setMethod("$", "PointFrame", \(x, name) do.call(`[[`, list(x, name)))
 
-# sub ----
-
-#' @rdname PointFrame
-#' @export
-setMethod("[", c("PointFrame", "missing", "ANY"),
-    \(x, i, j, ...) x[seq_len(nrow(x)), j])
-
-#' @rdname PointFrame
-#' @export
-setMethod("[", c("PointFrame", "ANY", "missing"),
-    \(x, i, j, ...) x[i, seq_len(ncol(x))])
-
-#' @rdname PointFrame
-#' @export
-setMethod("[", c("PointFrame", "missing", "missing"),
-    \(x, i, j, ...) x[seq_len(nrow(x)), seq_len(ncol(x))])
-
-#' @rdname PointFrame
-#' @export
-setMethod("[", c("PointFrame", "ANY", "character"), \(x, i, j, ...) {
-    stopifnot(all(j %in% names(x)))
-    x[i, match(j, names(x))]
-})
-
-#' @export
-#' @rdname PointFrame
-setMethod("[", c("PointFrame", "logical", "ANY"), \(x, i, j, ...) {
-    if (isTRUE(i)) return(x[, j])
-    if (isFALSE(i)) return(x[0, j])
-    stopifnot(length(i) != length(x))
-    x[seq_len(nrow(x))[i], j]
-})
-
-#' @rdname PointFrame
-#' @importFrom dplyr mutate filter select all_of
-#' @export
-setMethod("[", c("PointFrame", "numeric", "numeric"), \(x, i, j, ...) {
-    i <- seq_len(nrow(x))[i]
-    j <- seq_len(ncol(x))[j]
-    cn <- make.unique(c(names(x), "rn"))[ncol(x) + 1]
-    x@data <- x@data |> 
-        mutate(!!cn := row_number()) |>
-        filter(.data[[cn]] %in% i) |>
-        select(-all_of(cn)) |> 
-        select(all_of(j))
-    # # TODO: this worked having assumed indices are unique;
-    # # they may not be, so subsetting on a query doesn't work
-    # .i <- `__null_dask_index__` <- NULL # R CMD check
-    # i <- seq_len(nrow(x))[i]
-    # x@data <- data(x) |>
-    #     mutate(.i=1+`__null_dask_index__`) |>
-    #     filter(.i %in% i) |>
-    #     select(-.i)
-    # # make sure this is kept in any case
-    # ndi <- "__null_dask_index__"
-    # ndi <- match(ndi, colnames(x@data), nomatch=0)
-    # x@data <- x@data |> select(all_of(c(j, ndi)))
-    return(x)
-})
-
 #' @rdname PointFrame
 #' @importFrom BiocGenerics as.data.frame
 #' @export

R/ShapeFrame.R

@@ -111,31 +111,51 @@ setMethod("geom_type", "ShapeFrame", \(x) {
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("[", c("ShapeFrame", "missing", "ANY"),
-    \(x, i, j, ...) x[seq_len(nrow(x)), j])
+setMethod("[", c("sdFrame", "missing", "missing"),
+    \(x, i, j, ...) x[TRUE, TRUE])
 
+#' @rdname ShapeFrame    
+#' @export
+setMethod("[", c("sdFrame", "missing", "ANY"),
+    \(x, i, j, ...) x[seq_len(nrow(x)), j])
+
 #' @rdname ShapeFrame
 #' @export
-setMethod("[", c("ShapeFrame", "ANY", "missing"),
+setMethod("[", c("sdFrame", "ANY", "missing"),
     \(x, i, j, ...) x[i, seq_len(ncol(x))])
 
+#' @export
 #' @rdname ShapeFrame
+setMethod("[", c("sdFrame", "logical", "ANY"), \(x, i, j, ...) {
+    if (isTRUE(i)) return(x[, j])
+    if (isFALSE(i)) return(x[0, j])
+    stopifnot(length(i) != nrow(x))
+    x[seq_len(nrow(x))[i], j]
+})
+
 #' @export
-setMethod("[", c("ShapeFrame", "missing", "missing"),
-    \(x, i, j, ...) x[seq_len(nrow(x)), seq_len(ncol(x))])
+#' @rdname ShapeFrame
+setMethod("[", c("sdFrame", "ANY", "logical"), \(x, i, j, ...) {
+    if (isTRUE(j)) return(x[i, ])
+    if (isFALSE(j)) return(x[i, 0])
+    stopifnot(length(j) != ncol(x))
+    x[i, seq_len(nrow(x))[j]]
+})
 
 #' @rdname ShapeFrame
-#' @importFrom dplyr mutate filter select all_of row_number
-#' @importFrom rlang .data !! :=
 #' @export
-setMethod("[", c("ShapeFrame", "numeric", "numeric"), \(x, i, j, ...) {
-    i <- seq_len(nrow(x))[i]
-    j <- seq_len(ncol(x))[j]
-    cn <- make.unique(c(names(x), "rn"))[ncol(x) + 1]
+setMethod("[", c("sdFrame", "ANY", "character"), \(x, i, j, ...) {
+    stopifnot(all(j %in% names(x)))
+    x[i, match(j, names(x))]
+})
+
+#' @rdname ShapeFrame
+#' @importFrom dplyr row_number select all_of 
+#' @export
+setMethod("[", c("sdFrame", "numeric", "numeric"), \(x, i, j, ...) {
+    if (any(i < 0)) stop("negative row-subsetting not supported")
     x@data <- x@data |> 
-        mutate(!!cn := row_number()) |>
-        filter(.data[[cn]] %in% i) |>
-        select(-all_of(cn)) |> 
+        filter(row_number() %in% i) |>
         select(all_of(j))
     return(x)
 })

tests/testthat/test-methods.R

@@ -163,24 +163,24 @@ test_that("$", {
 
 test_that("[,Shape/PointFrame", {
     y <- shape(x)
+    expect_error(y[-1,])
     # one index subsets in vector-like fashion
     expect_equal(dim(y[1]), c(1, ncol(y)))
     # two indices subset in array-like fashion
     expect_equal(nrow(y[1,]), 1) # no j
     expect_equal(ncol(y[,1]), 1) # no i
     expect_equal(dim(y[1,1]), c(1,1)) # both
     expect_identical(dim(y[,]), dim(y)) # none
-    expect_equal(nrow(y[-1,]), nrow(y)-1) # neg
 
     y <- point(x)
+    expect_error(y[-1,])
     # one index subsets in vector-like fashion
     expect_equal(dim(y[1]), c(1, ncol(y)))
     # two indices subset in array-like fashion
     expect_equal(nrow(y[1,]), 1) # no j
     expect_equal(ncol(y[,1]), 2) # no i (preserve geometry)
     expect_equal(dim(y[1,1]), c(1,2)) # both
     expect_identical(dim(y[,]), dim(y)) # none
-    expect_equal(nrow(y[-1,]), nrow(y)-1) # neg
 })
 
 test_that("[,LabelArray", {