Diff of /R/make_predictors.R [000000] .. [242173]

Switch to side-by-side view

--- 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))
+}
+
+