R/interleave.R

In ornelles/EBImageExtra: Helper Functions for EBImage

#' Interleave Images in an Array
#'
#' Interleave images in an array of grayscale or color images
#'
#' @param x an array of \code{Image} objects with 3- or 4-dimensions 
#' @param n the number of adjacent images
#'
#' @details
#' This function will create a new \code{Image} object from an array of
#' grayscale or color \code{Image} objects by interleaving every \code{n}-th
#' render frame. The
#' motivation behind this function is to simplify the task of reordering an
#' array that was generated by \emph{sequentially} combining groups of images so
#' that related images are adjacent.
#' 
#' Note that if the number of images (frames)
#' is not an even multiple of \code{n}, the excess frames will be dropped with
#' a warning. This generally indicates an error. 
#'
#' As a typical application, three different images (DAPI, FITC, and Cy5) are
#' taken of many separate fields of cells. The images are
#' separated then colorized as a group. Then groups are then combined with
#' \code{combine(...)} or
#' \code{abind(..., along = 4)}. Plotting the resulting image with
#' \code{plot(..., all= TRUE)} shows the images arranged sequentially 
#' with all of the DAPI images first, followed by all of
#' the FITC images and then all the Cy5 images. Interleaving this image with
#' \code{n = 3} reorganizes the stack so that images from the same field are
#' next to each other as DAPI, FITC, Cy5, DAPI, FITC, Cy5, etc.
#'
#' @return array of \code{Image} objects with the final dimension permuted
#'
#' @examples
#' # Example of DAPI + Fluorescent + Merged pairs
#'   x <- readImage(system.file("extdata", "cells.tif", package="EBImageExtra"))
#'   nuc <- x[,,c(1,3)]
#'   cel <- x[,,c(2,4)]
#'   img <- rgbImage(red = 0.1 * cel, green = cel + 0.2 * nuc, blue = 0.4 * nuc)
#'   stk <- combine(toRGB(0.5*nuc), toRGB(cel), img)
#' 
#' # Original order
#'   plotStack(stk, label = TRUE, nx = 3)
#' 
#' # "Interleaved" order
#'   plotStack(interleave(stk, n = 3), label = c("DAPI", "Fluor", "Merged"), nx = 3)
#' 
#' @import EBImage
#'
#' @export
#'
interleave <- function(x, n) {
	if (missing(n))
		stop("provide the number of distinct images for interleaving")
	nf <- numberOfFrames(x, type = "render")
	if (nf == 1)
		ans <- x
  else {
		dm <- dim(x)
    nx <- nf%/%n
    N <- seq.int(n * nx)
    if (max(N) != nf) warning("the last ", nf - max(N), " frame(s) were dropped")
    idx <- lapply(dm, seq.int) # expanded image coordinates
    idx[[length(idx)]] <- c(matrix(N, ncol = nx, byrow = TRUE))
    ans <- do.call("[", c(list(x), idx)) # replace dimension
  }
  return(ans)
}