R/first_order.R

Defines functions first_order

Documented in first_order

#' @title Calculates first-order statistical metrics for RIA_image
#' @export
#'
#' @description  Calculates first-order statistical metrics of \emph{RIA_image}.
#' First-order metrics discard all spatial information. 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_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://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


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 July 2, 2018, 1:04 a.m.