#' Reduce Image, Dropping Image Dimensions
#'
#' @param x List of processed filenames
#' @param outdir Output directory
#' @param cleanup Argument to \code{\link{oMask}}. If >0, morphological
#' operations will be applied to clean up the mask by
#' eroding away small or weakly-connected areas, and closing holes.
#' @param verbose print diagnostic messages
#' @param suffix Name to append to the image filename
#'
#' @return List of filenames
#' @export
#' @importFrom extrantsr oMask
reduce_img = function(
x,
verbose = TRUE,
cleanup = 1,
outdir = tempdir(),
suffix = "_reduced") {
nii_names = names(x)
if (length(nii_names) != length(x)) {
stop("x must be a named vector or named list")
}
if (verbose > 0) {
message("Dropping Empty Dimensions")
}
####################################################
# Dropping empty dimensions
####################################################
fnames = file.path(
outdir,
paste0(nii_names,
suffix,
".nii.gz"))
names(fnames) = nii_names
ind_fnames = file.path(
outdir,
paste0(nii_names,
suffix,
".rds"))
names(ind_fnames) = nii_names
if (!all_exists(c(fnames, ind_fnames))) {
nn = llply(
x,
function(nn){
dd = mask_reduce(nn, cleanup = cleanup)
}, .progress = ifelse(verbose, "text", "none"))
rm_neck = lapply(nn, function(dd){
return(dd$outimg)
})
mapply(function(dd, fname){
saveRDS(dd$inds, file = fname)
}, nn, ind_fnames)
mapply(function(img, fname){
writenii(img, filename = fname)
}, rm_neck, fnames)
}
rm_neck = lapply(
fnames,
identity)
return(rm_neck)
}
#' @rdname reduce_img
#' @export
#' @importFrom extrantsr oMask
#' @importFrom neurobase dropEmptyImageDimensions
mask_reduce = function(x, cleanup = 1) {
# cleanup 0 because more liberal
mask = oMask(x, cleanup = cleanup)
dd = dropEmptyImageDimensions(
mask,
keep_ind = TRUE,
other.imgs = x)
dd$outimg = dd$other.imgs
dd$other.imgs = NULL
return(dd)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.