Nothing
R/glcm.R
In RIA: Radiomics Image Analysis Toolbox for Medial Images
Defines functions
glcm
# #' @title Creates gray-level co-occurrence matrix of RIA image
# #' @encoding UTF-8
# #'
# #' @description Creates gray-level co-occurrence matrix (GLCM) from \emph{RIA_image}.
# #' GLCM assesses the spatial relation of voxels to each other. By default the \emph{$modif}
# #' image will be used to calculate GLCMs. 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 determined
# #' by the supplied string in \emph{save_name}, or is automatically generated by RIA.
# #'
# #' @param RIA_data_in \emph{RIA_image}.
# #'
# #' @param off_right integer, indicating the number of voxels to look to the right.
# #' Negative values indicate to the left.
# #'
# #' @param off_down integer, indicating the number of voxels to look down.
# #' Negative values indicate up.
# #'
# #' @param off_z integer, indicating the number of voxels to look in cross plane.
# #'
# #' @param symmetric logical, indicating whether to create a symmetric glcm
# #' by also calculating the glcm in the opposite direction (-1*off_right; -1*off_down;
# #' -1*off_z), 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 GLCM.
# #'
# #' @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(RIA_image, use_orig = FALSE, verbose_in = TRUE)
# #'
# #' #Use use_slot parameter to set which image to use
# #' RIA_image <- glcm(RIA_image, use_orig = FALSE, use_slot = "discretized$ep_4",
# #' off_right = 2, off_down = -1, off_z = 0)
# #'
# #' #Batch calculation of GLCM matrices on all discretized images
# #' RIA_image <- glcm(RIA_image, use_type = "discretized",
# #' off_right = 1, off_down = -1, off_z = 0)
# #' }
# #'
# #' @references
# #' Robert M. HARALICK et al.
# #' Textural Features for Image Classification.
# #' IEEE Transactions on Systems, Man, and Cybernetics. 1973; SMC-3:610-621.
# #' DOI: 10.1109/TSMC.1973.4309314
# #' \url{https://ieeexplore.ieee.org/document/4309314/}
# #'
# #' 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 <- function(RIA_data_in, off_right = 1, off_down = 0, off_z = 0, symmetric = TRUE, normalize = TRUE, use_type = "single", use_orig = FALSE, use_slot = NULL, save_name = NULL, verbose_in = TRUE)
{
data_in_orig <- check_data_in(RIA_data_in, use_type = use_type, use_orig = use_orig, use_slot = use_slot, verbose_in = verbose_in)
if(any(class(data_in_orig) != "list")) data_in_orig <- list(data_in_orig)
list_names <- names(data_in_orig)
if(!is.null(save_name) & (length(data_in_orig) != 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: ", length(data_in_orig), "\n"))
}
#cycle through all data
for (k in 1: length(data_in_orig))
{
data_in <- data_in_orig[[k]]
data_NA <- as.vector(data_in)
data_NA <- data_NA[!is.na(data_NA)]
if(length(data_NA) == 0) {stop("WARNING: SUPPLIED RIA_image DOES NOT CONTAIN ANY DATA!!!")}
if(length(dim(data_in)) < 2 | length(dim(data_in)) > 3) stop(paste0("DATA LOADED IS ", length(dim(data_in)), " DIMENSIONAL. ONLY 2D AND 3D DATA ARE SUPPORTED!"))
dim_x <- dim(data_in)[1]
dim_y <- dim(data_in)[2]
dim_z <- ifelse(!is.na(dim(data_in)[3]), dim(data_in)[3], 1)
dist <- max(abs(off_right), abs(off_down), abs(off_z)) ##maximum offset needed to increase matrix
base_m <- array(NA, dim = c(dim_x+2*dist, dim_y+2*dist, dim_z+2*dist))
base_m[(1+dist):(dim_x+dist), (1+dist):(dim_y+dist), (1+dist):(dim_z+dist)] <- data_in ##create base matrix containing data_in which is enlarged by dist in all directions
shift_m <- array(NA, dim = c(dim_x+2*dist, dim_y+2*dist, dim_z+2*dist))
shift_m[(1+(dist+off_down)):(dim_x+(dist+off_down)), (1+(dist-off_right)):(dim_y+(dist-off_right)), (1+(dist+off_z)):(dim_z+(dist+off_z))] <- data_in
#create gray level number, first by the name of the file, then the event log
num_ind <- unlist(gregexpr('[1-9]', list_names[k]))
num_txt <- substr(list_names[k], num_ind[1], num_ind[length(num_ind)])
gray_levels <- as.numeric(num_txt)
if (length(gray_levels) == 0) {
txt <- automatic_name(RIA_data_in, use_orig, use_slot)
num_ind <- unlist(gregexpr('[1-9]', txt))
num_txt <- substr(txt, num_ind[1], num_ind[length(num_ind)])
gray_levels <- as.numeric(num_txt)
}
gray_levels_unique <- unique(data_NA)[order(unique(data_NA))] #optimize which gray values to run on
#populate GLCM
glcm <- matrix(0, nrow = gray_levels, ncol = gray_levels)
for (i in gray_levels_unique) {
for (j in gray_levels_unique) {
glcm[i, j] <- sum(shift_m==i & base_m==j, na.rm = TRUE)
}
}
if(symmetric) glcm <- (glcm + t(glcm))
if(normalize) {
if(sum(glcm) == 0) {
} else {glcm <- glcm/sum(glcm)}
}
#export based-on processing type
if(use_type == "single") {
if(any(class(RIA_data_in) == "RIA_image") )
{
if(is.null(save_name)) {
txt <- automatic_name(RIA_data_in, use_orig, use_slot)
txt <- paste0(txt, "_", off_right, off_down, off_z)
RIA_data_in$glcm[[txt]] <- glcm
}
if(!is.null(save_name)) {RIA_data_in$glcm[[save_name]] <- glcm
}
}
}
if(use_type == "discretized") {
if(any(class(RIA_data_in) == "RIA_image"))
{
if(is.null(save_name[k])) {
txt <- list_names[k]
txt <- paste0(txt, "_", off_right, off_down, off_z)
RIA_data_in$glcm[[txt]] <- glcm
}
if(!is.null(save_name[k])) {RIA_data_in$glcm[[save_name[k]]] <- glcm
}
}
}
if(is.null(save_name)) {txt_name <- txt
} else {txt_name <- save_name}
if(verbose_in) {message(paste0("GLCM WAS SUCCESSFULLY ADDED TO '", txt_name, "' SLOT OF RIA_image$glcm\n"))}
}
if(any(class(RIA_data_in) == "RIA_image") ) return(RIA_data_in)
else return(glcm)
}
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.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions glcm
# #' @title Creates gray-level co-occurrence matrix of RIA image
# #' @encoding UTF-8
# #'
# #' @description Creates gray-level co-occurrence matrix (GLCM) from \emph{RIA_image}.
# #' GLCM assesses the spatial relation of voxels to each other. By default the \emph{$modif}
# #' image will be used to calculate GLCMs. 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 determined
# #' by the supplied string in \emph{save_name}, or is automatically generated by RIA.
# #'
# #' @param RIA_data_in \emph{RIA_image}.
# #'
# #' @param off_right integer, indicating the number of voxels to look to the right.
# #' Negative values indicate to the left.
# #'
# #' @param off_down integer, indicating the number of voxels to look down.
# #' Negative values indicate up.
# #'
# #' @param off_z integer, indicating the number of voxels to look in cross plane.
# #'
# #' @param symmetric logical, indicating whether to create a symmetric glcm
# #' by also calculating the glcm in the opposite direction (-1*off_right; -1*off_down;
# #' -1*off_z), 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 GLCM.
# #'
# #' @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(RIA_image, use_orig = FALSE, verbose_in = TRUE)
# #'
# #' #Use use_slot parameter to set which image to use
# #' RIA_image <- glcm(RIA_image, use_orig = FALSE, use_slot = "discretized$ep_4",
# #' off_right = 2, off_down = -1, off_z = 0)
# #'
# #' #Batch calculation of GLCM matrices on all discretized images
# #' RIA_image <- glcm(RIA_image, use_type = "discretized",
# #' off_right = 1, off_down = -1, off_z = 0)
# #' }
# #'
# #' @references
# #' Robert M. HARALICK et al.
# #' Textural Features for Image Classification.
# #' IEEE Transactions on Systems, Man, and Cybernetics. 1973; SMC-3:610-621.
# #' DOI: 10.1109/TSMC.1973.4309314
# #' \url{https://ieeexplore.ieee.org/document/4309314/}
# #'
# #' 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 <- function(RIA_data_in, off_right = 1, off_down = 0, off_z = 0, symmetric = TRUE, normalize = TRUE, use_type = "single", use_orig = FALSE, use_slot = NULL, save_name = NULL, verbose_in = TRUE)
{
data_in_orig <- check_data_in(RIA_data_in, use_type = use_type, use_orig = use_orig, use_slot = use_slot, verbose_in = verbose_in)
if(any(class(data_in_orig) != "list")) data_in_orig <- list(data_in_orig)
list_names <- names(data_in_orig)
if(!is.null(save_name) & (length(data_in_orig) != 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: ", length(data_in_orig), "\n"))
}
#cycle through all data
for (k in 1: length(data_in_orig))
{
data_in <- data_in_orig[[k]]
data_NA <- as.vector(data_in)
data_NA <- data_NA[!is.na(data_NA)]
if(length(data_NA) == 0) {stop("WARNING: SUPPLIED RIA_image DOES NOT CONTAIN ANY DATA!!!")}
if(length(dim(data_in)) < 2 | length(dim(data_in)) > 3) stop(paste0("DATA LOADED IS ", length(dim(data_in)), " DIMENSIONAL. ONLY 2D AND 3D DATA ARE SUPPORTED!"))
dim_x <- dim(data_in)[1]
dim_y <- dim(data_in)[2]
dim_z <- ifelse(!is.na(dim(data_in)[3]), dim(data_in)[3], 1)
dist <- max(abs(off_right), abs(off_down), abs(off_z)) ##maximum offset needed to increase matrix
base_m <- array(NA, dim = c(dim_x+2*dist, dim_y+2*dist, dim_z+2*dist))
base_m[(1+dist):(dim_x+dist), (1+dist):(dim_y+dist), (1+dist):(dim_z+dist)] <- data_in ##create base matrix containing data_in which is enlarged by dist in all directions
shift_m <- array(NA, dim = c(dim_x+2*dist, dim_y+2*dist, dim_z+2*dist))
shift_m[(1+(dist+off_down)):(dim_x+(dist+off_down)), (1+(dist-off_right)):(dim_y+(dist-off_right)), (1+(dist+off_z)):(dim_z+(dist+off_z))] <- data_in
#create gray level number, first by the name of the file, then the event log
num_ind <- unlist(gregexpr('[1-9]', list_names[k]))
num_txt <- substr(list_names[k], num_ind[1], num_ind[length(num_ind)])
gray_levels <- as.numeric(num_txt)
if (length(gray_levels) == 0) {
txt <- automatic_name(RIA_data_in, use_orig, use_slot)
num_ind <- unlist(gregexpr('[1-9]', txt))
num_txt <- substr(txt, num_ind[1], num_ind[length(num_ind)])
gray_levels <- as.numeric(num_txt)
}
gray_levels_unique <- unique(data_NA)[order(unique(data_NA))] #optimize which gray values to run on
#populate GLCM
glcm <- matrix(0, nrow = gray_levels, ncol = gray_levels)
for (i in gray_levels_unique) {
for (j in gray_levels_unique) {
glcm[i, j] <- sum(shift_m==i & base_m==j, na.rm = TRUE)
}
}
if(symmetric) glcm <- (glcm + t(glcm))
if(normalize) {
if(sum(glcm) == 0) {
} else {glcm <- glcm/sum(glcm)}
}
#export based-on processing type
if(use_type == "single") {
if(any(class(RIA_data_in) == "RIA_image") )
{
if(is.null(save_name)) {
txt <- automatic_name(RIA_data_in, use_orig, use_slot)
txt <- paste0(txt, "_", off_right, off_down, off_z)
RIA_data_in$glcm[[txt]] <- glcm
}
if(!is.null(save_name)) {RIA_data_in$glcm[[save_name]] <- glcm
}
}
}
if(use_type == "discretized") {
if(any(class(RIA_data_in) == "RIA_image"))
{
if(is.null(save_name[k])) {
txt <- list_names[k]
txt <- paste0(txt, "_", off_right, off_down, off_z)
RIA_data_in$glcm[[txt]] <- glcm
}
if(!is.null(save_name[k])) {RIA_data_in$glcm[[save_name[k]]] <- glcm
}
}
}
if(is.null(save_name)) {txt_name <- txt
} else {txt_name <- save_name}
if(verbose_in) {message(paste0("GLCM WAS SUCCESSFULLY ADDED TO '", txt_name, "' SLOT OF RIA_image$glcm\n"))}
}
if(any(class(RIA_data_in) == "RIA_image") ) return(RIA_data_in)
else return(glcm)
}
Try the RIA package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.