R/plot.cpr_cn.R

In dewittpe/cpr: Control Polygon Reduction

#' Plotting Control Nets
#'
#' Three-dimensional plots of control nets and/or surfaces
#'
#' This plotting method generates three-dimensional plots of the control net,
#' surface, or both, for a \code{cpr_cn} objects.  The three-dimensional plots
#' are generated by either \code{\link[plot3D]{persp3D}} form the \code{plot3D}
#' package or \code{\link[rgl]{persp3d}} from the \code{rgl} package.
#' \code{rgl} graphics may or may not work on your system depending on support
#' for OpenGL.
#'
#' Building complex and customized graphics might be easier for you if you use
#' \code{\link{get_surface}} to generate the needed data for plotting.  See
#' \code{vignette(topic = "cnr", package = "cpr")} for examples of building
#' different plots.
#'
#' For \code{rgl} graphics, the \code{surface_args} and \code{net_args} are
#' lists of \code{\link[rgl]{rgl.material}} and other arguments passed to
#' \code{\link[rgl]{persp3d}}. Defaults are \code{col = "black", front =
#' "lines", back = "lines"} for the \code{net_args} and
#' \code{col = "grey20", front = "fill", back = "lines"} for the
#' \code{surface_args}.
#'
#' For \code{plot3D} graphics there are no defaults values for the
#' \code{net_args} and \code{surface_args}.
#'
#' @param x a \code{cpr_cn} object
#' @param ... common arguments which would be
#' used for both the plot of the control net and the surface, e.g., xlim, ylim,
#' zlim.
#' @param xlab,ylab,zlab labels for the axes.
#' @param show_net logical, show the control net
#' @param show_surface logical, show the tensor product surface
#' @param get_surface_args a list of arguments passed to the
#' \code{\link{get_surface}} call.  This call generates the needed data sets
#' used in the plotting.
#' @param net_args arguments to be used explicitly for the control net.  Ignored
#' if \code{show_net = FALSE}.
#' @param surface_args arguments to be used explicitly for the surface.  Ignored
#' if \code{show_surface = FALSE}.
#' @param rgl If \code{TRUE}, the default, generate use \code{rgl::persp3d} to
#' generate the graphics.  If \code{FALSE}, use \code{plot3D::persp3D} to
#' generate the graphics.
#'
#' @return the plotting data needed to generate the plot is returned invisibly.
#'
#' @seealso \code{\link{plot.cpr_cp}} for plotting control polygons and splines,
#' \code{\link[rgl]{persp3d}} and \code{\link[rgl]{rgl.material}} for generating
#' and controlling rgl graphics. \code{\link[plot3D]{persp3D}} for building
#' plot3D graphics. \code{\link{get_surface}} for generating the data sets
#' needed for the plotting methods.
#'
#' @seealso \code{vignette(topic = "cnr", package = "cpr")}
#'
#' @examples
#' \donttest{
#'  acn <- cn(log10(pdg) ~ btensor(  x = list(day, age)
#'                                 , df = list(30, 4)
#'                                 , bknots = list(c(-1, 1), c(44, 53)))
#'            , data = spdg)
#'
#' # plot3D
#' plot(acn, rgl = FALSE)
#'
#' # rgl
#' if (require(rgl)) {
#'   plot(acn, rgl = TRUE)
#' }
#' }
#'
#' @method plot cpr_cn
#' @export
plot.cpr_cn <- function(x, ...,
                        xlab = "", ylab = "", zlab = "",
                        show_net = TRUE,
                        show_surface = FALSE,
                        get_surface_args,
                        net_args,
                        surface_args,
                        rgl = TRUE
                        ) {

  if (missing(get_surface_args)) {
      get_surface_args <- list(x = x)
  } else {
    get_surface_args$x <- x
  }
  plot_data <- do.call(get_surface, get_surface_args)

  if (rgl & requireNamespace("rgl", quietly = TRUE)) {
    plotter <- match.fun(rgl::persp3d)
  } else {
    if (rgl) {
      rgl <- FALSE
      warning("requireNamespace('rgl') is FALSE - reverting to plot3D::persp3D")
    }
    plotter <- match.fun(plot3D::persp3D)
  }

  if (missing(net_args)) {
    if (rgl) {
      net_args <- list(col = "black", front = "lines", back = "lines", ...)
    } else {
      net_args <- list(...)
    }
  }

  if (missing(surface_args)) {
    if (rgl) {
      surface_args <- list(col = "grey20", front = "fill", back = "lines", ...)
    } else {
      surface_args <- list(...)
    }
  }

  net_args$xlab <- surface_args$xlab <- xlab
  net_args$ylab <- surface_args$ylab <- ylab
  net_args$zlab <- surface_args$zlab <- zlab

  if (show_net) {
    do.call(plotter,
            c(list(x = unique(plot_data$cn[[1]]),
                   y = unique(plot_data$cn[[2]]),
                   z = matrix(plot_data$cn[[3]],
                              nrow = length(unique(plot_data$cn[[1]])),
                              ncol = length(unique(plot_data$cn[[2]])))),
              net_args))
    if (show_surface) {
      do.call(plotter,
              c(list(x = unique(plot_data$surface[[1]]),
                     y = unique(plot_data$surface[[2]]),
                     z = matrix(plot_data$surface[[3]],
                                nrow = length(unique(plot_data$surface[[1]])),
                                ncol = length(unique(plot_data$surface[[2]])))),
                surface_args,
                add = TRUE))
    }
  } else if (!show_net && show_surface) {
      do.call(plotter,
              c(list(x = unique(plot_data$surface[[1]]),
                     y = unique(plot_data$surface[[2]]),
                     z = matrix(plot_data$surface[[3]],
                                nrow = length(unique(plot_data$surface[[1]])),
                                ncol = length(unique(plot_data$surface[[2]])))),
                surface_args))
  } else {
    warning("Nothing to plot.", call. = FALSE)
  }

  invisible(plot_data)
}