R/plot3d.BrcParcellation.R

In cdgreenidge/brcvis:

#' Generic 3D Plotting
#'
#' Generic function for 3D plotting of R objects.
#'
#' For detailed documentation, use `methods(plot3d)` and
#' see the man pages for the individual methods.
#'
#' @param x the S3 object to plot
#' @param ... Arguments to be passed to methods, such as graphical parameters.
#' @export
plot3d <- function(x, ...) UseMethod("plot3d")

#' 3D Plotting for a BrcParcellation Object
#'
#' Creates a 3D plot of a BrcParcellation.
#'
#' @param x the BrcParcellation object
#' @param view a string specifying the camera view. One of "saggital",
#'   "saggital_reversed", "coronal", "coronal_reversed", "axial", or
#'   "axial_reversed"
#' @param colors A list of R colors similar to that generated by
#'   grDevices::rainbow().  Must contain a background color, plus exactly as
#'   many colors as there are unique parcels. If NULL, a default coloring is
#'   used.
#' @param ... not used
plot3d.BrcParcellation <- function(x, view="sagittal", colors=NULL, ...) {
  numParcels <- .numParcels(x)

  tryCatch({ brcbase::isValid(x) }, error=function(e) {
    stop(paste("Tried to plot invalid BrcParcellation object: ", e))
  })

  if (is.null(colors)) {
    colors <- .defaultColors(numParcels)
  } else if (!all(.isColor(colors))) {
    stop("color argument contains invalid colors")
  } else if (.numParcels(x) != (length(colors) - 1)) {
    stop(paste("colors argument must contain 1 more color than the number ",
               "of parcels in the parcellation"))
  }

  arr <- .parcellationToArray(x)
  shapes <- .arrayToShapes(arr)
  kdes <- .smoothShapes(shapes)
  invisible(.plotKdes(kdes, view, colors))

}

.arrayToShapes <- function(arr) {
  parcels <- unique(c(arr))
  parcels <- parcels[parcels != 0]
  shapes <- lapply(parcels, function(x) {
    which(arr == x, arr.ind=T)
  })
}

.smoothShapes <- function(shapes) {
  lapply(shapes, function(x) {
    bandwidth <- matrix(1, ncol=3, nrow=3)
    diag(bandwidth) <- 3
    ks::kde(x, H=bandwidth, compute.cont=TRUE)
  })
}

.plotKdes <- function(kdes, view, colors) {
  rgl::material3d(shininess=0, specular="#000000")
  for (i in 1:length(kdes)) {
    graphics::plot(kdes[[i]],
                   add=TRUE,
                   alphavec=1,
                   axes=FALSE,
                   box=FALSE,
                   colors=colors[[i + 1]],
                   cont=30,
                   drawpoints=FALSE,
                   xlab="",
                   ylab="",
                   zlab="")
  }
  rgl::clear3d(type="lights")
  rgl::light3d(specular="black")
  rgl::light3d(diffuse=grDevices::rgb(0.4, 0.4, 0.4), specular="black")
  invisible(rgl::par3d("userMatrix"=.rglView(view)))
}

.rglView <- function(view) {
  mat <- switch(view,
    sagittal={
      matrix(c(0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow=4, ncol=4)
    },
    sagittal_reversed={
      matrix(c(0, 0, -1, 0, -1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow=4,
             ncol=4)
    },
    coronal={
      matrix(c(1, 0, 0, 0, 0, 0, -1, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow=4, ncol=4)
    },
    coronal_reversed={
      matrix(c(-1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1), nrow=4, ncol=4)
    },
    axial={
      diag(4)
    },
    axial_reversed={
      matrix(c(-1, 0, 0, 0, 0, 1, 0, 0, 0, 0, -1, 0, 0, 0, 0, 1), nrow=4,
             ncol=4)
    },
    {
      stop(paste("view argument must be one of 'sagittal',",
                 "'sagittal_reversed', 'coronal', 'coronal_reversed',",
                 "'axial', or 'axial_reversed'"))
    }
  )
}