R/select_names.R

In espadon: Easy Study of Patient DICOM Data in Oncology

######################################################################################
#' Regions of Interest (RoI) indices
#' @description The select.names function allows you to select words from a
#' vector of words, according to several criteria, eliminating spaces and case.
#' @param names Words vector
#' @param roi.name Vector of words to compare to \code{names}. By default 
#' \code{roi.name = NULL}. See Details
#' @param roi.sname Vector of words or parts of words to compare. By default 
#' \code{roi.sname = NULL}. See Details
#' @param roi.idx Index vector. By default \code{roi.idx = NULL}. See Details.
#' @details If \code{roi.name}, \code{roi.sname}, and \code{roi.idx} are all 
#' \code{NULL}, then all RoI are selected.
# @note The returned index vector is sorted from smallest to largest.
#' @return Returns the indices of the elements of the word vector \code{names} 
#' satisfying one or more of the following conditions:
#' \itemize{
#' \item ASCII // TRANSLIT transcriptions, without spaces, of \code{names} and 
#' \code{roi.name}, are identical.
#' \item ASCII // TRANSLIT transcriptions, without spaces of \code{roi.sname}
#' are identical to part of ASCII // TRANSLIT transcriptions, without spaces of
#' \code{names}.
#' \item \code{names} indices belong to the index vector \code{roi.idx}.
#' }
#' @examples
#' # loading patient objects
#' names <- c ("Eye left", "EyeR", "OPTICAL nerve L", "opical nervR", "chiasma")
#'
#' # RoI selection.
#' select.names (names = names, roi.name = c("eye left", "eye right"))
#' select.names (names = names, roi.sname = c("eye", "ner"))
#' select.names (names = names, roi.idx = 4:9)

#' @export
select.names <- function (names, roi.name = NULL, roi.sname = NULL,
                          roi.idx = NULL) {
  if (is.null(names)) return(NULL)
  if (all (is.null (roi.name)) & all (is.null (roi.sname)) & all (is.null (roi.idx))) return (1:length (names))
  s.idx <- c()
  
  if (!all (is.null (roi.idx))) s.idx <- c(s.idx, roi.idx[roi.idx %in% 1:length (names)])
  
  a <- iconv (names, to="ASCII//TRANSLIT")
  a <- toupper (gsub("[[:space:],_]", "", a))
  b <- iconv (roi.name, to="ASCII//TRANSLIT")
  b <- toupper (gsub("[[:space:],_]", "", b))
  # if (!all (is.null (roi.name))) s.idx <- c(s.idx, which (a %in% b))
  if (!all (is.null (roi.name))) s.idx <- c(s.idx, match(b,a))
  s.idx <- s.idx[!is.na(s.idx)]
  
  b <- iconv (roi.sname, to="ASCII//TRANSLIT")
  b <- toupper (gsub("[[:space:],_]", "", b))
  if (!all (is.null (roi.sname))) {
    # result <- sapply (b, function (test) return (grepl (pattern=test, a)))
    # if (any(result)) s.idx <- c(s.idx, which (apply (result, 1, function (v) sum (v) > 0)))
    result <- unlist(lapply (b, function (test) return (grep (pattern=test, a))))
    if (length(result) > 0) s.idx <- c(s.idx, result)
  }
  # s.idx <- sort (unique (s.idx))
  s.idx <-  (unique (s.idx))
  if (length(s.idx)==0) return (NULL)
  return (s.idx)
}