R/glcm_all.R

Defines functions glcm_all

# #' @title Creates gray-level co-occurrence matrix of all possible directions of a RIA image
# #'
# #' @description  Creates gray-level co-occurrence matrix (GLCM) from \emph{RIA_image}.
# #' GLCM assesses the spatial relation of voxels to each other. While the \code{\link[RIA]{glcm}}
# #' function calculates the GLCM in one given direction, the \code{\link[RIA]{glcm_all}} function
# #' simultaneously calculates all GLCMs in all possible directions. 
# #' For 3D datasets, this means GLCMs will be calculated for all 26 different directions.
# #' However, due to symmetry overall only 13 different GLCMs will be generated.
# #' If the \emph{symmetric} parameter is set to \emph{FALSE}, then 26 non-symmetrical GLCM matrices
# #' will be returned.
# #' In case of 2D datasets, instead of 8 GLCMs, only 4 are returned by default. If the \emph{symmetric}
# #' parameter is set to \emph{FALSE} then all 8 non-symmetrical GLCM matrices are returned.
# #' For detailes see: \url{https://pubmed.ncbi.nlm.nih.gov/28346329/}
# #' By default the \emph{use_type} is set to \emph{discretize}, therefore GLCMs will be calculated
# #' for all discretized images in all directions. Also \emph{single} data processing is supported, 
# #' then by default the image in the \emph{$modif} slot will be used. If \emph{use_slot} is given,
# #' then the data present in \emph{RIA_image$use_slot} will be used for calculations.
# #' Results will be saved into the \emph{glcm} slot. The name of the subslot is automatically
# #' generated by RIA.
# #'
# #' @param RIA_data_in \emph{RIA_image}.
# #'
# #' @param distance integer, distance between the voxels being compared.
# #' 
# #' @param symmetric logical, indicating whether to create a symmetric glcm
# #' by also calculating the glcm in the opposite direction and add it to the glcm.
# #'
# #' @param normalize logical, indicating whether to change glcm elements to relaive frequencies.
# #'
# #' @param use_type string, can be \emph{"single"} which runs the function on a single image,
# #' which is determined using \emph{"use_orig"} or \emph{"use_slot"}. \emph{"discretized"}
# #' takes all datasets in the \emph{RIA_image$discretized} slot and runs the analysis on them.
# #'
# #' @param use_orig logical, indicating to use image present in \emph{RIA_data$orig}.
# #' If FALSE, the modified image will be used stored in \emph{RIA_data$modif}.
# #'
# #' @param use_slot string, name of slot where data wished to be used is. Use if the desired image
# #' is not in the \emph{data$orig} or \emph{data$modif} slot of the \emph{RIA_image}. For example,
# #' if the desired dataset is in \emph{RIA_image$discretized$ep_4}, then \emph{use_slot} should be
# #' \emph{discretized$ep_4}. The results are automatically saved. If the results are not saved to
# #' the desired slot, then please use \emph{save_name} parameter.
# #'
# #' @param save_name string, indicating the name of subslot of \emph{$glcm} to save results to.
# #' If left empty, then it will be automatically determined by RIA.
# #'
# #' @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 GLCMs.
# #'
# #' @examples \dontrun{
# #' #Discretize loaded image and then calculate GLCM matrix of RIA_image$modif
# #' RIA_image <- discretize(RIA_image, bins_in = c(4, 8), equal_prob = TRUE,
# #' use_orig = TRUE, write_orig = FALSE)
# #' RIA_image <- glcm_all(RIA_image, use_type = "single")
# #'
# #' #Use use_slot parameter to set which image to use
# #' RIA_image <- glcm_all(RIA_image, use_type = "single",
# #' use_orig = FALSE, use_slot = "discretized$ep_4")
# #' 
# #' #Batch calculation of GLCM matrices on all disretized images at a distance of 1 and 2
# #' RIA_image <- glcm_all(RIA_image, use_type = "discretized", distance = c(1:2))
# #' }
# #' 
# #' @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://pubmed.ncbi.nlm.nih.gov/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://pubmed.ncbi.nlm.nih.gov/28346329/}
# #' @encoding UTF-8

glcm_all <- function(RIA_data_in, distance = 1, symmetric = TRUE, normalize = TRUE, use_type = "discretized", use_orig = FALSE, use_slot = NULL, save_name = NULL, 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 RIA load_ FUNCTIONS")}
    
    if(dim(RIA_data_in$data$orig)[3] == 1) {
        dim_image <- 2
    } else {dim_image <- 3}
    
    if(dim_image == 3 & symmetric == FALSE)  {
        offsets <- matrix(c( 1, 0, 0,
                             -1, 0, 0,
                             0, 1, 0,
                             0,-1, 0,
                             1, 1, 0,
                             -1,-1, 0,
                             1,-1, 0,
                             -1, 1, 0,
                             
                             1, 0, 1,
                             -1, 0, 1,
                             0, 1, 1,
                             0,-1, 1,
                             1, 1, 1,
                             -1,-1, 1,
                             1,-1, 1,
                             -1, 1, 1,
                             
                             1, 0,-1,
                             -1, 0,-1,
                             0, 1,-1,
                             0,-1,-1,
                             1, 1,-1,
                             -1,-1,-1,
                             1,-1,-1,
                             -1, 1,-1,
                             
                             0, 0, 1,
                             0, 0,-1
        ), nrow = 26, ncol = 3, byrow = TRUE)
    }
    
    if(dim_image == 3 & symmetric == TRUE)  {
        offsets <- 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)
    }
    
    if(dim_image == 2 & symmetric == FALSE)  {
        offsets <- matrix(c( 1, 0, 0,
                             -1, 0, 0,
                             0, 1, 0,
                             0,-1, 0,
                             1, 1, 0,
                             -1,-1, 0,
                             1,-1, 0,
                             -1, 1, 0
        ), nrow = 8, ncol = 3, byrow = TRUE)
    }
    
    if(dim_image == 2 & symmetric == TRUE)  {
        offsets <- matrix(c(1, 0, 0,
                            0, 1, 0,
                            1, 1, 0,
                            1,-1, 0
        ), nrow = 4, ncol = 3, byrow = TRUE)
    }
    
    offsets <- offsets * distance
    
    if(!is.null(save_name) & (dim(offsets)[1] != length(save_name))) {stop(paste0("PLEASE PROVIDE THE SAME NUMBER OF NAMES AS THERE ARE IMAGES!\n",
                                                                                  "NUMBER OF NAMES:  ", length(save_name), "\n",
                                                                                  "NUMBER OF IMAGES: ", dim(offsets)[1], "\n"))
    }
    
    for (i in 1: dim(offsets)[1])
    {
        RIA_data_in <- glcm(RIA_data_in, off_right = offsets[i,1], off_down = offsets[i,2], off_z = offsets[i,3],
                            symmetric = symmetric, normalize = normalize, use_type = use_type, use_orig = use_orig, use_slot = use_slot, save_name = save_name[i], verbose_in = verbose_in)
    }
    
    return(RIA_data_in)
    
}

Try the RIA package in your browser

Any scripts or data that you put into this service are public.

RIA documentation built on May 31, 2023, 7 p.m.