--- a +++ b/R/make_predictors.R @@ -0,0 +1,720 @@ +#' @title Make CT Predictors +#' +#' @description Create a set of predictors for ICH segmentation +#' for CT +#' @param img Filename of image intensities +#' @param mask Filename of brain mask +#' @param roi Filename of ROI for Y +#' @param nvoxels Voxel neighborhood +#' @param moments Moments of neighborhood to take +#' @param center Center the moments +#' @param lthresh Lower threshold for neighborhood setting +#' @param uthresh Upper threshold for neighborhood setting +#' @param sigmas Sigma values for Gaussian smoothed images (in mm) +#' @param save_imgs Logical to save all images that are created as +#' predictors +#' @param outdir Output directory of saved images, needs to be set +#' if \code{save_imgs = TRUE} +#' @param stub Basename to write image names if \code{save_imgs = TRUE} +#' @param overwrite If \code{save_imgs} is \code{TRUE}, +#' then should +#' the files be overwritten? If not, then files will be read +#' instead instead of code being re-run. +#' @param template.file Template to register to (CT Template) +#' @param mean.img Mean image in template space for z-scoring +#' @param sd.img SD image in template space for z-scoring +#' @param zscore.typeofTransform type of transform for z-scoring +#' @param zscore.interpolator type of interpolator for z-scoring +#' @param flip.typeofTransform type of transform for flipped difference +#' @param flip.interpolator type of interpolator for flipped difference +#' @param low_thresh Threshold for forcing values to zero +#' @param verbose Logical indicator if output messages should be +#' printed +#' @param shiny Should shiny progress be called? +#' @param erode_mask Should the brain mask be eroded? +#' @param ... options passed to \code{\link{get_neighbors}} +#' @importFrom neurobase readnii checkimg zscore_img finite_img +#' @importFrom fslr fslerode fsl_smooth +#' @importFrom oro.nifti zero_trans cal_img voxdim pixdim convert.datatype convert.bitpix +#' @importFrom extrantsr zscore_template otropos reg_flip perona_malik +#' @importFrom stats sd quantile predict complete.cases +#' @export +#' @return List of a data.frame of Predictors and set of +#' indices to +#' keep in mask and an empty nifti object for plotting. +#' Also the number of voxels of the roi that were not in the +#' mask +make_predictors <- function(img, mask, roi = NULL, + nvoxels = 1, moments = 1:4, + center = c(FALSE, TRUE, TRUE, TRUE), + lthresh = 40, uthresh = 80, + sigmas = c(5, 10, 20), + save_imgs = TRUE, + outdir = NULL, + stub = NULL, + overwrite = FALSE, + template.file = system.file( + "scct_unsmooth_SS_0.01.nii.gz", + package = "ichseg"), + mean.img = system.file( + "Mean_Image.nii.gz", + package = "ichseg"), + sd.img = system.file( + "SD_Image.nii.gz", + package = "ichseg"), + zscore.typeofTransform = "SyN", + zscore.interpolator = "Linear", + flip.typeofTransform = "Affine", + flip.interpolator = "LanczosWindowedSinc", + low_thresh = 1e-13, + verbose= TRUE, + shiny = FALSE, + erode_mask = TRUE, + ...) { + make_fname = function(addstub){ + fname = addstub + fname = file.path(outdir, paste0(stub, "_", fname, ".nii.gz")) + fname + } + + write_img = function(arr, addstub){ + fname = addstub + fname = file.path(outdir, paste0(stub, "_", fname)) + if ( !inherits( arr, "nifti")){ + mom = nim + mom@.Data = array(arr, dim = dim(mom)) + } else { + mom = arr + } + mom = cal_img(mom) + mom = zero_trans(mom) + mom = datatyper(mom, + datatype = convert.datatype()$FLOAT32, + bitpix = convert.bitpix()$FLOAT32) + writenii(mom, filename = fname) + } + + + make_moment_list = function(){ + mom.exist = sapply(moments, function(moment){ + addstub = paste0("moment", moment) + fname = make_fname(addstub) + file.exists(fname) + }) + + ### if all data does not exist or rewrite - remake data + if (!all(mom.exist) | overwrite) { + msg = "# Running Local_Moment" + if (verbose){ + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + moms = local_moment( + img, + mask = mask, + nvoxels = nvoxels, + moment = moments, center = center, + invert = FALSE, + ...) + if (save_imgs) { + for (imom in seq_along(moments)) { + moment = moments[imom] + addstub = paste0("moment", moment) + fname = make_fname(addstub) + mom.img = moms[[imom]] + write_img(mom.img, addstub) + } + } + } + ### if all data exists and not to rewrite - just read in + if (all(mom.exist) & !overwrite) { + moms = lapply(moments, function(moment){ + addstub = paste0("moment", moment) + fname = make_fname(addstub) + mom.img = readnii(fname, reorient = FALSE) + return(mom.img) + }) + } + msg = "# Creating Moment Matrix" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + mat = matrix(NA, + ncol = length(moms), + nrow = prod(dim(mask)) + ) + for (imom in seq_along(moms)) { + mat[, imom] = c(moms[[imom]]) + } + # moms = sapply(moms, c) + rm(list = "moms"); gc(); gc(); + colnames(mat) = paste0("moment", moments) + mat = as.data.frame(mat) + return(mat) + } + + img.fname = checkimg(img) + img = check_nifti(img) + + mask.fname = checkimg(mask) + orig.mask = mask = check_nifti(mask) + + if (!is.null(roi)) { + # roi.fname = roi + roi = check_nifti(roi) + } + + # stopifnot(class(roi) == "character") + # stopifnot(class(img) == "character") + # stopifnot(class(mask) == "character") + + + if (save_imgs){ + stopifnot(!is.null(outdir)) + stopifnot(!is.null(stub)) + } + if (is.null(outdir)){ + outdir = tempdir() + } + if (is.null(stub)){ + stub = nii.stub(img.fname, bn = TRUE) + } + + msg = "# Reading Images" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + # img = readnii(img.fname, reorient= FALSE) + orig.img = img + # stub = nii.stub(img.fname, bn=TRUE) + + nim = niftiarr(img, array(NA, dim = dim(orig.img))) + nim = datatyper(nim, + datatype = convert.datatype()$FLOAT32, + bitpix = convert.bitpix()$FLOAT32) + dimg = dim(nim) + vdim = voxdim(nim) + + # if (is.null(roi)){ + # roi = niftiarr(img, array(0, dim = dim(nim))) + # } + + msg = "# Eroding Mask" + addstub = "usemask" + fname = make_fname(addstub) + + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + + if (file.exists(fname) & !overwrite){ + mask = readnii(fname, reorient = FALSE) + } else { + if (erode_mask) { + # erode the mask + mask = fslerode(file = mask.fname, + kopts = "-kernel box 3x3x1", + reorient = FALSE, retimg = TRUE, + verbose = verbose > 1) + } else { + mask = readnii(mask.fname) + } + #### may add this - think about it + # mask = fslfill(mask, bin=TRUE, retimg = TRUE) + mask = mask > 0 + mask = datatyper(mask) + if (save_imgs){ + write_img(mask, addstub) + } + } + + if (sum(mask) == 0) { + msg = paste0( + "Eroded mask is empty! Something went wrong with eroding ", + "or Skull stripping") + stop(msg) + } + orig.masked.img = mask_img(orig.img, orig.mask) + masked.img = mask_img(orig.img, mask) + if (!is.null(roi)){ + miss.roi = sum(mask == 0 & roi > 0 ) + } else { + miss.roi = NULL + } + + + keep.ind = which(mask > 0) + + msg = "# Getting Moments" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + ################################################ + # Making Moment Images + ################################################ + + df = make_moment_list() + ########### + # Creating Skew/Kurtosis + ########### + df$skew = df$moment3/df$moment2 ^ {3/2} + df$kurtosis = df$moment4/df$moment2 ^ {2} + df$moment3 = df$moment4 = NULL + + ########### + # Writing Skew + ########### + addstub = "skew" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite) { + + } else { + skew = niftiarr(img, df$skew) + if (save_imgs) { + write_img(skew, addstub) + } + rm(list = c("skew")); gc(); gc(); + } + + ########### + # Writing Kurtosis + ########### + addstub = "kurtosis" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite) { + + } else { + kurtosis = niftiarr(img, df$kurtosis) + if (save_imgs) { + write_img(kurtosis, addstub) + } + rm(list = c("kurtosis")); gc(); gc(); + } + + ################################################ + # Making Percent threshold image + ################################################ + msg = paste0("# Getting thresholded from ", + lthresh, " to ", uthresh, "\n") + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = paste0("thresh_", lthresh, "_", uthresh) + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + thresh_img = readnii(fname, reorient=FALSE) + } else { + thresh_img = niftiarr(img, img >= lthresh & img <= uthresh) + if (save_imgs){ + write_img(thresh_img, addstub) + } + } + + df$value = c(masked.img) + df$thresh = c(thresh_img) + + cn = colnames(df) + + ################################################ + # Making Z-score Images + ################################################ + msg = "# Getting Z-scored images" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + zimgs = lapply(1:3, function(i){ + addstub = paste0("zscore", i) + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + img = readnii(fname, reorient=FALSE) + } else { + img = zscore_img(masked.img, mask = mask, margin = i) + if (save_imgs){ + write_img(img, addstub) + } + } + return(img) + }) + zimgs = sapply(zimgs, c) + colnames(zimgs) = paste0("zscore", 1:3) + zimgs = as.data.frame(zimgs) + for (i in 1:3) { + df[, paste0("zscore", i)] = zimgs[, paste0("zscore", i)] + } + rm(list = c("zimgs")); gc(); gc(); + + # wmean2 = function(img, mask, trim = 0.2){ + # x = img[ mask == 1] + # mn = psych::winsor.mean(x, trim = trim) + # s = psych::winsor.sd(x, trim = trim) + # z = (x-mn)/s + # img[mask == 1] = z + # img[mask == 0] = 0 + # img = cal_img(img) + # return(img) + # } + + wmean = function(img, mask, trim = 0.2){ + x = img[ mask == 1 ] + stopifnot(length(trim) == 1) + stopifnot(trim > 0) + stopifnot(trim <= 0.5) + qtrim <- quantile(x, + c(trim, 0.5, 1 - trim), + na.rm = TRUE) + xbot <- qtrim[1] + xtop <- qtrim[3] + + if (trim < 0.5) { + x[x < xbot] <- xbot + x[x > xtop] <- xtop + } else { + x[!is.na(x)] <- qtrim[2] + } + + mn = mean(x, na.rm=TRUE) + s = sd(x, na.rm=TRUE) + img = (img-mn)/s + img = mask_img(img, mask) + img = finite_img(img) + return(img) + } + + msg = "# Getting Winsorized Image" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = paste0("win_z") + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + wmean_img = readnii(fname, reorient=FALSE) + } else { + wmean_img = wmean(orig.img, mask = mask, trim = 0.2) + if (save_imgs){ + write_img(wmean_img, addstub) + } + } + df$win_z = c(wmean_img) + rm(list = c("wmean_img")); gc(); gc(); + + ################################################ + # Making Percent threshold image + ################################################ + msg = paste0("# Getting Percent thresholded from ", + lthresh, " to ", uthresh) + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = paste0("pct_thresh_", lthresh, "_", uthresh) + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + pct_thresh = readnii(fname, reorient=FALSE) + } else { + pct_thresh = local_moment(thresh_img, mask = mask, + nvoxels = nvoxels, + moment = 1, center = FALSE, + ...)[[1]] + if (save_imgs){ + write_img(pct_thresh, addstub) + } + } + + df$pct_thresh = c(pct_thresh) + rm(list = c("thresh_img", "pct_thresh")); gc(); gc(); + + + ################################################ + # Making Probability + ################################################ + msg = "# Getting Top Probability Segmentation from Atropos" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = paste0("prob_img") + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + prob_img = readnii(fname, reorient = FALSE) + } else { + window.masked.img = window_img(masked.img, window = c(0, 100)) + seg = otropos( window.masked.img, i = "KMeans[4]", verbose = verbose > 1) + prob_img = seg$probabilityimages[[3]] + seg$probabilityimages[[4]] + rm(list = c("seg")); gc(); gc(); + if (save_imgs){ + write_img(prob_img, addstub) + } + } + + df$prob_img = c(prob_img) + rm(list = c("prob_img")); gc(); gc(); + + + ################################################ + # Making Percent that are 0 + ################################################ + msg = "# Getting Percent 0" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + ###### changed to masked.img + thresh_0 = niftiarr(masked.img, masked.img == 0) + addstub = "pct_zero_neighbor" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + pct_zero_neighbor = readnii(fname, reorient=FALSE) + } else { + pct_zero_neighbor = local_moment(thresh_0, mask = NULL, + nvoxels = nvoxels, + moment = 1, center = FALSE, + ...)[[1]] + pct_zero_neighbor = mask_img(pct_zero_neighbor, mask) + if (save_imgs){ + write_img(pct_zero_neighbor, addstub) + } + } + df$pct_zero_neighbor = c(pct_zero_neighbor) + rm(list = c("pct_zero_neighbor", "thresh_0")); gc(); gc(); + + msg = "# Getting Any 0 Neighbors" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = "any_zero_neighbor" + df$any_zero_neighbor = (df$pct_zero_neighbor > 0) *1 + + ################################################ + # Making Distance to centroid + ################################################ + msg = "# Getting Distance to centroid" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = "dist_centroid" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite){ + dist.img = readnii(fname, reorient=FALSE) + } else { + centroid = t(which(mask > 0, arr.ind=TRUE)) + all.ind = expand.grid(lapply(dimg, seq)) + colnames(all.ind) = paste0("dim", seq(length(dimg))) + all.ind = t(as.matrix(all.ind)) + all.ind = all.ind * vdim + centroid = centroid * vdim + dist.img = t(all.ind - rowMeans(centroid)) + rm(list = c("all.ind")); gc(); gc(); + + dist.img = sqrt(rowSums(dist.img^2)) + dist.img = niftiarr(img, array(dist.img, dim =dimg)) + dist.img = mask_img(dist.img, mask) + dist.img = datatyper(dist.img, + datatype= convert.datatype()$FLOAT32, + bitpix= convert.bitpix()$FLOAT32) + if (save_imgs){ + write_img(dist.img, addstub) + } + } + df$dist_centroid = c(dist.img) + rm(list = c("dist.img")); gc(); gc(); + + + ################################################ + # Making Distance to centroid + ################################################ + msg = "# Perona Malik Smoother" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = "perona_malik" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite) { + dist.img = readnii(fname, reorient = FALSE) + } else { + pm_img = extrantsr::perona_malik( + masked.img, n_iter = 10, + conductance = 5) + if (save_imgs) { + write_img(pm_img, addstub) + } + rm(list = c("seg")); gc(); gc(); + } + df$perona_malik = c(pm_img) + rm(list = c("pm_img")); gc(); gc(); + + ################################################ + # Making 10mm and 20mm smoother + ################################################ + make_smooth_img = function(sigma){ + msg = paste0("# Getting Smooth ", sigma) + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = paste0("smooth", sigma) + if (save_imgs){ + fname = make_fname(addstub) + } else { + fname = tempfile() + if (file.exists(fname)){ + file.remove(fname) + } + } + if (file.exists(fname) & !overwrite) { + smooth.img = readnii(fname, reorient = FALSE) + } else { + smooth.mask = fslr::fsl_smooth( + file = mask, + sigma = sigma, + mask = NULL, + smooth_mask = FALSE, + verbose = verbose > 1) + smooth.img = fslsmooth(img.fname, sigma=sigma, + mask = mask, retimg = TRUE, + outfile = fname, + verbose = verbose > 1) + } + return(c(smooth.img)) + } + # df$smooth2 = make_smooth_img(sigma=2) + # df$smooth5 = make_smooth_img(sigma=5) + smooths = sapply(sigmas, make_smooth_img) + colnames(smooths) = paste0("smooth", sigmas) + df = cbind(df, smooths) + rm(list = c("smooths")); gc(); gc(); + + + + msg = "# Z-score to template" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = "zscore_template" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite) { + zscore = readnii(fname, reorient = FALSE) + } else { + zscore = extrantsr::zscore_template(img = orig.masked.img, + template.file = template.file, + mean.img = mean.img, + sd.img = sd.img, + typeofTransform = zscore.typeofTransform, + interpolator = zscore.interpolator, + verbose = verbose > 1) + if (save_imgs){ + write_img(zscore, addstub) + } + } + df$zscore_template = c(zscore) + rm(list = c("zscore")); gc(); gc(); + + msg = "# Flipped Difference" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + addstub = "flipped_value" + fname = make_fname(addstub) + if (file.exists(fname) & !overwrite) { + flipped_value = readnii(fname, reorient=FALSE) + } else { + flipper = extrantsr::reg_flip( + t1 = orig.masked.img, + mask = orig.mask, + template.file = template.file, + typeofTransform = flip.typeofTransform, + interpolator = flip.interpolator, + verbose = verbose > 1) + flipper = flipper$t1 + ########################## + # Take difference + ########################## + flipped_value = orig.masked.img - flipper + rm(list = c("flipper")); gc(); gc(); + if (save_imgs) { + write_img(flipped_value, addstub) + } + } + df$flipped_value = c(flipped_value) + rm(list = c("flipped_value")); gc(); gc(); + + msg = "# Thresholding small values" + if (verbose) { + message(msg) + } + if (shiny) { + shiny::incProgress(message = msg, amount = 0.02) + } + + + for (icn in seq(ncol(df))) { + x = df[, icn] + if (!(class(x) %in% c("factor", "character"))) { + x[ !is.finite(x) ] = 0 + } + df[, icn] = x + } + + df = as.matrix(df) + low = abs(df) < low_thresh + df[ low ] = 0 + + df = data.frame(df, stringsAsFactors = FALSE) + if (!is.null(roi)) { + df$Y = c(roi) + } else { + df$Y = NA + } + df$mask = c(mask) + + + return(list(df = df, keep.ind = keep.ind, nim = nim, + miss.roi = miss.roi)) +} + +