From bf0f42ae850ea4328c58bcc27c289a59007ecd02 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:29:03 +0200 Subject: [PATCH 01/10] init per-layer validity --- NAMESPACE | 1 + R/validity.R | 83 ++++++++++++++++++-------------- tests/testthat/test-labelarray.R | 12 ++--- tests/testthat/test-validity.R | 36 ++++++++++++++ 4 files changed, 89 insertions(+), 43 deletions(-) create mode 100644 tests/testthat/test-validity.R diff --git a/NAMESPACE b/NAMESPACE index 6b3bfcdc..e0822d18 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -117,6 +117,7 @@ importFrom(SummarizedExperiment,assay) importFrom(SummarizedExperiment,colData) importFrom(ZarrArray,ZarrArray) importFrom(ZarrArray,path) +importFrom(ZarrArray,type) importFrom(arrow,open_dataset) importFrom(basilisk,BasiliskEnvironment) importFrom(basilisk,basiliskRun) diff --git a/R/validity.R b/R/validity.R index 75287b9f..e2a3fdfa 100644 --- a/R/validity.R +++ b/R/validity.R @@ -17,38 +17,46 @@ return(msg) } -.validatePointFrame <- function(object) { - msg <- NULL - # Checks if the points have the x,y coordinates, as they are hard-coded - # in the plot functions - if (length(points(object))) { # there are some cases where the points are empty - if (!is.null(data(point(object)))) { - np <- length(points(object)) - for (i in seq_len(np)) { - dfi <- data(point(object, i)) - if (!all(c("x", "y") %in% names(dfi))) { - msg <- c(msg, paste0("'x' and 'y' missing in data point ", i)) - } - } - } - } +.validatePointFrame <- \(object) { + msg <- c() + if (!length(object)) return(msg) + if (!"x" %in% names(object)) msg <- c(msg, "'PointFrame' missing 'x'.") + if (!"y" %in% names(object)) msg <- c(msg, "'PointFrame' missing 'y'.") return(msg) } +#' @importFrom S4Vectors setValidity2 +setValidity2("PointFrame", .validatePointFrame) -.validateImageArray <- function(object) { +.validateImageArray <- \(object) { msg <- c() - if (ni <- length(images(object))) { - for (i in seq_len(ni)) { - ai <- as.array(aperm(data(image(object,1))/255, perm=c(3,2,1))) - for (j in seq_len(dim(ai)[3])) { - if (!all(vapply(ai[,,j], is.numeric, logical(1)))) { - msg <- c(msg, paste0("Image ", i, " channel ", j, " not numeric")) - } - } - } + res <- length(object) + for (k in seq_len(res)) { + x <- data(object, k) + if (length(dim(x)) != 3) msg <- c(msg, paste( + "'ImageArray' resolution", k, "is not 3D")) + if (!type(x) %in% c("double", "integer")) msg <- c(msg, paste( + "'ImageArray' resolution", k, "is not of type double or integer")) } - return(msg) + if (length(msg)) return(msg) else return(TRUE) } +#' @importFrom S4Vectors setValidity2 +setValidity2("ImageArray", .validateImageArray) + +#' @importFrom ZarrArray type +.validateLabelArray <- \(object) { + msg <- c() + res <- length(object) + for (k in seq_len(res)) { + x <- data(object, k) + if (length(dim(x)) != 2) msg <- c(msg, paste( + "'LabelArray' resolution", k, "is not 2D")) + if (type(x) != "integer") msg <- c(msg, paste( + "'LabelArray' resolution", k, "is not of type integer")) + } + if (length(msg)) return(msg) else return(TRUE) +} +#' @importFrom S4Vectors setValidity2 +setValidity2("LabelArray", .validateLabelArray) #' @importFrom methods is .validateSpatialData <- \(x) { @@ -64,17 +72,20 @@ msg <- c(msg, sprintf("'%s' should be a list of '%s'", ., typ[.])) msg <- c(msg, .validatePointFrame(x)) msg <- c(msg, .validateTable(x)) - for (y in labels(x)) .validateZattrsLabelArray(y) - if (length(msg)) - return(msg) - return(TRUE) + for (y in labels(x)) { + ok <- .validateLabelArray(y) + if (!isTRUE(ok)) msg <- c(msg, ok) + ok <- .validateZattrsLabelArray(y) + if (!isTRUE(ok)) msg <- c(msg, ok) + } + if (length(msg)) return(msg) else return(TRUE) } #' @importFrom S4Vectors setValidity2 setValidity2("SpatialData", .validateSpatialData) .validateZattrs_multiscales <- \(x, msg) { - if (is.null(ms <- x$multiscales)) + if (is.null(ms <- x$multiscales[[1]])) msg <- c(msg, "missing 'multiscales'") # MUST contain for (. in c("axes", "datasets")) @@ -96,17 +107,17 @@ setValidity2("SpatialData", .validateSpatialData) .validateZattrs_coordTrans <- \(x, msg) { if (!is.list(ct <- x$coordinateTransformations)) msg <- c(msg, "missing or non-list 'coordTrans'") - ct <- ct[[1]] - for (. in c("input", "output", "type")) - if (is.null(ct[[.]])) - msg <- c(msg, sprintf("'coordTrans' missing '%s'", .)) + for (i in seq_along(ct)) + for (j in c("input", "output", "type")) + if (is.null(ct[[i]][[j]])) + msg <- c(msg, sprintf("'coordTrans' %s missing '%s'", i, j)) return(msg) } .validateZattrsLabelArray <- \(x) { msg <- c() za <- meta(x) msg <- .validateZattrs_multiscales(za, msg) - ms <- za$multiscales + ms <- za$multiscales[[1]] msg <- .validateZattrs_axes(ms, msg) msg <- .validateZattrs_coordTrans(ms, msg) if (length(msg)) return(msg) else return(TRUE) diff --git a/tests/testthat/test-labelarray.R b/tests/testthat/test-labelarray.R index a1c31547..e8f2b7f7 100644 --- a/tests/testthat/test-labelarray.R +++ b/tests/testthat/test-labelarray.R @@ -1,7 +1,5 @@ -arr <- seq_len(12) - test_that("LabelArray()", { - val <- sample(arr, 20*20, replace=TRUE) + val <- sample(seq_len(12), 20*20, replace=TRUE) mat <- array(val, dim=c(20, 20)) # invalid expect_error(LabelArray(mat)) @@ -12,14 +10,14 @@ test_that("LabelArray()", { expect_silent(LabelArray(list(mat))) expect_silent(LabelArray(list(mat), Zattrs())) # multiscale - dim <- lapply(c(20, 10, 5), \(.) c(3, rep(., 2))) - lys <- lapply(dim, \(.) array(sample(arr, prod(.), replace=TRUE), dim=.)) + dim <- lapply(c(20, 10, 5), \(.) rep(., 2)) + lys <- lapply(dim, \(.) array(sample(seq_len(12), prod(.), replace=TRUE), dim=.)) expect_silent(LabelArray(lys)) }) test_that("data(),LabelArray", { - dim <- lapply(c(8, 4, 2), \(.) c(3, rep(., 2))) - lys <- lapply(dim, \(.) array(0, dim=.)) + dim <- lapply(c(8, 4, 2), \(.) rep(., 2)) + lys <- lapply(dim, \(.) array(0L, dim=.)) lab <- LabelArray(lys) for (. in seq_along(lys)) expect_identical(data(lab, .), lys[[.]]) diff --git a/tests/testthat/test-validity.R b/tests/testthat/test-validity.R new file mode 100644 index 00000000..c718ef5f --- /dev/null +++ b/tests/testthat/test-validity.R @@ -0,0 +1,36 @@ +library(SpatialData.plot) +zs <- file.path("extdata", "blobs.zarr") +zs <- system.file(zs, package="SpatialData") +sd <- readSpatialData(zs, tables=FALSE) + +test_that("validity,ImageArray", { + # all resolutions should be numbers + # (note: logical gets coerces to binary) + expect_error(ImageArray(list(v <- character(1)))) + x <- image(sd,1); x@data[[1]][1,1,1] <- v; expect_error(validObject(x)) + x <- image(sd,2); x@data[[2]][1,1,1] <- v; expect_error(validObject(x)) + # there should be two dimensions + expect_error(ImageArray(list(a <- array(numeric(1), c(1,1))))) + x <- image(sd,1); x@data[[1]] <- a; expect_error(validObject(x)) + x <- image(sd,2); x@data[[2]] <- a; expect_error(validObject(x)) +}) + +test_that("validity,LabelArray", { + # all resolutions should be of type integer + for (v in list(logical(1), character(1), numeric(1))) { + expect_error(LabelArray(list(v))) + x <- label(sd,1); x@data[[1]][1,1] <- v; expect_error(validObject(x)) + x <- label(sd,2); x@data[[2]][1,1] <- v; expect_error(validObject(x)) + } + # there should be two dimensions + expect_error(LabelArray(list(a <- array(integer(1), c(1,1,1))))) + x <- label(sd,1); x@data[[1]] <- a; expect_error(validObject(x)) + x <- label(sd,2); x@data[[2]] <- a; expect_error(validObject(x)) +}) + +test_that("validity,PointFrame", { + x <- point(sd,1) + expect_error(validObject(select(x, -x))) + expect_error(validObject(select(x, -y))) + expect_silent(validObject(select(x, -c(x, y))[0,])) +}) From 767fd75f2ce7f3572c4cf0aba33e92db4c23424e Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:39:30 +0200 Subject: [PATCH 02/10] +validity,ShapeFrame --- R/validity.R | 29 +++++++++++++++++++---------- tests/testthat/test-validity.R | 12 ++++++++++++ 2 files changed, 31 insertions(+), 10 deletions(-) diff --git a/R/validity.R b/R/validity.R index e2a3fdfa..23147843 100644 --- a/R/validity.R +++ b/R/validity.R @@ -17,16 +17,6 @@ return(msg) } -.validatePointFrame <- \(object) { - msg <- c() - if (!length(object)) return(msg) - if (!"x" %in% names(object)) msg <- c(msg, "'PointFrame' missing 'x'.") - if (!"y" %in% names(object)) msg <- c(msg, "'PointFrame' missing 'y'.") - return(msg) -} -#' @importFrom S4Vectors setValidity2 -setValidity2("PointFrame", .validatePointFrame) - .validateImageArray <- \(object) { msg <- c() res <- length(object) @@ -58,6 +48,25 @@ setValidity2("ImageArray", .validateImageArray) #' @importFrom S4Vectors setValidity2 setValidity2("LabelArray", .validateLabelArray) +.validatePointFrame <- \(object) { + msg <- c() + if (!length(object)) return(msg) + if (!"x" %in% names(object)) msg <- c(msg, "'PointFrame' missing 'x'.") + if (!"y" %in% names(object)) msg <- c(msg, "'PointFrame' missing 'y'.") + return(msg) +} +#' @importFrom S4Vectors setValidity2 +setValidity2("PointFrame", .validatePointFrame) + +.validateShapeFrame <- \(object) { + msg <- c() + if (!nrow(object)) return(msg) + if (!"geometry" %in% names(object)) msg <- c(msg, "'ShapeFrame' missing 'geometry'.") + return(msg) +} +#' @importFrom S4Vectors setValidity2 +setValidity2("ShapeFrame", .validateShapeFrame) + #' @importFrom methods is .validateSpatialData <- \(x) { typ <- c( diff --git a/tests/testthat/test-validity.R b/tests/testthat/test-validity.R index c718ef5f..8162b0ee 100644 --- a/tests/testthat/test-validity.R +++ b/tests/testthat/test-validity.R @@ -34,3 +34,15 @@ test_that("validity,PointFrame", { expect_error(validObject(select(x, -y))) expect_silent(validObject(select(x, -c(x, y))[0,])) }) + +test_that("validity,ShapeFrame", { + x <- shape(sd,1) + x@data <- select(data(x), -radius) + expect_silent(validObject(x)) + x <- shape(sd,1) + x@data <- filter(data(x), radius == Inf) + expect_silent(validObject(x)) + x <- shape(sd,1) + x@data <- select(data(x), -geometry) + expect_error(validObject(x)) +}) From 98108e89c2204a6d6d6454b6ba1f26c538fd58c5 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:39:59 +0200 Subject: [PATCH 03/10] require dplyr for testing --- tests/testthat/test-validity.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-validity.R b/tests/testthat/test-validity.R index 8162b0ee..2d97f88d 100644 --- a/tests/testthat/test-validity.R +++ b/tests/testthat/test-validity.R @@ -1,4 +1,4 @@ -library(SpatialData.plot) +require(dplyr, quietly=TRUE) zs <- file.path("extdata", "blobs.zarr") zs <- system.file(zs, package="SpatialData") sd <- readSpatialData(zs, tables=FALSE) From a573807f3d2d384a0a2870c6d3cbe4a28ac2567c Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:40:51 +0200 Subject: [PATCH 04/10] fix comment typo --- tests/testthat/test-validity.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-validity.R b/tests/testthat/test-validity.R index 2d97f88d..675485f2 100644 --- a/tests/testthat/test-validity.R +++ b/tests/testthat/test-validity.R @@ -9,7 +9,7 @@ test_that("validity,ImageArray", { expect_error(ImageArray(list(v <- character(1)))) x <- image(sd,1); x@data[[1]][1,1,1] <- v; expect_error(validObject(x)) x <- image(sd,2); x@data[[2]][1,1,1] <- v; expect_error(validObject(x)) - # there should be two dimensions + # there should be three dimensions (channels + spatial) expect_error(ImageArray(list(a <- array(numeric(1), c(1,1))))) x <- image(sd,1); x@data[[1]] <- a; expect_error(validObject(x)) x <- image(sd,2); x@data[[2]] <- a; expect_error(validObject(x)) From 3f2058d86e2bbf9b7d240c65b510143df3a67e53 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:45:44 +0200 Subject: [PATCH 05/10] validity,SpatialData --- R/validity.R | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/R/validity.R b/R/validity.R index 23147843..15b36d52 100644 --- a/R/validity.R +++ b/R/validity.R @@ -27,7 +27,7 @@ if (!type(x) %in% c("double", "integer")) msg <- c(msg, paste( "'ImageArray' resolution", k, "is not of type double or integer")) } - if (length(msg)) return(msg) else return(TRUE) + return(msg) } #' @importFrom S4Vectors setValidity2 setValidity2("ImageArray", .validateImageArray) @@ -43,7 +43,7 @@ setValidity2("ImageArray", .validateImageArray) if (type(x) != "integer") msg <- c(msg, paste( "'LabelArray' resolution", k, "is not of type integer")) } - if (length(msg)) return(msg) else return(TRUE) + return(msg) } #' @importFrom S4Vectors setValidity2 setValidity2("LabelArray", .validateLabelArray) @@ -69,25 +69,26 @@ setValidity2("ShapeFrame", .validateShapeFrame) #' @importFrom methods is .validateSpatialData <- \(x) { + msg <- c() typ <- c( images="ImageArray", labels="LabelArray", points="PointFrame", shapes="ShapeFrame", tables="SingleCellExperiment") - msg <- NULL for (. in names(typ)) if (length(x[[.]])) if (!all(vapply(x[[.]], \(y) is(y, typ[.]), logical(1)))) msg <- c(msg, sprintf("'%s' should be a list of '%s'", ., typ[.])) - msg <- c(msg, .validatePointFrame(x)) - msg <- c(msg, .validateTable(x)) + # TODO: validate .zattrs across all layers for (y in labels(x)) { - ok <- .validateLabelArray(y) - if (!isTRUE(ok)) msg <- c(msg, ok) - ok <- .validateZattrsLabelArray(y) - if (!isTRUE(ok)) msg <- c(msg, ok) + msg <- c(msg, .validateLabelArray(y)) + msg <- c(msg, .validateZattrsLabelArray(y)) } - if (length(msg)) return(msg) else return(TRUE) + for (y in images(x)) msg <- c(msg, .validateImageArray(y)) + for (y in points(x)) msg <- c(msg, .validatePointFrame(y)) + for (y in shapes(x)) msg <- c(msg, .validateShapeFrame(y)) + msg <- c(msg, .validateTable(x)) + return(msg) } #' @importFrom S4Vectors setValidity2 @@ -129,5 +130,5 @@ setValidity2("SpatialData", .validateSpatialData) ms <- za$multiscales[[1]] msg <- .validateZattrs_axes(ms, msg) msg <- .validateZattrs_coordTrans(ms, msg) - if (length(msg)) return(msg) else return(TRUE) + return(msg) } From 31c8189301a74396d7060737fce094c741f65cd5 Mon Sep 17 00:00:00 2001 From: "Helena L. Crowell" Date: Mon, 6 Apr 2026 18:51:53 +0200 Subject: [PATCH 06/10] fix comment typo Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- tests/testthat/test-validity.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-validity.R b/tests/testthat/test-validity.R index 675485f2..e08c8393 100644 --- a/tests/testthat/test-validity.R +++ b/tests/testthat/test-validity.R @@ -5,7 +5,7 @@ sd <- readSpatialData(zs, tables=FALSE) test_that("validity,ImageArray", { # all resolutions should be numbers - # (note: logical gets coerces to binary) + # (note: logical gets coerced to binary) expect_error(ImageArray(list(v <- character(1)))) x <- image(sd,1); x@data[[1]][1,1,1] <- v; expect_error(validObject(x)) x <- image(sd,2); x@data[[2]][1,1,1] <- v; expect_error(validObject(x)) From 79af773f336f26f32613eb405688966e45e5abbe Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:53:02 +0200 Subject: [PATCH 07/10] track v0.99.26 changes --- inst/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/inst/NEWS b/inst/NEWS index 48b32dea..4c35e07a 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,3 +1,9 @@ +changes in version 0.99.26 + +- added unit tests for existing transformations +- implemented minimal layer-wise validity checks + (Image/LabelArray and Shape/PointFrame elements) + changes in version 0.99.25 - improved Zattrs show method (cf., PR #117) From da875c24c1dde99358bb4be4441bb2acbec3e450 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:53:15 +0200 Subject: [PATCH 08/10] v0.99.26 bump --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 85239e41..a3c52e55 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SpatialData Title: Representation of Python's SpatialData in R Depends: R (>= 4.5) -Version: 0.99.25 +Version: 0.99.26 Description: Interface to Python's 'SpatialData', currently including: reticulate-based use of 'spatialdata-io' for reading of manufacturer data and writing to .zarr, on-disk representation of images/labels as From 84a431d57e5afeff557790d853cece7520d20cd6 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 18:58:16 +0200 Subject: [PATCH 09/10] fix show bug --- R/Zattrs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Zattrs.R b/R/Zattrs.R index 017dcb61..bff3360e 100644 --- a/R/Zattrs.R +++ b/R/Zattrs.R @@ -58,7 +58,7 @@ setMethod("$", "Zattrs", \(x, name) x[[name]]) cat(sprintf("- %s: (%s%s)\n", CTname(object)[i], CTtype(object)[i], - f(CTdata(object)[[i]][[CTtype(object)[i]]]))) + f(CTlist(object)[[i]][[CTtype(object)[i]]]))) ms <- object$multiscales[[1]] if (!is.null(ms)) { ds <- ms$datasets From 9e785cbdd64e2677bebd58033067445066264bfc Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 6 Apr 2026 19:08:23 +0200 Subject: [PATCH 10/10] add todo note --- R/Zattrs.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/Zattrs.R b/R/Zattrs.R index bff3360e..2d69664c 100644 --- a/R/Zattrs.R +++ b/R/Zattrs.R @@ -44,6 +44,7 @@ setMethod("$", "Zattrs", \(x, name) x[[name]]) cat("- name:", vapply(ax, \(.) .$name, character(1)), "\n") cat("- type:", vapply(ax, \(.) .$type, character(1)), "\n") } + # TODO: more detailed 'sequence' display cat(sprintf("coordTrans(%d):\n", n <- length(CTname(object)))) g <- \(.) { . <- paste(unlist(.), collapse=",")