Write utilities for SpatialData

NAMESPACE

@@ -16,6 +16,8 @@ export(SpatialDataImage)
 export(SpatialDataLabel)
 export(SpatialDataPoint)
 export(SpatialDataShape)
+export(create_zarr)
+export(create_zarr_group)
 export(filter)
 export(mutate)
 export(pull)
@@ -26,6 +28,12 @@ export(readShape)
 export(readSpatialData)
 export(readTable)
 export(select)
+export(writeImage)
+export(writeLabel)
+export(writePoint)
+export(writeShape)
+export(writeSpatialData)
+export(writeTable)
 exportClasses(SpatialData)
 exportMethods("$")
 exportMethods("[")
@@ -118,12 +126,15 @@ importFrom(BiocGenerics,colnames)
 importFrom(BiocGenerics,combine)
 importFrom(BiocGenerics,rownames)
 importFrom(DelayedArray,DelayedArray)
+importFrom(EBImage,resize)
 importFrom(EBImage,rotate)
 importFrom(Matrix,sparseMatrix)
 importFrom(Matrix,sparseVector)
 importFrom(Matrix,summary)
 importFrom(RBGL,sp.between)
 importFrom(Rarr,read_zarr_attributes)
+importFrom(Rarr,write_zarr_array)
+importFrom(Rarr,write_zarr_attributes)
 importFrom(Rarr,zarr_overview)
 importFrom(S4Vectors,"metadata<-")
 importFrom(S4Vectors,coolcat)
@@ -146,8 +157,10 @@ importFrom(ZarrArray,ZarrArray)
 importFrom(ZarrArray,path)
 importFrom(ZarrArray,type)
 importFrom(anndataR,read_zarr)
+importFrom(anndataR,write_zarr)
 importFrom(dplyr,all_of)
 importFrom(dplyr,anti_join)
+importFrom(dplyr,bind_cols)
 importFrom(dplyr,coalesce)
 importFrom(dplyr,collect)
 importFrom(dplyr,count)
@@ -161,10 +174,12 @@ importFrom(dplyr,select)
 importFrom(dplyr,slice)
 importFrom(dplyr,sql)
 importFrom(dplyr,tally)
+importFrom(dplyr,tibble)
 importFrom(duckspatial,as_duckspatial_df)
 importFrom(duckspatial,ddbs_bbox)
 importFrom(duckspatial,ddbs_intersects)
 importFrom(duckspatial,ddbs_open_dataset)
+importFrom(duckspatial,ddbs_write_dataset)
 importFrom(graph,"edgeData<-")
 importFrom(graph,"edgeDataDefaults<-")
 importFrom(graph,"nodeData<-")
@@ -196,6 +211,7 @@ importFrom(sf,st_geometry_type)
 importFrom(sf,st_polygon)
 importFrom(sf,st_sf)
 importFrom(sf,st_sfc)
+importFrom(stats,setNames)
 importFrom(utils,.DollarNames)
 importFrom(utils,head)
 importFrom(utils,tail)

R/AllClasses.R

@@ -2,6 +2,20 @@
     Class="SpatialDataAttrs",
     contains="list")
 
