R/plot.cpr_cn.R

#' 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.
#'
#' 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("cpr-pkg", 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}.
#'
#' @author Peter DeWitt \email{dewittpe@gmail.com}
#'
#' @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 result of the \code{get_surface} call 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.
#'
#' @examples
#' ## see vignette("cpr-pkg", package = "cpr")
#'
#' @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
  }
  .data <- do.call(get_surface, get_surface_args)

  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 (rgl) {
    plotter <- match.fun(rgl::persp3d)
  } else {
    plotter <- match.fun(plot3D::persp3D)
  }

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

  invisible(.data)
}

Try the cpr package in your browser

Any scripts or data that you put into this service are public.

cpr documentation built on May 1, 2019, 10:46 p.m.