R/antsApplyTransforms.R

In stnava/ANTsR: ANTs in R: Quantification Tools for Biomedical Images

#' Apply transforms to images.
#'
#' Apply a transform list to map an image from one domain to another. In image
#' registration, one computes mappings between (usually) pairs of images.
#' These transforms are often a sequence of increasingly complex maps, e.g.
#' from translation, to rigid, to affine to deformation.  The list of such
#' transforms is passed to this function to interpolate one image domain
#' into the next image domain, as below.  The order matters strongly and the
#' user is advised to familiarize with the standards established in examples.
#'
#' @param fixed fixed image defining domain into which the moving image is
#' transformed.
#' @param moving moving image to be mapped to fixed space.
#' @param transformlist character vector of transforms generated by antsRegistration where
#' each transform is a filename.
#' @param interpolator Choice of interpolator.  Supports partial matching.
#' \itemize{
#' \item{linear}{}
#' \item{nearestNeighbor}{}
#' \item{multiLabel}{ for label images but genericlabel is preferred}
#' \item{gaussian}{}
#' \item{bSpline}{}
#' \item{cosineWindowedSinc}{}
#' \item{welchWindowedSinc}{}
#' \item{hammingWindowedSinc}{}
#' \item{lanczosWindowedSinc}{}
#' \item{genericLabel}{ use this for label images}
#' }
#' @param imagetype choose 0/1/2/3 mapping to scalar/vector/tensor/time-series
#' @param whichtoinvert optional list of booleans, same length as transforms.
#' whichtoinvert[i] is TRUE if transformlist[i] is a matrix, and the matrix should
#' be inverted. If transformlist[i] is a warp field, whichtoinvert[i] must be FALSE.
#'
#' If the transform list is a matrix followed by a warp field, whichtoinvert
#' defaults to c(TRUE,FALSE). Otherwise it defaults to rep(FALSE, length(transformlist)).
#' @param compose if it is a character string pointing to a valid file location,
#' this will force the function to return a composite transformation filename.
#' @param verbose print command and run verbose application of transform.
#' @param ... extra parameters
#' @return an antsImage or transformation filename is output. 1 -- Failure
#' @author Shrinidhi KL, Avants BB
#' @examples
#'
#' # will give the full form of help
#' antsApplyTransforms("-h")
#' # see antsRegistration
#' # example 1 - simplified
#' fixed <- ri(1)
#' moving <- ri(2)
#' fixed <- resampleImage(fixed, c(64, 64), 1, 0)
#' moving <- resampleImage(moving, c(68, 68), 1, 0)
#' mytx <- antsRegistration(
#'   fixed = fixed, moving = moving,
#'   typeofTransform = "SyN", verbose = TRUE, printArgs = TRUE
#' )
#' mywarpedimage <- antsApplyTransforms(
#'   fixed = fixed, moving = moving,
#'   transformlist = mytx$fwdtransforms
#' )
#' testthat::expect_true(antsImagePhysicalSpaceConsistency(mywarpedimage, fixed))
#' invwarped_image <- antsApplyTransforms(
#'   fixed = moving, moving = fixed,
#'   transformlist = mytx$invtransforms
#' )
#' testthat::expect_true(antsImagePhysicalSpaceConsistency(invwarped_image, moving))
#' # full access via listing the inputs in standard ANTs format
#'
#' res1 <- antsApplyTransforms(
#'   fixed = fixed, moving = moving,
#'   transformlist = mytx$fwdtransforms[2],
#'   whichtoinvert = 1, verbose = TRUE
#' )
#' cfile <- antsApplyTransforms(
#'   fixed = fixed, moving = moving,
#'   transformlist = mytx$fwdtransforms,
#'   compose = tempfile()
#' )
#' cimg <- antsImageRead(cfile)
#' cout <- antsApplyTransforms(
#'   fixed = fixed, moving = moving,
#'   transformlist = cimg
#' )
#' testthat::expect_error(
#'   antsApplyTransforms(
#'     fixed = fixed, moving = moving,
#'     transformlist = cimg, whichtoinvert = 1
#'   ), "nnot invert transform"
#' )
#' testthat::expect_error(
#'   antsApplyTransforms(
#'     fixed = fixed, moving = moving,
#'     transformlist = cimg, whichtoinvert = c(1, 2)
#'   ), "same length"
#' )
#' testthat::expect_error(antsApplyTransforms(
#'   fixed = fixed, moving = moving,
#'   transformlist = ""
#' ))
#'
#' @seealso \code{\link{antsRegistration}}
#' @export antsApplyTransforms
antsApplyTransforms <- function(
    fixed,
    moving,
    transformlist = "",
    interpolator = c(
      "linear",
      "nearestNeighbor",
      "multiLabel",
      "gaussian",
      "bSpline",
      "cosineWindowedSinc",
      "welchWindowedSinc",
      "hammingWindowedSinc",
      "lanczosWindowedSinc",
      "genericLabel"
    ),
    imagetype = 0, whichtoinvert = NA,
    compose = NA, verbose = FALSE, ...) {
  if (is.character(fixed)) {
    if (fixed == "-h") {
      ANTsRCore::antsApplyTransforms(.int_antsProcessArguments(
        list("-h")
      ))
      return()
    }
  }
  if (missing(fixed) | missing(moving) | missing(transformlist)) {
    print("missing inputs")
    return(NA)
  }
  interpolator[1] <- paste(tolower(substring(interpolator[1], 1, 1)),
    substring(interpolator[1], 2),
    sep = "", collapse = " "
  )
  interpOpts <- c(
    "linear",
    "nearestNeighbor",
    "multiLabel",
    "gaussian",
    "bSpline",
    "cosineWindowedSinc",
    "welchWindowedSinc",
    "hammingWindowedSinc",
    "lanczosWindowedSinc",
    "genericLabel"
  )
  interpolator <- match.arg(interpolator, interpOpts)

  # if (is.antsImage(moving)) {
  # moving = antsImageClone(moving)
  # }
  # if (is.antsImage(fixed)) {
  # fixed = antsImageClone(fixed)
  # }
  if (is.antsImage(transformlist)) {
    warning("transformlist is an antsImage, creating a temporary file")
    tfile <- tempfile(fileext = ".nii.gz")
    antsImageWrite(transformlist, filename = tfile)
    transformlist <- tfile
  }

  if (!is.character(transformlist)) {
    warning("transformlist is not a character vector")
  }

  args <- list(fixed, moving, transformlist, interpolator, ...)
  if (!is.character(fixed)) {
    moving <- check_ants(moving)
    if (fixed@class[[1]] == "antsImage" & moving@class[[1]] == "antsImage") {
      for (i in 1:length(transformlist)) {
        if (!file.exists(transformlist[i])) {
          stop(paste("Transform ", transformlist[i], " does not exist.", sep = ""))
        }
      }
      inpixeltype <- fixed@pixeltype
      warpedmovout <- antsImageClone(moving)
      f <- fixed
      m <- moving
      if ((moving@dimension == 4) & (fixed@dimension == 3) &
        (imagetype == 0)) {
        stop("Set imagetype 3 to transform time series images.")
      }
      mytx <- list()
      # If whichtoinvert is NA, then attempt to guess the right thing to do
      #
      # If the transform list is (affine.mat, warp), whichtoinvert = c("T", "F")
      #
      # else whichtoinvert = rep("F", length(transformlist))
      if (all(is.na(whichtoinvert))) {
        if (length(transformlist) == 2 & grepl("\\.mat$", transformlist[1]) & !(grepl("\\.mat$", transformlist[2]))) {
          whichtoinvert <- c(TRUE, FALSE)
        } else {
          whichtoinvert <- rep(FALSE, length(transformlist))
        }
      }
      if (length(whichtoinvert) != length(transformlist)) {
        stop("Transform list and inversion list must be the same length")
      }
      for (i in c(1:length(transformlist))) {
        ismat <- FALSE
        if (grepl("\\.mat$", transformlist[i]) || grepl("\\.txt$", transformlist[i])) {
          ismat <- TRUE
        }
        if (whichtoinvert[i] && !(ismat)) {
          # Can't invert a warp field, user should pass inverseWarp directly. Something wrong
          stop(paste("Cannot invert transform ", i, " ( ", transformlist[i], " ), because it is not a matrix. ", sep = ""))
        }
        if (whichtoinvert[i]) {
          mytx <- list(mytx, "-t", paste("[", transformlist[i], ",1]",
            sep = ""
          ))
        } else {
          mytx <- list(mytx, "-t", transformlist[i])
        }
      }
      if (is.na(compose)) {
        args <- list(
          d = fixed@dimension, i = m, o = warpedmovout, r = f, n = interpolator,
          unlist(mytx)
        )
      }
      tfn <- paste(compose, "comptx.nii.gz", sep = "")
      if (!is.na(compose)) {
        mycompo <- paste("[", tfn, ",1]", sep = "")
        args <- list(
          d = fixed@dimension, i = m, o = mycompo, r = f,
          n = interpolator, unlist(mytx)
        )
      }
      myargs <- .int_antsProcessArguments(c(args))
      for (jj in c(1:length(myargs))) {
        if (!is.na(myargs[jj])) {
          if (myargs[jj] == "-") {
            myargs2 <- rep(NA, (length(myargs) - 1))
            myargs2[1:(jj - 1)] <- myargs[1:(jj - 1)]
            myargs2[jj:(length(myargs) - 1)] <- myargs[(jj + 1):(length(myargs))]
            myargs <- myargs2
          }
        }
      }
      myverb <- as.numeric(verbose)
      if (verbose) print(myargs)
      ANTsRCore::antsApplyTransforms(c(myargs, "-z", 1, "-v", myverb, "--float", 1, "-e", imagetype))

      if (is.na(compose)) {
        return(antsImageClone(warpedmovout, inpixeltype))
      }
      if (!is.na(compose)) if (file.exists(tfn)) {
        return(tfn)
      } else {
        return(NA)
      }
    }
    # Get here if fixed, moving, transformlist are not missing, fixed is not of type character,
    # and fixed and moving are not both of type antsImage
    stop(paste0(
      "fixed, moving, transformlist are not missing,",
      " fixed is not of type character,",
      " and fixed and moving are not both of type antsImage"
    ))
    return(1)
  }
  # if ( Sys.info()['sysname'] == 'XXX' ) { mycmd<-.antsrParseListToString( c(args)
  # ) system( paste('antsApplyTransforms ', mycmd$mystr ) ) return( antsImageRead(
  # mycmd$outimg, as.numeric(mycmd$outdim) ) ) }
  ANTsRCore::antsApplyTransforms(.int_antsProcessArguments(
    c(args, "-z", 1, "--float", 1, "-e", imagetype)
  ))
}


