R/geometry.R
In neuroconductor/RIA: Radiomics Image Analysis Toolbox for Medial Images
Defines functions
geometry
Documented in
geometry
#' @title Calculates geometry-based parameters of RIA image
#' @export
#'
#' @description Calculates geometry-based parameters of original or subcomponents of
#' an image after discretization.
#' By default the \emph{$modif} image will be used to calculate statistics. 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{stat_geometry} 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 xy_dim numeric, in plane resolution.
#'
#' @param z_dim numeric, cross plane resolution.
#'
#' @param all_vol numeric, volume of whole lesion.
#'
#' @param all_surf numeric, surface of whole lesion.
#'
#' @param calc_dist logical, whether to calculate distances, may take very long.
#'
#' @param calc_sub logical, indicating whether to calculate metrics for all different values
#' present in the image. This can be useful for calculating metrics of subcomponents for
#' a discretized image. If FALSE, then all voxels are treated equally and the results will
#' be based on the whole image.
#'
#' @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{$stat_geometry} 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 geometry calculations.
#'
#' @examples \dontrun{
#' #Calculate geometry-based parameters on original image
#' RIA_image <- geometry(RIA_image, use_orig = TRUE, calc_sub = FALSE)
#'
#' #Discretize loaded image and then calculate geometry-based statistics on subcomponents
#' RIA_image <- discretize(RIA_image, bins_in = c(4,8), equal_prob = TRUE, use_orig = TRUE)
#' RIA_image <- geometry(RIA_image, use_orig = FALSE, calc_sub = TRUE)
#'
#' #Use use_slot parameter to set which image to use
#' RIA_image <- geometry(RIA_image, use_orig = FALSE, calc_sub = TRUE, use_slot = "discretized$ep_4")
#'
#' #Batch calculation of geometry-based statistics on all discretized images and subcomponents
#' RIA_image <- geometry(RIA_image, use_type = "discretized", calc_sub = TRUE)
#' }
#'
#'
#' @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
geometry<- function(RIA_data_in, xy_dim = RIA_data_in$log$orig_xy_dim, z_dim = RIA_data_in$log$orig_z_dim, all_vol = RIA_data_in$log$orig_vol_mm, all_surf = RIA_data_in$log$orig_surf_mm,
calc_dist = FALSE, calc_sub = 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), "\n"))
}
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) {message("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!"))
# if(!calc_sub) {data_in[!is.na(data_in)] <- 1; data_NA <- 1}
# values <- as.numeric(names(table(data_NA)))
#create gray level number, first by the name of the file, then the event log, then by the number of gray levels
if(!calc_sub) {
data_in[!is.na(data_in)] <- 1; data_NA <- 1
gray_levels <- as.numeric(names(table(data_NA)))
} else {
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)
}
}
#volume
calc_v <- list(); calc_vr <- list()
#surface
calc_s <- list(); calc_sr <- list(); calc_sv <- list()
#compactness
calc_c1 <- list(); calc_c2 <- list();
#sphericitiy
calc_sd <- list(); calc_sh <- list()
#distance
if(calc_dist) calc_d <- list()
#Fractal
calc_bc_d <- list(); calc_i_d <- list(); calc_c_d <- list()
for(j in 1:gray_levels) {
mod_dichot_data <- data_in
mod_dichot_data[mod_dichot_data != j] <- NA
vol <- volume(mod_dichot_data, xy_dim = xy_dim, z_dim = z_dim)
calc_v[[as.character(j)]] <- vol
calc_vr[[as.character(j)]] <- ifelse(all_vol > 0, vol/all_vol, 0)
surf <- surface(mod_dichot_data, xy_dim = xy_dim, z_dim = z_dim)
calc_s[[as.character(j)]] <- surf
calc_sr[[as.character(j)]] <- ifelse(all_surf > 0, surf/all_surf, 0)
calc_sv[[as.character(j)]] <- ifelse(vol > 0, surf/vol, 0)
compact1 <- compactness1(vol = vol, surf = surf)
compact2 <- compactness2(vol = vol, surf = surf)
calc_c1[[as.character(j)]] <- compact1
calc_c2[[as.character(j)]] <- compact2
spher_dis <- spherical_dis(vol = vol, surf = surf)
spher <- sphericity(vol = vol, surf = surf)
calc_sd[[as.character(j)]] <- spher_dis
calc_sh[[as.character(j)]] <- spher
if(calc_dist) dist <- surface_dis(mod_dichot_data, xy_dim = xy_dim, z_dim = z_dim); if(calc_dist) calc_d[[as.character(j)]] <- dist
fractal_d <- fractal(mod_dichot_data)
calc_bc_d[[as.character(j)]] <- as.numeric(fractal_d[1])
calc_i_d[[as.character(j)]] <- as.numeric(fractal_d[2])
calc_c_d[[as.character(j)]] <- as.numeric(fractal_d[3])
}
if(use_type == "single") {
if(any(class(RIA_data_in) == "RIA_image") )
{
if(is.null(save_name)) {
txt_name <- automatic_name(RIA_data_in = RIA_data_in, orig_in = use_orig, use_slot = use_slot)
}
if(!is.null(save_name)) {txt_name <- save_name
}
}
}
if(use_type == "discretized") {
if(any(class(RIA_data_in) == "RIA_image"))
{
if(is.null(save_name[k])) {
txt_name <- list_names[k]
}
if(!is.null(save_name[k])) {txt_name <- list_names[k]
}
}
}
RIA_data_in$stat_geometry[[txt_name]][["volume"]] <- calc_v
RIA_data_in$stat_geometry[[txt_name]][["v_ratio_to_all"]] <- calc_vr
RIA_data_in$stat_geometry[[txt_name]][["surface"]] <- calc_s
RIA_data_in$stat_geometry[[txt_name]][["s_ratio_to_all"]] <- calc_sr
RIA_data_in$stat_geometry[[txt_name]][["surface_volume_r"]] <- calc_sv
RIA_data_in$stat_geometry[[txt_name]][["compactness1"]] <- calc_c1
RIA_data_in$stat_geometry[[txt_name]][["compactness2"]] <- calc_c2
RIA_data_in$stat_geometry[[txt_name]][["spher_dis"]] <- calc_sd
RIA_data_in$stat_geometry[[txt_name]][["spher"]] <- calc_sh
if(calc_dist) RIA_data_in[[txt_name]][["max_distance"]] <- calc_d
RIA_data_in$stat_geometry[[txt_name]][["fractal_bc_d"]] <- calc_bc_d
RIA_data_in$stat_geometry[[txt_name]][["fractal_i_d"]] <- calc_i_d
RIA_data_in$stat_geometry[[txt_name]][["fractal_c_d"]] <- calc_c_d
if(verbose_in) {message(paste0("GEOMETRY-BASED STATISTICS WAS SUCCESSFULLY ADDED TO '", txt_name, "' SLOT OF RIA_image$stat_geometry\n"))}
}
if(any(class(RIA_data_in) == "RIA_image") ) return(RIA_data_in)
else return(RIA_data_in)
}
neuroconductor/RIA documentation built on May 21, 2021, 6:56 a.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 geometry
Documented in geometry
#' @title Calculates geometry-based parameters of RIA image
#' @export
#'
#' @description Calculates geometry-based parameters of original or subcomponents of
#' an image after discretization.
#' By default the \emph{$modif} image will be used to calculate statistics. 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{stat_geometry} 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 xy_dim numeric, in plane resolution.
#'
#' @param z_dim numeric, cross plane resolution.
#'
#' @param all_vol numeric, volume of whole lesion.
#'
#' @param all_surf numeric, surface of whole lesion.
#'
#' @param calc_dist logical, whether to calculate distances, may take very long.
#'
#' @param calc_sub logical, indicating whether to calculate metrics for all different values
#' present in the image. This can be useful for calculating metrics of subcomponents for
#' a discretized image. If FALSE, then all voxels are treated equally and the results will
#' be based on the whole image.
#'
#' @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{$stat_geometry} 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 geometry calculations.
#'
#' @examples \dontrun{
#' #Calculate geometry-based parameters on original image
#' RIA_image <- geometry(RIA_image, use_orig = TRUE, calc_sub = FALSE)
#'
#' #Discretize loaded image and then calculate geometry-based statistics on subcomponents
#' RIA_image <- discretize(RIA_image, bins_in = c(4,8), equal_prob = TRUE, use_orig = TRUE)
#' RIA_image <- geometry(RIA_image, use_orig = FALSE, calc_sub = TRUE)
#'
#' #Use use_slot parameter to set which image to use
#' RIA_image <- geometry(RIA_image, use_orig = FALSE, calc_sub = TRUE, use_slot = "discretized$ep_4")
#'
#' #Batch calculation of geometry-based statistics on all discretized images and subcomponents
#' RIA_image <- geometry(RIA_image, use_type = "discretized", calc_sub = TRUE)
#' }
#'
#'
#' @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
geometry<- function(RIA_data_in, xy_dim = RIA_data_in$log$orig_xy_dim, z_dim = RIA_data_in$log$orig_z_dim, all_vol = RIA_data_in$log$orig_vol_mm, all_surf = RIA_data_in$log$orig_surf_mm,
calc_dist = FALSE, calc_sub = 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), "\n"))
}
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) {message("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!"))
# if(!calc_sub) {data_in[!is.na(data_in)] <- 1; data_NA <- 1}
# values <- as.numeric(names(table(data_NA)))
#create gray level number, first by the name of the file, then the event log, then by the number of gray levels
if(!calc_sub) {
data_in[!is.na(data_in)] <- 1; data_NA <- 1
gray_levels <- as.numeric(names(table(data_NA)))
} else {
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)
}
}
#volume
calc_v <- list(); calc_vr <- list()
#surface
calc_s <- list(); calc_sr <- list(); calc_sv <- list()
#compactness
calc_c1 <- list(); calc_c2 <- list();
#sphericitiy
calc_sd <- list(); calc_sh <- list()
#distance
if(calc_dist) calc_d <- list()
#Fractal
calc_bc_d <- list(); calc_i_d <- list(); calc_c_d <- list()
for(j in 1:gray_levels) {
mod_dichot_data <- data_in
mod_dichot_data[mod_dichot_data != j] <- NA
vol <- volume(mod_dichot_data, xy_dim = xy_dim, z_dim = z_dim)
calc_v[[as.character(j)]] <- vol
calc_vr[[as.character(j)]] <- ifelse(all_vol > 0, vol/all_vol, 0)
surf <- surface(mod_dichot_data, xy_dim = xy_dim, z_dim = z_dim)
calc_s[[as.character(j)]] <- surf
calc_sr[[as.character(j)]] <- ifelse(all_surf > 0, surf/all_surf, 0)
calc_sv[[as.character(j)]] <- ifelse(vol > 0, surf/vol, 0)
compact1 <- compactness1(vol = vol, surf = surf)
compact2 <- compactness2(vol = vol, surf = surf)
calc_c1[[as.character(j)]] <- compact1
calc_c2[[as.character(j)]] <- compact2
spher_dis <- spherical_dis(vol = vol, surf = surf)
spher <- sphericity(vol = vol, surf = surf)
calc_sd[[as.character(j)]] <- spher_dis
calc_sh[[as.character(j)]] <- spher
if(calc_dist) dist <- surface_dis(mod_dichot_data, xy_dim = xy_dim, z_dim = z_dim); if(calc_dist) calc_d[[as.character(j)]] <- dist
fractal_d <- fractal(mod_dichot_data)
calc_bc_d[[as.character(j)]] <- as.numeric(fractal_d[1])
calc_i_d[[as.character(j)]] <- as.numeric(fractal_d[2])
calc_c_d[[as.character(j)]] <- as.numeric(fractal_d[3])
}
if(use_type == "single") {
if(any(class(RIA_data_in) == "RIA_image") )
{
if(is.null(save_name)) {
txt_name <- automatic_name(RIA_data_in = RIA_data_in, orig_in = use_orig, use_slot = use_slot)
}
if(!is.null(save_name)) {txt_name <- save_name
}
}
}
if(use_type == "discretized") {
if(any(class(RIA_data_in) == "RIA_image"))
{
if(is.null(save_name[k])) {
txt_name <- list_names[k]
}
if(!is.null(save_name[k])) {txt_name <- list_names[k]
}
}
}
RIA_data_in$stat_geometry[[txt_name]][["volume"]] <- calc_v
RIA_data_in$stat_geometry[[txt_name]][["v_ratio_to_all"]] <- calc_vr
RIA_data_in$stat_geometry[[txt_name]][["surface"]] <- calc_s
RIA_data_in$stat_geometry[[txt_name]][["s_ratio_to_all"]] <- calc_sr
RIA_data_in$stat_geometry[[txt_name]][["surface_volume_r"]] <- calc_sv
RIA_data_in$stat_geometry[[txt_name]][["compactness1"]] <- calc_c1
RIA_data_in$stat_geometry[[txt_name]][["compactness2"]] <- calc_c2
RIA_data_in$stat_geometry[[txt_name]][["spher_dis"]] <- calc_sd
RIA_data_in$stat_geometry[[txt_name]][["spher"]] <- calc_sh
if(calc_dist) RIA_data_in[[txt_name]][["max_distance"]] <- calc_d
RIA_data_in$stat_geometry[[txt_name]][["fractal_bc_d"]] <- calc_bc_d
RIA_data_in$stat_geometry[[txt_name]][["fractal_i_d"]] <- calc_i_d
RIA_data_in$stat_geometry[[txt_name]][["fractal_c_d"]] <- calc_c_d
if(verbose_in) {message(paste0("GEOMETRY-BASED STATISTICS WAS SUCCESSFULLY ADDED TO '", txt_name, "' SLOT OF RIA_image$stat_geometry\n"))}
}
if(any(class(RIA_data_in) == "RIA_image") ) return(RIA_data_in)
else return(RIA_data_in)
}
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.