+.sdFormat <- setClass(
+  Class = "sdFormat",
+  slots = list(
+    version = "character",
+    zarr_version = "integer",
+    ome_version = "character",
+    image = "character",
+    label = "character",
+    point = "character",
+    shape = "character",
+    table = "character"
+  )
+)
+
 #' @importFrom methods setClassUnion
 #' @importClassesFrom S4Arrays Array
 setClassUnion(

R/AllGenerics.R

@@ -107,9 +107,17 @@ setGeneric("centroids", \(x, ...) standardGeneric("centroids"))
 setGeneric("data_type", \(x, ...) standardGeneric("data_type"))
 setGeneric("geom_type", \(x, ...) standardGeneric("geom_type"))
 setGeneric("multiscales", \(x, ...) standardGeneric("multiscales"))
+setGeneric("datasets", \(x, ...) standardGeneric("datasets"))
 
 # tbl ----
 
 setGeneric("hasTable", \(x, i, ...) standardGeneric("hasTable"))
 setGeneric("getTable", \(x, i, ...) standardGeneric("getTable"))
 setGeneric("setTable", \(x, i, ...) standardGeneric("setTable"))
+
+# zarr ----
+
+setGeneric("version", \(x, ...) standardGeneric("version"))
+setGeneric("version<-", \(x, value) standardGeneric("version<-"))
+setGeneric("zarr_version", \(x, ...) standardGeneric("zarr_version"))
+setGeneric("ome_version", \(x, ...) standardGeneric("ome_version"))

R/SpatialData.R

@@ -28,6 +28,7 @@
 #' @param x \code{SpatialData}
 #' @param i,j character string, scalar or vector of indices
 #'   specifying the element to extract from a given layer.
+#'   
 #' @param drop ignored.
 #' @param name character string for extraction (see \code{?base::`$`}).
 #' @param value (list of) element(s) with layer-compliant object(s), 
@@ -51,11 +52,11 @@
 #' 
 #' @export
 SpatialData <- \(images, labels, points, shapes, tables) {
-    if (missing(images)) images <- list()
-    if (missing(labels)) labels <- list()
-    if (missing(points)) points <- list()
-    if (missing(shapes)) shapes <- list()
-    if (missing(tables)) tables <- list()
+    if (missing(images)) images <- setNames(list(), character(0))
+    if (missing(labels)) labels <- setNames(list(), character(0))
+    if (missing(points)) points <- setNames(list(), character(0))
+    if (missing(shapes)) shapes <- setNames(list(), character(0))
+    if (missing(tables)) tables <- setNames(list(), character(0))
     .SpatialData(
         images=images, labels=labels, 
         points=points, shapes=shapes, tables=tables)

R/format.R

@@ -0,0 +1,49 @@
+#' @name sdFormat
+#' @title The `sdFormat` class
+#' 
+#' @param version SpatialData version: 0.1 or 0.2.
+#' 
+#' @details
+#' 
+#' @return \code{sdFormat}
+#' 
+#' @noRd
+sdFormat <- function(version = "0.1") {
+  switch(as.character(version), 
+         "0.2" = {
+           .sdFormat(
+             version = "0.2",
+             zarr_version = 3L,
+             ome_version = "0.5",
+             image = "0.3",
+             label = "0.3",
+             shape = "0.3",
+             point = "0.2",
+             table = "0.2"
+           )
+         }, 
+         "0.1" = {
+           .sdFormat(
+             version = "0.1",
+             zarr_version = 2L,
+             ome_version = "0.5",
+             image = "0.2",
+             label = "0.2",
+             shape = "0.2",
+             point = "0.1",
+             table = "0.1"
+           )
+         },
+         stop("Incorrect SpatialData version. Must be 0.1 or 0.2!")
+  )
+}
+
+setMethod("image", "sdFormat", \(x) x@image)
+setMethod("label", "sdFormat", \(x) x@label)
+setMethod("shape", "sdFormat", \(x) x@shape)
+setMethod("point", "sdFormat", \(x) x@point)
+setMethod("table", "sdFormat", \(x) x@table)
+setMethod("zarr_version", "sdFormat", \(x) x@zarr_version)
+setMethod("zarr_version", "character", \(x) zarr_version(sdFormat(x)))
+setMethod("ome_version", "sdFormat", \(x) x@ome_version)
+setMethod("version", "sdFormat", \(x) x@version)

R/read.R

@@ -56,14 +56,16 @@ NULL
 #' @export
 readImage <- function(x, ...) {
     l <- .readArray(x, ...)
-    SpatialDataImage(data=l$array, meta=SpatialDataAttrs(l$md), ...)
+    SpatialDataImage(data=l$array, meta=SpatialDataAttrs(l$md), 
+                     version = version(l$md), ...)
 }
 
 #' @rdname readSpatialData
 #' @export
 readLabel <- function(x, ...) {
     l <- .readArray(x, ...)
-    SpatialDataLabel(data=l$array, meta=SpatialDataAttrs(l$md), ...)
+    SpatialDataLabel(data=l$array, meta=SpatialDataAttrs(l$md), 
+                     version = version(l$md), ...)
 }
 
 #' @rdname readSpatialData
@@ -79,7 +81,7 @@ readPoint <- function(x, ...) {
         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))
+    SpatialDataPoint(data=df, meta=SpatialDataAttrs(md), version = version(md))
 }
 
 #' @rdname readSpatialData
@@ -90,7 +92,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))
+    SpatialDataShape(data=ddbs_open_dataset(pq), meta=SpatialDataAttrs(md), 
+                     version = version(md))
 }
 
 #' @export
@@ -105,7 +108,7 @@ readTable <- function(x) {
     })
     # move these to 'int_metadata'
     nm <- "spatialdata_attrs"
-    md <- metadata(sce)[[nm]]
+    md <- read_zarr_attributes(x)
     int_metadata(sce)[[nm]] <- md
     metadata(sce)[[nm]] <- NULL
     # move these to 'int_colData'