R/struct_from_bin.R

In espadon: Easy Study of Patient DICOM Data in Oncology

#' Creation of struct class object from a binary volume
#' @description The \code{struct.from.bin} function creates a struct object with 
#' a unique RoI, defined by the contours of binary volume.
#' @param vol "volume" class object, of binary modality.
#' @param roi.name Character string, representing the name of created RoI.
#' @param roi.nb Positive integer, representing the number of created RoI.
#' @param roi.color Color of the created RoI, in hex code format ("#RRGGBB").
#' @param roi.type Type of RoI, from among "", "EXTERNAL", "PTV", "CTV", "GTV", 
#' "TREATED_VOLUME", "IRRAD_VOLUME", "OAR", "BOLUS", "AVOIDANCE", "ORGAN", "MARKER", 
#' "REGISTRATION", "ISOCENTER", "CONTRAST_AGENT", "CAVITY", "BRACHY_CHANNEL", 
#' "BRACHY_ACCESSORY", "BRACHY_SRC_APP", "BRACHY_CHNL_SHLD", "SUPPORT", "FIXATION", 
#' "DOSE_REGION","CONTROL" and "DOSE_MEASUREMENT"
#' @param external.only Boolean. If \code{TRUE}, only external contours are kept.
#' @param alias Character string, \code{$alias} of the created object.
#' @param description Character string, describing the created object.
#' @return Returns a "struct" class object (see \link[espadon]{espadon.class}
#' for class definition), including the unique \code{roi.name} as region of interest.
#' @examples
#' # Contours of a sphere of 10 mm radius
#' b.sphere <- vol.create(n.ijk = c(40, 40, 40), dxyz = c(1,1,1), 
#'                        mid.pt = c(0, 0, 0), modality = "binary", 
#'                        default.value = FALSE)
#' xyz <- expand.grid(-20:19, -20:19, -20:19)
#' R <- 10
#' Sphere.flag <-(xyz[, 1]^2 + xyz[, 2]^2 + xyz[, 3]^2) <= R^2
#' b.sphere$vol3D.data[Sphere.flag] <- TRUE
#' b.sphere$max.pixel <- TRUE
#' S.sphere <- struct.from.bin(b.sphere, roi.name = "sphere", external.only = TRUE)
#' str(S.sphere$roi.info)                 

