Nothing
R/first_order.R
In RIA: Radiomics Image Analysis Toolbox for Medial Images
Defines functions
first_order
# #' @title Calculates first-order statistical metrics for RIA_image
# #'
# #' @description Calculates first-order statistical metrics of \emph{RIA_image}.
# #' First-order metrics discard all spatial information. By default the \emph{$orig}
# #' 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_fo} 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 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 whether 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_fo} to save results to.
# #' If left empty, then it will be automatically determined.
# #'
# #' @param verbose_in logical indicating whether to print detailed information.
# #' Most prints can also be suppresed using the \code{\link{suppressMessages}} function.
# #'
# #' @return \emph{RIA_image} containing the statistical information.
# #'
# #' @examples \dontrun{
# #' #Calculate first-order statistics on original data
# #' RIA_image <- first_order(RIA_image, use_orig = TRUE)
# #'
# #' #Dichotomize loaded image and then calculate first order statistics
# #' on it and save results into the RIA_image
# #' RIA_image <- dichotomize(RIA_image, bins_in = c(4, 8), equal_prob = TRUE,
# #' use_orig = TRUE, write_orig = FALSE)
# #' RIA_image <- first_order(RIA_image, use_orig = FALSE, verbose_in = TRUE)
# #'
# #' #Use use_slot parameter to set which image to use
# #' RIA_image <- first_order(RIA_image, use_orig = FALSE, use_slot = "discretized$ep_4")
# #'
# #' #Batch calculation of first-order statistics on all discretized images
# #' RIA_image <- first_order(RIA_image, use_type = "discretized")
# #' }
# #'
# #' @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
first_order <- function(RIA_data_in, use_type = "single", use_orig = TRUE, use_slot = NULL, save_name = NULL, verbose_in = TRUE)
{
data_in <- 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) != "list")) data_in <- list(data_in)
list_names <- names(data_in)
if(!is.null(save_name) & (length(data_in) != 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 (i in 1: length(data_in))
{
data <- as.vector(data_in[[i]])
data <- data[!is.na(data)]
data_NA <- as.vector(data)
data_NA <- data_NA[!is.na(data_NA)]
if(length(data_NA) == 0) {stop("WARNING: SUPPLIED RIA_image DOES NOT CONTAIN ANY DATA!!!")}
Mean <- base::mean(data)
Median <- stats::median(data)
Mode <- mode(data)[1]
Geo_mean <- geo_mean(data)
Geo_mean2 <- geo_mean2(data)
Geo_mean3 <- geo_mean3(data)
Har_mean <- har_mean(data)
Trim_mean_5 <- base::mean(data, trim = 0.025)
Trim_mean_10 <- base::mean(data, trim = 0.05)
Trim_mean_20 <- base::mean(data, trim = 0.1)
IQ_mean <- base::mean(data, trim = 0.25)
Tri_mean <- (as.numeric(stats::quantile(data, 0.25)) +2*as.numeric(stats::quantile(data, 0.50)) + as.numeric(stats::quantile(data, 0.25)))/4
Mn_AD_mn <- mn_AD_mn(data)
Mn_AD_md <- mn_AD_md(data)
Md_AD_mn <- md_AD_mn(data)
Md_AD_md <- md_AD_md(data)
MAD <- stats::mad(data)
Max_AD_mn <- max_AD_mn(data)
Max_AD_md <- max_AD_md(data)
RMS <- rms(data)
Min <- base::min(data)
Max <- base::max(data)
Quartiles <- stats::quantile(data, seq(0.25, 0.75, 0.50))
IQR <- stats::IQR(data)
Low_notch <- as.numeric(Quartiles[1])-1.5*IQR
High_notch <- as.numeric(Quartiles[1])+1.5*IQR
Range <- abs(abs(base::range(data)[2] - base::range(data)[1]))
Deciles <- stats::quantile(data, seq(0.1, 0.9, 0.1))
Variance <- ifelse(length(data)>1, stats::var(data), 0)
SD <- ifelse(length(data)>1, stats::sd(data), 0)
Skew <- ifelse(length(data)>1, skew(data), 0)
Kurtosis <- ifelse(length(data)>1, kurtosis(data), 0)
Energy <- energy(data)
Uniformity <- uniformity(data)
Entropy <- entropy(data, 2)
metrics <- list(
Mean <- Mean,
Median <- Median,
Mode <- Mode,
Geo_mean <- Geo_mean,
Geo_mean2 <- Geo_mean2,
Geo_mean3 <- Geo_mean3,
Har_mean <- Har_mean,
Trim_mean_5 <- Trim_mean_5,
Trim_mean_10 <- Trim_mean_10,
Trim_mean_20 <- Trim_mean_20,
IQ_mean <- IQ_mean,
Tri_mean <- Tri_mean,
Mn_AD_mn <- Mn_AD_mn,
Mn_AD_md <- Mn_AD_md,
Md_AD_mn <- Md_AD_mn,
Md_AD_md <- Md_AD_md,
MAD <- MAD,
Max_AD_mn <- Max_AD_mn,
Max_AD_md <- Max_AD_md,
RMS <- RMS,
Min <- Min,
Max <- Max,
Quartiles <- Quartiles,
IQR <- IQR,
Low_notch <- Low_notch,
High_notch <- High_notch,
Range <- Range,
Deciles <- Deciles,
Variance <- Variance,
SD <- SD,
Skew <- Skew,
Kurtosis <- Kurtosis,
Energy <- Energy,
Uniformity <- Uniformity,
Entropy <- Entropy
)
names(metrics) <- c("Mean",
"Median",
"Mode",
"Geo_mean",
"Geo_mean2",
"Geo_mean3",
"Har_mean",
"Trim_mean_5",
"Trim_mean_10",
"Trim_mean_20",
"IQ_mean",
"Tri_mean",
"Mn_AD_mn",
"Mn_AD_md",
"Md_AD_mn",
"Md_AD_md",
"MAD",
"Max_AD_mn",
"Max_AD_md",
"RMS",
"Min",
"Max",
"Quartiles",
"IQR",
"Low_notch",
"High_notch",
"Range",
"Deciles",
"Variance",
"SD",
"Skew",
"Kurtosis",
"Energy",
"Uniformity",
"Entropy")
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)
RIA_data_in$stat_fo[[txt]] <- metrics
}
if(!is.null(save_name)) {RIA_data_in$stat_fo[[save_name]] <- metrics
}
}
}
if(use_type == "discretized") {
if(any(class(RIA_data_in) == "RIA_image"))
{
if(is.null(save_name[i])) {
txt <- list_names[i]
RIA_data_in$stat_fo[[txt]] <- metrics
}
if(!is.null(save_name[i])) {RIA_data_in$stat_fo[[save_name[i]]] <- metrics
}
}
}
if(is.null(save_name)) {txt_name <- txt
} else {txt_name <- save_name[i]}
if(verbose_in) {message(paste0("FIRST-ORDER STATISTICS WAS SUCCESSFULLY ADDED TO '", txt_name, "' SLOT OF RIA_image$stat_fo\n")) }
}
if(any(class(RIA_data_in) == "RIA_image") ) return(RIA_data_in)
else return(metrics)
}
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 first_order
# #' @title Calculates first-order statistical metrics for RIA_image
# #'
# #' @description Calculates first-order statistical metrics of \emph{RIA_image}.
# #' First-order metrics discard all spatial information. By default the \emph{$orig}
# #' 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_fo} 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 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 whether 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_fo} to save results to.
# #' If left empty, then it will be automatically determined.
# #'
# #' @param verbose_in logical indicating whether to print detailed information.
# #' Most prints can also be suppresed using the \code{\link{suppressMessages}} function.
# #'
# #' @return \emph{RIA_image} containing the statistical information.
# #'
# #' @examples \dontrun{
# #' #Calculate first-order statistics on original data
# #' RIA_image <- first_order(RIA_image, use_orig = TRUE)
# #'
# #' #Dichotomize loaded image and then calculate first order statistics
# #' on it and save results into the RIA_image
# #' RIA_image <- dichotomize(RIA_image, bins_in = c(4, 8), equal_prob = TRUE,
# #' use_orig = TRUE, write_orig = FALSE)
# #' RIA_image <- first_order(RIA_image, use_orig = FALSE, verbose_in = TRUE)
# #'
# #' #Use use_slot parameter to set which image to use
# #' RIA_image <- first_order(RIA_image, use_orig = FALSE, use_slot = "discretized$ep_4")
# #'
# #' #Batch calculation of first-order statistics on all discretized images
# #' RIA_image <- first_order(RIA_image, use_type = "discretized")
# #' }
# #'
# #' @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
first_order <- function(RIA_data_in, use_type = "single", use_orig = TRUE, use_slot = NULL, save_name = NULL, verbose_in = TRUE)
{
data_in <- 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) != "list")) data_in <- list(data_in)
list_names <- names(data_in)
if(!is.null(save_name) & (length(data_in) != 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 (i in 1: length(data_in))
{
data <- as.vector(data_in[[i]])
data <- data[!is.na(data)]
data_NA <- as.vector(data)
data_NA <- data_NA[!is.na(data_NA)]
if(length(data_NA) == 0) {stop("WARNING: SUPPLIED RIA_image DOES NOT CONTAIN ANY DATA!!!")}
Mean <- base::mean(data)
Median <- stats::median(data)
Mode <- mode(data)[1]
Geo_mean <- geo_mean(data)
Geo_mean2 <- geo_mean2(data)
Geo_mean3 <- geo_mean3(data)
Har_mean <- har_mean(data)
Trim_mean_5 <- base::mean(data, trim = 0.025)
Trim_mean_10 <- base::mean(data, trim = 0.05)
Trim_mean_20 <- base::mean(data, trim = 0.1)
IQ_mean <- base::mean(data, trim = 0.25)
Tri_mean <- (as.numeric(stats::quantile(data, 0.25)) +2*as.numeric(stats::quantile(data, 0.50)) + as.numeric(stats::quantile(data, 0.25)))/4
Mn_AD_mn <- mn_AD_mn(data)
Mn_AD_md <- mn_AD_md(data)
Md_AD_mn <- md_AD_mn(data)
Md_AD_md <- md_AD_md(data)
MAD <- stats::mad(data)
Max_AD_mn <- max_AD_mn(data)
Max_AD_md <- max_AD_md(data)
RMS <- rms(data)
Min <- base::min(data)
Max <- base::max(data)
Quartiles <- stats::quantile(data, seq(0.25, 0.75, 0.50))
IQR <- stats::IQR(data)
Low_notch <- as.numeric(Quartiles[1])-1.5*IQR
High_notch <- as.numeric(Quartiles[1])+1.5*IQR
Range <- abs(abs(base::range(data)[2] - base::range(data)[1]))
Deciles <- stats::quantile(data, seq(0.1, 0.9, 0.1))
Variance <- ifelse(length(data)>1, stats::var(data), 0)
SD <- ifelse(length(data)>1, stats::sd(data), 0)
Skew <- ifelse(length(data)>1, skew(data), 0)
Kurtosis <- ifelse(length(data)>1, kurtosis(data), 0)
Energy <- energy(data)
Uniformity <- uniformity(data)
Entropy <- entropy(data, 2)
metrics <- list(
Mean <- Mean,
Median <- Median,
Mode <- Mode,
Geo_mean <- Geo_mean,
Geo_mean2 <- Geo_mean2,
Geo_mean3 <- Geo_mean3,
Har_mean <- Har_mean,
Trim_mean_5 <- Trim_mean_5,
Trim_mean_10 <- Trim_mean_10,
Trim_mean_20 <- Trim_mean_20,
IQ_mean <- IQ_mean,
Tri_mean <- Tri_mean,
Mn_AD_mn <- Mn_AD_mn,
Mn_AD_md <- Mn_AD_md,
Md_AD_mn <- Md_AD_mn,
Md_AD_md <- Md_AD_md,
MAD <- MAD,
Max_AD_mn <- Max_AD_mn,
Max_AD_md <- Max_AD_md,
RMS <- RMS,
Min <- Min,
Max <- Max,
Quartiles <- Quartiles,
IQR <- IQR,
Low_notch <- Low_notch,
High_notch <- High_notch,
Range <- Range,
Deciles <- Deciles,
Variance <- Variance,
SD <- SD,
Skew <- Skew,
Kurtosis <- Kurtosis,
Energy <- Energy,
Uniformity <- Uniformity,
Entropy <- Entropy
)
names(metrics) <- c("Mean",
"Median",
"Mode",
"Geo_mean",
"Geo_mean2",
"Geo_mean3",
"Har_mean",
"Trim_mean_5",
"Trim_mean_10",
"Trim_mean_20",
"IQ_mean",
"Tri_mean",
"Mn_AD_mn",
"Mn_AD_md",
"Md_AD_mn",
"Md_AD_md",
"MAD",
"Max_AD_mn",
"Max_AD_md",
"RMS",
"Min",
"Max",
"Quartiles",
"IQR",
"Low_notch",
"High_notch",
"Range",
"Deciles",
"Variance",
"SD",
"Skew",
"Kurtosis",
"Energy",
"Uniformity",
"Entropy")
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)
RIA_data_in$stat_fo[[txt]] <- metrics
}
if(!is.null(save_name)) {RIA_data_in$stat_fo[[save_name]] <- metrics
}
}
}
if(use_type == "discretized") {
if(any(class(RIA_data_in) == "RIA_image"))
{
if(is.null(save_name[i])) {
txt <- list_names[i]
RIA_data_in$stat_fo[[txt]] <- metrics
}
if(!is.null(save_name[i])) {RIA_data_in$stat_fo[[save_name[i]]] <- metrics
}
}
}
if(is.null(save_name)) {txt_name <- txt
} else {txt_name <- save_name[i]}
if(verbose_in) {message(paste0("FIRST-ORDER STATISTICS WAS SUCCESSFULLY ADDED TO '", txt_name, "' SLOT OF RIA_image$stat_fo\n")) }
}
if(any(class(RIA_data_in) == "RIA_image") ) return(RIA_data_in)
else return(metrics)
}
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.