DuckDB fix

DESCRIPTION

@@ -54,6 +54,7 @@ Authors@R: c(
 Imports:
     anndataR (>= 1.1.3),
     BiocGenerics,
+    DBI,
     DelayedArray,
     dplyr,
     duckspatial,

NAMESPACE

@@ -117,6 +117,7 @@ importFrom(BiocGenerics,as.data.frame)
 importFrom(BiocGenerics,colnames)
 importFrom(BiocGenerics,combine)
 importFrom(BiocGenerics,rownames)
+importFrom(DBI,dbIsValid)
 importFrom(DelayedArray,DelayedArray)
 importFrom(EBImage,rotate)
 importFrom(Matrix,sparseMatrix)
@@ -164,8 +165,10 @@ importFrom(dplyr,sql)
 importFrom(dplyr,tally)
 importFrom(duckspatial,as_duckspatial_df)
 importFrom(duckspatial,ddbs_bbox)
+importFrom(duckspatial,ddbs_create_conn)
 importFrom(duckspatial,ddbs_intersects)
 importFrom(duckspatial,ddbs_open_dataset)
+importFrom(duckspatial,ddbs_write_table)
 importFrom(graph,"edgeData<-")
 importFrom(graph,"edgeDataDefaults<-")
 importFrom(graph,"nodeData<-")

R/mask.R

@@ -120,6 +120,7 @@ setMethod(".mask", c("SpatialDataImage", "SpatialDataLabel"), \(i, j, how=NULL,
         "POINT"=mutate(data(j), geometry=ST_Buffer(geometry, radius)), 
         data(j))
     ddbs_intersects(df_j, data(i), sparse=TRUE)
+
 }
 
 #' @noRd

R/read.R

@@ -75,13 +75,26 @@ readPoint <- function(x, ...) {
     pq <- list.files(x, "\\.parquet$", full.names=TRUE)
     md <- read_zarr_attributes(x)
     ax <- unlist(md$axes)
-    df <- ddbs_open_dataset(pq) |>
+    df <- ddbs_open_dataset(pq, conn=.conn()) |>
         mutate(geometry=sql(sprintf("ST_Point(%s, %s)", ax[1], ax[2]))) |>
         as_duckspatial_df(crs=NA_character_) |>
         select(-all_of(ax))
     SpatialDataPoint(data=df, meta=SpatialDataAttrs(md))
 }
 
+# create DuckDB connection
+# (to be used everywhere!)
+#' @importFrom DBI dbIsValid
+#' @importFrom duckspatial ddbs_create_conn
+.conn <- \() {
+    nm <- ".SpatialData_DuckDB_conn"
+    if (!exists(nm, envir=.GlobalEnv) ||
+        !dbIsValid(.GlobalEnv[[nm]])) {
+        .GlobalEnv[[nm]] <- ddbs_create_conn()
+    }
+    .GlobalEnv[[nm]]
+}
+
 #' @rdname readSpatialData
 #' @importFrom Rarr read_zarr_attributes
 #' @importFrom duckspatial ddbs_open_dataset
@@ -90,7 +103,8 @@ readPoint <- function(x, ...) {
 readShape <- function(x, ...) {
     md <- read_zarr_attributes(x)
     pq <- list.files(x, "\\.parquet$", full.names=TRUE)
-    SpatialDataShape(data=ddbs_open_dataset(pq), meta=SpatialDataAttrs(md))
+    df <- ddbs_open_dataset(pq, conn=.conn(), crs=NA_character_)
+    SpatialDataShape(data=df, meta=SpatialDataAttrs(md))
 }
 
 #' @export

R/sdFrame.R

@@ -114,7 +114,7 @@ SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=l
             "found: ", paste(gt, collapse=", "))
         # always ensure internal data is 'duckspatial_df'
         if (!is(data, "duckspatial_df"))
-            data <- as_duckspatial_df(data, crs=NA)
+            data <- as_duckspatial_df(data, crs=NA_character_)
     }
     # update 'spatialdata_attrs' if keys are provided
     za <- as.list(meta)
@@ -138,13 +138,25 @@ SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=l
 #' @rdname SpatialDataFrame
 #' @importFrom methods is
 #' @importFrom S4Vectors metadata<-
+#' @importFrom duckspatial ddbs_write_table
 #' @importFrom duckspatial as_duckspatial_df
 SpatialDataShape <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=list(), ...) {
     data <- .df_to_sf(data, "POLYGON")
     # always ensure internal data is 'duckspatial_df'
-    if (isTRUE(nrow(data) > 0L) &&
-            !is(data, "duckspatial_df"))
-        data <- as_duckspatial_df(data, crs=NA)
+    if (!is(data, "duckspatial_df") && isTRUE(nrow(data) > 0L)) {
+        suppressMessages( # silent complaint re: missing CRS
+        ddbs_write_table(
+            conn=.conn(),
+            data=data,
+            name="sdShape",
+            overwrite=TRUE,
+            temp_view=FALSE))
+        data <- as_duckspatial_df(
+            x="sdShape", 
+            conn=.conn(), 
+            crs=NA_character_,
+            geom_col=attr(data, "sf_column"))
+    }
     x <- .SpatialDataShape(data=data, meta=meta, ...)
     metadata(x) <- metadata
     return(x)

tests/testthat/test-mask.R

@@ -21,7 +21,7 @@ test_that("mask,unaligned", {
     # non-existent
     expect_error(
         mask(x, i, j, "x"), 
-        "should be \"global\"")
+        "'arg' should be")
 
     # not shared
     za <- meta(image(x, i))
@@ -157,9 +157,8 @@ test_that("mask,sdShape,sdShape", {
     y <- setTable(x, i, se)
 
     # out-of-bounds masking
-    t <- translation(s, c(1e3,1e3))
-    shape(y, "out") <- t
-    expect_error(mask(y, i, "out"))
+    shape(y, "out") <- translation(s, c(1e3,1e3))
+    expect_error(mask(y, i, "out", how="sum"))
 
     # note: data at "0" are from non-intersecting instances;
     # here, all data should be aggregated to column "1"