R/glrlm_stat_all.R

In neuroconductor/RIA: Radiomics Image Analysis Toolbox for Medial Images

#' @title Aggregates GLRLM-based statistics based-on supplied function
#' @export
#'
#' @description Calculates aggregated statistics of GLRLM matrix statistics calculated on
#' GLRLM matrices evaluated in all different directions.
#' 
#' @param RIA_data_in \emph{RIA_image}.
#' 
#' @param statistic string, defining the statistic to be calculated on the array of GLRLM statistics.
#' By default, statistic is set to \emph{"mean"}, however any function may be provided. The proper
#' syntax is: function(X, attributes). The supplied string must contain a "X", which will be replaced
#' with the array of the GLRLM statistics value. Further attributes of the function may also be given.
#' For example, if you wish to calculate the median of all GLRLMs calculated in different directions,
#' then it must be supplied as: \emph{median(X, na.rm = TRUE)}.
#'
#' @param verbose_in logical, indicating whether to print detailed information.
#' Most prints can also be suppressed using the \code{\link{suppressMessages}} function.
#'
#' @return \emph{RIA_image} containing the statistical information.
#'
#' @examples \dontrun{
#' #Discretize loaded image and then calculate GLCM statistics for all matrices
#' RIA_image <- discretize(RIA_image, bins_in = c(4, 8), equal_prob = TRUE,
#' use_orig = TRUE, write_orig = FALSE)
#' RIA_image <- glrlm_all(RIA_image, use_type = "discretized")
#' RIA_image <- glrlm_stat(RIA_image)
#' 
#' #Calculate the average of the different GLCM matrices in the different directions
#' RIA_image <- glrlm_stat_all(RIA_image)
#' }
#' 
#' @references Márton KOLOSSVÁRY et al.
#' Radiomic Features Are Superior to Conventional Quantitative Computed Tomographic
#' Metrics to Identify Coronary Plaques With Napkin-Ring Sign
#' Circulation: Cardiovascular Imaging (2017).
#' DOI: 10.1161/circimaging.117.006843
#' \url{https://www.ncbi.nlm.nih.gov/pubmed/29233836}
#' 
#' Márton KOLOSSVÁRY et al.
#' Cardiac Computed Tomography Radiomics: A Comprehensive Review on Radiomic Techniques.
#' Journal of Thoracic Imaging (2018).
#' DOI: 10.1097/RTI.0000000000000268
#' \url{https://www.ncbi.nlm.nih.gov/pubmed/28346329}
#' @encoding UTF-8


glrlm_stat_all <- function(RIA_data_in, statistic = "mean(X, na.rm = TRUE)", verbose_in = TRUE)
{
  if(!any(class(RIA_data_in) == "RIA_image")) {message("PROCESSING OF RIA_image OBJECTS ARE SUPPORTED, OTHER CLASSES MIGHT CAUSE PROBLEMS! PLEASE LOAD DATA USING load_dicom")}
  
  
  #create names to save to
  names_raw <- names(RIA_data_in$stat_glrlm)
  
  
  stat_abr <-  which(strsplit(statistic, "")[[1]]=="(")-1
  stat_abr <-  substr(statistic, start = 1, stop = stat_abr)
  
  names_dcr <- substr(names_raw, start = 1, stop = 2)
  names_dcr <- unique(names_dcr)
  
  bins <- NULL
  names_bin <- unlist(gregexpr('_', names_raw))
  for (i in seq(1, 2*length(names_raw), 2)) {
    bins <- c(bins, substring(names_raw[(i+1)/2], names_bin[i]+1, names_bin[i+1]-1))
  }
  names_bin <- unique(bins)
  
  names_out <- NULL
  for (i in 1: length(names_dcr))
  {
    for (j in 1: length(names_bin))
    {
        names_out <- append(names_out, paste0(names_dcr[i], "_b", names_bin[j], "_", stat_abr))
    }
  }
  
  #identify stat names
  m_number <- NULL
  
  D3s <-     matrix(c( 1, 0, 0,
                       0, 1, 0,
                       1, 1, 0,
                       1,-1, 0,
                       
                       1, 0, 1,
                       0, 1, 1,
                       1, 1, 1,
                       1,-1, 1,
                       
                       1, 0,-1,
                       0, 1,-1,
                       1, 1,-1,
                       1,-1,-1,
                       
                       0, 0, 1
  ), nrow = 13, ncol = 3, byrow = TRUE)
  
  
  D2s <- matrix(c(1, 0, 0,
                  0, 1, 0,
                  1, 1, 0,
                  1,-1, 0
  ), nrow = 4, ncol = 3, byrow = TRUE)
  
  
  
  names_in <- list()
  for (i in 1: length(names_dcr))
  {
    for (j in 1: length(names_bin))
    {
        names_in_each <- NULL
        if(length(dim(RIA_data_in$data$orig)) == 2) {offsets <- D2s
        } else if (length(dim(RIA_data_in$data$orig)) == 3) {offsets <- D3s
        } else {stop(paste0("DATA LOADED IS ", length(dim(RIA_data_in$data$orig)), " DIMENSIONAL. ONLY 2D AND 3D DATA ARE SUPPORTED!"))}
        
        for (l in 1: dim(offsets)[1])
        {
          names_in_each <- c(names_in_each, paste0(names_dcr[i], "_", names_bin[j], "_", offsets[l,1], offsets[l,2], offsets[l,3]))
        }
        names_in <- c(names_in, list(names_in_each))
        
    }
  }
  
  
  #statistical names
  stat_names <- names(RIA_data_in$stat_glrlm[[names_in[[1]][1]]])
  stat_abr_plus <- paste0("stat_glrlm_", stat_abr)
  stat_abr_str <- gsub("X", "stat_data",statistic)
  
  
  
  
  for (i in 1: length(names_out))
  {
    RIA_data_in[[stat_abr_plus]][[names_out[i]]] <- list()
    
    for (j in 1: length(stat_names))
    {
      
      stat_data <- NULL
      for (k in 1: length(names_in[[i]])){
        
        stat_data <- append(stat_data, eval(parse(text = paste0("RIA_data_in$stat_glrlm$`", names_in[[i]][k], "`$", stat_names[j]))))
      }
      
      func_stat_data <- eval(parse(text = stat_abr_str))
      
      RIA_data_in[[stat_abr_plus]][[names_out[i]]][[stat_names[j]]] <- func_stat_data
      
    }
    
    if (verbose_in == TRUE) {message(paste0("AGGREGATED STATISTICS WAS ADDED TO '", names_out[i], "' SLOT OF RIA_image$", stat_abr_plus, "\n"))}
    
  }
  
  return (RIA_data_in)
  
}