diff --git a/DESCRIPTION b/DESCRIPTION index a1c4f12..8881df7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: ImageArray Type: Package Title: A framework for on-disk and in-memory image arrays -Version: 1.1.6 +Version: 1.1.7 Authors@R: c( person("Artür", "Manukyan", role=c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index b8e181f..7211294 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,11 +7,12 @@ export(ImageArray) export(createImageArray) export(getImageInfo) export(writeImageArray) +exportClasses(ImageArray) exportMethods("[") exportMethods("[[") exportMethods("[[<-") -exportMethods("axes<-") exportMethods("path<-") +exportMethods("scales<-") exportMethods(affine) exportMethods(aperm) exportMethods(axes) @@ -29,7 +30,6 @@ exportMethods(realize) exportMethods(resolution) exportMethods(rotate) exportMethods(scale) -exportMethods(scales) exportMethods(series) exportMethods(translation) exportMethods(type) @@ -75,7 +75,8 @@ importFrom(methods, setClassUnion, setOldClass, slot, - slotNames + slotNames, + validObject ) importFrom(rhdf5, h5createFile, diff --git a/NEWS.md b/NEWS.md index a623592..5fec2e7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,14 @@ +# ImageArray 1.1.7 + +## New features + +* Compatibility with https://github.com/Huber-group-EMBL/romeo +* `ImageArray` class is now exported. +* `axes` slot is dropped from `ImageArray` class and now parsed from + names(scales(object)[[1]]) (which can still be parsed from `axes(object)` + as usual). +* scales of pyramid axes are now inverted, e.g. 1, 0.5, 0.125 are now 1, 2, 4. + # ImageArray 1.1.6 ## New features diff --git a/R/AllClasses.R b/R/AllClasses.R index 4ad05c2..f29df09 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -6,8 +6,6 @@ NULL # magick classes setOldClass("magick-image") setOldClass("bitmap") -setClassUnion(c("magick_class"), - c("magick-image", "bitmap")) # array and matrix classes setClassUnion("matrix_array_Array", @@ -18,11 +16,26 @@ setClassUnion("matrix_array_Array", contains="SimpleList", prototype=prototype(elementType="matrix_array_Array")) +#' @title ImageArray class +#' +#' @description +#' An S4 container for a multi-resolution (pyramidal) image, holding the +#' pyramid levels together with their scales. Objects are created with +#' \code{\link{ImageArray}}. +#' +#' @slot levels an \code{ImageList} of pyramid levels, ordered from the +#' highest to the lowest resolution +#' @slot scales a list of named numeric vectors, one per level, where values +#' are the scales of these axes. The names of these vectors define the axes +#' of the object, hence they are a subset of \code{c("c", "y", "x", "z", "t")} +#' and are shared, in the same order, by all levels. See +#' \url{https://ngff.openmicroscopy.org/} for more information. +#' +#' @exportClass ImageArray .ImageArray <- setClass( Class = "ImageArray", slots = c( levels = "ImageList", - axes = "character", scales = "list" ) ) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 2081109..8e91508 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -6,6 +6,8 @@ NULL setGeneric("createImageList", function(image, ...) standardGeneric("createImageList")) setGeneric("scales", function(object, ...) standardGeneric("scales")) +setGeneric("scales<-", + function(object, ..., value) standardGeneric("scales<-")) setGeneric("axes", function(object, ...) standardGeneric("axes")) setGeneric("axes<-", function(object, ..., value) standardGeneric("axes<-")) setGeneric("read_image", diff --git a/R/ImageArray.R b/R/ImageArray.R index 2c741ed..af1317d 100644 --- a/R/ImageArray.R +++ b/R/ImageArray.R @@ -47,6 +47,8 @@ #' axes<-,ImageArray-method #' scales #' scales,ImageArray-method +#' scales<- +#' scales<-,ImageArray-method #' realize #' realize,ImageArray-method #' as.raster @@ -185,20 +187,50 @@ setMethod("length", signature = "ImageArray", function(x) length(x@levels)) #' @describeIn ImageArray-methods get axes metadata of the ImageArray object #' @exportMethod axes -setMethod("axes", "ImageArray", function(object) object@axes) +setMethod("axes", "ImageArray", function(object) + .get_axes_from_scales(scales(object))) -#' @describeIn ImageArray-methods get axes metadata of the ImageArray object -#' @exportMethod axes<- -setMethod("axes<-", "ImageArray", function(object, ..., value){ - value <- .check_axes(object[[1]], axes = value) - object@axes <- value +#' @describeIn ImageArray-methods replace axes metadata of the ImageArray +#' object, the replacement can only be a permutation of the existing axes +setReplaceMethod("axes", "ImageArray", function(object, ..., value){ + ax <- axes(object) + + # check axes, should be a permutation + if(!is.character(value) || length(value) != length(ax) || + anyDuplicated(value) || !setequal(value, ax)) + stop("axes can only be replaced by a permutation of the existing axes: ", + paste(ax, collapse = ","), "!") + + # update axes + scales(object) <- lapply(scales(object), \(.) .[value]) object }) #' @describeIn ImageArray-methods get scales metadata of the ImageArray object -#' @exportMethod scales setMethod("scales", "ImageArray", function(object) object@scales) +#' @describeIn ImageArray-methods replace scales metadata of the ImageArray +#' object, each vector should be named by a permutation of the existing axes +#' @importFrom methods validObject +#' @exportMethod scales<- +setReplaceMethod("scales", "ImageArray", function(object, ..., value) { + if(!is.list(value)) stop("scales must be a list!") + + # the axes of an ImageArray object can only be permuted, all remaining + # checks are done by the validity of the class below + ax <- axes(object) + for(s in value){ + if(is.null(names(s)) || length(s) != length(ax) || + anyDuplicated(names(s)) || !setequal(names(s), ax)) + stop("names of each vector in scales should be a permutation of ", + "the existing axes: ", paste(ax, collapse = ","), "!") + } + + object@scales <- value + methods::validObject(object) + object +}) + #### # Create/Write #### #### @@ -369,8 +401,8 @@ createListFromEBImage <- function( if (verbose) .img_create_msg(dim_image, i) cur_image <- EBImage::resize( cur_image, - w = dim_image["x"]*scales[[i]]["x"], - h = dim_image["y"]*scales[[i]]["y"] + w = dim_image["x"]/scales[[i]]["x"], + h = dim_image["y"]/scales[[i]]["y"] ) cur_img <- aperm(cur_image, perm = img_perm_backward) image_list[[i]] <- @@ -412,7 +444,10 @@ createListFromList <- function(image, } #' @noRd -setMethod("createImageList", "magick_class", createListFromMagick) +setMethod("createImageList", "magick-image", createListFromMagick) + +#' @noRd +setMethod("createImageList", "bitmap", createListFromMagick) #' @noRd setMethod("createImageList", "Image", createListFromEBImage) @@ -452,8 +487,8 @@ setMethod("createImageList", "list", createListFromList) #' typical an integer starting from 1. #' @param verbose verbose #' -#' @name ImageArray -#' @rdname ImageArray +#' @name ImageArray-constructor +#' @rdname ImageArray-constructor #' #' @aliases #' createImageArray @@ -528,12 +563,11 @@ ImageArray <- function( S4Vectors::new2( "ImageArray", levels = image$levels, - axes = image$axes, scales = scales ) } -#' @describeIn ImageArray deprecated function +#' @describeIn ImageArray-constructor deprecated function #' @export createImageArray <- function( image, @@ -832,7 +866,7 @@ setMethod("read_image", #' @keywords internal #' @noRd .magick_resize_scale <- function(dim_img, scales){ - paste0(paste(round(dim_img*scales[c("x", "y")]), collapse = "x"),"!") + paste0(paste(round(dim_img/scales[c("x", "y")]), collapse = "x"),"!") } @@ -849,7 +883,7 @@ setMethod("read_image", if(length(d) != length(axes)) stop(msg) d <- setNames(d, axes) sc <- .TEMPLATE_SCALES[axes] - sc[scaled_axes] <- d[scaled_axes]/first_dim[scaled_axes] + sc[scaled_axes] <- first_dim[scaled_axes]/d[scaled_axes] sc }) } @@ -861,7 +895,7 @@ setMethod("read_image", stop("axes should have at least x and y dimensions!") lapply(seq_len(n.levels), \(i){ ax <- .TEMPLATE_SCALES[axes] - ax[c("x", "y")] <- ax[c("x", "y")] / 2^(i-1) + ax[c("x", "y")] <- ax[c("x", "y")] * 2^(i-1) ax }) } diff --git a/R/Validity.R b/R/Validity.R index d8f708d..18d224f 100644 --- a/R/Validity.R +++ b/R/Validity.R @@ -1,32 +1,36 @@ .validate_ImageArray <- function(object) { + # check scales vs levels, this is done first since the axes are + # given by the names of the scales + sc <- scales(object) + if(length(sc) != length(object@levels)) + stop("scales should be of the same length as levels!") + # check default axes ax <- axes(object) - if (!all(ax %in% .AXES)) { - stop("The axes of the ImageArray object should be a subset of ", + if (!all(ax %in% .AXES)) + stop("The axes of the ImageArray object should be a subset of ", deparse(.AXES)) - } - - # check scales - sc <- scales(object) + + # check duplicate axes + ind_dup <- which(table(ax) > 1) + if (length(ind_dup)) + stop("Duplicated axes are detected: ", + paste(names(ind_dup), collapse = ",")) + + # check scales, all levels should carry the same axes in the same order for(s in sc){ - if(!all(names(s) %in% ax)) stop("scale names do not match axes") - if(!all(is.numeric(s) & is.finite(s))) + if(!identical(names(s), ax)) stop("scale names do not match axes") + if(!all(is.numeric(s) & is.finite(s))) stop("scale entries are not numeric") } # check all dim vs axes all_length <- vapply(object@levels, function(x) length(dim(x)), integer(1)) - if (!all(all_length == length(ax))) { + if (!all(all_length == length(ax))) stop( "The number of dimensions of all levels should match the number of axes." ) - } - - # check all dim vs scales - all_dim <- lapply(object@levels, function(x) dim(x)) - if(length(sc) != length(all_dim)) - stop("scales should be of the same length as levels!") TRUE } diff --git a/R/manipulation.R b/R/manipulation.R index b452365..bc3f26a 100644 --- a/R/manipulation.R +++ b/R/manipulation.R @@ -74,8 +74,8 @@ setMethod("crop", signature = "ImageArray", function(object, index) { lapply(seq_along(index[scaled_axes]), function(j) { ind <- index[scaled_axes][[j]] ind <- c( - floor(ind[1] * cur_scale[scaled_axes][j]), - ceiling(ind[length(ind)] * cur_scale[scaled_axes][j]) + floor(ind[1] / cur_scale[scaled_axes][j]), + ceiling(ind[length(ind)] / cur_scale[scaled_axes][j]) ) seq(max(ind[1], 1), min(ind[2], selected_dim[j])) }) diff --git a/R/transformations.R b/R/transformations.R index 538a7e2..bc06e88 100644 --- a/R/transformations.R +++ b/R/transformations.R @@ -556,9 +556,9 @@ setMethod("affine", scl <- scales(x) for (i in seq_along(x@levels)) { sc <- scl[[i]][selected_axes] - m <- solve(diag(c(1/sc, 1))) %*% m %*% diag(1/sc) + m <- solve(diag(c(sc, 1))) %*% m %*% diag(sc) if(!is.null(output.dim)){ - cur_output.dim <- output.dim * sc + cur_output.dim <- output.dim / sc } else { cur_output.dim <- output.dim } @@ -663,7 +663,7 @@ setMethod("scale", .check_outputdim(output.dim) for (i in seq_along(x@levels)) { sc <- scl[[i]][selected_axes] - cur_output.dim <- output.dim * sc + cur_output.dim <- output.dim / sc x[[i]] <- .scale_transform( x[[i]], output.dim = cur_output.dim, diff --git a/man/ImageArray-class.Rd b/man/ImageArray-class.Rd new file mode 100644 index 0000000..c1b4e26 --- /dev/null +++ b/man/ImageArray-class.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllClasses.R +\docType{class} +\name{ImageArray-class} +\alias{ImageArray-class} +\alias{.ImageArray} +\title{ImageArray class} +\description{ +An S4 container for a multi-resolution (pyramidal) image, holding the +pyramid levels together with their scales. Objects are created with +\code{\link{ImageArray}}. +} +\section{Slots}{ + +\describe{ +\item{\code{levels}}{an \code{ImageList} of pyramid levels, ordered from the +highest to the lowest resolution} + +\item{\code{scales}}{a list of named numeric vectors, one per level, where values +are the scales of these axes. The names of these vectors define the axes +of the object, hence they are a subset of \code{c("c", "y", "x", "z", "t")} +and are shared, in the same order, by all levels. See +\url{https://ngff.openmicroscopy.org/} for more information.} +}} + diff --git a/man/ImageArray.Rd b/man/ImageArray-constructor.Rd similarity index 86% rename from man/ImageArray.Rd rename to man/ImageArray-constructor.Rd index 888d838..8790ffc 100644 --- a/man/ImageArray.Rd +++ b/man/ImageArray-constructor.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ImageArray.R -\name{ImageArray} +\name{ImageArray-constructor} +\alias{ImageArray-constructor} \alias{ImageArray} \alias{createImageArray} \alias{createImageArray,ImageArray-method} @@ -17,6 +18,16 @@ ImageArray( resolution = NULL, verbose = FALSE ) + +createImageArray( + image, + n.levels = NULL, + series = NULL, + resolution = NULL, + max.pixel.threshold = max.pixel.threshold, + engine = "EBImage", + verbose = FALSE +) } \arguments{ \item{image}{a path to a file, a single array or a list of arrays @@ -58,6 +69,11 @@ An ImageArray object \description{ creates an object of ImageArray class } +\section{Functions}{ +\itemize{ +\item \code{createImageArray()}: deprecated function + +}} \examples{ # get image library(EBImage) diff --git a/man/ImageArray-methods.Rd b/man/ImageArray-methods.Rd index 1b520b1..eb3ebd0 100644 --- a/man/ImageArray-methods.Rd +++ b/man/ImageArray-methods.Rd @@ -19,6 +19,8 @@ \alias{axes<-,ImageArray-method} \alias{scales} \alias{scales,ImageArray-method} +\alias{scales<-} +\alias{scales<-,ImageArray-method} \alias{realize} \alias{realize,ImageArray-method} \alias{as.raster} @@ -54,6 +56,8 @@ \S4method{scales}{ImageArray}(object) +\S4method{scales}{ImageArray}(object, ...) <- value + \S4method{realize}{ImageArray}(x, level = NULL, max.pixel.size = NULL, min.pixel.size = NULL) \method{as.raster}{ImageArray}(x, level = NULL, max.pixel.size = NULL, min.pixel.size = NULL, ...) @@ -131,10 +135,14 @@ for \code{ImageArray} objects \item \code{axes(ImageArray)}: get axes metadata of the ImageArray object -\item \code{axes(ImageArray) <- value}: get axes metadata of the ImageArray object +\item \code{axes(ImageArray) <- value}: replace axes metadata of the ImageArray +object, the replacement can only be a permutation of the existing axes \item \code{scales(ImageArray)}: get scales metadata of the ImageArray object +\item \code{scales(ImageArray) <- value}: replace scales metadata of the ImageArray +object, each vector should be named by a permutation of the existing axes + \item \code{realize(ImageArray)}: realize the array \item \code{as.raster(ImageArray)}: create a raster object diff --git a/tests/testthat/test-array.R b/tests/testthat/test-array.R index 97fdb6a..344e032 100644 --- a/tests/testthat/test-array.R +++ b/tests/testthat/test-array.R @@ -70,7 +70,7 @@ test_that("array downscaled with EBImage and scales", { imgarray <- ImageArray(img3d, scales = list(c(x = 1, y = 1, c = 1), - c(x = 0.66, y = 0.2, c = 1))) + c(x = 1.5, y = 5, c = 1))) expect_equal(dim(imgarray[[2]]), c(13, 10, 3)) }) @@ -78,7 +78,7 @@ test_that("array downscaled with magick and scales", { imgarray <- ImageArray(img3d, scales = list(c(x = 1, y = 1, c = 1), - c(x = 0.66, y = 0.2, c = 1)), + c(x = 1.5, y = 5, c = 1)), engine = "magick-image") expect_equal(dim(imgarray[[2]]), c(13, 10, 3)) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-axes.R b/tests/testthat/test-axes.R index 881b60f..c45376d 100644 --- a/tests/testthat/test-axes.R +++ b/tests/testthat/test-axes.R @@ -67,12 +67,16 @@ test_that("duplicate axes", { axes <- .check_axes(mat3d, c("c", "x", "x")), "axes should include at least both x and y dimensions!" ) + expect_error( + axes <- .check_axes(mat4d, c("x", "y", "c", "c")), + "Duplicated axes are detected: c" + ) }) test_that("get axes from scales", { scales <- list(c(x = 1, y = 1), - c(x = 0.6, y = 0.6)) + c(x = 1.33, y = 1.33)) axes <- .get_axes_from_scales(scales) expect_equal(axes, c("x", "y")) @@ -87,4 +91,61 @@ test_that("get axes from scales", { .get_axes_from_scales(list(c())), "Each vector in scales should be named!" ) -}) \ No newline at end of file +}) + +test_that("get axes of an ImageArray", { + + # the axes of an ImageArray are given by the names of its scales + imgarray <- ImageArray(image = list(array(1:75, dim = c(3,5,5)), + array(1:12, dim = c(3,2,2))), + axes = c("c", "y", "x")) + expect_equal(axes(imgarray), c("c", "y", "x")) + expect_equal(axes(imgarray), names(scales(imgarray)[[1]])) + + # axes are also picked up from user provided scales + imgarray <- ImageArray(image = list(array(1:25, dim = c(5,5)), + array(1:9, dim = c(3,3))), + scales = list(c(y = 1, x = 1), + c(y = 0.6, x = 0.6))) + expect_equal(axes(imgarray), c("y", "x")) +}) + +test_that("replace axes of an ImageArray", { + + imgarray <- ImageArray(image = list(array(1:75, dim = c(3,5,5)), + array(1:12, dim = c(3,2,2))), + axes = c("c", "y", "x")) + + # axes can be permuted, all levels are permuted alike + axes(imgarray) <- c("y", "x", "c") + expect_equal(axes(imgarray), c("y", "x", "c")) + for(s in scales(imgarray)) + expect_equal(names(s), c("y", "x", "c")) + + # the scales follow their axes + expect_equal(scales(imgarray)[[2]], c(y = 2.5, x = 2.5, c = 1)) + + # the object remains valid + expect_true(validObject(imgarray)) + + # levels are untouched by the permutation + expect_equal(dim(imgarray[[1]]), c(3, 5, 5)) +}) + +test_that("replace axes of an ImageArray with invalid axes", { + + imgarray <- ImageArray(image = list(array(1:75, dim = c(3,5,5)), + array(1:12, dim = c(3,2,2))), + axes = c("c", "y", "x")) + msg <- "axes can only be replaced by a permutation of the existing axes" + + # only permutations of the existing axes are allowed + expect_error(axes(imgarray) <- c("z", "y", "x"), msg) + expect_error(axes(imgarray) <- c("y", "x"), msg) + expect_error(axes(imgarray) <- c("c", "y", "x", "t"), msg) + expect_error(axes(imgarray) <- c("x", "x", "y"), msg) + expect_error(axes(imgarray) <- seq_len(3), msg) + + # the object is left untouched + expect_equal(axes(imgarray), c("c", "y", "x")) +}) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index a0e4c2d..c94459d 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -26,11 +26,11 @@ test_that("get scales from number of levels", { expect_equal(length(sc), 4) expect_equal( vapply(sc, \(.) .[["x"]], numeric(1)), - c(1, 0.5, 0.25, 0.125) + c(1, 2, 4, 8) ) expect_equal( vapply(sc, \(.) .[["y"]], numeric(1)), - c(1, 0.5, 0.25, 0.125) + c(1, 2, 4, 8) ) expect_equal( vapply(sc, \(.) .[["c"]], numeric(1)), @@ -42,4 +42,97 @@ test_that("get scales from number of levels", { .get_scales_from_nlevels(n.levels = 2, axes = c("c", "x")), "axes should have at least x and y dimensions!" ) -}) \ No newline at end of file +}) + +test_that("get scales of an ImageArray", { + + imgarray <- ImageArray(image = list(array(1:75, dim = c(3,5,5)), + array(1:12, dim = c(3,2,2))), + axes = c("c", "y", "x")) + + # one named vector of scales per level + sc <- scales(imgarray) + expect_equal(length(sc), length(imgarray)) + expect_equal(sc[[1]], c(c = 1, y = 1, x = 1)) + expect_equal(sc[[2]], c(c = 1, y = 2.5, x = 2.5)) +}) + +test_that("replace scales of an ImageArray", { + + imgarray <- ImageArray(image = list(array(1:75, dim = c(3,5,5)), + array(1:12, dim = c(3,2,2))), + axes = c("c", "y", "x")) + + # scales can be replaced with new values + scales(imgarray) <- list(c(c = 1, y = 1, x = 1), + c(c = 1, y = 2, x = 2)) + expect_equal(scales(imgarray)[[2]], c(c = 1, y = 2, x = 2)) + expect_true(validObject(imgarray)) + + # the names of the scales may be a permutation of the existing axes, + # which in turn permutes the axes of the object + scales(imgarray) <- list(c(y = 1, x = 1, c = 1), + c(y = 2, x = 2, c = 1)) + expect_equal(axes(imgarray), c("y", "x", "c")) +}) + +test_that("replace scales of an ImageArray with invalid scales", { + + imgarray <- ImageArray(image = list(array(1:75, dim = c(3,5,5)), + array(1:12, dim = c(3,2,2))), + axes = c("c", "y", "x")) + msg <- paste0("names of each vector in scales should be a permutation of ", + "the existing axes") + + # scales should be a list + expect_error( + scales(imgarray) <- c(c = 1, y = 1, x = 1), + "scales must be a list!" + ) + + # each vector should be named by a permutation of the existing axes + expect_error(scales(imgarray) <- list(c(1, 1, 1), c(1, 2, 2)), msg) + expect_error( + scales(imgarray) <- list(c(c = 1, y = 1, z = 1), + c(c = 1, y = 2, z = 2)), + msg + ) + expect_error( + scales(imgarray) <- list(c(y = 1, x = 1), c(y = 2, x = 2)), + msg + ) + expect_error( + scales(imgarray) <- list(c(c = 1, y = 1, y = 1), + c(c = 1, y = 2, y = 2)), + msg + ) + + # all levels should carry the same axes in the same order + expect_error( + scales(imgarray) <- list(c(c = 1, y = 1, x = 1), + c(y = 2, x = 2, c = 1)), + "scale names do not match axes" + ) + + # one vector of scales per level + expect_error( + scales(imgarray) <- list(c(c = 1, y = 1, x = 1)), + "scales should be of the same length as levels!" + ) + + # scales should be finite numbers + expect_error( + scales(imgarray) <- list(c(c = 1, y = 1, x = 1), + c(c = 1, y = Inf, x = 2)), + "scale entries are not numeric" + ) + expect_error( + scales(imgarray) <- list(c(c = "1", y = "1", x = "1"), + c(c = "1", y = "2", x = "2")), + "scale entries are not numeric" + ) + + # the object is left untouched + expect_equal(axes(imgarray), c("c", "y", "x")) + expect_equal(scales(imgarray)[[2]], c(c = 1, y = 2.5, x = 2.5)) +})