Use duckspatial instead of arrow for ShapeFrame and PointFrame

DESCRIPTION

@@ -33,7 +33,6 @@ Authors@R: c(
         email="louise.deconinck@gmail.com",
         comment=c(ORCID="0000-0001-8100-6823")))
 Imports:
-    arrow,
     basilisk,
     BiocGenerics,
     DelayedArray,

NAMESPACE

@@ -113,11 +113,9 @@ importFrom(DelayedArray,DelayedArray)
 importFrom(EBImage,resize)
 importFrom(EBImage,rotate)
 importFrom(EBImage,translate)
-importFrom(Matrix,rowSums)
 importFrom(Matrix,sparseMatrix)
 importFrom(Matrix,sparseVector)
 importFrom(Matrix,summary)
-importFrom(Matrix,t)
 importFrom(RBGL,sp.between)
 importFrom(Rarr,read_zarr_attributes)
 importFrom(Rarr,zarr_overview)
@@ -140,17 +138,24 @@ importFrom(SummarizedExperiment,colData)
 importFrom(ZarrArray,ZarrArray)
 importFrom(ZarrArray,path)
 importFrom(ZarrArray,type)
-importFrom(arrow,open_dataset)
 importFrom(basilisk,BasiliskEnvironment)
 importFrom(basilisk,basiliskRun)
 importFrom(basilisk,basiliskStart)
 importFrom(basilisk,basiliskStop)
 importFrom(dplyr,all_of)
 importFrom(dplyr,collect)
+importFrom(dplyr,count)
 importFrom(dplyr,filter)
+importFrom(dplyr,inner_join)
+importFrom(dplyr,join_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,pull)
+importFrom(dplyr,row_number)
 importFrom(dplyr,select)
+importFrom(dplyr,slice)
+importFrom(dplyr,tally)
+importFrom(duckspatial,as_duckspatial_df)
+importFrom(duckspatial,ddbs_intersects)
 importFrom(duckspatial,ddbs_open_dataset)
 importFrom(graph,"edgeData<-")
 importFrom(graph,"edgeDataDefaults<-")
@@ -171,16 +176,19 @@ importFrom(methods,new)
 importFrom(methods,setClassUnion)
 importFrom(methods,setReplaceMethod)
 importFrom(reticulate,import)
+importFrom(rlang,"!!")
+importFrom(rlang,.data)
 importFrom(sf,"st_geometry<-")
 importFrom(sf,st_as_sf)
+importFrom(sf,st_as_sfc)
 importFrom(sf,st_bbox)
 importFrom(sf,st_coordinates)
-importFrom(sf,st_crop)
-importFrom(sf,st_distance)
 importFrom(sf,st_geometry)
 importFrom(sf,st_geometry_type)
 importFrom(sf,st_intersects)
 importFrom(sf,st_polygon)
+importFrom(sf,st_sf)
+importFrom(sf,st_sfc)
 importFrom(utils,.DollarNames)
 importFrom(utils,head)
 importFrom(utils,tail)

R/AllClasses.R

@@ -3,7 +3,7 @@
     contains="list")
 
 #' @importFrom methods setClassUnion
-#' @importClassesFrom S4Arrays Array 
+#' @importClassesFrom S4Arrays Array
 setClassUnion(
     "array_OR_df",
     c("Array", "array", "data.frame"))
