R/vol_create.R

In espadon: Easy Study of Patient DICOM Data in Oncology

#' Volume creating
#' @description The \code{vol.create} function creates a volume object from a 
#' user-defined grid.
#' @param n.ijk Vector of length 3, representing the number of elements on the i, 
#' j and k axes.
#' @param dxyz Vector of length 3, representing the x, y, z steps in mm, between 
#' voxels. See details.
#' @param mid.pt Vector of length 3, representing the x, y, z coordinates of the
#' midpoint  of the volume. See details.
#' @param pt000 Vector of length 3, representing the x, y, z coordinates of the
#' first voxel of the first plane.
#' @param default.value Numerical or boolean value, representing the default 
#' value of the voxels.
#' @param value.sd Positive integer. If \code{default.value} is a number, it 
#' represents standard deviation of the volume default value.
#' @param ref.pseudo Character string, frame of reference pseudonym of the 
#' created object.By defaukt equal to "ref1"
#' @param frame.of.reference Character string, frame of reference of the 
#' created object.
#' @param alias Character string, \code{$alias} of the created object.
#' @param modality Character string, \code{$modality} of the created object.
#' @param description Character string, describing the the created object.
#' @param number Integer, by default set to 0, number of the created object.
#' @details If \code{mid.pt} and \code{pt000} are both equal to \code{NULL}, 
#' then \code{mid.pt = c (0, 0, 0)} by default. 
#' If \code{mid.pt} and \code{pt000} are both different from \code{NULL}, then 
#' only \code{mid.pt} is taken into account. 


#' @return Returns a "volume" class object (see \link[espadon]{espadon.class} 
#' for class definitions), in which the grid is defined by  \code{pt000} or 
#' \code{mid.pt}, \code{dxyz} \code{n.ijk}. If \code{default.value} are 
#' initialized to \code{FALSE}, then \code{modality = "binary"}. 
#' The orientation of the patient is orthonormal to the grid.

#' @examples
#' new.vol <- vol.create (pt000 = c(1,10,10), dxyz = c (1 , 1, 1),
#'                        n.ijk = c(100, 100, 100),
#'                        ref.pseudo = "ref1",
#'                        frame.of.reference = "toyref1",
#'                        alias = "new ct", modality = "ct",
#'                        description = "")
#' str (new.vol)

#' @export
vol.create <- function (n.ijk, dxyz, mid.pt = NULL, pt000 = NULL, 
                        default.value = NA, value.sd = 0, ref.pseudo = "ref1", 
                        frame.of.reference = "",
                        alias = "", modality = "",  
                        description = "", number = 0) {
  
  if (is.null(pt000) & is.null(mid.pt)) {
    mid.pt <- c (0, 0, 0)
    pt000 <- mid.pt + (0.5 - n.ijk/2.0) * dxyz
  } else if(is.null(pt000)){
    pt000 <- mid.pt + (0.5 - n.ijk/2.0) * dxyz
  }
  
  back.vol <- list()
  back.vol$patient <- ""
  back.vol$patient.name <- ""
  back.vol$patient.bd <- ""
  back.vol$patient.sex <- ""
  
  back.vol$file.basename <- ""
  back.vol$file.dirname <- ""
  back.vol$object.name <- alias
  back.vol$object.alias <- alias

  back.vol$frame.of.reference <- frame.of.reference
  back.vol$ref.pseudo <- ref.pseudo
  back.vol$modality <- modality
  back.vol$description <- description
  if (!is.na(default.value) & modality == "" & is.logical(default.value)) back.vol$modality = "binary"
  
  
  back.vol$acq.date <- ""
  back.vol$study.date <- ""
  back.vol$creation.date <- format(Sys.Date(), "%Y%m%d")
  
  # back.vol$error <- ""
  
  back.vol$number <- number

 
  back.vol$unit <- ""
  back.vol$n.ijk <- n.ijk
  back.vol$slice.thickness <- abs (dxyz[3])



  back.vol$dxyz<- dxyz
  back.vol$orientation <- c(1,0,0,0,1,0)
  back.vol$xyz0 <- matrix(pt000,ncol=3)
 

  back.vol$xyz.from.ijk <- as.matrix( cbind (c (1,0,0,0) * dxyz[1],
                                             c (0,1,0,0) * dxyz[2],
                                             c (0,0,1,0) * dxyz[3],
                                             c (pt000,1)))
  
  back.vol$k.idx <- 0:(n.ijk[3]-1)
  back.vol$missing.k.idx <- FALSE
  
  back.vol$xyz0  <- matrix((as.matrix (expand.grid (0, 0, back.vol$k.idx,1))%*% t(back.vol$xyz.from.ijk))[ ,1:3],ncol=3)
  
  back.vol$cube.idx <- matrix ( c(0,0,0,1,
                                  n.ijk[1]-1, 0, 0, 1,
                                  n.ijk[1]-1, n.ijk[2]-1, 0, 1,
                                  0, n.ijk[2]-1, 0, 1,
                                  0, 0, n.ijk[3]-1, 1,
                                  n.ijk[1]-1, 0, n.ijk[3]-1, 1,
                                  n.ijk[1]-1, n.ijk[2]-1, n.ijk[3]-1, 1,
                                  0, n.ijk[2]-1, n.ijk[3]-1, 1), nrow=4, byrow= FALSE)
  
  if (is.numeric(default.value[1]) & abs(value.sd)!=0) {
    back.vol$vol3D.data <- rnorm (prod(back.vol$n.ijk), default.value[1], abs(value.sd))
    if (is.integer(default.value[1]))  back.vol$vol3D.data  <- as.integer(round(back.vol$vol3D.data))
    back.vol$vol3D.data <- array(back.vol$vol3D.data, dim=back.vol$n.ijk)
    back.vol$min.pixel <- min(back.vol$vol3D.data, na.rm = TRUE)
    back.vol$max.pixel <- max(back.vol$vol3D.data, na.rm = TRUE)
  } else {
    back.vol$vol3D.data <- array(default.value[1], dim=back.vol$n.ijk)
    back.vol$min.pixel <- default.value[1]
    back.vol$max.pixel <- default.value[1]
    }

  class (back.vol) <- "volume"
  return(back.vol)
}