diff --git a/NAMESPACE b/NAMESPACE index e2d9d22e..5e8d79f8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -113,6 +113,7 @@ exportMethods(tableNames) exportMethods(tables) exportMethods(transform) exportMethods(translation) +exportMethods(version) importFrom(BiocGenerics, as.data.frame, colnames, diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 5c37437d..1cf99050 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -78,6 +78,7 @@ setGeneric("feature_key", \(x, ...) standardGeneric("feature_key")) setGeneric("feature_key<-", \(x, value) standardGeneric("feature_key<-")) setGeneric("instance_key", \(x, ...) standardGeneric("instance_key")) setGeneric("instance_key<-", \(x, value) standardGeneric("instance_key<-")) +setGeneric("version", \(x, ...) standardGeneric("version")) # uts ---- diff --git a/R/path.R b/R/path.R index a6c798cb..5851ba21 100644 --- a/R/path.R +++ b/R/path.R @@ -54,19 +54,5 @@ setMethod("path", "SingleCellExperiment", \(object, ...) { #' @export #' @rdname path -#' @importFrom dplyr tibble -setMethod("path", "SpatialData", \(object, simplify=TRUE, ...) { - names(ls) <- ls <- rownames(object) - ps <- lapply(ls, \(l) { - names(es) <- es <- names(object[[l]]) - lapply(es, \(e) path(object[[l]][[e]])) - }) - - if (!simplify) return(ps) - - do.call(rbind, lapply(names(ps), \(l) - do.call(rbind, lapply(names(ps[[l]]), \(e) - tibble(layer = l, element = e, path = ps[[l]][[e]]) - )) - )) -}) +setMethod("path", "SpatialData", \(object, simplify=TRUE, ...) + .element_apply(object, path, "path", simplify)) diff --git a/R/sdAttrs.R b/R/sdAttrs.R index 3cfb32b4..2db2cdb8 100644 --- a/R/sdAttrs.R +++ b/R/sdAttrs.R @@ -94,7 +94,7 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "point", "shape"), \(.) list(label = .))))) res <- c(res, list( - version=.get_ome_version(ver), + version=.ome_ver_from_sd(ver), multiscales= list( list( @@ -199,7 +199,7 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]]) x$multiscales[[1]]$version %||% x$omero$version %||% x$ome$version - if (!length(v)) stop("couldn't find 'version' in 'spatialdata_attrs'") + if (!length(v)) stop("couldn't find OME-NGFF (OME-Zarr) version") .val_ome_ver(v) } @@ -215,13 +215,13 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]]) x } -.get_ome_version <- \(x) { +.ome_ver_from_sd <- \(x) { switch(as.character(x), "0.1" = "0.4", "0.2" = "0.4-dev-spatialdata", "0.3" = "0.5-dev-spatialdata", - stop("Invalid SpatialDataImage/Label format! ", - "Must be 0.1, 0.2, or 0.3")) + stop("Invalid SpatialData Image/Label element version; ", + "expected '0.x' where x is 1-3")) } # internal use only! @@ -396,3 +396,49 @@ setReplaceMethod("instances", c("SingleCellExperiment", "ANY"), \(x, value) { int_colData(x)[[ik]] <- value return(x) }) + +# version ---- + +#' @name version +#' @title Retrieve versions of \code{SpatialData} elements +#' +#' @param x \code{\link{SpatialData}} object or one of its elements. +#' @param simplify logical scalar; whether to flatten paths into a tibble. +#' @param ... ignored. +#' +#' @returns +#' for single elements, a character string; +#' for \link{SpatialData} objects, if \code{simplify=TRUE} (default), +#' a \code{tibble} where rows=elements and columns=layers/elements/versions. +#' if \code{simplify=FALSE}, a depth-3 list where levels=layers/elements/versions. +#' +#' @examples +#' zs <- file.path("extdata", "blobs.zarr") +#' zs <- system.file(zs, package="spatialdataR") +#' sd <- readSpatialData(zs) +#' +#' # element-wise +#' version(shape(sd)) +#' +#' # object-wide +#' version(sd) +#' version(sd, FALSE)$labels +#' +NULL + +#' @export +#' @rdname version +setMethod("version", "SpatialDataElement", \(x) version(meta(x))) + +#' @export +#' @rdname version +setMethod("version", "SpatialDataAttrs", \(x) x$spatialdata_attrs$version) + +#' @export +#' @rdname version +setMethod("version", "SingleCellExperiment", \(x) meta(x)$version) + +#' @export +#' @rdname version +setMethod("version", "SpatialData", \(x, simplify=TRUE, ...) + .element_apply(x, version, "version", simplify)) diff --git a/R/utils.R b/R/utils.R index 486500a9..ba7dfb8b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -167,18 +167,18 @@ # validate OME version .val_ome_ver <- \(v) { ok <- length(v) == 1 && is.character(v) && (v <- gsub("-.*", "", v)) %in% sprintf("0.%d", seq_len(6)) - if (!ok) stop("invalid OME 'version'; expected '0.x' where x is 1-6") + if (!ok) stop("invalid OME-NGFF (OME-Zarr) 'version'; expected '0.x' where x is 1-6") return(v) } # validate SpatialData version .val_sd_ver <- \(v, type) { - type <- match.arg(type, c("image", "label", "point", "shape")) + type <- match.arg(type, c("table", "image", "label", "point", "shape")) ok <- length(v) == 1 && is.character(v) && - v %in% sprintf("0.%d", seq_len(if(type == "point") 2 else 3)) - if (!ok) stop("invalid SpatialData 'version'; expected '0.x' where x is 1-3 ", - "for image/label/shape and 1-2 for point") + v %in% sprintf("0.%d", seq_len(if(type %in% c("point", "table")) 2 else 3)) + if (!ok) stop("invalid SpatialData element version; expected '0.x' where ", + "x is 1-3 for image/label/shape and 1-2 for point and table") return(v) } @@ -220,3 +220,26 @@ " least one data() pair with identical dimensions") return(ks) } + +# path/version ---- + +#' @importFrom dplyr tibble +#' @noRd +.element_apply <- function(x, FUN, col, simplify=TRUE) { + names(ls) <- ls <- rownames(x) + ps <- lapply(ls, \(l) { + names(es) <- es <- names(x[[l]]) + lapply(es, \(e) FUN(x[[l]][[e]])) + }) + + if (!simplify) return(ps) + + df <- do.call(rbind, lapply(names(ps), \(l) + do.call(rbind, lapply(names(ps[[l]]), \(e) + tibble(layer=l, element=e, value=ps[[l]][[e]]) + )) + )) + + if (!is.null(df)) names(df)[3] <- col + df +} diff --git a/inst/NEWS b/inst/NEWS index 70babde7..c347c882 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,7 +1,8 @@ changes in version 0.99.47 - support 'affine' coordinate transformations for - point/shape elements via 'duckspatial::ST_affine' + point/shape elements via 'duckspatial::ST_affine' (#276) +- added 'version()' to retrieve format versions of SpatialData elements (#288) changes in version 0.99.46 @@ -14,7 +15,6 @@ changes in version 0.99.45 - setup auto-benchmarks - add contribution guidelines - code style and efficiency improvements -<<<<<<< HEAD - added read support from S3 object storage for "images", "labels", "points", "shapes" elements - added new 'CTunit()' helper function @@ -54,7 +54,7 @@ changes in version 0.99.39 - class revision: SpatialData slots were base::list, now prototyped S4Vectors::SimpleList with layer-specific properties & validation -- added 'path()' to retrieve on-disk paths of spatial data elements +- added 'path()' to retrieve on-disk paths of SpatialData elements changes in version 0.99.38 diff --git a/man/SpatialData.Rd b/man/SpatialData.Rd index 9a4c6c34..520da91e 100644 --- a/man/SpatialData.Rd +++ b/man/SpatialData.Rd @@ -63,8 +63,6 @@ \alias{points,SpatialData-method} \alias{shapes,SpatialData-method} \alias{tables,SpatialData-method} -\alias{[[<-,SpatialData,character,ANY,ANY-method} -\alias{[[<-,SpatialData,ANY,ANY,ANY-method} \title{The `SpatialData` class} \usage{ SpatialData( @@ -117,9 +115,9 @@ SpatialData( \S4method{tables}{SpatialData}(x) -\S4method{[[}{SpatialData,character,ANY,ANY}(x, i) <- value +\S4method{[[}{SpatialData,character,ANY}(x, i) <- value -\S4method{[[}{SpatialData,ANY,ANY,ANY}(x, i) <- value +\S4method{[[}{SpatialData,ANY,ANY}(x, i) <- value } \arguments{ \item{images}{list of \code{\link{SpatialDataImage}}s} diff --git a/man/version.Rd b/man/version.Rd new file mode 100644 index 00000000..1bc09b6e --- /dev/null +++ b/man/version.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sdAttrs.R +\name{version} +\alias{version} +\alias{version,SpatialDataElement-method} +\alias{version,SpatialDataAttrs-method} +\alias{version,SingleCellExperiment-method} +\alias{version,SpatialData-method} +\title{Retrieve versions of \code{SpatialData} elements} +\usage{ +\S4method{version}{SpatialDataElement}(x) + +\S4method{version}{SpatialDataAttrs}(x) + +\S4method{version}{SingleCellExperiment}(x) + +\S4method{version}{SpatialData}(x, simplify = TRUE, ...) +} +\arguments{ +\item{x}{\code{\link{SpatialData}} object or one of its elements.} + +\item{simplify}{logical scalar; whether to flatten paths into a tibble.} + +\item{...}{ignored.} +} +\value{ +for single elements, a character string; +for \link{SpatialData} objects, if \code{simplify=TRUE} (default), +a \code{tibble} where rows=elements and columns=layers/elements/versions. +if \code{simplify=FALSE}, a depth-3 list where levels=layers/elements/versions. +} +\description{ +Retrieve versions of \code{SpatialData} elements +} +\examples{ +zs <- file.path("extdata", "blobs.zarr") +zs <- system.file(zs, package="spatialdataR") +sd <- readSpatialData(zs) + +# element-wise +version(shape(sd)) + +# object-wide +version(sd) +version(sd, FALSE)$labels + +} diff --git a/tests/testthat/test-sdattrs.R b/tests/testthat/test-sdattrs.R index 3e75e086..7df6db1a 100644 --- a/tests/testthat/test-sdattrs.R +++ b/tests/testthat/test-sdattrs.R @@ -1,4 +1,13 @@ -z <- list(v1="blobs.zarr", v3="blobs_v3.zarr") +# testing for both SpatialData container versions 0.1 and 0.2 +z <- list(v01="blobs.zarr", v02="blobs_v3.zarr") +zv <- list( + v01 = list( + image="0.1", label="0.1", point="0.1", shape="0.2", table="0.1" + ), + v02 = list( + image="0.3", label="0.3", point="0.2", shape="0.3", table="0.2" + ) +) for (v in names(z)) { @@ -35,7 +44,7 @@ for (v in names(z)) { # missing y <- image(x) switch(v, - "v3"=y@meta$ome$multiscales[[1]]$axes <- NULL, + "v02"=y@meta$ome$multiscales[[1]]$axes <- NULL, y@meta$multiscales[[1]]$axes <- NULL) expect_error(axes(y)) }) @@ -45,6 +54,20 @@ for (v in names(z)) { expect_silent(z <- channels(y <- image(x))) expect_length(z, dim(y)[1]) }) + + test_that("version()", { + vx <- version(x) + expect_s3_class(vx, c("tbl_df", "tbl", "data.frame")) + expect_equal(colnames(vx), + c("layer", "element", "version")) + expect_all_true(vx$layer %in% paste0(names(zv[[v]]), "s")) + for (el in names(zv[[v]])[1:4]) { + f <- match.fun(el) + expect_equal(version(f(x)), zv[[v]][[el]]) + } + # match.fun matches with base::table + expect_equal(version(table(x)), zv[[v]][["table"]]) + }) } test_that(".val_ome_ver()", { @@ -70,15 +93,18 @@ test_that(".val_sd_ver()", { expect_error(.val_sd_ver("0.30", "image")) expect_error(.val_sd_ver(c("0.3", "0.4"), "image")) expect_error(.val_sd_ver("0.3", "point")) + expect_error(.val_sd_ver("0.3", "table")) # valid expect_silent(x <- .val_sd_ver(v <- "0.3", "image")) expect_silent(x <- .val_sd_ver(v <- "0.3", "label")) expect_silent(x <- .val_sd_ver(v <- "0.3", "shape")) expect_silent(x <- .val_sd_ver(v <- "0.2", "point")) + expect_silent(x <- .val_sd_ver(v <- "0.2", "table")) expect_type(x, "character") expect_length(x, 1) expect_identical(x, v) }) + test_that("SpatialDataAttrs()", { # invalid expect_error(SpatialDataAttrs(nch=0))