R/display_plane.R

In espadon: Easy Study of Patient DICOM Data in Oncology

#' Display the transverse frontal or sagittal view in the patient reference system
#' @description The \code{display.plane} function displays an overlay of images and RoI
#' closed planar contours on a plane defined by the equations x = constant (sagittal 
#' view), or y = constant (frontal view) or z = constant (transverse view) in a 
#' frame of reference chosen by the user.
#' @param bottom "volume" class object, displayed using \code{bottom.col}
#' palette. If \code{bottom = NULL}, no bottom image is displayed.
#' @param top "volume" class object, displayed as an overlay, using \code{top.col}
#' palette. If \code{top = NULL}, no overlay image is displayed.
#' @param struct "struct" class object. If \code{NULL}, no RoI is displayed. Only
#' RoI of closed planar or point type are displayed.
#' @param roi.name Vector of exact names of the RoI in the \code{struct} object.
#' By default \code{roi.name = NULL}. See Details.
#' @param roi.sname Vector of names or parts of names of the RoI in the \code{struct} 
#' object. By default \code{roi.sname = NULL}. See Details.
#' @param roi.idx Vector of indices of the RoI that belong to the \code{struct} 
#' object. By default \code{roi.idx = NULL}. See Details.
#' @param struct.dxyz 3D vector. Used in case of \code{bottom} and 
#' \code{top} are set to \code{NULL}. It represents the voxel size in the \code{display.ref} 
#' frame of reference, used to calculate contours in frontal or sagittal view.
#' @param display.ref Character string. Pseudonym of the frame of reference used 
#' for display. If \code{NULL} (default), the bottom image FoR, or top image FoR 
#' (when no bottom image), or struct FoR (when no volume displayed).
#' @param T.MAT "t.mat" class object, created by \link[espadon]{load.patient.from.Rdcm} 
#' or \link[espadon]{load.T.MAT}. If \code{T.MAT} is \code{NULL}, \code{bottom}, 
#' \code{top} and \code{struct} must have the same frame of reference.
#' @param interpolate Boolean, indicating whether to apply linear interpolation, 
#' when calculating the bottom and top cuts,and then when displaying them.
#' If \code{interpolate = FALSE}, the values of the nearest voxels are used. When \code{TRUE} (by delfault), 
#' trilinear interpolation is used.
#' @param view.type Character string, defining the view to display. It must be set to
#' \itemize{
#' \item \code{"trans"} for a transverse view,
#' \item \code{"front"} for a frontal view or,
#' \item \code{"sagi"} for a sagittal view.
#' }
#' @param view.coord Numeric vector of the coordinates along the normal vector of 
#' the selected view.
#' @param bg Background color of the image. By default, this color is black.
#' @param abs.rng Vector of 2 elements indicating the minimum and maximum abscissa
#' to display on the background image.
#' @param ord.rng Vector of 2 elements indicating the minimum and maximum ordinate
#' to display on the background image.
#' @param bottom.col,top.col Vectors, representing the palette color of 
#' \code{bottom} and \code{top}.
#' @param bottom.breaks,top.breaks One of :
#' \itemize{
#' \item \code{NULL} : the minimum and the maximum value of \code{bottom} or
#' \code{top} define the range.
#' \item Vector giving the breakpoints of each color. Outside values are transparent,
#' leaving the background visible, depending on \code{sat.transp}.
#' }
#' When breaks are specified, the number of breaks must be one unit more then the number of colors.
#' @param sat.transp Boolean. If \code{TRUE}, outside values are transparent, else set
#' to \code{bottom.breaks} or \code{top.breaks} limits.
#' @param struct.lwd Line thickness of the RoI contours.
#' @param main Character string. When \code{main} different from \code{NULL}, 
#' it replaces the title, and removes the subtitle and the maximum dose indication 
#' if \code{top} is of modality rtdose.
#' @param legend.plot Boolean, that indicates whether the RoI legend should be 
#' displayed on the image. It is displayed by default.
#' @param legend.shift Numeric. It shifts (in mm) the display of the RoI legend 
#' on x-axis.
#' @param legend.roi.pseudo Boolean. If \code{TRUE}, the name used 
#' for a RoI in the legend comes from the \code{struct$roi.info$roi.pseudo} 
#' column, otherwise the \code{struct$roi.info$name} column.
#' @param ... others parameters of plot function
#' @details If \code{roi.name}, \code{roi.sname}, and \code{roi.idx} are
#' all set to \code{NULL}, all closed planar or point RoI are selected.
#' If a RoI is not present in the requested plane, the RoI legend won't mention it.
#' @note 1- The main title is given by \code{bottom}, the
#' subtitle by \code{top}.
#' @note 2- When \code{top} is in the "rtdose" modality, the maximum dose is 
#' written on the image.
#' @seealso \link[espadon]{display.kplane}, \link[espadon]{plot.volume}, 
#' \link[espadon]{plot.struct}, \link[espadon]{plot.mesh}.
#' @return Returns a display of the  transverse, sagittal or frontal plane. This plane
#' has the coordinate z = view.coord (transverse), y = view.coord (sagittal) pr 
#' x = view.coord (frontal). The display is an overlay of:
#' \itemize{
#' \item a background image of uniform color \code{bg}
#' \item the bottom image if it exists
#' \item the top image if it exists
#' \item the contours of the regions of interest if they exist in the plane considered.
#' } 
#' @examples
#' # loading of toy-patient objects (decrease dxyz and increase beam.nb for 
#' # better result)
#' step <- 4
#' patient <- toy.load.patient (modality = c("ct", "mr", "rtstruct", "rtdose"), 
#'                              roi.name  = "",
#'                              dxyz = rep (step, 3), beam.nb = 3)
#' CT <- patient$ct[[1]]
#' MR <- patient$mr[[1]]
#' D <- patient$rtdose[[1]]
#' S <- patient$rtstruct[[1]]
#' 
#' display.plane (bottom = CT, top = D, struct = S, view.coord = -30, 
#'                interpolate = FALSE, legend.shift = -80)
#' # Display of CT in reference frame "ref1" and  MR in "ref2"               
#' display.plane (bottom = CT, top = MR, interpolate = FALSE)
#' 
#' # Display of CT and MR in reference frame "ref2"
#' display.plane (bottom = CT, top = MR, interpolate = FALSE, display.ref ="ref2",
#'                T.MAT = patient$T.MAT)
#' @export
#' @importFrom grDevices rainbow grey.colors
#' @importFrom methods is
display.plane <- function(bottom = NULL, top = NULL, struct = NULL, 
                          roi.name = NULL, roi.sname = NULL, roi.idx = NULL, 
                          struct.dxyz = c(0.5, 0.5, struct$thickness), 
                          display.ref = NULL, 
                          T.MAT = NULL, interpolate = TRUE,
                          view.type = c("trans", "front", "sagi"), 
                          view.coord = 0,
                          bg="#000000", abs.rng = NULL, ord.rng = NULL,
                          bottom.col = grey.colors(255, start = 0, end = 1),
                          top.col = pal.rainbow(255),
                          bottom.breaks = NULL, top.breaks = NULL, 
                          sat.transp = FALSE,
                          struct.lwd=2, main = NULL, 
                          legend.plot = TRUE, legend.shift = 0,
                          legend.roi.pseudo = TRUE, ...) {
  
  args <- tryCatch(list(...), error = function(e)list())
  if (!is.null(abs.rng)) args[["xlim"]] <- abs.rng
  if (!is.null(ord.rng)) args[["ylim"]] <- ord.rng
  if (!is.null(main)) args[["main"]] <- main
  args[["bg"]] <- bg
  args[["view.type"]] <- view.type[1]
  add <- FALSE
  if (!is.null(args[["add"]]))  add <- args[["add"]]
  
  xpd <- NULL
  on.exit(
    expr = {
      if (!is.null(xpd)) par(xpd = xpd)
    })

  view.type <- view.type[1]
  list.roi.idx <- NULL
  
  if (!is.null(struct) & !is(struct, "struct")) stop("struct should be a struct class object.")

  if (!is.null(bottom)) {
    if (!is(bottom, "volume")) {
      stop("bottom should be a volume class object.")
    } else if  (is.null(bottom$vol3D.data)) {
        message("bottom should have vol3D.data.")
        bottom$vol3D.data <- array(NA, dim = bottom$n.ijk)
    }
  }
  if (!is.null(top)) {
    if (!is(top, "volume")) {
      stop("top should be a volume class object.")
    } else if (is.null(top$vol3D.data)) {
      message("top should have vol3D.data.")
      top$vol3D.data <- array(NA, dim = bottom$n.ijk)
    }
  }

  if (length(view.coord) == 0) stop("view.coord length is 0.")
  if (!is.null(struct)) list.roi.idx <- select.names(struct$roi.info$roi.pseudo, roi.name, roi.sname, roi.idx)

  warn.ref <- FALSE
  warn.ref.struct <- FALSE
  selected.ref <- display.ref
  if (is.null(selected.ref)) {
    if (!is.null(bottom)) selected.ref <- bottom$ref.pseudo
    else if (!is.null(top)) selected.ref <- top$ref.pseudo
    else if (!is.null(list.roi.idx) & length(list.roi.idx) != 0) selected.ref <- struct$ref.pseudo
    else return(NULL)
  }
  
  if (length(unique(c(display.ref,bottom$ref.pseudo, 
                      top$ref.pseudo, struct$ref.pseudo))) != 1 & 
      is.null(T.MAT)) warning("objects have different ref.pseudo. Load T.MAT for correct display")
  if (!is.null(bottom)) {
    dum <- tryCatch(vol.in.new.ref(bottom, selected.ref, T.MAT), error = function(e) NULL)
    if (is.null(dum)) {
      warning(paste("bottom is displayed in the ref.pseudo", bottom$ref.pseudo, "instead of", selected.ref))
      warn.ref <- TRUE
    } else {bottom <- dum}}
  if (!is.null(top)) {
    dum <- tryCatch(vol.in.new.ref(top, selected.ref, T.MAT),error = function(e) NULL)
    if (is.null(dum)) {
      warning(paste("top is displayed in the ref.pseudo", top$ref.pseudo, "instead of", selected.ref))
      warn.ref <- TRUE
    } else {top <- dum}}

  if (is.null(bottom) & is.null(top) & is.null(list.roi.idx)) {
    stop("nothing to display")
  }

  if (!is.null(list.roi.idx)) {
    dum <- tryCatch(struct.in.new.ref(struct,new.ref.pseudo = selected.ref, T.MAT), error = function(e) NULL)
    if (is.null(dum)) {
      warning(paste("struct is displayed in the ref.pseudo", struct$ref.pseudo, "instead of", selected.ref))
      warn.ref.struct <- TRUE
    } else {struct <- dum}}
  if (is.null(struct))  {
    list.roi.idx <- NULL
  }else{
    back.dxyz <- struct.dxyz
    if (!is.null(bottom)) {
      back.dxyz[1:2] <- c(min(bottom$dxyz[1],back.dxyz[1]), min(bottom$dxyz[2],back.dxyz[2]))
    } else if (!is.null(top)) {
      back.dxyz <- c(min(bottom$dxyz[1],back.dxyz[1]), min(bottom$dxyz[2],back.dxyz[2]))
    }
  }

  for (coord.idx in 1:length(view.coord)) {
    args[["view.coord"]] <- view.coord[coord.idx]
    
    coord.lab <- switch(view.type, "trans" = "z", "front" = "y", "sagi" = "x")
    
    top.p <- bottom.p <- NULL
    if (!is.null(bottom)) {
      args_ <- args
 
      args_[["x"]] <- bottom
      args_[["col"]] <- bottom.col
      args_[["breaks"]] <- bottom.breaks 
      args_[["sat.transp"]] <- sat.transp 
      args_[["add"]] <-  add
      args_[["cut.interpolate"]] <- interpolate
      args_[["display.interpolate"]] <- interpolate
      if (is.null(main)) args_[["main"]] <- ""
      
      bottom.p <- tryCatch(suppressMessages(do.call(plot,args_)), error = function(e) list(max.pixel = NA))
      if (is.na(bottom.p$max.pixel)) {
        bottom.p <- NULL; 
        message("no bottom view @", coord.lab," = ", round(view.coord[coord.idx],2), " mm")
      } else if (is.null(main)) {
        idx <- which(bottom.p$xyz.from.ijk[,3] != 0)
        mtext(paste(bottom$modality, "(", bottom$description,") @ ", c("x","y","z")[idx],
                      " = ",round(bottom.p$xyz0[1,idx],3)," mm",sep = ""),
               side = 3, line = par()$cex.main*(1.3),  cex = par()$cex.main, font = par()$font.main)
      }
    }
    
    if (!is.null(top)) {
      args_ <- args
      args_[["x"]] <- top
      args_[["col"]] <- top.col
      args_[["breaks"]] <- top.breaks 
      args_[["sat.transp"]] <- sat.transp 
      args_[["add"]] <- !is.null(bottom.p$max.pixel) | add
      args_[["cut.interpolate"]] <- interpolate
      args_[["display.interpolate"]] <- interpolate
      top.p <- tryCatch(suppressMessages(do.call(plot,args_)), error = function(e) list(max.pixel = NA))
      if (is.na(top.p$max.pixel)) {
        top.p <- NULL; 
        message("no top view @", coord.lab," = ", round(view.coord[coord.idx],2), " mm")
      } else if (is.null(main)) {
        if (args_[["add"]]) {
          idx <- which(top.p$xyz.from.ijk[,3] != 0)
          mtext(paste(top$modality, "(", top$description,") @ ", c("x","y","z")[idx],
                        " = ",round(top.p$xyz0[1,idx], 3), " mm",sep = ""),
                 side = 3, line = 0.4, col = 'gray32', cex = 0.8)
        }
        if (top$modality  == "rtdose")
          text(par("usr")[1], par("usr")[4] - (par("usr")[4] - par("usr")[3]) * 0.1,
               paste("  Dose max : ", round(top.p$max.pixel, 3)," Gy", sep = ""),
               cex = 1, col = "red", adj = c(0,0))
      }
      
    }
    if (length(list.roi.idx) != 0) {
      args_ <- args
      args_[["x"]] <- struct
      args_[["col"]] <- NULL
      args_[["breaks"]] <- NULL
      args_[["sat.transp"]] <- NULL 
      args_[["add"]] <- !(is.null(bottom.p) & is.null(top.p)) | add
      args_[["lwd"]] <- !is.null(struct.lwd)
      args_[["interpolate"]] <- NULL
      args_[["roi.idx"]] <- list.roi.idx
      args_[["lwd"]] <- struct.lwd
      args_[["back.dxyz"]] <- struct.dxyz
      S  <- tryCatch(do.call(plot,args_), error = function(e) list(nb.of.roi = 0))
      
      if (S$nb.of.roi > 0) {
        legendlabel <- S$roi.info$roi.pseudo
        legendcol <- S$roi.info$color
        type <- do.call(rbind.data.frame,lapply(S$roi.data, function(L) {
          v <- castlow.str(unique(sapply(L,function(l) l$type)))
          return(c(any(grepl("planar$",v)), any(grepl("point$",v))))}))
        legendlty <- rep(0,nrow(type)); legendlty[type[,1]] <- 1
        legendpch <- rep(" ", nrow(type)); legendpch[type[,2]] <- "+"
        if (length(legendlabel) > 0 & legend.plot) {
          xpd <- par()$xpd
          par(xpd = TRUE)
          legend(par("usr")[2] + legend.shift, par("usr")[4],
                 legend = legendlabel, col = legendcol,
                 ncol = 1, lty = legendlty, lwd = struct.lwd, pch = legendpch,
                 bty = "o", cex = 0.6, text.col = "white", bg = "black")
        }
      }
    }
  }
}