# .antsrParseListToString <- function(mylist, outimg = NA, outdim = NA) {
#   mystr <- ""
#   len <- length(mylist)
#   outimg <- ""
#   outdim <- 11
#   for (x in 1:len) {
#     if (is.antsImage(mylist[[x]])) {
#       tfn <- paste(tempdir(), "img", x, ".nii.gz", sep = "")
#       antsImageWrite(mylist[[x]], tfn)
#       mystr <- paste(mystr, tfn)
#       outdim <- mylist[[x]]@dimension
#       if (typeof(mylist[[x - 1]]) == "character") {
#         if (mylist[[x - 1]] == "-o")
#           outimg <- tfn
#       }
#       if (typeof(mylist[[x - 1]]) != "S4")
#         if (mylist[[x - 1]] == "-o")
#           outimg <- tfn
#     } else mystr <- paste(mystr, toString(mylist[[x]]))
#   }
#   mystr <- sub(",", " ", mystr)
#   mystr <- sub(" - ", " ", mystr)
#   mystr <- sub("-t,", "-t ", mystr)
#   mystr <- sub(", ", " ", mystr)
#   return(list(mystr = mystr, outimg = outimg, outdim = outdim))
# }
#
# ..antsrParseListToString2 <- function(mylist, outimg = NA, outdim = NA) {
#   mystr <- ""
#   outimg <- ""
#   outdim <- 11
#   len <- length(mylist)
#   for (x in 1:len) {
#     mystr <- paste(mystr, " -", names(mylist)[x], " ", sep = "")
#     if (is.antsImage(mylist[[x]])) {
#       tfn <- paste(tempdir(), "img", x, ".nii.gz", sep = "")
#       antsImageWrite(mylist[[x]], tfn)
#       mystr <- paste(mystr, tfn)
#       outdim <- mylist[[x]]@dimension
#       if (names(mylist)[x] == "o")
#         outimg <- tfn
#     } else mystr <- paste(mystr, toString(mylist[[x]]))
#   }
#   mystr <- sub(",", " ", mystr)
#   mystr <- sub(" - ", " ", mystr)
#   mystr <- sub("-t,", "-t ", mystr)
#   mystr <- sub(", ", " ", mystr)
#   return(list(mystr = mystr, outimg = outimg, outdim = outdim))
# }