R/plot2dgraphics.R

In zenplots: Zigzag Expanded Navigation Plots

## Default 2d plot functions based on graphics
## Idea: Pass through all arguments you want to adjust (in a base graphics
##       plot function) as formal arguments with good defaults (and only those).
##       Use `...' to pass through all other parameters of the base
##       graphics function.


##' @title Point plot in 2d
##' @param x An (n,2)-matrix of points
##' @param cex Character extension factor
##' @param plotID The plot ID as passed from zenplot()
##' @param turn The turn out of the current plot
##' @param add A logical indicating whether this plot should be added to the last one
##' @param ann A logicial indicating whether the plot should be annotated (e.g., titles etc.)
##' @param axes A logicial indicating whether axes should be drawn
##' @param xlim x limits of the plotting region (to set the scale)
##' @param ylim y limits of the plotting region (to set the scale)
##' @param ... Additional parameters passed to plot()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, plotID, turn have to be passed here
##'       as they are not valid graphical parameters (when passed on to '...')
points_2d_graphics <- function(x, type="p", cex=0.4,
                               plotID, turn,
                               add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1),
                               ...)
{
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    points(x, type=type, cex=cex, ...)
}

##' @title Density plot in 2d
##' @param x An (n,2)-matrix of points
##' @param ngrids Number of grid points in each dimension.
##'        Can be scalar or a length-2 integer vector.
##' @param nlevels Number of contour levels to be drawn.
##' @param drawlabels A logical indicating whether the contours should be labelled
##' @param plotID The plot ID as passed from zenplot()
##' @param turn The turn out of the current plot
##' @param add A logical indicating whether this plot should be added to the last one
##' @param axes A logicial indicating whether axes should be drawn
##' @param xlim x limits of the plotting region (to set the scale)
##' @param ylim y limits of the plotting region (to set the scale)
##' @param ... Additional parameters passed to contour()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
density_2d_graphics <- function(x, ngrids=25, nlevels=10, drawlabels=FALSE,
                                plotID, turn,
                                add=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    dens <- kde2d(x[,1], x[,2], n=ngrids, lims=c(xlim, ylim))
    contour(dens$x, dens$y, dens$z, drawlabels=drawlabels, add=add, axes=axes, ...)
}

##' @title Axes arrows in 2d
##' @param x An (n,2)-matrix of points
##' @param plotID The plot ID as passed from zenplot()
##' @param turn The turn out of the current plot
##' @param length The length of the arrow head
##' @param eps Distance by which the axes are moved away from the plot region
##' @param code Integer code determining the kind of arrows to be drawn; see ?arrows
##' @param xpd A logical or NA, determining the region with respect to which clipping
##'        takes place; see ?par
##' @param add A logical indicating whether this plot should be added to the last one
##' @param ann A logicial indicating whether the plot should be annotated (e.g., titles etc.)
##' @param axes A logicial indicating whether axes should be drawn
##' @param xlim x limits of the plotting region (to set the scale)
##' @param ylim y limits of the plotting region (to set the scale)
##' @param ... Additional parameters passed to arrows()
##' @note Inspired by https://stat.ethz.ch/pipermail/r-help/2004-October/059525.html
axes_2d_graphics <- function(x, length=0.1, eps=0.04, code=2, xpd=NA,
                             plotID, turn,
                             add=FALSE, ann=FALSE, axes=FALSE,
                             xlim=c(0,1), ylim=c(0,1), ...)
{
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim)
    arrows(xlim[1]-eps, ylim[1]-eps, xlim[2]+eps, ylim[1]-eps,
           length=length, code=code, xpd=xpd, ...) # x axis
    arrows(xlim[1]-eps, ylim[1]-eps, xlim[1]-eps, ylim[2]+eps,
           length=length, code=code, xpd=xpd, ...) # y axis
}

##' @title Label plot in 2d
##' @param loc.x x-location of the label
##' @param loc.y y-location of the label
##' @param labels The label to be used
##' @param adj x (and optionally y) adjustment of the label
##' @param cex The font size magnification factor
##' @param x An (n,2)-matrix of points
##' @param plotID The plot ID as passed from zenplot()
##' @param turn The turn out of the current plot
##' @param add A logical indicating whether this plot should be added to the last one
##' @param ann A logicial indicating whether the plot should be annotated (e.g., titles etc.)
##' @param axes A logicial indicating whether axes should be drawn
##' @param xlim x limits of the plotting region (to set the scale)
##' @param ylim y limits of the plotting region (to set the scale)
##' @param ... Additional parameters passed to text()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
label_2d_graphics <- function(loc.x=1, loc.y=0, labels=NULL,
                              adj=c(1,0), cex=0.75,
                              x, plotID, turn,
                              add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    if(is.null(labels))
        labels <- if(is.null(colnames(x))) { # also applies to a vector (colnames == NULL)
            paste0("Indices (",plotID$idx[1],", ",plotID$idx[2],")")
        } else {
            paste0("Var (",plotID$name[1],", ",plotID$name[2],")")
        }
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    text(x=loc.x, y=loc.y, labels=labels, adj=adj, cex=cex, ...)
}

##' @title Arrow plot in 2d
##' @param loc (x,y) location of the center of the arrow
##' @param length The length of the edges of the arrow head (in inches)
##' @param angle The angle from the shaft to the edge of the arrow head
##' @param x n-vector of data
##' @param plotID The plot ID as passed from zenplot()
##' @param turn A turn ("l", "r", "d", "u")
##' @param add A logical indicating whether this plot should be added to the last one
##' @param ann A logicial indicating whether the plot should be annotated (e.g., titles etc.)
##' @param axes A logicial indicating whether axes should be drawn
##' @param xlim x limits of the plotting region (to set the scale)
##' @param ylim y limits of the plotting region (to set the scale)
##' @param ... Additional parameters passed to segments()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
arrow_2d_graphics <- function(loc=c(xlim[2], ylim[2])/2, length=0.2, angle=30,
                              x, plotID, turn,
                              add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    arr <- loc + zen_arrow(turn, length=length, angle=angle)
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    segments(x0=rep(arr[1,2], 2), y0=rep(arr[2,2], 2),
             x1=c(arr[1,1], arr[1,3]), y1=c(arr[2,1], arr[2,3]), ...)
}

##' @title Rectangle plot in 2d
##' @param loc.x x-location of rectangle
##' @param loc.y y-location of rectangle
##' @param width The width of the rugs as a fraction of 1
##' @param height The height of the rugs as a fraction of 1
##' @param x An (n,2)-matrix of points
##' @param plotID The plot ID as passed from zenplot()
##' @param turn A turn ("l", "r", "d", "u")
##' @param add A logical indicating whether this plot should be added to the last one
##' @param ann A logicial indicating whether the plot should be annotated (e.g., titles etc.)
##' @param axes A logicial indicating whether axes should be drawn
##' @param xlim x limits of the plotting region (to set the scale)
##' @param ylim y limits of the plotting region (to set the scale)
##' @param ... Additional parameters passed rect()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
rect_2d_graphics <- function(loc.x=0.5, loc.y=0.5, width=1.08, height=1.08,
                             x, plotID, turn,
                             add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    xleft <- loc.x-width/2
    xright <- loc.x+width/2
    ybottom <- loc.y-height/2
    ytop <- loc.y+height/2
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    rect(xleft=xleft, ybottom=ybottom, xright=xright, ytop=ytop, ...)
}