@@ -22,16 +22,17 @@ setClassUnion(
 # this somehow does the trick...
 setClass("FileSystemDataset", "VIRTUAL")
 setClass("arrow_dplyr_query", "VIRTUAL")
+setClass("tbl_duckdb_connection", "VIRTUAL")
 setClass("duckspatial_df", "VIRTUAL")
 setClass("Table", "VIRTUAL")
 
 # TODO: this isn't great... arrow::open_dataset gives a FileSystemDataset,
-# read_parquet gives a Table, dplyr calls give a query, but also wanna 
+# read_parquet gives a Table, dplyr calls give a query, but also wanna
 # be able to store a normal data.frame, maybe?
 #' @importFrom methods setClassUnion
 setClassUnion(
     "arrow_OR_df",
-    c("duckspatial_df", "FileSystemDataset", "Table", "arrow_dplyr_query", "data.frame"))
+    c("tbl_duckdb_connection", "duckspatial_df", "FileSystemDataset", "Table", "arrow_dplyr_query", "data.frame"))
 
 .PointFrame <- setClass(
     Class="PointFrame",

R/PointFrame.R

@@ -2,11 +2,11 @@
 #' @title The `PointFrame` class
 #'
 #' @description
-#' The \code{PointFrame} class stores \code{SpatialData} elements from its 
+#' The \code{PointFrame} class stores \code{SpatialData} elements from its
 #' \code{"points"} layers. These are represented as \code{\link[arrow]{Table}}
-#' (\code{data} slot) associated with .zattrs stored as \code{\link{Zattrs}} 
+#' (\code{data} slot) associated with .zattrs stored as \code{\link{Zattrs}}
 #' (\code{meta} slot); a list of \code{metadata} stores other arbitrary info.
-#'  
+#'
 #' Currently defined methods (here, \code{x} is a \code{PointFrame}):
 #' \itemize{
 #' \item \code{data/meta(x)} to access underlying \code{Table/Zattrs}
@@ -21,7 +21,7 @@
 #' @param data \code{arrow}-derived table for on-disk,
 #'   \code{data.frame} for in-memory representation.
 #' @param meta \code{\link{Zattrs}}
-#' @param metadata optional list of arbitrary 
+#' @param metadata optional list of arbitrary
 #'   content describing the overall object.
 #' @param name character string for extraction (see \code{?base::`$`}).
 #' @param i,j indices for subsetting (see \code{?base::Extract}).
@@ -35,7 +35,7 @@
 #' zs <- get_demo_SDdata("merfish")
 #' x <- file.path(zs, "points", "single_molecule")
 #' (p <- readPoint(x))
-#' 
+#'
 #' head(as.data.frame(data(p)))
 #' (q <- dplyr::filter(p, cell_type == "VISp_wm"))
 #'
@@ -51,15 +51,15 @@ PointFrame <- function(data=data.frame(), meta=Zattrs(), metadata=list(), ...) {
 #' @rdname PointFrame
 #' @export
 setMethod("names", "PointFrame", \(x) {
-    setdiff(names(data(x)), "__null_dask_index__") })
+    setdiff(colnames(data(x)), "__null_dask_index__") })
 
 #' @rdname PointFrame
 #' @export
-setMethod("dim", "PointFrame", \(x) c(nrow(data(x)), length(names(x))))
+setMethod("dim", "PointFrame", \(x) c(length(x), length(names(x))))
 
 #' @rdname PointFrame
 #' @export
-setMethod("length", "PointFrame", \(x) nrow(data(x)))
+setMethod("length", "PointFrame", \(x) data(x) |> tally() |> pull(n))
 
 #' @rdname PointFrame
 #' @importFrom dplyr select all_of collect
