v0.99.40

* simplify code bits using seq_along(), lengths(), .data, etc.
* assure layer lists are fully named (updated validity, tests, setters)
* make SpatialDataImage/Label() accept single-arary (#216)
* v0.99.40

---------

Co-authored-by: Hugo Gruson <git@hugogruson.fr>

Author: HelenaLC

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: spatialdataR
 Title: Representation of Python's spatialdata in R
 Depends: R (>= 4.6)
-Version: 0.99.39
+Version: 0.99.40
 Description: R interface to Python/scverse's 'spatialdata' framework for 
     unified spatial omics data handling. Adheres to OME-NGFF standards, 
     providing lazy, on-disk representations for multiscale images and 

NAMESPACE

@@ -155,6 +155,7 @@ importFrom(ZarrArray,ZarrArray)
 importFrom(ZarrArray,path)
 importFrom(ZarrArray,type)
 importFrom(anndataR,read_zarr)
+importFrom(dplyr,.data)
 importFrom(dplyr,all_of)
 importFrom(dplyr,coalesce)
 importFrom(dplyr,collect)

R/SpatialData.R

@@ -60,10 +60,8 @@ SpatialData <- \(
     shapes=list(), 
     tables=list())
 {
-    .SpatialData(
-        images=sdImageList(images),
-        labels=sdLabelList(labels),
-        points=sdPointList(points),
-        shapes=sdShapeList(shapes),
-        tables=sdTableList(tables))
+    sd <- .SpatialData()
+    for (l in .LAYERS)
+        sd[[l]] <- get(l)
+    return(sd)
 }

R/combine.R

@@ -25,7 +25,7 @@ NULL
 setMethod("combine", c("SpatialData", "SpatialData"), \(x, y, ...) {
     # ensure element names are unique across objects
     old <- list(unlist(colnames(x)), unlist(colnames(y)))
-    idx <- rep.int(c(1, 2), vapply(old, length, integer(1)))
+    idx <- rep.int(c(1, 2), lengths(old))
     new <- split(make.unique(unlist(old)), idx)
     for (i in c(1, 2)) {
         # get input element names

R/crop.R

@@ -201,7 +201,7 @@ setMethod("crop", "SpatialDataArray", \(x, y, j=1, ...) {
 
 #' @export
 #' @rdname crop
-#' @importFrom dplyr pull
+#' @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, ...) {
@@ -225,8 +225,7 @@ setMethod("crop", "SpatialDataFrame", \(x, y, j=1, ...) {
     df <- data(transform(x, j))
     fd <- data(SpatialDataShape(fd))
     ok <- ddbs_intersects(df, fd, sparse=TRUE)
-    id_x <- NULL # R CMD check
-    x[pull(ok, id_x), ]
+    x[pull(ok, .data$id_x), ]
 })
 
 #' @export

R/extent.R

@@ -29,8 +29,8 @@ NULL
 setMethod("extent", "SpatialData", \(x, i=1) {
     ex <- .lapplyLayer(x, extent, i=i)
     ex <- unlist(ex, recursive=FALSE)
-    xy <- do.call(rbind, lapply(ex, do.call, what=cbind))
-    list(x=range(xy[, 1]), y=range(xy[, 2]))
+    xy <- dplyr::bind_rows(ex)
+    list(x=range(xy$x), y=range(xy$y))
 })
 
 #' @export

R/mask.R

@@ -180,9 +180,8 @@ setMethod("mask_i_by_j",
     if (nrow(collect(head(ij, 1))) == 0)
         stop("found no intersections",
             " between shapes 'i' and 'j'")
-    id_x <- id_y <- NULL # R CMD check
-    is <- pull(ij, id_y) # elements in i
-    js <- pull(ij, id_x) # masks in j
+    is <- pull(ij, .data$id_y) # elements in i
+    js <- pull(ij, .data$id_x) # masks in j
     na <- setdiff(seq_along(i), is)
     # aggregation
     mx <- assay(table, assay)

R/methods.R

@@ -43,6 +43,7 @@ setMethod("data", "SpatialDataElement", \(x, k=1, ...) {
         "NULL or a scalar positive integer")
     # get number of available scales
     n <- length(x <- x@data)   
+    if (!length(x)) return(NULL)
     # input of Inf uses lowest
     if (is.infinite(k)) k <- n 
     # return specified scale
@@ -262,6 +263,20 @@ NULL
 f <- \(l) setReplaceMethod(l, 
     c("SpatialData", getSlots("SpatialData")[[l]]), 
     \(x, value) {
+        if (length(value)) {
+            nms <- names(value)
+            e <- gsub("s$", "", l)
+            if (is.null(nms)) {
+                nms <- paste0(e, seq_along(value))
+                names(value) <- nms
+            } else {
+                na <- nchar(nms) == 0
+                if (any(na)) {
+                    nms[na] <- paste0(e, which(na))
+                    names(value) <- nms
+                }
+            }
+        }
         if (l != "tables") {
             old <- names(slot(x, l))
             new <- names(value)

R/read.R

@@ -146,8 +146,8 @@ readSpatialData <- function(x,
                 stop("couldn't find ", l, " of name", .)
             j <- j[opt]
         }
-        f <- get(paste0("read", toupper(substr(l, 1, 1)), substr(l, 2, nchar(l)-1)))
-        lapply(j, \(.) do.call(f, list(.)))
+        f <- paste0("read", toupper(substr(l, 1, 1)), substr(l, 2, nchar(l)-1))
+        lapply(j, f)
     }
 
     names(ls) <- ls <- .LAYERS[!skip]

R/sdArray.R

@@ -67,7 +67,8 @@ NULL
 #' @rdname SpatialDataArray
 #' @importFrom methods new
 #' @importFrom S4Vectors metadata<-
-SpatialDataImage <- function(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) {
+SpatialDataImage <- \(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) {
+    if (is.array(data)) data <- list(data)
     x <- .SpatialDataImage(data=data, meta=meta, ...)
     metadata(x) <- metadata
     return(x)
@@ -77,7 +78,8 @@ SpatialDataImage <- function(data=list(), meta=SpatialDataAttrs(), metadata=list
 #' @rdname SpatialDataArray
 #' @importFrom methods new
 #' @importFrom S4Vectors metadata<-
-SpatialDataLabel <- function(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) {
+SpatialDataLabel <- \(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) {
+    if (is.array(data)) data <- list(data)
     x <- .SpatialDataLabel(data=data, meta=meta, ...)
     metadata(x) <- metadata
     return(x)