R/ref_remove.R

In espadon: Easy Study of Patient DICOM Data in Oncology

#' Deletion of a frame of reference in T.MAT
#' @description The \code{ref.remove} function removes the management of a frame
#' of reference in T.MAT.
#' @param ref.name Character string, pseudonym of the frame of reference to delete.
#' @param T.MAT "t.mat" class object in which the \code{ref.name} frame of 
#' reference is to be deleted.
#' @return Returns a "t.mat" class object, which no longer contains transfer 
#' matrices from or to the ref.pseudo \code{ref.name}.
#' \link[espadon]{ref.cutplane.add}.
#' @examples
#' # Adding of the reference frame "ref1_60", which is a 60 degree rotation of 
#' # reference frame "ref1".
#' orientation <- c(cos(pi / 3), sin(pi / 3), 0, 
#'                  -sin(pi / 3), cos(pi / 3), 0)
#'
#' local.Tmat <- ref.add(src.ref = "ref1", orientation = orientation,
#'                       new.ref.pseudo = "ref1_60")
#' str(local.Tmat)
#' 
#' # Removal of  "ref1_60"
#' local.Tmat <- ref.remove(ref.name =  "ref1_60", T.MAT = local.Tmat)
#' str(local.Tmat)

#' @export
#' @importFrom methods is

ref.remove <- function(ref.name, T.MAT) {
  if (!is(T.MAT, "t.mat")) {
    warning("T.MAT should be a t.mat class object.")
    return(NULL)
  }
  
  ref.info <- T.MAT$ref.info[T.MAT$ref.info$ref.pseudo != ref.name,]
  row.names(ref.info) <- NULL
  
  
  reg.info <- T.MAT$reg.info 
  if (nrow(T.MAT$reg.info$file) != 0)
    reg.info$file <- T.MAT$reg.info$file[sapply(T.MAT$reg.info$file$t, 
                                                function(str) !(ref.name %in% unlist(strsplit(str,"<-")))),]
  
  matrix.description <- unlist(lapply(ref.info$ref.pseudo,function(r) paste(paste(ref.info$ref.pseudo, r, sep = "<-"), r, ref.info$ref.pseudo, sep = ";")))
  matrix.description <- do.call(rbind.data.frame, strsplit(matrix.description, ";"))
  names(matrix.description)  <- c("t","src","dest")
  matrix.description$type = ""
  matrix.description[] <- data.frame(lapply(matrix.description[], as.character), stringsAsFactors = FALSE)
  
  list.matrix <- lapply(matrix.description$t,function(r) return(NULL))
  names(list.matrix) <- matrix.description$t
  for (i in 1:nrow(matrix.description)) {
    if (!is.null(T.MAT$matrix.list[[matrix.description$t[i]]])) {
      list.matrix[[i]] <- T.MAT$matrix.list[[matrix.description$t[i]]]
      matrix.description[i,]$type <- T.MAT$matrix.description[T.MAT$matrix.description$t == matrix.description$t[i], ]$type
    }
  }
  r <- list(ref.info = ref.info, reg.info = reg.info, matrix.description = matrix.description, matrix.list = list.matrix)
  class(r) <- "t.mat"
  return(r)
}