diff --git a/R/CTutils.R b/R/CTutils.R index a185485f..6b55d555 100644 --- a/R/CTutils.R +++ b/R/CTutils.R @@ -59,7 +59,12 @@ setMethod("axes", "SpatialDataAttrs", \(x, y=NULL, ...) { if (is.null(x)) stop("couldn't find 'axes'") if (is.null(y)) return(x) y <- match.arg(y, c("name", "type", "unit")) - vapply(x, `[[`, character(1), y) + # shape/point axes have no type and unit, return axes names as given + if(y == "name" && is.null(names(x[[1]]))){ + unlist(x) + } else { + vapply(x, `[[`, character(1), y) + } }) # CTlist/data/type/name() ---- diff --git a/R/crop.R b/R/crop.R index 2b77e003..b4cfb8fb 100644 --- a/R/crop.R +++ b/R/crop.R @@ -141,9 +141,9 @@ NULL ct[[type]] <- .adapt(data, type) } # update input axes from 'cyx' to 'xy' - ct$input$axes <- .default_ax(type="frame") + ct$input$axes <- .default_ax(type="shape") # create temporary shape & transform back - md <- SpatialDataAttrs(type="frame", trans=list(ct)) + md <- SpatialDataAttrs(type="shape", trans=list(ct)) z <- SpatialDataShape(df, meta=md) z <- transform(z, 1, rev=TRUE) # extract coordinates & return range diff --git a/R/sdAttrs.R b/R/sdAttrs.R index 5ea5bae8..be1ccf68 100644 --- a/R/sdAttrs.R +++ b/R/sdAttrs.R @@ -10,18 +10,19 @@ #' #' @param x element or list extracted from a OME-NGFF compliant .zattrs file. #' @param name character string for extraction (see ?base::`$`). -#' @param type character string; either "array" (image/label) or "frame" (point/shape). -#' @param label flag; when \code{type="frame"}, should attributes be for a label? +#' @param type character string; either "image", "label", "point" or "shape" #' @param trans list of coordinate transformations; defaults to identity only. #' @param value character string (for one \code{region} and \code{_key}s), #' or vector (for many \code{region}s, \code{instances} and \code{regions}). -#' @param ver character string; specifies the OME version to comply with. +#' @param ver character string; specifies the version of the SpatialData +#' element to comply with. #' @param dim scalar integer in 2-4; -#' number of dimensions: 2 = XY, 3 adds Z, 4 adds T (time); -#' when \code{type="image"}, C (channel) will be added (for any \code{dim}). +#' number of dimensions: 2 = XY, 3 adds Z, 4 adds T (time) for image and +#' label; when \code{type="image"}, C (channel) will be added (for any +#' \code{dim}). #' @param nch scalar integer; how many channels should there be? -#' (ignored unless \code{type="frame"} and \code{label=FALSE}). -#' @param ... additional attributes (e.g., version, feature_key). +#' (ignored if \code{type="label"}, \code{type="shape"}, or +#' \code{type="point"}). #' #' @details #' When \code{x} is a spatial element, the following applies: @@ -29,10 +30,10 @@ #' \code{SingleCellExperiment}: \code{region}, \code{region/instance_key}. #' #' When missing \code{x}, \code{SpatialDataAttrs} will generate a valid object -#' with default axes (array: cyx, frame: xy) and transformations (identify) -#' according to the specified type. +#' with default axes (image: cyx, label: yx, point/shape: xy) and +#' transformations (identify) according to the specified type. #' -#' @return character string +#' @return SpatialDataAttrs object #' #' @examples #' x <- file.path("extdata", "blobs.zarr") @@ -55,27 +56,30 @@ #' CTdata(z, "scale") #' #' # constructor -#' SpatialDataAttrs(type="frame") +#' SpatialDataAttrs(type="point") +#' SpatialDataAttrs(type="shape") #' SpatialDataAttrs(type="image", nch=7) #' SpatialDataAttrs(type="label", dim=3) #' #' @export -SpatialDataAttrs <- \(x, type=c("image", "label", "frame"), - trans=NULL, ver="0.3", dim=2, nch=3, ...) +SpatialDataAttrs <- \(x, type=c("image", "label", "point", "shape"), + trans=NULL, ver=NULL, dim=2, nch=3) { - stopifnot( - length(dim) == 1, is.numeric(dim), dim %in% seq(2, 4), - length(nch) == 1, is.numeric(nch), round(nch) == nch, nch > 0) if (!missing(x)) return(.SpatialDataAttrs(x)) type <- match.arg(type) - ver <- .val_ome_ver(ver) + stopifnot( + length(dim) == 1, is.numeric(dim), + dim %in% seq(2, if(type %in% c("point", "shape")) 3 else 4), + length(nch) == 1, is.numeric(nch), round(nch) == nch, nch > 0) + if(is.null(ver)) ver <- if(type == "point") "0.2" else "0.3" + ver <- .val_sd_ver(ver, type) ax <- .default_ax(type, dim) # transformations: ct <- trans %||% .default_ct(ax) - # datasets: - ds <- .default_ds(.ax_names(ax)) - # .zattrs list: - if (type != "frame") { + # zarr attributes list: + if (!type %in% c("point", "shape")) { + # datasets: + ds <- .default_ds(.ax_names(ax)) # default structure res <- list() if(type != "label") @@ -98,14 +102,17 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "frame"), if (ver == "0.3") res <- list(ome=res) } else { # points/shapes - res <- list(axes=ax, coordinateTransformations=ct) + res <- list( + axes=.ax_names(ax), # point and shape take only names + coordinateTransformations=ct + ) } res$spatialdata_attrs <- list(version=ver) SpatialDataAttrs(res) } # Internal helper to generate OME-NGFF axes -.default_ax <- \(type=c("image", "label", "frame"), dim=2) { +.default_ax <- \(type=c("image", "label", "point", "shape"), dim=2) { c <- list(name="c", type="channel") t <- list(name="t", type="time") z <- list(name="z", type="space") @@ -113,11 +120,11 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "frame"), x <- list(name="x", type="space") switch(match.arg(type), # xyzt for points/shapes - frame={ + point=, + shape={ ax <- list(x, y) if (dim > 2) { ax <- c(ax, list(z)) - if (dim > 3) ax <- c(ax, list(t)) } }, # tczyx for images/labels @@ -144,7 +151,11 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "frame"), # Internal helper to generate coordinate transformations .default_ct <- \(axes, name="global", type="identity", data=NULL) { - ct <- list(input=axes, output=list(name=name), type=type) + ct <- list(input=list(axes=axes, + name=paste(.ax_names(axes), collapse = "")), + output=list(axes=axes, + name=name), + type=type) if (!is.null(data)) ct[[type]] <- data list(ct) } diff --git a/R/sdFrame.R b/R/sdFrame.R index 5f24f14c..5e1caa86 100644 --- a/R/sdFrame.R +++ b/R/sdFrame.R @@ -123,7 +123,7 @@ NULL #' @importFrom methods is #' @importFrom sf st_geometry_type #' @importFrom S4Vectors metadata<- -SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=list(), ik=NULL, fk=NULL, ...) { +SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="point"), metadata=list(), ik=NULL, fk=NULL, ...) { data <- .df_to_sf(data, "POINT") if (isTRUE(nrow(data) > 0L)) { gt <- tryCatch(unique(st_geometry_type(data)), error=\(.) "n/a") @@ -153,7 +153,7 @@ SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=l #' @rdname SpatialDataFrame #' @importFrom methods is #' @importFrom S4Vectors metadata<- -SpatialDataShape <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=list(), ...) { +SpatialDataShape <- \(data=NULL, meta=SpatialDataAttrs(type="shape"), metadata=list(), ...) { data <- .df_to_sf(data, "POLYGON") if (!is(data, "duckspatial_df")) data <- .duck(data, "sdShape") diff --git a/R/utils.R b/R/utils.R index 30627fb1..e234c338 100644 --- a/R/utils.R +++ b/R/utils.R @@ -174,6 +174,17 @@ return(v) } +# validate SpatialData version +.val_sd_ver <- \(v, type) { + type <- match.arg(type, c("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") + return(v) +} + # multiscales ---- # internal helper to get the 'active' metadata level diff --git a/man/SpatialDataAttrs.Rd b/man/SpatialDataAttrs.Rd index 4638d8cd..d15032c5 100644 --- a/man/SpatialDataAttrs.Rd +++ b/man/SpatialDataAttrs.Rd @@ -38,12 +38,11 @@ \usage{ SpatialDataAttrs( x, - type = c("image", "label", "frame"), + type = c("image", "label", "point", "shape"), trans = NULL, - ver = "0.3", + ver = NULL, dim = 2, - nch = 3, - ... + nch = 3 ) \S4method{$}{SpatialDataAttrs}(x, name) @@ -89,30 +88,29 @@ SpatialDataAttrs( \arguments{ \item{x}{element or list extracted from a OME-NGFF compliant .zattrs file.} -\item{type}{character string; either "array" (image/label) or "frame" (point/shape).} +\item{type}{character string; either "image", "label", "point" or "shape"} \item{trans}{list of coordinate transformations; defaults to identity only.} -\item{ver}{character string; specifies the OME version to comply with.} +\item{ver}{character string; specifies the version of the SpatialData +element to comply with.} \item{dim}{scalar integer in 2-4; -number of dimensions: 2 = XY, 3 adds Z, 4 adds T (time); -when \code{type="image"}, C (channel) will be added (for any \code{dim}).} +number of dimensions: 2 = XY, 3 adds Z, 4 adds T (time) for image and +label; when \code{type="image"}, C (channel) will be added (for any +\code{dim}).} \item{nch}{scalar integer; how many channels should there be? -(ignored unless \code{type="frame"} and \code{label=FALSE}).} - -\item{...}{additional attributes (e.g., version, feature_key).} +(ignored if \code{type="label"}, \code{type="shape"}, or +\code{type="point"}).} \item{name}{character string for extraction (see ?base::`$`).} \item{value}{character string (for one \code{region} and \code{_key}s), or vector (for many \code{region}s, \code{instances} and \code{regions}).} - -\item{label}{flag; when \code{type="frame"}, should attributes be for a label?} } \value{ -character string +SpatialDataAttrs object } \description{ The `SpatialDataAttrs` class @@ -123,8 +121,8 @@ When \code{x} is a spatial element, the following applies: \code{SingleCellExperiment}: \code{region}, \code{region/instance_key}. When missing \code{x}, \code{SpatialDataAttrs} will generate a valid object -with default axes (array: cyx, frame: xy) and transformations (identify) -according to the specified type. +with default axes (image: cyx, label: yx, point/shape: xy) and +transformations (identify) according to the specified type. } \examples{ x <- file.path("extdata", "blobs.zarr") @@ -147,7 +145,8 @@ CTtype(z) CTdata(z, "scale") # constructor -SpatialDataAttrs(type="frame") +SpatialDataAttrs(type="point") +SpatialDataAttrs(type="shape") SpatialDataAttrs(type="image", nch=7) SpatialDataAttrs(type="label", dim=3) diff --git a/man/SpatialDataFrame.Rd b/man/SpatialDataFrame.Rd index 32709981..c3de2dfe 100644 --- a/man/SpatialDataFrame.Rd +++ b/man/SpatialDataFrame.Rd @@ -23,7 +23,7 @@ \usage{ SpatialDataPoint( data = NULL, - meta = SpatialDataAttrs(type = "frame"), + meta = SpatialDataAttrs(type = "point"), metadata = list(), ik = NULL, fk = NULL, @@ -32,7 +32,7 @@ SpatialDataPoint( SpatialDataShape( data = NULL, - meta = SpatialDataAttrs(type = "frame"), + meta = SpatialDataAttrs(type = "shape"), metadata = list(), ... ) diff --git a/tests/testthat/test-ctutils.R b/tests/testthat/test-ctutils.R index 239817d1..eed38d95 100644 --- a/tests/testthat/test-ctutils.R +++ b/tests/testthat/test-ctutils.R @@ -21,6 +21,18 @@ test_that("axes", { expect_length(z, d) expect_in(z, c("time","channel","space")) } + es <- list(shape(x), point(x)) + for (e in es) { + z <- axes(e) + d <- length(dim(e)) + expect_type(z, "list") + expect_length(z, d) + expect_error(axes(e, "bad")) + # name + # TODO: should "name" only return itself for frames, or return error + expect_silent(z <- axes(e, "name")) + expect_type(z, "character") + } }) .CTtype <- c( diff --git a/tests/testthat/test-sdattrs.R b/tests/testthat/test-sdattrs.R index 97a6a780..3e75e086 100644 --- a/tests/testthat/test-sdattrs.R +++ b/tests/testthat/test-sdattrs.R @@ -61,12 +61,32 @@ test_that(".val_ome_ver()", { expect_length(x, 1) expect_identical(x, v) }) +test_that(".val_sd_ver()", { + # invalid + expect_error(.val_sd_ver(0.3), 'argument "type" is missing') + expect_error(.val_sd_ver(1, "image")) + expect_error(.val_sd_ver(TRUE, "image")) + expect_error(.val_sd_ver("0.0", "image")) + 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")) + # 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_type(x, "character") + expect_length(x, 1) + expect_identical(x, v) +}) test_that("SpatialDataAttrs()", { # invalid expect_error(SpatialDataAttrs(nch=0)) expect_error(SpatialDataAttrs(dim=7)) expect_error(SpatialDataAttrs(ver="0.0")) expect_error(SpatialDataAttrs(type="bad")) + expect_error(SpatialDataAttrs(type = "point", dim=4)) + expect_error(SpatialDataAttrs(type = "shape", dim=4)) # 2-4D image nms <- c("c", "t", "z", "y", "x") for (d in seq(2, 4)) { @@ -87,6 +107,8 @@ test_that("SpatialDataAttrs()", { expect_length(y, 7) expect_type(y, "character") expect_all_true(!duplicated(y)) + # version + expect_equal(x$spatialdata_attrs$version, "0.3") } # 2-4D label for (d in seq(2, 4)) { @@ -95,14 +117,28 @@ test_that("SpatialDataAttrs()", { expect_length(y, d) expect_equal(sum(y == "time"), ifelse(d == 4, 1, 0)) expect_equal(sum(y == "space"), ifelse(d == 2, 2, 3)) + # version + expect_equal(x$spatialdata_attrs$version, "0.3") } # 3-4D shape/point - for (d in seq(2, 4)) { - x <- SpatialDataAttrs(type="frame", dim=d) - y <- axes(x, "type") + nms <- c("x", "y", "z") + for (d in seq(2, 3)) { + for(typ in c("shape", "point")){ + x <- SpatialDataAttrs(type=typ, dim=d) + ok <- if (d == 2) nms[-3] else nms + y <- axes(x) expect_length(y, d) + expect_equal(unlist(y), ok) expect_null(channels(x)) - expect_equal(sum(y == "time"), ifelse(d == 4, 1, 0)) - expect_equal(sum(y == "space"), ifelse(d == 2, 2, 3)) + # axes name + y <- axes(x, "name") + expect_length(y, d) + expect_type(y, "character") + expect_identical(y, ok) + expect_error(axes(x, "type")) + # version + expect_equal(x$spatialdata_attrs$version, + if(typ == "point") "0.2" else "0.3") + } } })