## @importFrom sp point.in.polygon
#' @importFrom methods is
#' @export
struct.from.bin <- function(vol, roi.name = vol$description, roi.nb = 1,
                            roi.color = "#379DA2", 
                            roi.type = c("","EXTERNAL", "PTV", "CTV", "GTV", 
                                         "TREATED_VOLUME", "IRRAD_VOLUME", "OAR", 
                                         "BOLUS", "AVOIDANCE", "ORGAN", "MARKER", 
                                         "REGISTRATION", "ISOCENTER", "CONTRAST_AGENT", 
                                         "CAVITY", "BRACHY_CHANNEL", "BRACHY_ACCESSORY", 
                                         "BRACHY_SRC_APP", "BRACHY_CHNL_SHLD", 
                                         "SUPPORT", "FIXATION", "DOSE_REGION", 
                                         "CONTROL", "DOSE_MEASUREMENT"),
                            external.only = FALSE, alias = "", 
                            description = paste("RoI from", vol$object.alias)) {
  
  if (!is(vol, "volume")) stop("vol should be a volume class object.")
  if ((vol$modality != "binary")) stop("vol must be of binary modality.")

  t.mat <- ref.cutplane.add(vol,ref.cutplane = "intern", origin = c(0,0,0))
  
  bin_ <- vol.in.new.ref(vol, new.ref.pseudo = "intern", t.mat)
  roi.name <- roi.name[1]
  roi.color <- roi.color[1]
  alias <- alias[1]
  defined.type <- c("","EXTERNAL", "PTV", "CTV", "GTV", 
                     "TREATED_VOLUME", "IRRAD_VOLUME", "OAR", 
                     "BOLUS", "AVOIDANCE", "ORGAN", "MARKER", 
                     "REGISTRATION", "ISOCENTER", "CONTRAST_AGENT", 
                     "CAVITY", "BRACHY_CHANNEL", "BRACHY_ACCESSORY", 
                     "BRACHY_SRC_APP", "BRACHY_CHNL_SHLD", 
                     "SUPPORT", "FIXATION", "DOSE_REGION", 
                     "CONTROL", "DOSE_MEASUREMENT")
  roi.type <- roi.type[!is.na(match(roi.type,defined.type))][1]
  if (is.na(roi.type)) roi.type <- ""
  
  struct <- list()
  
  struct$patient <- vol$patient
  struct$patient.name <- vol$patient.name
  struct$patient.bd <- vol$patient.bd
  struct$patient.sex <- vol$patient.sex
  struct$file.basename <- ""
  struct$file.dirname <- ""
  struct$object.name <- alias
  struct$object.alias <- alias
  struct$frame.of.reference <-  vol$frame.of.reference
  struct$ref.pseudo <- vol$ref.pseudo
  struct$modality <- "rtstruct"
  struct$description <- description
  d <- format(Sys.time(),"%Y%m%d")
  struct$acq.date <- vol$acq.date
  struct$study.date <- d
  struct$creation.date <- d
  struct$study.time <- ""
  
  struct$number <- 1
  struct$nb.of.roi <- 1
  if (vol$min.pixel == vol$max.pixel) struct$nb.of.roi <- 0
  
  struct$thickness <- round(vol$slice.thickness, 6)
  struct$ref.from.contour <- get.rigid.M(t.mat,src.ref = "intern",
                                         dest.ref = vol$ref.pseudo)
  # struct$ref.from.contour[,4] <- c(0,0,0,1)
  class(struct) <- "struct"
  if (struct$nb.of.roi == 0)  return(struct)
  
  struct$roi.info <- data.frame(number = roi.nb[1], name = roi.name, description = "", 
                                generation.algorithm = "automatic",
                                color = roi.color, 
                                roi.pseudo = tolower(gsub("[[:space:],_]", "", 
                                                          iconv(roi.name,  to = "ASCII//TRANSLIT"))))
  
  struct$roi.obs <- data.frame(nb = roi.nb[1], roi.nb = roi.nb[1], label = "", 
                               code.value = "", code.scheme = "",code.scheme.v = "",
                               code.meaning = "", type = roi.type, interpreter = "")
                                     
  struct$roi.data <- list()
  # struct$roi.data[[1]] <- .display.roi.data.from.bin(bin_, bin_$xyz0[1,])
  struct$roi.data[[1]] <- .display.roi.data.from.bin(bin_)

  # We check whether the contours are inscribed or not.
  roi.all.z <- sapply(struct$roi.data[[1]], function(li)  li$pt[1,3])
  if (length(roi.all.z) > 0) {     
    kz <- rep(0, length(roi.all.z))
    if (struct$thickness > 0) kz <- round((roi.all.z - roi.all.z[1]) / struct$thickness)
    
    for (k.value in unique(kz)) {
      same.k.roi <- which(kz == k.value)
      if (length(same.k.roi) > 1) {
        for (j in same.k.roi) {
          ptj <- struct$roi.data[[1]][[j]]$pt
          roi.index.k <- same.k.roi[same.k.roi != j]
          # if (length(roi.index.z)!=0) {
          r <- unique(sapply(roi.index.k, function(k) {
            ptk <- struct$roi.data[[1]][[k]]$pt
            keep <- .pt.in.polygon(ptj[ ,1], ptj[ ,2],
                                      ptk[ ,1], ptk[ ,2]) > 0.5
            return(ifelse(all(keep), k,NA))}))
          r <- r[!is.na(r)]
          struct$roi.data[[1]][[j]]$level <- ifelse(length(r) != 0, length(r), 0)
        } 
      } else struct$roi.data[[1]][[same.k.roi]]$level <- 0
    }
  }
  
  if (external.only) {
    level.f  <- sapply(struct$roi.data[[1]], function(l) l$level == 0)
    struct$roi.data[[1]] <- struct$roi.data[[1]][level.f]
  }
  # names(struct$roi.data) <- roi.name
  
  db <- .struct.moreinfo(struct$roi.data, struct$ref.from.contour, struct$thickness)
  struct$roi.info  <- cbind(struct$roi.info, db)
  if (alias == "") return(struct)
  return(.set.ref.obj(struct,list(vol)))
}