@@ -71,7 +71,7 @@ setMethod("[[", "PointFrame", \(x, i, ...) {
 #' @importFrom utils .DollarNames
 #' @export
 .DollarNames.PointFrame <- \(x, pattern="") {
-    setdiff(names(data(x)), "__null_dask_index__") }
+    setdiff(colnames(data(x)), "__null_dask_index__") }
 
 #' @rdname PointFrame
 #' @importFrom dplyr select all_of collect
@@ -82,17 +82,17 @@ setMethod("$", "PointFrame", \(x, name) do.call(`[[`, list(x, name)))
 
 #' @rdname PointFrame
 #' @export
-setMethod("[", c("PointFrame", "missing", "ANY"), 
+setMethod("[", c("PointFrame", "missing", "ANY"),
     \(x, i, j, ...) x[seq_len(nrow(x)), j])
 
 #' @rdname PointFrame
 #' @export
-setMethod("[", c("PointFrame", "ANY", "missing"), 
+setMethod("[", c("PointFrame", "ANY", "missing"),
     \(x, i, j, ...) x[i, seq_len(ncol(x))])
 
 #' @rdname PointFrame
 #' @export
-setMethod("[", c("PointFrame", "missing", "missing"), 
+setMethod("[", c("PointFrame", "missing", "missing"),
     \(x, i, j, ...) x[seq_len(nrow(x)), seq_len(ncol(x))])
 
 #' @rdname PointFrame
@@ -110,7 +110,7 @@ setMethod("[", c("PointFrame", "logical", "ANY"), \(x, i, j, ...) {
     stopifnot(length(i) != length(x))
     x[seq_len(nrow(x))[i], j]
 })
-    
+
 #' @rdname PointFrame
 #' @importFrom dplyr mutate filter select
 #' @export
@@ -125,8 +125,8 @@ setMethod("[", c("PointFrame", "numeric", "numeric"), \(x, i, j, ...) {
         select(-.i)
     # make sure this is kept in any case
     ndi <- "__null_dask_index__"
-    ndi <- match(ndi, names(x@data), nomatch=0)
-    x@data <- x@data[, c(j, ndi)]
+    ndi <- match(ndi, colnames(x@data), nomatch=0)
+    x@data <- x@data |> select(c(j, ndi))
     return(x)
 })
 
@@ -141,14 +141,14 @@ setAs(
 
 #' @importFrom dplyr filter
 #' @export
-filter.PointFrame <- \(.data, ...) { 
+filter.PointFrame <- \(.data, ...) {
     .data@data <- filter(data(.data), ...)
     return(.data)
 }
 
 #' @importFrom dplyr select
 #' @export
-select.PointFrame <- \(.data, ...) { 
+select.PointFrame <- \(.data, ...) {
     .data@data <- select(data(.data), ...)
     return(.data)
 }

R/ShapeFrame.R

@@ -6,7 +6,7 @@
 #' @param data \code{arrow}-derived table for on-disk,
 #'   \code{data.frame} for in-memory representation.
 #' @param meta \code{\link{Zattrs}}
-#' @param metadata optional list of arbitrary 
+#' @param metadata optional list of arbitrary
 #'   content describing the overall object.
 #' @param name character string for extraction (see \code{?base::`$`}).
 #' @param i,j indices specifying elements to extract.
@@ -18,11 +18,11 @@
 #' @examples
 #' library(SpatialData.data)
 #' zs <- get_demo_SDdata("merfish")
-#' 
+#'
 #' y <- file.path(zs, "shapes", "cells")
 #' (s <- readShape(y))
 #' plot(sf::st_as_sf(data(s)), cex=0.2)
-#' 
+#'
 #' y <- file.path(zs, "shapes", "anatomical")
 #' (s <- readShape(y))
 #' plot(sf::st_as_sf(data(s)), cex=0.2)
@@ -37,36 +37,41 @@ ShapeFrame <- function(data=data.frame(), meta=Zattrs(), metadata=list(), ...) {
 }
 
 # TODO: it's really annoying that this doesn't just inherit
-# data.frame() operations, cuz data are in an extra slot... 
+# data.frame() operations, cuz data are in an extra slot...
 # but else not sure how to assure validity, stash .zattrs etc.
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("dim", "ShapeFrame", \(x) dim(data(x)))
+#' @importFrom dplyr tally pull
+setMethod("dim", "ShapeFrame", \(x) c(length(x),
+                                      ncol(data(x))))
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("length", "ShapeFrame", \(x) nrow(data(x)))
+#' @importFrom dplyr tally pull
+setMethod("length", "ShapeFrame", \(x) data(x) |> tally() |> pull(n))
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("names", "ShapeFrame", \(x) names(data(x)))
+setMethod("names", "ShapeFrame", \(x) colnames(data(x)))
 
 #' @export
 #' @rdname ShapeFrame
 #' @importFrom utils .DollarNames
-.DollarNames.ShapeFrame <- \(x, pattern="") 
+.DollarNames.ShapeFrame <- \(x, pattern="")
     grep(pattern, names(x), value=TRUE)
 
 #' @rdname ShapeFrame
+#' @importFrom dplyr pull
 #' @exportMethod $
-setMethod("$", "ShapeFrame", \(x, name) data(x)[[name]])
+setMethod("$", "ShapeFrame", \(x, name) data(x) |> pull(.data[[name]]))
 
 #' @export
 #' @rdname ShapeFrame
 #' @importFrom sf st_as_sf st_geometry_type
+#' @importFrom dplyr slice
 setMethod("geom_type", "ShapeFrame", \(x) {
-    y <- st_as_sf(data(x[1, ]))
+    y <- st_as_sf(data(x) |> head(1))
     z <- st_geometry_type(y)
     return(as.character(z))
 })
@@ -75,24 +80,29 @@ setMethod("geom_type", "ShapeFrame", \(x) {
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("[", c("ShapeFrame", "missing", "ANY"), 
+setMethod("[", c("ShapeFrame", "missing", "ANY"),
     \(x, i, j, ...) x[seq_len(nrow(x)), j])
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("[", c("ShapeFrame", "ANY", "missing"), 
+setMethod("[", c("ShapeFrame", "ANY", "missing"),
     \(x, i, j, ...) x[i, seq_len(ncol(x))])
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("[", c("ShapeFrame", "missing", "missing"), 
+setMethod("[", c("ShapeFrame", "missing", "missing"),
     \(x, i, j, ...) x[seq_len(nrow(x)), seq_len(ncol(x))])
 
 #' @rdname ShapeFrame
 #' @export
-setMethod("[", c("ShapeFrame", "numeric", "numeric"), \(x, i, j, ...) { 
+#' @importFrom dplyr mutate filter select all_of row_number
+#' @importFrom rlang .data !!
+setMethod("[", c("ShapeFrame", "numeric", "numeric"), \(x, i, j, ...) {
     i <- seq_len(nrow(x))[i]
     j <- seq_len(ncol(x))[j]
-    x@data <- x@data[i, 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(j)
     return(x)
 })