From 377b546d6ba43421a8a7c790bffeaf6e78e3068d Mon Sep 17 00:00:00 2001 From: Artur-man Date: Wed, 27 May 2026 14:17:35 +0200 Subject: [PATCH 1/9] initial imp. for delayed transformations --- .Rbuildignore | 2 + .gitignore | 1 + DESCRIPTION | 2 +- R/allgenerics.R | 5 + R/delayed.R | 604 ++++++++++++++++++++++++++++++++++++++ man/ImageArray-methods.Rd | 4 +- vignettes/ImageArray.Rmd | 56 ++++ 7 files changed, 671 insertions(+), 3 deletions(-) create mode 100644 R/delayed.R diff --git a/.Rbuildignore b/.Rbuildignore index d452576..436d224 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -3,3 +3,5 @@ LICENSE.md .github .git +^\.positai$ +^\.claude$ diff --git a/.gitignore b/.gitignore index 93b9e0f..42f5c48 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ .Ruserdata inst/.DS_Store *.Rproj +.positai diff --git a/DESCRIPTION b/DESCRIPTION index 978a26f..892ae39 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,6 @@ Description: ImageArray provides a framework for on-disk and in-memory image Zarr and life sciences image file formats (OME Bio-Formats). License: MIT + file LICENSE Encoding: UTF-8 -RoxygenNote: 7.3.3 biocViews: Software, Visualization Depends: R (>= 4.5.0), @@ -42,3 +41,4 @@ Config/testthat/edition: 3 VignetteBuilder: knitr URL: https://github.com/BIMSBbioinfo/ImageArray BugReports: https://github.com/BIMSBbioinfo/ImageArray/issues +Config/roxygen2/version: 8.0.0 diff --git a/R/allgenerics.R b/R/allgenerics.R index 85c6eeb..df6f03b 100644 --- a/R/allgenerics.R +++ b/R/allgenerics.R @@ -9,3 +9,8 @@ setGeneric("axes", function(object, ...) standardGeneric("axes")) setGeneric("rotate") setGeneric("flip") setGeneric("flop") + +# transformations +setGeneric("scale_transform", \(x, ...) standardGeneric("scale_transform")) +setGeneric("affine_transform", \(x, ...) standardGeneric("affine_transform")) +setGeneric("translate_transform", \(x, ...) standardGeneric("translate_transform")) \ No newline at end of file diff --git a/R/delayed.R b/R/delayed.R new file mode 100644 index 0000000..dac3caf --- /dev/null +++ b/R/delayed.R @@ -0,0 +1,604 @@ +#### +# Classes #### +#### + +## Delayed affine helpers + constructor +## Assumes these packages are available/loaded: +## library(DelayedArray) +## library(S4Arrays) +## library(EBImage) + +setClass( + "DelayedAffineSeed", + contains = "DelayedUnaryOp", + slots = c( + seed = "ANY", + dim = "integer", + dimnames = "list", + m = "matrix", + axes = "character", + filter = "character", + bg.col = "character", + antialias = "logical" + ) +) + +setClass( + "DelayedTranslateSeed", + contains = "DelayedUnaryOp", + slots = c( + seed = "ANY", + dim = "integer", + dimnames = "list", + shift = "numeric", + axes = "character" + ) +) + +setClassUnion("DelayedImageSeed", + c("DelayedAffineSeed", "DelayedTranslateSeed")) + +setMethod("dim", "DelayedImageSeed", function(x) { + x@dim +}) + +setMethod("dimnames", "DelayedImageSeed", function(x) { + x@dimnames +}) + +setMethod("type", "DelayedImageSeed", function(x) { + DelayedArray::type(x@seed) +}) + +#### +# Utils #### +#### + +.as_homogeneous <- function(m) { + if (!is.matrix(m) || !identical(dim(m), c(3L, 2L))) { + stop("'m' must be a 3 x 2 EBImage affine matrix") + } + + cbind(m, c(0, 0, 1)) +} + +.from_homogeneous <- function(M) { + M[, 1:2, drop = FALSE] +} + +.translate_h <- function(dx, dy) { + matrix( + c( + 1, 0, 0, + 0, 1, 0, + dx, dy, 1 + ), + nrow = 3, + byrow = TRUE + ) +} + +.default_axes <- function(ndim) { + c( + "x", + "y", + if (ndim > 2L) paste0("d", seq.int(3L, ndim)) else character() + ) +} + +.spatial_perm <- function(ndim, axes) { + xy <- match(c("x", "y"), axes) + + if (anyNA(xy)) { + stop("'axes' must contain 'x' and 'y'") + } + + c(xy, setdiff(seq_len(ndim), xy)) +} + +.spatial_first <- function(a, axes) { + p <- .spatial_perm(length(dim(a)), axes) + + if (identical(p, seq_along(p))) { + a + } else { + aperm(a, p) + } +} + +.spatial_back <- function(a, axes) { + ndim <- length(dim(a)) + p <- .spatial_perm(ndim, axes) + inv <- order(p) + + if (identical(inv, seq_len(ndim))) { + a + } else { + aperm(a, inv) + } +} + +.normalize_index <- function(index, dim) { + if (length(index) == 0L) { + index <- vector("list", length(dim)) + } + + if (length(index) != length(dim)) { + stop("'index' must have one entry per dimension") + } + + Map( + function(i, n) { + if (is.null(i)) { + seq_len(n) + } else { + as.integer(i) + } + }, + index, + dim + ) +} + +.is_full_index <- function(index, dim) { + all(vapply( + seq_along(dim), + function(k) identical(index[[k]], seq_len(dim[k])), + logical(1) + )) +} + +.bg_array <- function(x, dim) { + type <- tryCatch( + DelayedArray::type(x@seed), + error = function(e) "double" + ) + + proto <- switch( + type, + logical = logical(prod(dim)), + integer = integer(prod(dim)), + double = numeric(prod(dim)), + numeric = numeric(prod(dim)), + complex = complex(prod(dim)), + character = character(prod(dim)), + raw = raw(prod(dim)), + numeric(prod(dim)) + ) + + array(proto, dim = dim) +} + +.source_bbox_from_output_query <- function(m, + out_x, + out_y, + source_dim_xy, + filter = "bilinear") { + M <- .as_homogeneous(m) + Minv <- solve(M) + + ## EBImage-style pixel coordinates are treated as zero-based here. + ## R index 1 corresponds to coordinate 0. + x0 <- min(out_x) - 1 + x1 <- max(out_x) - 1 + y0 <- min(out_y) - 1 + y1 <- max(out_y) - 1 + + output_corners <- rbind( + c(x0, y0, 1), + c(x1, y0, 1), + c(x0, y1, 1), + c(x1, y1, 1) + ) + + source_corners <- output_corners %*% Minv + + sx_min <- min(source_corners[, 1]) + sx_max <- max(source_corners[, 1]) + sy_min <- min(source_corners[, 2]) + sy_max <- max(source_corners[, 2]) + + pad <- if (identical(filter, "bilinear")) 2L else 1L + + sx0 <- floor(sx_min) + 1L - pad + sx1 <- ceiling(sx_max) + 1L + pad + sy0 <- floor(sy_min) + 1L - pad + sy1 <- ceiling(sy_max) + 1L + pad + + sx0 <- max(1L, sx0) + sy0 <- max(1L, sy0) + sx1 <- min(source_dim_xy[1], sx1) + sy1 <- min(source_dim_xy[2], sy1) + + list( + x = if (sx0 <= sx1) seq.int(sx0, sx1) else integer(0), + y = if (sy0 <= sy1) seq.int(sy0, sy1) else integer(0) + ) +} + +.localize_affine <- function(m, + source_origin_index, + output_origin_index) { + M <- .as_homogeneous(m) + + ## Convert R indices to zero-based EBImage coordinates. + source_origin0 <- source_origin_index - 1 + output_origin0 <- output_origin_index - 1 + + M_local <- + .translate_h(source_origin0[1], source_origin0[2]) %*% + M %*% + .translate_h(-output_origin0[1], -output_origin0[2]) + + .from_homogeneous(M_local) +} + +.collect_affine_transform_seed <- function(x) { + full_index <- vector("list", length(dim(x@seed))) + + arr <- S4Arrays::extract_array(x@seed, full_index) + arr <- .spatial_first(arr, x@axes) + + xy <- match(c("x", "y"), x@axes) + + out <- EBImage::affine( + arr, + m = x@m, + filter = x@filter, + output.dim = x@dim[xy], + bg.col = x@bg.col, + antialias = x@antialias + ) + + .spatial_back(as.array(out), x@axes) +} + +.get_extent_from_box <- function(bboxmin, bboxmax) { + list(x = c(bboxmin[1], bboxmax[1]), + y = c(bboxmin[2], bboxmax[2])) +} + +# .get_bbox_from_extent <- function(extent){ +# list(min = vapply(extent, \(.) min(.), numeric(1), USE.NAMES = FALSE), +# max = vapply(extent, \(.) max(.), numeric(1), USE.NAMES = FALSE)) +# } + +.get_bbox_from_extent <- function(ext,m){ + px <- as.matrix(expand.grid(ext$x, ext$y)) + transformed <- sweep(px %*% m[1:2,], 2L, m[3,], "+") + bbox.min <- apply(transformed, 2L, min) + bbox.max <- apply(transformed, 2L, max) + list(min = bbox.min, max = bbox.max) +} + +.adjust_affine_matrix <- function(dim, axes, m){ + dim <- setNames(dim, axes) + bbox <- .get_bbox_from_extent( + list(x = c(0,dim[["x"]]), y = c(0,dim[["y"]])), + m = m) + m[3, ] <- m[3,] - bbox$min + newdim <- bbox$max - bbox$min + dim[c("x", "y")] <- newdim + names(dim) <- NULL + list(m=m, output.dim=dim) +} + +# extract_array #### + +setMethod( + "extract_array", + "DelayedAffineSeed", + function(x, index) { + out_dim <- dim(x) + index <- .normalize_index(index, out_dim) + + ans_dim <- vapply(index, length, integer(1)) + + if (any(ans_dim == 0L)) { + return(.bg_array(x, ans_dim)) + } + + if (.is_full_index(index, out_dim)) { + return(.collect_affine_transform_seed(x)) + } + + xdim <- match("x", x@axes) + ydim <- match("y", x@axes) + + out_x <- index[[xdim]] + out_y <- index[[ydim]] + + ## Render a contiguous output window, then subset/reorder at the end. + out_x_window <- seq.int(min(out_x), max(out_x)) + out_y_window <- seq.int(min(out_y), max(out_y)) + + source_dim <- dim(x@seed) + + bbox <- .source_bbox_from_output_query( + m = x@m, + out_x = out_x_window, + out_y = out_y_window, + source_dim_xy = source_dim[c(xdim, ydim)], + filter = x@filter + ) + + if (length(bbox$x) == 0L || length(bbox$y) == 0L) { + return(.bg_array(x, ans_dim)) + } + + source_index <- index + source_index[[xdim]] <- bbox$x + source_index[[ydim]] <- bbox$y + + source_patch <- S4Arrays::extract_array(x@seed, source_index) + source_patch <- .spatial_first(source_patch, x@axes) + + m_local <- .localize_affine( + m = x@m, + source_origin_index = c(min(bbox$x), min(bbox$y)), + output_origin_index = c(min(out_x_window), min(out_y_window)) + ) + + rendered <- EBImage::affine( + source_patch, + m = m_local, + filter = x@filter, + output.dim = c(length(out_x_window), length(out_y_window)), + bg.col = x@bg.col, + antialias = x@antialias + ) + + rendered <- .spatial_back(as.array(rendered), x@axes) + + local_index <- vector("list", length(out_dim)) + local_index[[xdim]] <- match(out_x, out_x_window) + local_index[[ydim]] <- match(out_y, out_y_window) + + for (k in seq_along(out_dim)) { + if (k != xdim && k != ydim) { + local_index[[k]] <- seq_along(index[[k]]) + } + } + + do.call( + `[`, + c(list(rendered), local_index, list(drop = FALSE)) + ) + } +) + +setMethod( + "extract_array", + "DelayedTranslateSeed", + function(x, index) { + out_dim <- dim(x) + index <- .normalize_index(index, out_dim) + S4Arrays::extract_array(x@seed, index) + }) + +# extent #### + +setGeneric("extent", \(x, ...) standardGeneric("extent")) + +setMethod("extent", "ImageArray", function(x){ + extent(x[[1]]) +}) + +setMethod("extent", "DelayedArray", function(x){ + extent(x@seed) +}) + +setMethod("extent", "DelayedAffineSeed", function(x){ + ext <- extent(x@seed) + xy <- match(c("x", "y"), x@axes) + bbox <- .get_bbox_from_extent(ext[xy], x@m) + ext[xy] <- .get_extent_from_box(bbox$min, bbox$max) + ext +}) + +setMethod("extent", "DelayedTranslateSeed", function(x){ + ext <- extent(x@seed) + xy <- match(c("x", "y"), x@axes) + ext[xy] <- Map(\(i,j){ + i+j + }, ext[xy],x@shift) + ext[xy] +}) + +setMethod("extent", "Array", function(x){ + lapply(dim(x), \(.){ + c(0,.) + }) +}) + +# lazy transformations #### + +.affine_transform <- function(x, + m, + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + filter <- match.arg(filter) + + adj <- .adjust_affine_matrix(dim(x), axes, m) + output.dim <- as.integer(adj$output.dim) + m <- adj$m + dn <- vector("list", length(output.dim)) + + seed <- new( + "DelayedAffineSeed", + seed = x@seed, + dim = as.integer(output.dim), + dimnames = dn, + m = m, + axes = axes, + filter = filter, + bg.col = bg.col, + antialias = isTRUE(antialias) + ) + + DelayedArray::DelayedArray(seed) +} + +setMethod("affine_transform", + signature = "ImageArray", + function(x, + m, + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + ax <- axes(x) + for (i in seq_along(x@levels)) { + scl <- rep(2^(i - 1), 2) + m <- solve(diag(c(scl, 1))) %*% m %*% diag(scl) + x[[i]] <- affine_transform( + x[[i]], + m = m, + axes = ax, + filter = filter, + bg.col = bg.col, + antialias = antialias + ) + } + x + }) + +setMethod("affine_transform", signature = "DelayedArray", .affine_transform) + +.scale_transform <- function(x, + output.dim = NULL, + output.origin = c(0,0), + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + if (length(output.origin) != 2L || !is.numeric(output.origin)) + stop("'output.origin' must be a numeric vector of length 2") + xy <- match(c("x", "y"), axes) + ratio <- output.dim/dim(x)[xy] + m <- matrix(c(ratio[1], 0, (1 - ratio[1]) * output.origin[1], + 0, ratio[2], (1 - ratio[2]) * output.origin[2]), 3L, + 2L) + .affine_transform(x, + m, + axes = axes, + filter = filter, + bg.col = bg.col, + antialias = antialias) +} + +setMethod("scale_transform", + signature = "ImageArray", + function(x, + output.dim = NULL, + output.origin = c(0,0), + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + ax <- axes(x) + for (i in seq_along(x@levels)) { + cur_output.dim <- output.dim / 2^(i - 1) + x[[i]] <- scale_transform( + x[[i]], + output.dim = cur_output.dim, + output.origin = output.origin, + axes = ax, + filter = filter, + bg.col = bg.col, + antialias = antialias + ) + } + x + }) + +setMethod("scale_transform", signature = "DelayedArray", .scale_transform) + +rotate_transform <- function(x, + angle, + output.dim = NULL, + output.origin = c(0,0), + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + if (length(angle) != 1L || !is.numeric(angle)) + stop("'angle' must be a number") + if (!missing(output.dim)) + if (length(output.dim) != 2L || !is.numeric(output.dim)) + stop("'output.dim' must be a numeric vector of length 2") + if ((angle%%90) == 0) + filter = "none" + angle = angle * pi/180 + d = dim(x)[1:2] + dx = d[1] + dy = d[2] + cos = cos(angle) + sin = sin(angle) + if (missing(output.origin)) { + newdim = c(dx * abs(cos) + dy * abs(sin), dx * abs(sin) + + dy * abs(cos)) + offset = c(dx * max(0, -cos) + dy * max(0, sin), dx * + max(0, -sin) + dy * max(0, -cos)) + if (missing(output.dim)) + output.dim = newdim + else offset = offset + (output.dim - newdim)/2 + } + else { + if (length(output.origin) != 2L || !is.numeric(output.origin)) + stop("'output.origin' must be a numeric vector of length 2") + offset = c(output.origin[1L] * (1 - cos) + output.origin[2L] * + sin, output.origin[2L] * (1 - cos) - output.origin[1L] * + sin) + } + m <- matrix(c(cos, -sin, offset[1], sin, cos, offset[2]), + 3L, 2L) + affine_transform(x, + m, + axes = axes, + filter = filter, + bg.col = bg.col, + antialias = antialias) +} + +.translate_transform <- function(x, + shift = c(0,0), + axes = NULL) { + if (length(shift) != 2L || !is.numeric(shift)) + stop("'shift' must be a numeric vector of length 2, ", + "associated with x,y dimenions of an image!") + + d1 <- dim(x) + dn <- vector("list", length(d1)) + + seed <- new( + "DelayedTranslateSeed", + seed = x@seed, + dim = as.integer(d1), + dimnames = dn, + shift = shift, + axes = axes + ) + + DelayedArray::DelayedArray(seed) +} + +setMethod("translate_transform", + signature = "ImageArray", + function(x, + shift = c(0,0), + axes = NULL) { + ax <- axes(x) + for (i in seq_along(x@levels)) { + x[[i]] <- translate_transform( + x[[i]], + shift = shift, + axes = ax + ) + } + x + }) + +setMethod("translate_transform", signature = "DelayedArray", .translate_transform) \ No newline at end of file diff --git a/man/ImageArray-methods.Rd b/man/ImageArray-methods.Rd index c8dc121..8fa2fae 100644 --- a/man/ImageArray-methods.Rd +++ b/man/ImageArray-methods.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ImageArray.R, R/conversion.R, R/manipulation.R, -% R/utils.R +% Please edit documentation in R/ImageArray.R, R/conversion.R, +% R/manipulation.R, R/utils.R \name{ImageArray-methods} \alias{ImageArray-methods} \alias{[[,ImageArray,numeric-method} diff --git a/vignettes/ImageArray.Rmd b/vignettes/ImageArray.Rmd index 210101f..6acc9b5 100644 --- a/vignettes/ImageArray.Rmd +++ b/vignettes/ImageArray.Rmd @@ -223,6 +223,62 @@ plot(bfa.raster) dim(bfa.raster) ``` +# Delayed Operations + +```{r delayed} +ome.tiff.file <- system.file("extdata", "xy_12bit__plant.ome.tiff", + package = "ImageArray") +read.metadata(ome.tiff.file) + +# define ImageArray object +imgarray <- createImageArray(ome.tiff.file, series = 1, resolution = 1:2) +imgarray +``` + +```{r delayed_magick} +# make random EBImage image +f <- system.file("images", "sample.png", package = "EBImage") + +# read image with magick +img <- image_read(f) + +# create image array +output_h5 <- tempfile(fileext = ".h5") +imgarray2 <- writeImageArray(img, output = output_h5) +imgarray2 +``` + +## translation + +```{r scale} +imgarray_trans <- translate_transform(imgarray2, + shift = c(100,20)) +``` + +## scale transformation + +```{r scale} +imgarray_scale <- scale_transform(imgarray2, + output.dim = c(200,300), + filter = "bilinear") +``` + +## affine transformation + +```{r scale} +m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) +imgarray_affine <- affine_transform(imgarray2, + m = m, + filter = "bilinear") +imgarray_scale <- scale_transform(imgarray_affine, + output.dim = c(200,300), + filter = "bilinear") +imgarray_trans <- translate_transform(imgarray_scale, + shift = c(100,20)) +``` + +## sequence transformation + # Use cases The delayed pyramid scheme introduced by `ImageArray` objects can also From 743543b4c3557e83083e76c18febb4e66dc037b5 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Wed, 27 May 2026 22:43:27 +0200 Subject: [PATCH 2/9] implement tests for delayed transformations --- R/ImageArray.R | 15 +-- R/allgenerics.R | 11 +- R/delayed.R | 67 +++++----- tests/testthat/helper-transformations.R | 39 ++++++ tests/testthat/test-delayedarray.R | 6 +- tests/testthat/test-transformations.R | 156 ++++++++++++++++++++++++ vignettes/ImageArray.Rmd | 17 ++- 7 files changed, 251 insertions(+), 60 deletions(-) create mode 100644 tests/testthat/helper-transformations.R create mode 100644 tests/testthat/test-transformations.R diff --git a/R/ImageArray.R b/R/ImageArray.R index ae3cb01..7659ac6 100644 --- a/R/ImageArray.R +++ b/R/ImageArray.R @@ -575,17 +575,10 @@ writeImageArray <- function( if(format == "hdf5") format <- "h5" if(fileext != format && format != "in-memory") { warning( - sprintf( - paste( - "The file extension of the output path%s does", - "not match the specified format (%s),", - "The object will be written as (%s).", - sep = " " - ), - if (fileext == "") "" else paste0(" (", fileext, ")"), - format, - format - ) + "The file extension of the output path", + if (fileext == "") "" else sprintf(" '%s'", fileext), + " does not match the specified format (", format, "). ", + "The object will be saved as ", format, " format. " ) } } diff --git a/R/allgenerics.R b/R/allgenerics.R index df6f03b..f0c0bd8 100644 --- a/R/allgenerics.R +++ b/R/allgenerics.R @@ -11,6 +11,11 @@ setGeneric("flip") setGeneric("flop") # transformations -setGeneric("scale_transform", \(x, ...) standardGeneric("scale_transform")) -setGeneric("affine_transform", \(x, ...) standardGeneric("affine_transform")) -setGeneric("translate_transform", \(x, ...) standardGeneric("translate_transform")) \ No newline at end of file +setGeneric("scale_transform", + \(x, ...) standardGeneric("scale_transform")) +setGeneric("affine_transform", + \(x, ...) standardGeneric("affine_transform")) +setGeneric("translate_transform", + \(x, ...) standardGeneric("translate_transform")) +setGeneric("rotate_transform", + \(x, ...) standardGeneric("rotate_transform")) \ No newline at end of file diff --git a/R/delayed.R b/R/delayed.R index dac3caf..de371c9 100644 --- a/R/delayed.R +++ b/R/delayed.R @@ -63,7 +63,7 @@ setMethod("type", "DelayedImageSeed", function(x) { } .from_homogeneous <- function(M) { - M[, 1:2, drop = FALSE] + M[, seq_len(2), drop = FALSE] } .translate_h <- function(dx, dy) { @@ -88,11 +88,6 @@ setMethod("type", "DelayedImageSeed", function(x) { .spatial_perm <- function(ndim, axes) { xy <- match(c("x", "y"), axes) - - if (anyNA(xy)) { - stop("'axes' must contain 'x' and 'y'") - } - c(xy, setdiff(seq_len(ndim), xy)) } @@ -258,14 +253,9 @@ setMethod("type", "DelayedImageSeed", function(x) { y = c(bboxmin[2], bboxmax[2])) } -# .get_bbox_from_extent <- function(extent){ -# list(min = vapply(extent, \(.) min(.), numeric(1), USE.NAMES = FALSE), -# max = vapply(extent, \(.) max(.), numeric(1), USE.NAMES = FALSE)) -# } - .get_bbox_from_extent <- function(ext,m){ - px <- as.matrix(expand.grid(ext$x, ext$y)) - transformed <- sweep(px %*% m[1:2,], 2L, m[3,], "+") + px <- as.matrix(expand.grid(ext[[1]], ext[[2]])) + transformed <- sweep(px %*% m[seq_len(2),], 2L, m[3,], "+") bbox.min <- apply(transformed, 2L, min) bbox.max <- apply(transformed, 2L, max) list(min = bbox.min, max = bbox.max) @@ -381,7 +371,9 @@ setMethod( setGeneric("extent", \(x, ...) standardGeneric("extent")) setMethod("extent", "ImageArray", function(x){ - extent(x[[1]]) + dims <- c("x", "y") + xy <- match(dims, axes(x)) + setNames(extent(x[[1]])[xy], dims) }) setMethod("extent", "DelayedArray", function(x){ @@ -402,7 +394,7 @@ setMethod("extent", "DelayedTranslateSeed", function(x){ ext[xy] <- Map(\(i,j){ i+j }, ext[xy],x@shift) - ext[xy] + ext }) setMethod("extent", "Array", function(x){ @@ -516,40 +508,39 @@ setMethod("scale_transform", setMethod("scale_transform", signature = "DelayedArray", .scale_transform) -rotate_transform <- function(x, - angle, - output.dim = NULL, - output.origin = c(0,0), - axes = NULL, - filter = c("bilinear", "none"), - bg.col = "black", - antialias = TRUE) { +.rotate_transform <- function(x, + angle, + output.dim = NULL, + output.origin = c(0,0), + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { if (length(angle) != 1L || !is.numeric(angle)) stop("'angle' must be a number") if (!missing(output.dim)) if (length(output.dim) != 2L || !is.numeric(output.dim)) stop("'output.dim' must be a numeric vector of length 2") if ((angle%%90) == 0) - filter = "none" - angle = angle * pi/180 - d = dim(x)[1:2] - dx = d[1] - dy = d[2] - cos = cos(angle) - sin = sin(angle) + filter <- "none" + angle <- angle * pi/180 + xy <- match(c("x", "y"), axes) + d <- dim(x)[xy] + cos <- cos(angle) + sin <- sin(angle) if (missing(output.origin)) { - newdim = c(dx * abs(cos) + dy * abs(sin), dx * abs(sin) + - dy * abs(cos)) - offset = c(dx * max(0, -cos) + dy * max(0, sin), dx * - max(0, -sin) + dy * max(0, -cos)) + newdim <- c(d[1] * abs(cos) + d[2] * abs(sin), d[1] * abs(sin) + + d[2] * abs(cos)) + offset <- c(d[1] * max(0, -cos) + d[2] * max(0, sin), d[1] * + max(0, -sin) + d[2] * max(0, -cos)) if (missing(output.dim)) - output.dim = newdim - else offset = offset + (output.dim - newdim)/2 + output.dim <- newdim + else offset <- offset + (output.dim - newdim)/2 } else { if (length(output.origin) != 2L || !is.numeric(output.origin)) stop("'output.origin' must be a numeric vector of length 2") - offset = c(output.origin[1L] * (1 - cos) + output.origin[2L] * + offset <- c(output.origin[1L] * (1 - cos) + output.origin[2L] * sin, output.origin[2L] * (1 - cos) - output.origin[1L] * sin) } @@ -563,6 +554,8 @@ rotate_transform <- function(x, antialias = antialias) } +setMethod("rotate_transform", signature = "DelayedArray", .rotate_transform) + .translate_transform <- function(x, shift = c(0,0), axes = NULL) { diff --git a/tests/testthat/helper-transformations.R b/tests/testthat/helper-transformations.R new file mode 100644 index 0000000..f5071dd --- /dev/null +++ b/tests/testthat/helper-transformations.R @@ -0,0 +1,39 @@ +# test affine +test_affine <- function(img, axes, m){ + actual_dim <- dim(img) + xy <- match(c("x", "y"), axes) + ap <- c(xy, setdiff(seq_along(actual_dim), xy)) + img <- aperm(img, perm = ap) + img <- EBImage::Image(img) + adj <- .adjust_affine_matrix(actual_dim, axes, m) + img_affine <- EBImage::affine(EBImage::Image(img), m = adj$m, output.dim = adj$output.dim[xy]) + img_affine <- EBImage::imageData(img_affine) + aperm(img_affine, perm = order(ap)) +} + +# test scale +test_scale <- function(img, axes, output.dim){ + actual_dim <- dim(img) + xy <- match(c("x", "y"), axes) + ap <- c(xy, setdiff(seq_along(actual_dim), xy)) + img <- aperm(img, perm = ap) + img <- EBImage::Image(img) + img_scale <- EBImage::resize(EBImage::Image(img), + w = output.dim[1], h = output.dim[2]) + img_scale <- EBImage::imageData(img_scale) + aperm(img_scale, perm = order(ap)) +} + +# test scale +test_subset <- function(img, axes, index){ + actual_dim <- dim(img) + xy <- match(c("x", "y"), axes) + ap <- c(xy, setdiff(seq_along(actual_dim), xy)) + img <- aperm(img, perm = ap) + if(length(dim(img)) == 2){ + img_subset <- img[index[[1]], index[[2]]] + } else { + img_subset <- img[index[[1]], index[[2]], , drop = FALSE] + } + aperm(img_subset, perm = order(ap)) +} \ No newline at end of file diff --git a/tests/testthat/test-delayedarray.R b/tests/testthat/test-delayedarray.R index 2e0107e..3fd5193 100644 --- a/tests/testthat/test-delayedarray.R +++ b/tests/testthat/test-delayedarray.R @@ -17,8 +17,7 @@ mat_raster <- as.raster(mat, max = 255) # read as magick object mat_image <- magick::image_read(mat_raster) -test_that("path hdf5", { - # h5 +test_that("path HDF5", { mat_list <- writeImageArray( mat_image, output = output_h5, @@ -39,8 +38,7 @@ test_that("path hdf5", { expect_equal(path(mat_list), output_h5_replace) }) -test_that("path zarr", { - # zarr +test_that("path Zarr", { mat_list <- writeImageArray( mat_image, output = output_zarr, diff --git a/tests/testthat/test-transformations.R b/tests/testthat/test-transformations.R new file mode 100644 index 0000000..4fa215e --- /dev/null +++ b/tests/testthat/test-transformations.R @@ -0,0 +1,156 @@ +library(magick) +library(rhdf5) +library(HDF5Array) +library(Rarr) + +# images +ome.tiff.file <- system.file("extdata", "xy_12bit__plant.ome.tiff", + package = "ImageArray") +f <- system.file("images", "sample.png", package = "EBImage") + +# array list +img_list <- list() + +# OME TIFF +imgarray <- createImageArray(ome.tiff.file, series = 1, resolution = 1:2) +img_list[["tiff"]] <- imgarray + +# HDF5 +img <- image_read(f) +output_h5 <- tempfile(fileext = ".h5") +imgarray <- writeImageArray(img, output = output_h5) +img_list[["hdf5"]] <- imgarray + +# Zarr +img <- image_read(f) +output_h5 <- tempfile(fileext = ".zarr") +imgarray <- writeImageArray(img, output = output_h5) +img_list[["zarr"]] <- imgarray + +for(ni in names(img_list)) { + + imgarray <- img_list[[ni]] + xy <- match(c("x", "y"), axes(imgarray)) + + test_that(paste0("translation transformation for ", ni), { + shift <- c(100,20) + imgarray_trans <- translate_transform(imgarray, + shift = shift) + + # check seed + expect_s4_class(imgarray_trans, "ImageArray") + for(i in seq_along(imgarray_trans)){ + expect_s4_class(imgarray_trans[[i]]@seed, "DelayedTranslateSeed") + expect_s4_class(imgarray_trans[[i]]@seed, "DelayedUnaryOp") + } + + # check extent + expect_equal( + extent(imgarray_trans), + mapply(\(i,j) i+j, extent(imgarray), shift, SIMPLIFY = FALSE) + ) + }) + + test_that(paste0("scaling transformation for ", ni), { + output.dim <- c(200,300) + imgarray_scale <- scale_transform(imgarray, output.dim = output.dim) + + # check seed + expect_s4_class(imgarray_scale, "ImageArray") + for(i in seq_along(imgarray_scale)){ + expect_s4_class(imgarray_scale[[i]]@seed, "DelayedAffineSeed") + expect_s4_class(imgarray_scale[[i]]@seed, "DelayedUnaryOp") + } + + # check dim + actual.dim <- dim(imgarray) + od <- actual.dim + od[xy] <- output.dim + expect_equal(dim(imgarray_scale), od) + for(i in seq_along(imgarray)){ + od[xy] <- od[xy] / 2^(i-1) + expect_equal(dim(imgarray_scale[[i]]), od) + } + + # check scale + img <- realize(imgarray) + img_scale <- test_scale(img, axes(imgarray), output.dim) + dimnames(img_scale) <- vector("list", length(dim(img_scale))) + expect_equal( + realize(imgarray_scale[[1]]), + img_scale + ) + + # check subset + index <- list(x = 100:140, y = 230:240) + imgarray_subset <- crop(imgarray_scale, index = index) + img_subset <- test_subset(img_scale, axes(imgarray), index) + dimnames(img_subset) <- NULL + expect_equal( + realize(imgarray_subset[[1]]), + img_subset + ) + }) + + test_that(paste0("affine transformation for ", ni), { + m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) + imgarray_affine <- affine_transform(imgarray, m = m) + + # check seed + expect_s4_class(imgarray_affine, "ImageArray") + for(i in seq_along(imgarray_affine)){ + expect_s4_class(imgarray_affine[[i]]@seed, "DelayedAffineSeed") + expect_s4_class(imgarray_affine[[i]]@seed, "DelayedUnaryOp") + } + + # check affine + img <- realize(imgarray) + img_affine <- test_affine(img, axes(imgarray), m) + dimnames(img_affine) <- vector("list", length(dim(img_affine))) + expect_equal( + realize(imgarray_affine[[1]]), + img_affine + ) + + # check subset + index <- list(x = 100:140, y = 230:240) + imgarray_subset <- crop(imgarray_affine, index = index) + img_subset <- test_subset(img_affine, axes(imgarray), index) + dimnames(img_subset) <- NULL + expect_equal( + realize(imgarray_subset[[1]]), + img_subset + ) + }) + + test_that(paste0("sequence transformation for ", ni), { + m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) + output.dim <- c(200,300) + shift <- c(100,20) + img <- realize(imgarray) + + # affine + imgarray_affine <- affine_transform(imgarray, m = m) + img_affine <- test_affine(img, axes(imgarray), m) + + # scale + imgarray_scale <- scale_transform(imgarray_affine, output.dim = output.dim) + img_scale <- test_scale(img_affine, axes(imgarray), output.dim = output.dim) + + # check equal + dimnames(img_scale) <- vector("list", length(dim(img_scale))) + expect_equal( + realize(imgarray_scale[[1]]), + img_scale + ) + + # translate + imgarray_trans <- translate_transform(imgarray_scale, shift = shift) + + # check extent + expect_equal( + extent(imgarray_trans), + mapply(\(i,j) i+j, extent(imgarray_scale), shift, SIMPLIFY = FALSE) + ) + }) +} \ No newline at end of file diff --git a/vignettes/ImageArray.Rmd b/vignettes/ImageArray.Rmd index 6acc9b5..1e8616d 100644 --- a/vignettes/ImageArray.Rmd +++ b/vignettes/ImageArray.Rmd @@ -223,7 +223,7 @@ plot(bfa.raster) dim(bfa.raster) ``` -# Delayed Operations +# Image Transformations ```{r delayed} ome.tiff.file <- system.file("extdata", "xy_12bit__plant.ome.tiff", @@ -250,7 +250,7 @@ imgarray2 ## translation -```{r scale} +```{r translation} imgarray_trans <- translate_transform(imgarray2, shift = c(100,20)) ``` @@ -265,7 +265,16 @@ imgarray_scale <- scale_transform(imgarray2, ## affine transformation -```{r scale} +```{r affine} +m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) +imgarray_affine <- affine_transform(imgarray2, + m = m, + filter = "bilinear") +``` + +## sequence transformation + +```{r sequence} m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) imgarray_affine <- affine_transform(imgarray2, m = m, @@ -277,8 +286,6 @@ imgarray_trans <- translate_transform(imgarray_scale, shift = c(100,20)) ``` -## sequence transformation - # Use cases The delayed pyramid scheme introduced by `ImageArray` objects can also From 71811a13929cead1215aa9bfc0d21eda0644f977 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Wed, 27 May 2026 22:45:13 +0200 Subject: [PATCH 3/9] add more tests --- tests/testthat/test-transformations.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-transformations.R b/tests/testthat/test-transformations.R index 4fa215e..2dc7568 100644 --- a/tests/testthat/test-transformations.R +++ b/tests/testthat/test-transformations.R @@ -152,5 +152,15 @@ for(ni in names(img_list)) { extent(imgarray_trans), mapply(\(i,j) i+j, extent(imgarray_scale), shift, SIMPLIFY = FALSE) ) + + # check subset + index <- list(x = 30:47, y = 53:58) + imgarray_subset <- crop(imgarray_trans, index = index) + img_subset <- test_subset(img_scale, axes(imgarray), index) + dimnames(img_subset) <- NULL + expect_equal( + realize(imgarray_subset[[1]]), + img_subset + ) }) } \ No newline at end of file From 7432c2a90613187b87cef1d6a6c58ad94ba32c19 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Thu, 28 May 2026 13:59:25 +0200 Subject: [PATCH 4/9] update roxygen2 --- DESCRIPTION | 3 +- NAMESPACE | 5 ++ R/allgenerics.R | 13 ++-- R/delayed.R | 104 +++++++++++++++++++------- man/ImageArray-methods.Rd | 8 +- man/trans.Rd | 68 +++++++++++++++++ tests/testthat/test-transformations.R | 13 ++-- vignettes/ImageArray.Rmd | 32 ++++---- 8 files changed, 187 insertions(+), 59 deletions(-) create mode 100644 man/trans.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 892ae39..feb8062 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,7 +28,8 @@ Imports: Rarr, ZarrArray, magick, - tools + tools, + BiocGenerics Suggests: testthat (>= 3.0.0), knitr, diff --git a/NAMESPACE b/NAMESPACE index 21568b1..c4bab35 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,10 +12,12 @@ exportMethods("[") exportMethods("[[") exportMethods("[[<-") exportMethods("path<-") +exportMethods(affine) exportMethods(aperm) exportMethods(axes) exportMethods(crop) exportMethods(dim) +exportMethods(extent) exportMethods(flip) exportMethods(flop) exportMethods(length) @@ -25,8 +27,11 @@ exportMethods(negate) exportMethods(path) exportMethods(realize) exportMethods(rotate) +exportMethods(scale) +exportMethods(translation) exportMethods(type) import(DelayedArray) +importFrom(BiocGenerics,scale) importFrom(DelayedArray,DelayedArray) importFrom(DelayedArray,path) importFrom(EBImage,flip) diff --git a/R/allgenerics.R b/R/allgenerics.R index f0c0bd8..d695e24 100644 --- a/R/allgenerics.R +++ b/R/allgenerics.R @@ -1,9 +1,12 @@ +#' @importFrom BiocGenerics scale + # generics of ImageArray setGeneric("crop", function(object, ...) standardGeneric("crop")) setGeneric("negate", function(object, ...) standardGeneric("negate")) setGeneric("modulate", function(object, ...) standardGeneric("modulate")) setGeneric("meta", function(object, ...) standardGeneric("meta")) setGeneric("axes", function(object, ...) standardGeneric("axes")) +setGeneric("extent", \(x, ...) standardGeneric("extent")) # generics from EBImage setGeneric("rotate") @@ -11,11 +14,7 @@ setGeneric("flip") setGeneric("flop") # transformations -setGeneric("scale_transform", - \(x, ...) standardGeneric("scale_transform")) -setGeneric("affine_transform", - \(x, ...) standardGeneric("affine_transform")) -setGeneric("translate_transform", - \(x, ...) standardGeneric("translate_transform")) -setGeneric("rotate_transform", +setGeneric("affine", \(x, ...) standardGeneric("affine")) +setGeneric("translation", \(x, ...) standardGeneric("translation")) +setGeneric("rotate_transform", \(x, ...) standardGeneric("rotate_transform")) \ No newline at end of file diff --git a/R/delayed.R b/R/delayed.R index de371c9..4964758 100644 --- a/R/delayed.R +++ b/R/delayed.R @@ -1,13 +1,29 @@ +#' @name trans +#' @rdname trans +#' @title Transformations +#' @aliases scale translation affine +#' +#' @description +#' Transformation methods for objects of ImageArray class. By default, +#' these operations are delayed thus transformations are only performed +#' when realized into the memory +#' +#' @param x an ImageArray object +#' @inheritParams EBImage::affine +#' @param axes axes +#' @param shift translation shift parameter, a vector of length 2 +#' @param ... arguments passed to other methods +#' +#' @returns an \code{ImageArray} object. +NULL + #### # Classes #### #### -## Delayed affine helpers + constructor -## Assumes these packages are available/loaded: -## library(DelayedArray) -## library(S4Arrays) -## library(EBImage) - +#' @noRd +#' @rdname trans +#' @keywords internal setClass( "DelayedAffineSeed", contains = "DelayedUnaryOp", @@ -23,6 +39,9 @@ setClass( ) ) +#' @noRd +#' @rdname trans +#' @keywords internal setClass( "DelayedTranslateSeed", contains = "DelayedUnaryOp", @@ -35,18 +54,28 @@ setClass( ) ) -setClassUnion("DelayedImageSeed", +setClassUnion("DelayedTransformSeed", c("DelayedAffineSeed", "DelayedTranslateSeed")) -setMethod("dim", "DelayedImageSeed", function(x) { + +#' @noRd +#' @rdname trans +#' @keywords internal +setMethod("dim", "DelayedTransformSeed", function(x) { x@dim }) -setMethod("dimnames", "DelayedImageSeed", function(x) { +#' @noRd +#' @rdname trans +#' @keywords internal +setMethod("dimnames", "DelayedTransformSeed", function(x) { x@dimnames }) -setMethod("type", "DelayedImageSeed", function(x) { +#' @noRd +#' @rdname trans +#' @keywords internal +setMethod("type", "DelayedTransformSeed", function(x) { DelayedArray::type(x@seed) }) @@ -368,18 +397,22 @@ setMethod( # extent #### -setGeneric("extent", \(x, ...) standardGeneric("extent")) - +#' @export +#' @rdname trans setMethod("extent", "ImageArray", function(x){ dims <- c("x", "y") xy <- match(dims, axes(x)) setNames(extent(x[[1]])[xy], dims) }) +#' @keywords internal +#' @noRd setMethod("extent", "DelayedArray", function(x){ extent(x@seed) }) +#' @keywords internal +#' @noRd setMethod("extent", "DelayedAffineSeed", function(x){ ext <- extent(x@seed) xy <- match(c("x", "y"), x@axes) @@ -388,6 +421,8 @@ setMethod("extent", "DelayedAffineSeed", function(x){ ext }) +#' @keywords internal +#' @noRd setMethod("extent", "DelayedTranslateSeed", function(x){ ext <- extent(x@seed) xy <- match(c("x", "y"), x@axes) @@ -397,6 +432,8 @@ setMethod("extent", "DelayedTranslateSeed", function(x){ ext }) +#' @keywords internal +#' @noRd setMethod("extent", "Array", function(x){ lapply(dim(x), \(.){ c(0,.) @@ -433,7 +470,9 @@ setMethod("extent", "Array", function(x){ DelayedArray::DelayedArray(seed) } -setMethod("affine_transform", +#' @export +#' @rdname trans +setMethod("affine", signature = "ImageArray", function(x, m, @@ -445,7 +484,7 @@ setMethod("affine_transform", for (i in seq_along(x@levels)) { scl <- rep(2^(i - 1), 2) m <- solve(diag(c(scl, 1))) %*% m %*% diag(scl) - x[[i]] <- affine_transform( + x[[i]] <- affine( x[[i]], m = m, axes = ax, @@ -457,7 +496,9 @@ setMethod("affine_transform", x }) -setMethod("affine_transform", signature = "DelayedArray", .affine_transform) +#' @keywords internal +#' @noRd +setMethod("affine", signature = "DelayedArray", .affine_transform) .scale_transform <- function(x, output.dim = NULL, @@ -465,7 +506,8 @@ setMethod("affine_transform", signature = "DelayedArray", .affine_transform) axes = NULL, filter = c("bilinear", "none"), bg.col = "black", - antialias = TRUE) { + antialias = TRUE, + ...) { if (length(output.origin) != 2L || !is.numeric(output.origin)) stop("'output.origin' must be a numeric vector of length 2") xy <- match(c("x", "y"), axes) @@ -481,7 +523,9 @@ setMethod("affine_transform", signature = "DelayedArray", .affine_transform) antialias = antialias) } -setMethod("scale_transform", +#' @export +#' @rdname trans +setMethod("scale", signature = "ImageArray", function(x, output.dim = NULL, @@ -489,24 +533,28 @@ setMethod("scale_transform", axes = NULL, filter = c("bilinear", "none"), bg.col = "black", - antialias = TRUE) { + antialias = TRUE, + ...) { ax <- axes(x) for (i in seq_along(x@levels)) { cur_output.dim <- output.dim / 2^(i - 1) - x[[i]] <- scale_transform( + x[[i]] <- scale( x[[i]], output.dim = cur_output.dim, output.origin = output.origin, axes = ax, filter = filter, bg.col = bg.col, - antialias = antialias + antialias = antialias, + ... ) } x }) -setMethod("scale_transform", signature = "DelayedArray", .scale_transform) +#' @keywords internal +#' @noRd +setMethod("scale", signature = "DelayedArray", .scale_transform) .rotate_transform <- function(x, angle, @@ -546,7 +594,7 @@ setMethod("scale_transform", signature = "DelayedArray", .scale_transform) } m <- matrix(c(cos, -sin, offset[1], sin, cos, offset[2]), 3L, 2L) - affine_transform(x, + affine(x, m, axes = axes, filter = filter, @@ -554,6 +602,8 @@ setMethod("scale_transform", signature = "DelayedArray", .scale_transform) antialias = antialias) } +#' @keywords internal +#' @noRd setMethod("rotate_transform", signature = "DelayedArray", .rotate_transform) .translate_transform <- function(x, @@ -578,14 +628,16 @@ setMethod("rotate_transform", signature = "DelayedArray", .rotate_transform) DelayedArray::DelayedArray(seed) } -setMethod("translate_transform", +#' @export +#' @rdname trans +setMethod("translation", signature = "ImageArray", function(x, shift = c(0,0), axes = NULL) { ax <- axes(x) for (i in seq_along(x@levels)) { - x[[i]] <- translate_transform( + x[[i]] <- translation( x[[i]], shift = shift, axes = ax @@ -594,4 +646,6 @@ setMethod("translate_transform", x }) -setMethod("translate_transform", signature = "DelayedArray", .translate_transform) \ No newline at end of file +#' @keywords internal +#' @noRd +setMethod("translation", signature = "DelayedArray", .translate_transform) \ No newline at end of file diff --git a/man/ImageArray-methods.Rd b/man/ImageArray-methods.Rd index 8fa2fae..14812da 100644 --- a/man/ImageArray-methods.Rd +++ b/man/ImageArray-methods.Rd @@ -28,6 +28,8 @@ \alias{path} \alias{path,ImageArray-method} \alias{[,ImageArray,ANY,ANY,ANY-method} +\alias{[[,ImageArray,numeric,ANY-method} +\alias{[[<-,ImageArray,numeric,ANY,ANY-method} \alias{dim,ImageArray-method} \alias{type,ImageArray-method} \alias{length,ImageArray-method} @@ -39,9 +41,9 @@ \usage{ \S4method{[}{ImageArray,ANY,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[[}{ImageArray,numeric}(x, i) +\S4method{[[}{ImageArray,numeric,ANY}(x, i) -\S4method{[[}{ImageArray,numeric}(x, i, j, ...) <- value +\S4method{[[}{ImageArray,numeric,ANY,ANY}(x, i, j, ...) <- value \S4method{dim}{ImageArray}(x) @@ -134,7 +136,7 @@ for \code{ImageArray} objects \item \code{x[[i}: Layer access for \code{ImageArray} objects -\item \code{`[[`(x = ImageArray, i = numeric) <- value}: Layer access +\item \code{`[[`(x = ImageArray, i = numeric, j = ANY) <- value}: Layer access for \code{ImageArray} objects \item \code{dim(ImageArray)}: dimensions of an ImageArray diff --git a/man/trans.Rd b/man/trans.Rd new file mode 100644 index 0000000..c52e7af --- /dev/null +++ b/man/trans.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delayed.R +\name{trans} +\alias{trans} +\alias{scale} +\alias{translation} +\alias{affine} +\alias{extent,ImageArray-method} +\alias{affine,ImageArray-method} +\alias{scale,ImageArray-method} +\alias{translation,ImageArray-method} +\title{Transformations} +\usage{ +\S4method{extent}{ImageArray}(x) + +\S4method{affine}{ImageArray}( + x, + m, + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE +) + +\S4method{scale}{ImageArray}( + x, + output.dim = NULL, + output.origin = c(0, 0), + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE, + ... +) + +\S4method{translation}{ImageArray}(x, shift = c(0, 0), axes = NULL) +} +\arguments{ +\item{x}{an ImageArray object} + +\item{m}{A 3x2 matrix describing the affine transformation. See Details.} + +\item{axes}{axes} + +\item{filter}{A character string indicating the interpolating sampling filter. + Valid values are 'none' or 'bilinear'. See Details.} + +\item{bg.col}{Color used to fill the background pixels, defaults to "black". In the case of multi-frame images the value is recycled, and individual background for each frame can be specified by providing a vector.} + +\item{antialias}{If \code{TRUE}, perform bilinear sampling at image edges using \code{bg.col}.} + +\item{output.dim}{A vector of 2 numbers indicating the dimension of the output image. + For \code{affine} and \code{translate} the default is \code{dim(x)}, for \code{resize} it equals \code{c(w, h)}, and for \code{rotate} it defaults to the bounding box size of the rotated image.} + +\item{output.origin}{A vector of 2 numbers indicating the output coordinates of the origin in pixels.} + +\item{...}{arguments passed to other methods} + +\item{shift}{translation shift parameter, a vector of length 2} +} +\value{ +an \code{ImageArray} object. +} +\description{ +Transformation methods for objects of ImageArray class. By default, +these operations are delayed thus transformations are only performed +when realized into the memory +} diff --git a/tests/testthat/test-transformations.R b/tests/testthat/test-transformations.R index 2dc7568..409d12b 100644 --- a/tests/testthat/test-transformations.R +++ b/tests/testthat/test-transformations.R @@ -34,8 +34,7 @@ for(ni in names(img_list)) { test_that(paste0("translation transformation for ", ni), { shift <- c(100,20) - imgarray_trans <- translate_transform(imgarray, - shift = shift) + imgarray_trans <- translation(imgarray, shift = shift) # check seed expect_s4_class(imgarray_trans, "ImageArray") @@ -53,7 +52,7 @@ for(ni in names(img_list)) { test_that(paste0("scaling transformation for ", ni), { output.dim <- c(200,300) - imgarray_scale <- scale_transform(imgarray, output.dim = output.dim) + imgarray_scale <- scale(imgarray, output.dim = output.dim) # check seed expect_s4_class(imgarray_scale, "ImageArray") @@ -94,7 +93,7 @@ for(ni in names(img_list)) { test_that(paste0("affine transformation for ", ni), { m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) - imgarray_affine <- affine_transform(imgarray, m = m) + imgarray_affine <- affine(imgarray, m = m) # check seed expect_s4_class(imgarray_affine, "ImageArray") @@ -130,11 +129,11 @@ for(ni in names(img_list)) { img <- realize(imgarray) # affine - imgarray_affine <- affine_transform(imgarray, m = m) + imgarray_affine <- affine(imgarray, m = m) img_affine <- test_affine(img, axes(imgarray), m) # scale - imgarray_scale <- scale_transform(imgarray_affine, output.dim = output.dim) + imgarray_scale <- scale(imgarray_affine, output.dim = output.dim) img_scale <- test_scale(img_affine, axes(imgarray), output.dim = output.dim) # check equal @@ -145,7 +144,7 @@ for(ni in names(img_list)) { ) # translate - imgarray_trans <- translate_transform(imgarray_scale, shift = shift) + imgarray_trans <- translation(imgarray_scale, shift = shift) # check extent expect_equal( diff --git a/vignettes/ImageArray.Rmd b/vignettes/ImageArray.Rmd index 1e8616d..6b317bb 100644 --- a/vignettes/ImageArray.Rmd +++ b/vignettes/ImageArray.Rmd @@ -251,39 +251,39 @@ imgarray2 ## translation ```{r translation} -imgarray_trans <- translate_transform(imgarray2, - shift = c(100,20)) +imgarray_trans <- translation(imgarray2, + shift = c(100,20)) ``` ## scale transformation ```{r scale} -imgarray_scale <- scale_transform(imgarray2, - output.dim = c(200,300), - filter = "bilinear") +imgarray_scale <- scale(imgarray2, + output.dim = c(200,300), + filter = "bilinear") ``` ## affine transformation ```{r affine} m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) -imgarray_affine <- affine_transform(imgarray2, - m = m, - filter = "bilinear") +imgarray_affine <- affine(imgarray2, + m = m, + filter = "bilinear") ``` ## sequence transformation ```{r sequence} m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) -imgarray_affine <- affine_transform(imgarray2, - m = m, - filter = "bilinear") -imgarray_scale <- scale_transform(imgarray_affine, - output.dim = c(200,300), - filter = "bilinear") -imgarray_trans <- translate_transform(imgarray_scale, - shift = c(100,20)) +imgarray_affine <- affine(imgarray2, + m = m, + filter = "bilinear") +imgarray_scale <- scale(imgarray_affine, + output.dim = c(200,300), + filter = "bilinear") +imgarray_trans <- translation(imgarray_scale, + shift = c(100,20)) ``` # Use cases From 22e34e801b279509c12ade389975e90e2ef5f3b2 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Fri, 29 May 2026 23:16:11 +0200 Subject: [PATCH 5/9] update lazy rotate --- R/ImageArray.R | 18 +-- R/manipulation.R | 71 ---------- R/{delayed.R => transformations.R} | 174 ++++++++++++++++++------ man/ImageArray-methods.Rd | 39 ++---- man/trans.Rd | 44 +++++- tests/testthat/helper-transformations.R | 12 ++ tests/testthat/test-transformations.R | 42 ++++++ vignettes/ImageArray.Rmd | 8 ++ 8 files changed, 251 insertions(+), 157 deletions(-) rename R/{delayed.R => transformations.R} (80%) diff --git a/R/ImageArray.R b/R/ImageArray.R index 7659ac6..602aaff 100644 --- a/R/ImageArray.R +++ b/R/ImageArray.R @@ -14,7 +14,6 @@ #' } #' } #' @param drop ignored -#' @param angle value between 0 and 360 for degrees to rotate #' @param brightness the brightness of the new image in percentage, e.g. 120 #' @param perm perm #' @param index a named or unnamed list of indices for cropping/subsetting the @@ -30,14 +29,8 @@ #' @aliases #' [[,ImageArray,numeric-method #' [[<-,ImageArray,numeric-method -#' rotate -#' rotate,ImageArray-method #' crop #' crop,ImageArray-method -#' flip -#' flip,ImageArray-method -#' flop -#' flop,ImageArray-method #' negate #' negate,ImageArray-method #' modulate @@ -52,6 +45,8 @@ #' as.raster,ImageArray-method #' path #' path,ImageArray-method +#' extent +#' extent,ImageArray-method #' #' @examples #' # get image @@ -89,6 +84,9 @@ #' #' # realize #' imgarray <- realize(imgarray) +#' +#' # extent +#' extent(imgarray) NULL #' @describeIn ImageArray-methods subset and crop @@ -99,12 +97,6 @@ setMethod( f = "[", signature = c("ImageArray"), function(x, i, j, ..., drop = FALSE) { - if (missing(x)) { - stop("'x' is missing") - } - if (!.isTRUEorFALSE(drop)) { - stop("'drop' must be TRUE or FALSE") - } Nindex <- S4Arrays:::extract_Nindex_from_syscall(sys.call(), parent.frame()) crop(x, index = Nindex) } diff --git a/R/manipulation.R b/R/manipulation.R index f9e1456..e507ada 100644 --- a/R/manipulation.R +++ b/R/manipulation.R @@ -1,43 +1,3 @@ -#' @importFrom EBImage rotate flip flop -NULL - -#' @describeIn ImageArray-methods rotate image array to 90, 180, 270 degrees -#' @export -setMethod("rotate", signature = "ImageArray", function(x, angle) { - # validate rotation - if (!angle %in% c(0, 90, 180, 270, 360)) { - stop("Only rotations of 0,90,180,270,360 degrees are supported!") - } - - # check dimensions - .check_dim(x) - dim_img <- dim(x[[1]]) - ax <- axes(x) - - # array perm. - if (angle %in% c(90, 270)) { - cur_perm <- .swap( - seq_along(dim_img), - which(ax == "x"), - which(ax == "y") - ) - x <- aperm(x, perm = cur_perm) - } - - # flop - if (angle %in% c(90, 180)) { - x <- flop(x) - } - - # flip - if (angle %in% c(180, 270)) { - x <- flip(x) - } - - # return - x -}) - #' @describeIn ImageArray-methods permute image #' @exportMethod aperm setMethod("aperm", signature = "ImageArray", function(a, perm) { @@ -74,37 +34,6 @@ setMethod("modulate", signature = "ImageArray", function(object, brightness) { object }) -#' @importFrom stats setNames -#' @noRd -.flipflop <- function(object, direction = "x") { - ax <- axes(object) - - # check dim - .check_dim(object) - - # flip all - for (i in seq_along(object@levels)) { - img <- object[[i]] - dim_img <- stats::setNames(dim(img), ax) - cur_ind <- stats::setNames(lapply(dim_img, seq_len), ax) - cur_ind[[direction]] <- rev(cur_ind[[direction]]) - object[[i]] <- .subset_array(object[[i]], cur_ind, drop = FALSE) - } - object -} - -#' @describeIn ImageArray-methods vertical flipping image -#' @export -setMethod("flip", signature = "ImageArray", function(x) { - .flipflop(x, direction = "y") -}) - -#' @describeIn ImageArray-methods horizontal flipping image -#' @export -setMethod("flop", signature = "ImageArray", function(x) { - .flipflop(x, direction = "x") -}) - #' @describeIn ImageArray-methods cropping image #' @importFrom utils head tail #' @importFrom stats setNames diff --git a/R/delayed.R b/R/transformations.R similarity index 80% rename from R/delayed.R rename to R/transformations.R index 4964758..aa12a7d 100644 --- a/R/delayed.R +++ b/R/transformations.R @@ -1,3 +1,6 @@ +#' @importFrom EBImage rotate flip flop +NULL + #' @name trans #' @rdname trans #' @title Transformations @@ -9,7 +12,8 @@ #' when realized into the memory #' #' @param x an ImageArray object -#' @inheritParams EBImage::affine +#' @inheritParams EBImage::affine +#' @inheritParams EBImage::rotate #' @param axes axes #' @param shift translation shift parameter, a vector of length 2 #' @param ... arguments passed to other methods @@ -282,26 +286,33 @@ setMethod("type", "DelayedTransformSeed", function(x) { y = c(bboxmin[2], bboxmax[2])) } -.get_bbox_from_extent <- function(ext,m){ +.get_bbox_from_extent <- function(ext,m, adjust = TRUE){ px <- as.matrix(expand.grid(ext[[1]], ext[[2]])) - transformed <- sweep(px %*% m[seq_len(2),], 2L, m[3,], "+") + transformed <- px %*% m[seq_len(2),] + if(adjust) transformed <- sweep(transformed, 2L, m[3,], "+") bbox.min <- apply(transformed, 2L, min) bbox.max <- apply(transformed, 2L, max) list(min = bbox.min, max = bbox.max) } -.adjust_affine_matrix <- function(dim, axes, m){ +.adjust_affine_matrix <- function(dim, axes, m, output.dim = NULL){ dim <- setNames(dim, axes) bbox <- .get_bbox_from_extent( list(x = c(0,dim[["x"]]), y = c(0,dim[["y"]])), m = m) m[3, ] <- m[3,] - bbox$min newdim <- bbox$max - bbox$min - dim[c("x", "y")] <- newdim + if(!is.null(output.dim)) newdim <- output.dim + dim[c("x", "y")] <- as.integer(round(newdim)) names(dim) <- NULL list(m=m, output.dim=dim) } +.check_outputdim <- function(output.dim){ + if (length(output.dim) != 2L || !is.numeric(output.dim)) + stop("'output.dim' must be a numeric vector of length 2") +} + # extract_array #### setMethod( @@ -398,7 +409,7 @@ setMethod( # extent #### #' @export -#' @rdname trans +#' @describeIn ImageArray-methods extent setMethod("extent", "ImageArray", function(x){ dims <- c("x", "y") xy <- match(dims, axes(x)) @@ -416,7 +427,7 @@ setMethod("extent", "DelayedArray", function(x){ setMethod("extent", "DelayedAffineSeed", function(x){ ext <- extent(x@seed) xy <- match(c("x", "y"), x@axes) - bbox <- .get_bbox_from_extent(ext[xy], x@m) + bbox <- .get_bbox_from_extent(ext[xy], x@m, adjust = FALSE) ext[xy] <- .get_extent_from_box(bbox$min, bbox$max) ext }) @@ -445,12 +456,13 @@ setMethod("extent", "Array", function(x){ .affine_transform <- function(x, m, axes = NULL, + output.dim = NULL, filter = c("bilinear", "none"), bg.col = "black", antialias = TRUE) { filter <- match.arg(filter) - adj <- .adjust_affine_matrix(dim(x), axes, m) + adj <- .adjust_affine_matrix(dim(x), axes, m, output.dim) output.dim <- as.integer(adj$output.dim) m <- adj$m dn <- vector("list", length(output.dim)) @@ -471,23 +483,31 @@ setMethod("extent", "Array", function(x){ } #' @export -#' @rdname trans +#' @describeIn trans affine transformation setMethod("affine", signature = "ImageArray", function(x, m, axes = NULL, + output.dim, filter = c("bilinear", "none"), bg.col = "black", antialias = TRUE) { ax <- axes(x) + .check_outputdim(output.dim) for (i in seq_along(x@levels)) { scl <- rep(2^(i - 1), 2) m <- solve(diag(c(scl, 1))) %*% m %*% diag(scl) + if(!missing(output.dim)){ + cur_output.dim <- output.dim / 2^(i - 1) + } else { + cur_output.dim <- NULL + } x[[i]] <- affine( x[[i]], m = m, axes = ax, + output.dim = cur_output.dim, filter = filter, bg.col = bg.col, antialias = antialias @@ -524,7 +544,7 @@ setMethod("affine", signature = "DelayedArray", .affine_transform) } #' @export -#' @rdname trans +#' @describeIn trans scale transformation setMethod("scale", signature = "ImageArray", function(x, @@ -536,6 +556,7 @@ setMethod("scale", antialias = TRUE, ...) { ax <- axes(x) + .check_outputdim(output.dim) for (i in seq_along(x@levels)) { cur_output.dim <- output.dim / 2^(i - 1) x[[i]] <- scale( @@ -558,17 +579,10 @@ setMethod("scale", signature = "DelayedArray", .scale_transform) .rotate_transform <- function(x, angle, - output.dim = NULL, - output.origin = c(0,0), axes = NULL, filter = c("bilinear", "none"), bg.col = "black", antialias = TRUE) { - if (length(angle) != 1L || !is.numeric(angle)) - stop("'angle' must be a number") - if (!missing(output.dim)) - if (length(output.dim) != 2L || !is.numeric(output.dim)) - stop("'output.dim' must be a numeric vector of length 2") if ((angle%%90) == 0) filter <- "none" angle <- angle * pi/180 @@ -576,30 +590,19 @@ setMethod("scale", signature = "DelayedArray", .scale_transform) d <- dim(x)[xy] cos <- cos(angle) sin <- sin(angle) - if (missing(output.origin)) { - newdim <- c(d[1] * abs(cos) + d[2] * abs(sin), d[1] * abs(sin) + - d[2] * abs(cos)) - offset <- c(d[1] * max(0, -cos) + d[2] * max(0, sin), d[1] * - max(0, -sin) + d[2] * max(0, -cos)) - if (missing(output.dim)) - output.dim <- newdim - else offset <- offset + (output.dim - newdim)/2 - } - else { - if (length(output.origin) != 2L || !is.numeric(output.origin)) - stop("'output.origin' must be a numeric vector of length 2") - offset <- c(output.origin[1L] * (1 - cos) + output.origin[2L] * - sin, output.origin[2L] * (1 - cos) - output.origin[1L] * - sin) - } + output.dim = c(d[1] * abs(cos) + d[2] * abs(sin), d[1] * abs(sin) + + d[2] * abs(cos)) + offset = c(d[1] * max(0, -cos) + d[2] * max(0, sin), d[1] * + max(0, -sin) + d[2] * max(0, -cos)) m <- matrix(c(cos, -sin, offset[1], sin, cos, offset[2]), 3L, 2L) affine(x, - m, - axes = axes, - filter = filter, - bg.col = bg.col, - antialias = antialias) + m, + axes = axes, + output.dim = output.dim, + filter = filter, + bg.col = bg.col, + antialias = antialias) } #' @keywords internal @@ -629,7 +632,7 @@ setMethod("rotate_transform", signature = "DelayedArray", .rotate_transform) } #' @export -#' @rdname trans +#' @describeIn trans translation transformation setMethod("translation", signature = "ImageArray", function(x, @@ -648,4 +651,95 @@ setMethod("translation", #' @keywords internal #' @noRd -setMethod("translation", signature = "DelayedArray", .translate_transform) \ No newline at end of file +setMethod("translation", signature = "DelayedArray", .translate_transform) + +# other transformations #### + +#' @describeIn trans rotation transformation +#' @export +setMethod("rotate", + signature = "ImageArray", + function(x, + angle, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + + # check angle + if (length(angle) != 1L || !is.numeric(angle)) + stop("'angle' must be a numeric") + + # this negates if angle is negative + angle <- angle %% 360 + + # validate rotation + if (!angle %in% c(0, 90, 180, 270, 360)) { + return( + .rotate_transform(x, + angle = angle, + axes = axes(x), + filter = filter, + bg.col = bg.col, + antialias = antialias) + ) + } + + # check dimensions + .check_dim(x) + dim_img <- dim(x[[1]]) + ax <- axes(x) + + # array perm. + if (angle %in% c(90, 270)) { + cur_perm <- .swap( + seq_along(dim_img), + which(ax == "x"), + which(ax == "y") + ) + x <- aperm(x, perm = cur_perm) + } + + # flop + if (angle %in% c(90, 180)) { + x <- flop(x) + } + + # flip + if (angle %in% c(180, 270)) { + x <- flip(x) + } + + # return + x +}) + +#' @importFrom stats setNames +#' @noRd +.flipflop <- function(object, direction = "x") { + ax <- axes(object) + + # check dim + .check_dim(object) + + # flip all + for (i in seq_along(object@levels)) { + img <- object[[i]] + dim_img <- stats::setNames(dim(img), ax) + cur_ind <- stats::setNames(lapply(dim_img, seq_len), ax) + cur_ind[[direction]] <- rev(cur_ind[[direction]]) + object[[i]] <- .subset_array(object[[i]], cur_ind, drop = FALSE) + } + object +} + +#' @describeIn trans vertical flipping +#' @export +setMethod("flip", signature = "ImageArray", function(x) { + .flipflop(x, direction = "y") +}) + +#' @describeIn trans horizontal flipping +#' @export +setMethod("flop", signature = "ImageArray", function(x) { + .flipflop(x, direction = "x") +}) \ No newline at end of file diff --git a/man/ImageArray-methods.Rd b/man/ImageArray-methods.Rd index 14812da..e6b3a1e 100644 --- a/man/ImageArray-methods.Rd +++ b/man/ImageArray-methods.Rd @@ -1,18 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ImageArray.R, R/conversion.R, -% R/manipulation.R, R/utils.R +% R/manipulation.R, R/transformations.R, R/utils.R \name{ImageArray-methods} \alias{ImageArray-methods} \alias{[[,ImageArray,numeric-method} \alias{[[<-,ImageArray,numeric-method} -\alias{rotate} -\alias{rotate,ImageArray-method} \alias{crop} \alias{crop,ImageArray-method} -\alias{flip} -\alias{flip,ImageArray-method} -\alias{flop} -\alias{flop,ImageArray-method} \alias{negate} \alias{negate,ImageArray-method} \alias{modulate} @@ -27,9 +21,9 @@ \alias{as.raster,ImageArray-method} \alias{path} \alias{path,ImageArray-method} +\alias{extent} +\alias{extent,ImageArray-method} \alias{[,ImageArray,ANY,ANY,ANY-method} -\alias{[[,ImageArray,numeric,ANY-method} -\alias{[[<-,ImageArray,numeric,ANY,ANY-method} \alias{dim,ImageArray-method} \alias{type,ImageArray-method} \alias{length,ImageArray-method} @@ -41,9 +35,9 @@ \usage{ \S4method{[}{ImageArray,ANY,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[[}{ImageArray,numeric,ANY}(x, i) +\S4method{[[}{ImageArray,numeric}(x, i) -\S4method{[[}{ImageArray,numeric,ANY,ANY}(x, i, j, ...) <- value +\S4method{[[}{ImageArray,numeric}(x, i, j, ...) <- value \S4method{dim}{ImageArray}(x) @@ -57,24 +51,20 @@ ImageArray(meta, levels) \method{as.raster}{ImageArray}(x, level = NULL, max.pixel.size = NULL, min.pixel.size = NULL, ...) -\S4method{rotate}{ImageArray}(x, angle) - \S4method{aperm}{ImageArray}(a, perm) \S4method{negate}{ImageArray}(object) \S4method{modulate}{ImageArray}(object, brightness) -\S4method{flip}{ImageArray}(x) - -\S4method{flop}{ImageArray}(x) - \S4method{crop}{ImageArray}(object, index) \S4method{axes}{ImageArray}(object) \S4method{meta}{ImageArray}(object) +\S4method{extent}{ImageArray}(x) + \S4method{path}{ImageArray}(object) \S4method{path}{ImageArray}(object) <- value @@ -108,8 +98,6 @@ starting with 1} \item{min.pixel.size}{minimum pixel size} -\item{angle}{value between 0 and 360 for degrees to rotate} - \item{perm}{perm} \item{brightness}{the brightness of the new image in percentage, e.g. 120} @@ -136,7 +124,7 @@ for \code{ImageArray} objects \item \code{x[[i}: Layer access for \code{ImageArray} objects -\item \code{`[[`(x = ImageArray, i = numeric, j = ANY) <- value}: Layer access +\item \code{`[[`(x = ImageArray, i = numeric) <- value}: Layer access for \code{ImageArray} objects \item \code{dim(ImageArray)}: dimensions of an ImageArray @@ -153,24 +141,20 @@ A function for creating objects of ImageArray class \item \code{as.raster(ImageArray)}: create a raster object -\item \code{rotate(ImageArray)}: rotate image array to 90, 180, 270 degrees - \item \code{aperm(ImageArray)}: permute image \item \code{negate(ImageArray)}: negate image \item \code{modulate(ImageArray)}: modulate image -\item \code{flip(ImageArray)}: vertical flipping image - -\item \code{flop(ImageArray)}: horizontal flipping image - \item \code{crop(ImageArray)}: cropping image \item \code{axes(ImageArray)}: get axes metadata of the ImageArray object \item \code{meta(ImageArray)}: get metadata of the ImageArray object +\item \code{extent(ImageArray)}: extent + \item \code{path(ImageArray)}: path of an ImageArray object \item \code{path(ImageArray) <- value}: replace method for path(ImageArray) @@ -212,4 +196,7 @@ imgarray_raster <- as.raster(imgarray) # realize imgarray <- realize(imgarray) + +# extent +extent(imgarray) } diff --git a/man/trans.Rd b/man/trans.Rd index c52e7af..d8814cb 100644 --- a/man/trans.Rd +++ b/man/trans.Rd @@ -1,22 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/delayed.R +% Please edit documentation in R/transformations.R \name{trans} \alias{trans} \alias{scale} \alias{translation} \alias{affine} -\alias{extent,ImageArray-method} \alias{affine,ImageArray-method} \alias{scale,ImageArray-method} \alias{translation,ImageArray-method} +\alias{rotate,ImageArray-method} +\alias{flip,ImageArray-method} +\alias{flop,ImageArray-method} \title{Transformations} \usage{ -\S4method{extent}{ImageArray}(x) - \S4method{affine}{ImageArray}( x, m, axes = NULL, + output.dim, filter = c("bilinear", "none"), bg.col = "black", antialias = TRUE @@ -34,6 +35,18 @@ ) \S4method{translation}{ImageArray}(x, shift = c(0, 0), axes = NULL) + +\S4method{rotate}{ImageArray}( + x, + angle, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE +) + +\S4method{flip}{ImageArray}(x) + +\S4method{flop}{ImageArray}(x) } \arguments{ \item{x}{an ImageArray object} @@ -42,6 +55,9 @@ \item{axes}{axes} +\item{output.dim}{A vector of 2 numbers indicating the dimension of the output image. + For \code{affine} and \code{translate} the default is \code{dim(x)}, for \code{resize} it equals \code{c(w, h)}, and for \code{rotate} it defaults to the bounding box size of the rotated image.} + \item{filter}{A character string indicating the interpolating sampling filter. Valid values are 'none' or 'bilinear'. See Details.} @@ -49,14 +65,13 @@ \item{antialias}{If \code{TRUE}, perform bilinear sampling at image edges using \code{bg.col}.} -\item{output.dim}{A vector of 2 numbers indicating the dimension of the output image. - For \code{affine} and \code{translate} the default is \code{dim(x)}, for \code{resize} it equals \code{c(w, h)}, and for \code{rotate} it defaults to the bounding box size of the rotated image.} - \item{output.origin}{A vector of 2 numbers indicating the output coordinates of the origin in pixels.} \item{...}{arguments passed to other methods} \item{shift}{translation shift parameter, a vector of length 2} + +\item{angle}{A numeric specifying the image rotation angle in degrees.} } \value{ an \code{ImageArray} object. @@ -66,3 +81,18 @@ Transformation methods for objects of ImageArray class. By default, these operations are delayed thus transformations are only performed when realized into the memory } +\section{Functions}{ +\itemize{ +\item \code{affine(ImageArray)}: affine transformation + +\item \code{scale(ImageArray)}: scale transformation + +\item \code{translation(ImageArray)}: translation transformation + +\item \code{rotate(ImageArray)}: rotation transformation + +\item \code{flip(ImageArray)}: vertical flipping + +\item \code{flop(ImageArray)}: horizontal flipping + +}} diff --git a/tests/testthat/helper-transformations.R b/tests/testthat/helper-transformations.R index f5071dd..153673b 100644 --- a/tests/testthat/helper-transformations.R +++ b/tests/testthat/helper-transformations.R @@ -11,6 +11,18 @@ test_affine <- function(img, axes, m){ aperm(img_affine, perm = order(ap)) } +# test affine +test_rotate <- function(img, axes, angle){ + actual_dim <- dim(img) + xy <- match(c("x", "y"), axes) + ap <- c(xy, setdiff(seq_along(actual_dim), xy)) + img <- aperm(img, perm = ap) + img <- EBImage::Image(img) + img_rotate <- EBImage::rotate(EBImage::Image(img), angle = angle) + img_rotate <- EBImage::imageData(img_rotate) + aperm(img_rotate, perm = order(ap)) +} + # test scale test_scale <- function(img, axes, output.dim){ actual_dim <- dim(img) diff --git a/tests/testthat/test-transformations.R b/tests/testthat/test-transformations.R index 409d12b..c8fff65 100644 --- a/tests/testthat/test-transformations.R +++ b/tests/testthat/test-transformations.R @@ -122,6 +122,48 @@ for(ni in names(img_list)) { ) }) + # test a lot of angles + basic_angles <- c(90, 180, 270) + for(angle in c(seq(2, 360, 20), basic_angles)){ + + # test a lot of angles + test_that(paste0("rotate (", angle, " degrees) transformation for ", ni), { + + # TODO: tiff rotation is ill-defined for 90, 180, 270 + skip_if(ni == "tiff", message = "90, 180, 270 angles wont work for tiff") + + imgarray_rotate <- ImageArray::rotate(imgarray, angle = angle) + + # check seed + expect_s4_class(imgarray_rotate, "ImageArray") + for(i in seq_along(imgarray_rotate)){ + if(!angle %in% basic_angles) + expect_s4_class(imgarray_rotate[[i]]@seed, "DelayedAffineSeed") + expect_s4_class(imgarray_rotate[[i]]@seed, "DelayedUnaryOp") + } + + # check affine + img <- realize(imgarray) + img_rotate <- test_rotate(img, axes(imgarray), angle) + if(!angle %in% basic_angles) + dimnames(img_rotate) <- vector("list", length(dim(img_rotate))) + expect_equal( + realize(imgarray_rotate[[1]]), + img_rotate + ) + + # check subset + index <- list(x = 100:140, y = 230:240) + imgarray_subset <- crop(imgarray_rotate, index = index) + img_subset <- test_subset(img_rotate, axes(imgarray), index) + dimnames(img_subset) <- NULL + expect_equal( + realize(imgarray_subset[[1]]), + img_subset + ) + }) + } + test_that(paste0("sequence transformation for ", ni), { m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) output.dim <- c(200,300) diff --git a/vignettes/ImageArray.Rmd b/vignettes/ImageArray.Rmd index 6b317bb..505870e 100644 --- a/vignettes/ImageArray.Rmd +++ b/vignettes/ImageArray.Rmd @@ -286,6 +286,14 @@ imgarray_trans <- translation(imgarray_scale, shift = c(100,20)) ``` +## rotate transformation + +```{r sequence} +imgarray_rotate <- rotate(imgarray, + angle = 45, + filter = "bilinear") +``` + # Use cases The delayed pyramid scheme introduced by `ImageArray` objects can also From 4220195f0d35a323bf3820c0eb7b3dca96d2e10d Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 30 May 2026 10:18:06 +0200 Subject: [PATCH 6/9] define extent for array and matrix --- R/transformations.R | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/R/transformations.R b/R/transformations.R index aa12a7d..e0ae53b 100644 --- a/R/transformations.R +++ b/R/transformations.R @@ -443,13 +443,23 @@ setMethod("extent", "DelayedTranslateSeed", function(x){ ext }) -#' @keywords internal -#' @noRd -setMethod("extent", "Array", function(x){ +.extent_array <- function(x) { lapply(dim(x), \(.){ c(0,.) }) -}) +} + +#' @keywords internal +#' @noRd +setMethod("extent", "Array", .extent_array) + +#' @keywords internal +#' @noRd +setMethod("extent", "array", .extent_array) + +#' @keywords internal +#' @noRd +setMethod("extent", "matrix", .extent_array) # lazy transformations #### From 915c290116cce2a3715d2e9b7444413660ed36d7 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 30 May 2026 15:30:33 +0200 Subject: [PATCH 7/9] fix some funcs and adjust rotate --- R/transformations.R | 149 +++++++++++++---------------- man/trans.Rd | 16 ++-- tests/testthat/test-manipulation.R | 6 +- vignettes/ImageArray.Rmd | 2 +- 4 files changed, 80 insertions(+), 93 deletions(-) diff --git a/R/transformations.R b/R/transformations.R index e0ae53b..dd30562 100644 --- a/R/transformations.R +++ b/R/transformations.R @@ -309,8 +309,9 @@ setMethod("type", "DelayedTransformSeed", function(x) { } .check_outputdim <- function(output.dim){ - if (length(output.dim) != 2L || !is.numeric(output.dim)) - stop("'output.dim' must be a numeric vector of length 2") + if(!is.null(output.dim)) + if (length(output.dim) != 2L || !is.numeric(output.dim)) + stop("'output.dim' must be a numeric vector of length 2") } # extract_array #### @@ -499,21 +500,21 @@ setMethod("affine", function(x, m, axes = NULL, - output.dim, + output.dim = NULL, filter = c("bilinear", "none"), bg.col = "black", antialias = TRUE) { ax <- axes(x) - .check_outputdim(output.dim) for (i in seq_along(x@levels)) { scl <- rep(2^(i - 1), 2) m <- solve(diag(c(scl, 1))) %*% m %*% diag(scl) - if(!missing(output.dim)){ + if(!is.null(output.dim)){ cur_output.dim <- output.dim / 2^(i - 1) } else { - cur_output.dim <- NULL + cur_output.dim <- output.dim } - x[[i]] <- affine( + .check_outputdim(cur_output.dim) + x[[i]] <- .affine_transform( x[[i]], m = m, axes = ax, @@ -526,10 +527,6 @@ setMethod("affine", x }) -#' @keywords internal -#' @noRd -setMethod("affine", signature = "DelayedArray", .affine_transform) - .scale_transform <- function(x, output.dim = NULL, output.origin = c(0,0), @@ -569,7 +566,7 @@ setMethod("scale", .check_outputdim(output.dim) for (i in seq_along(x@levels)) { cur_output.dim <- output.dim / 2^(i - 1) - x[[i]] <- scale( + x[[i]] <- .scale_transform( x[[i]], output.dim = cur_output.dim, output.origin = output.origin, @@ -583,10 +580,6 @@ setMethod("scale", x }) -#' @keywords internal -#' @noRd -setMethod("scale", signature = "DelayedArray", .scale_transform) - .rotate_transform <- function(x, angle, axes = NULL, @@ -615,9 +608,63 @@ setMethod("scale", signature = "DelayedArray", .scale_transform) antialias = antialias) } -#' @keywords internal -#' @noRd -setMethod("rotate_transform", signature = "DelayedArray", .rotate_transform) +#' @describeIn trans rotation transformation +#' @export +setMethod("rotate", + signature = "ImageArray", + function(x, + angle, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + + # check angle + if (length(angle) != 1L || !is.numeric(angle)) + stop("'angle' must be a numeric") + + # this negates if angle is negative + angle <- angle %% 360 + + # validate rotation + if (!angle %in% c(0, 90, 180, 270, 360)) { + return( + .rotate_transform(x, + angle = angle, + axes = axes(x), + filter = filter, + bg.col = bg.col, + antialias = antialias) + ) + } + + # check dimensions + .check_dim(x) + dim_img <- dim(x[[1]]) + ax <- axes(x) + + # array perm. + if (angle %in% c(90, 270)) { + cur_perm <- .swap( + seq_along(dim_img), + which(ax == "x"), + which(ax == "y") + ) + x <- aperm(x, perm = cur_perm) + } + + # flop + if (angle %in% c(90, 180)) { + x <- flop(x) + } + + # flip + if (angle %in% c(180, 270)) { + x <- flip(x) + } + + # return + x + }) .translate_transform <- function(x, shift = c(0,0), @@ -650,7 +697,7 @@ setMethod("translation", axes = NULL) { ax <- axes(x) for (i in seq_along(x@levels)) { - x[[i]] <- translation( + x[[i]] <- .translate_transform( x[[i]], shift = shift, axes = ax @@ -659,70 +706,8 @@ setMethod("translation", x }) -#' @keywords internal -#' @noRd -setMethod("translation", signature = "DelayedArray", .translate_transform) - # other transformations #### -#' @describeIn trans rotation transformation -#' @export -setMethod("rotate", - signature = "ImageArray", - function(x, - angle, - filter = c("bilinear", "none"), - bg.col = "black", - antialias = TRUE) { - - # check angle - if (length(angle) != 1L || !is.numeric(angle)) - stop("'angle' must be a numeric") - - # this negates if angle is negative - angle <- angle %% 360 - - # validate rotation - if (!angle %in% c(0, 90, 180, 270, 360)) { - return( - .rotate_transform(x, - angle = angle, - axes = axes(x), - filter = filter, - bg.col = bg.col, - antialias = antialias) - ) - } - - # check dimensions - .check_dim(x) - dim_img <- dim(x[[1]]) - ax <- axes(x) - - # array perm. - if (angle %in% c(90, 270)) { - cur_perm <- .swap( - seq_along(dim_img), - which(ax == "x"), - which(ax == "y") - ) - x <- aperm(x, perm = cur_perm) - } - - # flop - if (angle %in% c(90, 180)) { - x <- flop(x) - } - - # flip - if (angle %in% c(180, 270)) { - x <- flip(x) - } - - # return - x -}) - #' @importFrom stats setNames #' @noRd .flipflop <- function(object, direction = "x") { diff --git a/man/trans.Rd b/man/trans.Rd index d8814cb..4758b49 100644 --- a/man/trans.Rd +++ b/man/trans.Rd @@ -7,8 +7,8 @@ \alias{affine} \alias{affine,ImageArray-method} \alias{scale,ImageArray-method} -\alias{translation,ImageArray-method} \alias{rotate,ImageArray-method} +\alias{translation,ImageArray-method} \alias{flip,ImageArray-method} \alias{flop,ImageArray-method} \title{Transformations} @@ -17,7 +17,7 @@ x, m, axes = NULL, - output.dim, + output.dim = NULL, filter = c("bilinear", "none"), bg.col = "black", antialias = TRUE @@ -34,8 +34,6 @@ ... ) -\S4method{translation}{ImageArray}(x, shift = c(0, 0), axes = NULL) - \S4method{rotate}{ImageArray}( x, angle, @@ -44,6 +42,8 @@ antialias = TRUE ) +\S4method{translation}{ImageArray}(x, shift = c(0, 0), axes = NULL) + \S4method{flip}{ImageArray}(x) \S4method{flop}{ImageArray}(x) @@ -69,9 +69,9 @@ \item{...}{arguments passed to other methods} -\item{shift}{translation shift parameter, a vector of length 2} - \item{angle}{A numeric specifying the image rotation angle in degrees.} + +\item{shift}{translation shift parameter, a vector of length 2} } \value{ an \code{ImageArray} object. @@ -87,10 +87,10 @@ when realized into the memory \item \code{scale(ImageArray)}: scale transformation -\item \code{translation(ImageArray)}: translation transformation - \item \code{rotate(ImageArray)}: rotation transformation +\item \code{translation(ImageArray)}: translation transformation + \item \code{flip(ImageArray)}: vertical flipping \item \code{flop(ImageArray)}: horizontal flipping diff --git a/tests/testthat/test-manipulation.R b/tests/testthat/test-manipulation.R index 481af5c..48c013c 100644 --- a/tests/testthat/test-manipulation.R +++ b/tests/testthat/test-manipulation.R @@ -51,7 +51,8 @@ test_that("manipulate h5 ImageArray", { expect_equal(dim(mat_list_rotated), c(3, 5000, 2000)) mat_list_rotated <- rotate(mat_list, angle = 270) expect_equal(dim(mat_list_rotated), c(3, 2000, 5000)) - expect_error(mat_list_rotated <- rotate(mat_list, angle = 20)) + # TODO: angles like 20 now is acceptable + # expect_error(mat_list_rotated <- rotate(mat_list, angle = 20)) # flip flop mat_list_flipflop <- flip(mat_list) @@ -126,7 +127,8 @@ test_that("manipulate zarr ImageArray", { expect_equal(dim(mat_list_rotated), c(3, 5000, 2000)) mat_list_rotated <- rotate(mat_list, angle = 270) expect_equal(dim(mat_list_rotated), c(3, 2000, 5000)) - expect_error(mat_list_rotated <- rotate(mat_list, angle = 20)) + # TODO: this is not acceptable + # expect_error(mat_list_rotated <- rotate(mat_list, angle = 20)) # flip flop mat_list_flipflop <- flip(mat_list) diff --git a/vignettes/ImageArray.Rmd b/vignettes/ImageArray.Rmd index c01ad89..6860bdf 100644 --- a/vignettes/ImageArray.Rmd +++ b/vignettes/ImageArray.Rmd @@ -304,7 +304,7 @@ imgarray_trans <- translation(imgarray_scale, ## rotate transformation -```{r sequence} +```{r rotate_lazy} imgarray_rotate <- rotate(imgarray, angle = 45, filter = "bilinear") From a039becbec664021d52aaacbab97b58008e6e3aa Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 30 May 2026 15:55:25 +0200 Subject: [PATCH 8/9] replace rotate method with affine approach --- R/transformations.R | 132 +++++++++----------------- man/trans.Rd | 26 ++--- tests/testthat/test-manipulation.R | 20 ---- tests/testthat/test-transformations.R | 19 ++-- 4 files changed, 69 insertions(+), 128 deletions(-) diff --git a/R/transformations.R b/R/transformations.R index dd30562..bbf56ec 100644 --- a/R/transformations.R +++ b/R/transformations.R @@ -527,6 +527,52 @@ setMethod("affine", x }) + +.rotate_transform <- function(x, + angle, + axes = NULL, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + if ((angle%%90) == 0) + filter <- "none" + angle <- angle * pi/180 + xy <- match(c("x", "y"), axes) + d <- dim(x)[xy] + cos <- cos(angle) + sin <- sin(angle) + output.dim = c(d[1] * abs(cos) + d[2] * abs(sin), d[1] * abs(sin) + + d[2] * abs(cos)) + offset = c(d[1] * max(0, -cos) + d[2] * max(0, sin), d[1] * + max(0, -sin) + d[2] * max(0, -cos)) + m <- matrix(c(cos, -sin, offset[1], sin, cos, offset[2]), + 3L, 2L) + affine(x, + m, + axes = axes, + output.dim = output.dim, + filter = filter, + bg.col = bg.col, + antialias = antialias) +} + +#' @describeIn trans rotation transformation +#' @export +setMethod("rotate", + signature = "ImageArray", + function(x, + angle, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE) { + .rotate_transform(x, + angle = angle, + axes = axes(x), + filter = filter, + bg.col = bg.col, + antialias = antialias) + }) + .scale_transform <- function(x, output.dim = NULL, output.origin = c(0,0), @@ -580,92 +626,6 @@ setMethod("scale", x }) -.rotate_transform <- function(x, - angle, - axes = NULL, - filter = c("bilinear", "none"), - bg.col = "black", - antialias = TRUE) { - if ((angle%%90) == 0) - filter <- "none" - angle <- angle * pi/180 - xy <- match(c("x", "y"), axes) - d <- dim(x)[xy] - cos <- cos(angle) - sin <- sin(angle) - output.dim = c(d[1] * abs(cos) + d[2] * abs(sin), d[1] * abs(sin) + - d[2] * abs(cos)) - offset = c(d[1] * max(0, -cos) + d[2] * max(0, sin), d[1] * - max(0, -sin) + d[2] * max(0, -cos)) - m <- matrix(c(cos, -sin, offset[1], sin, cos, offset[2]), - 3L, 2L) - affine(x, - m, - axes = axes, - output.dim = output.dim, - filter = filter, - bg.col = bg.col, - antialias = antialias) -} - -#' @describeIn trans rotation transformation -#' @export -setMethod("rotate", - signature = "ImageArray", - function(x, - angle, - filter = c("bilinear", "none"), - bg.col = "black", - antialias = TRUE) { - - # check angle - if (length(angle) != 1L || !is.numeric(angle)) - stop("'angle' must be a numeric") - - # this negates if angle is negative - angle <- angle %% 360 - - # validate rotation - if (!angle %in% c(0, 90, 180, 270, 360)) { - return( - .rotate_transform(x, - angle = angle, - axes = axes(x), - filter = filter, - bg.col = bg.col, - antialias = antialias) - ) - } - - # check dimensions - .check_dim(x) - dim_img <- dim(x[[1]]) - ax <- axes(x) - - # array perm. - if (angle %in% c(90, 270)) { - cur_perm <- .swap( - seq_along(dim_img), - which(ax == "x"), - which(ax == "y") - ) - x <- aperm(x, perm = cur_perm) - } - - # flop - if (angle %in% c(90, 180)) { - x <- flop(x) - } - - # flip - if (angle %in% c(180, 270)) { - x <- flip(x) - } - - # return - x - }) - .translate_transform <- function(x, shift = c(0,0), axes = NULL) { diff --git a/man/trans.Rd b/man/trans.Rd index 4758b49..e180b0f 100644 --- a/man/trans.Rd +++ b/man/trans.Rd @@ -6,8 +6,8 @@ \alias{translation} \alias{affine} \alias{affine,ImageArray-method} -\alias{scale,ImageArray-method} \alias{rotate,ImageArray-method} +\alias{scale,ImageArray-method} \alias{translation,ImageArray-method} \alias{flip,ImageArray-method} \alias{flop,ImageArray-method} @@ -23,6 +23,14 @@ antialias = TRUE ) +\S4method{rotate}{ImageArray}( + x, + angle, + filter = c("bilinear", "none"), + bg.col = "black", + antialias = TRUE +) + \S4method{scale}{ImageArray}( x, output.dim = NULL, @@ -34,14 +42,6 @@ ... ) -\S4method{rotate}{ImageArray}( - x, - angle, - filter = c("bilinear", "none"), - bg.col = "black", - antialias = TRUE -) - \S4method{translation}{ImageArray}(x, shift = c(0, 0), axes = NULL) \S4method{flip}{ImageArray}(x) @@ -65,12 +65,12 @@ \item{antialias}{If \code{TRUE}, perform bilinear sampling at image edges using \code{bg.col}.} +\item{angle}{A numeric specifying the image rotation angle in degrees.} + \item{output.origin}{A vector of 2 numbers indicating the output coordinates of the origin in pixels.} \item{...}{arguments passed to other methods} -\item{angle}{A numeric specifying the image rotation angle in degrees.} - \item{shift}{translation shift parameter, a vector of length 2} } \value{ @@ -85,10 +85,10 @@ when realized into the memory \itemize{ \item \code{affine(ImageArray)}: affine transformation -\item \code{scale(ImageArray)}: scale transformation - \item \code{rotate(ImageArray)}: rotation transformation +\item \code{scale(ImageArray)}: scale transformation + \item \code{translation(ImageArray)}: translation transformation \item \code{flip(ImageArray)}: vertical flipping diff --git a/tests/testthat/test-manipulation.R b/tests/testthat/test-manipulation.R index 48c013c..93ec6f9 100644 --- a/tests/testthat/test-manipulation.R +++ b/tests/testthat/test-manipulation.R @@ -44,16 +44,6 @@ test_that("manipulate h5 ImageArray", { expect_equal(unique(as.vector(tmp)), 255) expect_equal(type(mat_list_negated[[1]]), "integer") - # rotate - mat_list_rotated <- rotate(mat_list, angle = 90) - expect_equal(dim(mat_list_rotated), c(3, 2000, 5000)) - mat_list_rotated <- rotate(mat_list, angle = 180) - expect_equal(dim(mat_list_rotated), c(3, 5000, 2000)) - mat_list_rotated <- rotate(mat_list, angle = 270) - expect_equal(dim(mat_list_rotated), c(3, 2000, 5000)) - # TODO: angles like 20 now is acceptable - # expect_error(mat_list_rotated <- rotate(mat_list, angle = 20)) - # flip flop mat_list_flipflop <- flip(mat_list) expect_equal( @@ -120,16 +110,6 @@ test_that("manipulate zarr ImageArray", { tmp <- realize(mat_list[[1]]) + realize(mat_list_negated[[1]]) expect_equal(unique(as.vector(tmp)), 255) - # rotate - mat_list_rotated <- rotate(mat_list, angle = 90) - expect_equal(dim(mat_list_rotated), c(3, 2000, 5000)) - mat_list_rotated <- rotate(mat_list, angle = 180) - expect_equal(dim(mat_list_rotated), c(3, 5000, 2000)) - mat_list_rotated <- rotate(mat_list, angle = 270) - expect_equal(dim(mat_list_rotated), c(3, 2000, 5000)) - # TODO: this is not acceptable - # expect_error(mat_list_rotated <- rotate(mat_list, angle = 20)) - # flip flop mat_list_flipflop <- flip(mat_list) expect_equal( diff --git a/tests/testthat/test-transformations.R b/tests/testthat/test-transformations.R index c8fff65..bce93d4 100644 --- a/tests/testthat/test-transformations.R +++ b/tests/testthat/test-transformations.R @@ -33,6 +33,8 @@ for(ni in names(img_list)) { xy <- match(c("x", "y"), axes(imgarray)) test_that(paste0("translation transformation for ", ni), { + + # translate image shift <- c(100,20) imgarray_trans <- translation(imgarray, shift = shift) @@ -51,6 +53,8 @@ for(ni in names(img_list)) { }) test_that(paste0("scaling transformation for ", ni), { + + # scale image output.dim <- c(200,300) imgarray_scale <- scale(imgarray, output.dim = output.dim) @@ -92,6 +96,8 @@ for(ni in names(img_list)) { }) test_that(paste0("affine transformation for ", ni), { + + # affine transform image m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) imgarray_affine <- affine(imgarray, m = m) @@ -123,30 +129,25 @@ for(ni in names(img_list)) { }) # test a lot of angles - basic_angles <- c(90, 180, 270) - for(angle in c(seq(2, 360, 20), basic_angles)){ + for(angle in c(seq(2, 360, 20), c(90, 180, 270))){ # test a lot of angles test_that(paste0("rotate (", angle, " degrees) transformation for ", ni), { - # TODO: tiff rotation is ill-defined for 90, 180, 270 - skip_if(ni == "tiff", message = "90, 180, 270 angles wont work for tiff") - + # rotate image imgarray_rotate <- ImageArray::rotate(imgarray, angle = angle) # check seed expect_s4_class(imgarray_rotate, "ImageArray") for(i in seq_along(imgarray_rotate)){ - if(!angle %in% basic_angles) - expect_s4_class(imgarray_rotate[[i]]@seed, "DelayedAffineSeed") + expect_s4_class(imgarray_rotate[[i]]@seed, "DelayedAffineSeed") expect_s4_class(imgarray_rotate[[i]]@seed, "DelayedUnaryOp") } # check affine img <- realize(imgarray) img_rotate <- test_rotate(img, axes(imgarray), angle) - if(!angle %in% basic_angles) - dimnames(img_rotate) <- vector("list", length(dim(img_rotate))) + dimnames(img_rotate) <- vector("list", length(dim(img_rotate))) expect_equal( realize(imgarray_rotate[[1]]), img_rotate From fa77a97382fee028a4c6c776a40e4468299f7f52 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 30 May 2026 16:08:34 +0200 Subject: [PATCH 9/9] update examples --- R/transformations.R | 62 ++++++++++++++++++++++++++++++++++++++------- man/trans.Rd | 44 ++++++++++++++++++++++++++++++++ 2 files changed, 97 insertions(+), 9 deletions(-) diff --git a/R/transformations.R b/R/transformations.R index bbf56ec..ace7526 100644 --- a/R/transformations.R +++ b/R/transformations.R @@ -19,6 +19,50 @@ NULL #' @param ... arguments passed to other methods #' #' @returns an \code{ImageArray} object. +#' +#' @examples +#' ome.tiff.file <- system.file("extdata", "xy_12bit__plant.ome.tiff", +#' package = "ImageArray") +#' read.metadata(ome.tiff.file) +#' +#' # define ImageArray object +#' imgarray <- createImageArray(ome.tiff.file, series = 1, resolution = 1:2) +#' +#' # translate image +#' imgarray_trans <- translation(imgarray, shift = c(100,20)) +#' +#' # scale image +#' imgarray_scale <- scale(imgarray, output.dim = c(200,300), +#' filter = "bilinear") +#' imgarray_scale +#' +#' # rotate image +#' imgarray_rotate <- rotate(imgarray, angle = 45, filter = "bilinear") +#' imgarray_rotate +#' +#' # image with affine transformation +#' m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) +#' imgarray_affine <- affine(imgarray, +#' m = m, +#' filter = "bilinear") +#' imgarray_affine +#' +#' # get extent of the transformed image +#' extent(imgarray_affine) +#' +#' # a sequence of transformations +#' m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) +#' imgarray_trans <- affine(imgarray, +#' m = m, +#' filter = "bilinear") +#' imgarray_trans +#' +#' imgarray_trans <- scale(imgarray_trans, +#' output.dim = c(200,300), +#' filter = "bilinear") +#' imgarray_trans <- translation(imgarray_trans, +#' shift = c(100,20)) +#' NULL #### @@ -119,13 +163,13 @@ setMethod("type", "DelayedTransformSeed", function(x) { ) } -.spatial_perm <- function(ndim, axes) { +.axes_perm <- function(ndim, axes) { xy <- match(c("x", "y"), axes) c(xy, setdiff(seq_len(ndim), xy)) } -.spatial_first <- function(a, axes) { - p <- .spatial_perm(length(dim(a)), axes) +.axes_first <- function(a, axes) { + p <- .axes_perm(length(dim(a)), axes) if (identical(p, seq_along(p))) { a @@ -134,9 +178,9 @@ setMethod("type", "DelayedTransformSeed", function(x) { } } -.spatial_back <- function(a, axes) { +.axes_back <- function(a, axes) { ndim <- length(dim(a)) - p <- .spatial_perm(ndim, axes) + p <- .axes_perm(ndim, axes) inv <- order(p) if (identical(inv, seq_len(ndim))) { @@ -265,7 +309,7 @@ setMethod("type", "DelayedTransformSeed", function(x) { full_index <- vector("list", length(dim(x@seed))) arr <- S4Arrays::extract_array(x@seed, full_index) - arr <- .spatial_first(arr, x@axes) + arr <- .axes_first(arr, x@axes) xy <- match(c("x", "y"), x@axes) @@ -278,7 +322,7 @@ setMethod("type", "DelayedTransformSeed", function(x) { antialias = x@antialias ) - .spatial_back(as.array(out), x@axes) + .axes_back(as.array(out), x@axes) } .get_extent_from_box <- function(bboxmin, bboxmax) { @@ -362,7 +406,7 @@ setMethod( source_index[[ydim]] <- bbox$y source_patch <- S4Arrays::extract_array(x@seed, source_index) - source_patch <- .spatial_first(source_patch, x@axes) + source_patch <- .axes_first(source_patch, x@axes) m_local <- .localize_affine( m = x@m, @@ -379,7 +423,7 @@ setMethod( antialias = x@antialias ) - rendered <- .spatial_back(as.array(rendered), x@axes) + rendered <- .axes_back(as.array(rendered), x@axes) local_index <- vector("list", length(out_dim)) local_index[[xdim]] <- match(out_x, out_x_window) diff --git a/man/trans.Rd b/man/trans.Rd index e180b0f..29741c0 100644 --- a/man/trans.Rd +++ b/man/trans.Rd @@ -96,3 +96,47 @@ when realized into the memory \item \code{flop(ImageArray)}: horizontal flipping }} +\examples{ +ome.tiff.file <- system.file("extdata", "xy_12bit__plant.ome.tiff", +package = "ImageArray") +read.metadata(ome.tiff.file) + +# define ImageArray object +imgarray <- createImageArray(ome.tiff.file, series = 1, resolution = 1:2) + +# translate image +imgarray_trans <- translation(imgarray, shift = c(100,20)) + +# scale image +imgarray_scale <- scale(imgarray, output.dim = c(200,300), + filter = "bilinear") +imgarray_scale + +# rotate image +imgarray_rotate <- rotate(imgarray, angle = 45, filter = "bilinear") +imgarray_rotate + +# image with affine transformation +m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) +imgarray_affine <- affine(imgarray, + m = m, + filter = "bilinear") +imgarray_affine + +# get extent of the transformed image +extent(imgarray_affine) + +# a sequence of transformations +m <- matrix(c(1, -.5, 128, 0, 1, 0), nrow=3, ncol=2) +imgarray_trans <- affine(imgarray, + m = m, + filter = "bilinear") +imgarray_trans + +imgarray_trans <- scale(imgarray_trans, + output.dim = c(200,300), + filter = "bilinear") +imgarray_trans <- translation(imgarray_trans, + shift = c(100,20)) + +}