From 72c6e7d473335fd57220e00a5ea9f67dc3078bb1 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 20:58:25 +0200 Subject: [PATCH 1/4] channels() bug fix --- R/sdArray.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/sdArray.R b/R/sdArray.R index a299f8b1..881da707 100644 --- a/R/sdArray.R +++ b/R/sdArray.R @@ -131,7 +131,9 @@ setMethod("data_type", "DelayedArray", \(x) { v <- tryCatch(.ome_ver(x), error=\(e) NULL) if (is.null(v)) return() if (v == "0.5") x <- x$ome - unlist(x$omero$channels) + # NOTE: can't use 'vapply' as we + # have encountered integer 'label's + unlist(lapply(x$omero$channels, `[[`, "label")) } #' @export From a0395e68bc4a3b1db31655b6a3e6fcdd743308ce Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 20:58:45 +0200 Subject: [PATCH 2/4] fmatch scales in mask() --- R/mask.R | 23 ++++++++++++++--------- tests/testthat/test-mask.R | 8 +++++++- 2 files changed, 21 insertions(+), 10 deletions(-) diff --git a/R/mask.R b/R/mask.R index e62d04bf..a58a87e1 100644 --- a/R/mask.R +++ b/R/mask.R @@ -93,20 +93,25 @@ setGeneric("mask_i_by_j", \(i, j, ...) standardGeneric("mask_i_by_j")) setMethod("mask_i_by_j", c("SpatialDataImage", "SpatialDataLabel"), \(i, j, how=NULL, ...) { - .wh <- \(.) { - ds <- dim(.); if (length(ds) == 3) ds <- ds[-1] - metadata(.)$wh %||% list(c(0, ds[2]), c(0, ds[1])) - } - stopifnot( - "image/label width mismatch"=.wh(i)[[1]] == .wh(j)[[1]], - "image/label height mismatch"=.wh(i)[[2]] == .wh(j)[[2]]) + di <- lapply(data(i, NULL), dim) + dj <- lapply(data(j, NULL), dim) + ij <- outer( + seq_along(di), + seq_along(dj), + Vectorize(\(i, j) identical(tail(di[[i]], length(dj[[j]])), dj[[j]]))) + ij <- which(ij, arr.ind=TRUE) + if (nrow(ij) == 0) + stop("couldn't find shared multiscales level between label/image;", + " need at least one data() pair with identical dimensions") + ki <- ij[1, 1] + kj <- ij[1, 2] if (is.null(how)) { message("Missing 'how'; defaulting to 'mean'") how <- "mean" } - .j <- as(data(j), "sparseVector") + .j <- as(data(j, kj), "sparseVector") .j <- as.vector(.j[ok <- .j > 0]) - mx <- apply(data(i), 1, \(.i) { + mx <- apply(data(i, ki), 1, \(.i) { .i <- as(.i, "sparseVector") .i <- as.vector(.i[ok]) tapply(.i, .j, how) diff --git a/tests/testthat/test-mask.R b/tests/testthat/test-mask.R index 9f214ab6..cf1e938e 100644 --- a/tests/testthat/test-mask.R +++ b/tests/testthat/test-mask.R @@ -46,6 +46,12 @@ test_that("mask,sdImage,sdLabel", { expect_equivalent( assay(tables(y)[[2]]), assay(tables(x)[[1]])) + + # no matching scale + .i <- image(x, "blobs_multiscale_image") + .i@data <- lapply(.i@data, \(.) .[,,-1]) + .x <- x; image(.x, i) <- .i + expect_error(mask(.x, i, j)) }) test_that("mask w/ transform", { @@ -58,7 +64,7 @@ test_that("mask w/ transform", { l <- list(1,.1,.1); t <- "scale" a <- addCT(a, name=t, type=t, data=l) y <- x; y[[layer(y, i)]][[i]] <- a - expect_error(mask(y, i, j, t)) + expect_no_error(mask(y, i, j, t)) # aligned l <- c(list(1), CTdata(b, t <- "scale")) From 7e3d7da39117c23ec6431bb3c05fa02fbbfe6577 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 21:34:40 +0200 Subject: [PATCH 3/4] fix [,sdArray docs --- R/sdArray.R | 6 ++++-- man/SpatialDataArray.Rd | 7 +++++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/sdArray.R b/R/sdArray.R index 881da707..c8490276 100644 --- a/R/sdArray.R +++ b/R/sdArray.R @@ -175,8 +175,6 @@ setMethod("channels", "SpatialDataElement", \(x, ...) stop("only 'images' have c # https://github.com/Huber-group-EMBL/Rarr/blob/1795c676e2ac81a9ba2a592c7210cc59036544b6/R/utils.R#L74-L79 .sub <- \(x, ix) rlang::inject(x[!!!ix, drop=FALSE]) -#' @exportMethod [ -#' @rdname SpatialDataArray #' @importFrom utils head tail .sub_sda <- \(x, yx, z=list()) { #x <- label(sd); yx <- list(1:10, 1:10); z <- list() @@ -210,6 +208,8 @@ setMethod("channels", "SpatialDataElement", \(x, ...) stop("only 'images' have c x } +#' @exportMethod [ +#' @rdname SpatialDataArray setMethod("[", "SpatialDataImage", \(x, i, j, k, ..., drop=FALSE) { if (missing(i)) i <- TRUE if (missing(j)) j <- TRUE else if (isFALSE(j)) j <- 0 else .check_jk(j, "j") @@ -217,6 +217,8 @@ setMethod("[", "SpatialDataImage", \(x, i, j, k, ..., drop=FALSE) { .sub_sda(x, yx=list(j, k), z=list(i)) }) +#' @exportMethod [ +#' @rdname SpatialDataArray setMethod("[", "SpatialDataLabel", \(x, i, j, ..., drop=FALSE) { if (missing(i)) i <- TRUE else if (isFALSE(i)) i <- 0 else .check_jk(i, "i") if (missing(j)) j <- TRUE else if (isFALSE(j)) j <- 0 else .check_jk(j, "j") diff --git a/man/SpatialDataArray.Rd b/man/SpatialDataArray.Rd index 7549c6e2..4cbe62a8 100644 --- a/man/SpatialDataArray.Rd +++ b/man/SpatialDataArray.Rd @@ -13,7 +13,8 @@ \alias{channels,SpatialDataAttrs-method} \alias{channels,SpatialDataImage-method} \alias{channels,SpatialDataElement-method} -\alias{.sub_sda} +\alias{[,SpatialDataImage,ANY,ANY,ANY-method} +\alias{[,SpatialDataLabel,ANY,ANY,ANY-method} \title{\code{SpatialDataArray}} \usage{ SpatialDataImage( @@ -44,7 +45,9 @@ SpatialDataLabel( \S4method{channels}{SpatialDataElement}(x, ...) -.sub_sda(x, yx, z = list()) +\S4method{[}{SpatialDataImage,ANY,ANY,ANY}(x, i, j, k, ..., drop = FALSE) + +\S4method{[}{SpatialDataLabel,ANY,ANY,ANY}(x, i, j, ..., drop = FALSE) } \arguments{ \item{data}{list of \code{ZarrArray}s} From a866bd8ff954860e599b700d82c962224c52ef6a Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 21:41:06 +0200 Subject: [PATCH 4/4] let channels() handle non-list spec --- R/sdArray.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/sdArray.R b/R/sdArray.R index c8490276..82c73701 100644 --- a/R/sdArray.R +++ b/R/sdArray.R @@ -133,7 +133,8 @@ setMethod("data_type", "DelayedArray", \(x) { if (v == "0.5") x <- x$ome # NOTE: can't use 'vapply' as we # have encountered integer 'label's - unlist(lapply(x$omero$channels, `[[`, "label")) + x <- x$omero$channels + x$label %||% unlist(lapply(x, `[[`, "label")) } #' @export