R/plot1dgraphics.R

## Default 1d 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 Rug plot in 1d
##' @param x n-vector of data
##' @param width The width of the rugs
##' @param height The height of the rugs
##' @param col The color of the rugs
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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 rug() (e.g., to 'axis')
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##'       as they are not valid graphical parameters (when passed on to '...')
rug_1d_graphics <- function(x, width=if(horizontal) 1 else 0.4,
                            height=if(horizontal) 0.4 else 1, col=par("fg"),
                            horizontal=TRUE, plotAsp=0.1, plotID, turn,
                            add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    len.x <- length(x)
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    if(len.x > 0) {
        if(horizontal)
            segments(x0=x, y0=0.5-height/2, x1=x, y1=0.5+height/2, col=col, lwd=width, ...)
        else
            segments(x0=0.5-width/2, y0=x, x1=0.5+width/2, y1=x, col=col, lwd=height, ...)
    }
}

##' @title Dot plot in 1d
##' @param x n-vector of data
##' @param cex Character extension factor
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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 rug() (e.g., to 'axis')
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##'       as they are not valid graphical parameters (when passed on to '...')
points_1d_graphics <- function(x, cex=0.4,
                               horizontal=TRUE, plotAsp=0.1, 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
    if(horizontal)
        points(x=x,y=rep(0.5,length(x)), cex=cex, ...)
    else
        points(x=rep(0.5,length(x)), y=x, cex=cex, ...)
}

##' @title Jittered dot plot in 1d
##' @param x n-vector of data
##' @param cex Character extension factor
##' @param offset A number in [0,0.5] determining the distance between the
##'        1d and 2d plots (for creating space between the two)
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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 rug() (e.g., to 'axis')
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##'       as they are not valid graphical parameters (when passed on to '...')
jitter_1d_graphics <- function(x, cex=0.4, offset=0.25, horizontal=TRUE,
                               plotAsp=0.1, plotID, turn,
                               add=FALSE, ann=FALSE, axes=FALSE,
                               xlim=c(0,1), ylim=c(0,1), ...)
{
    stopifnot(0 <= offset, offset <= 0.5)
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    if(horizontal)
        points(x=x, y=offset+(1-2*offset)*runif(length(x)), cex=cex, ...)
    else
        points(x=offset+(1-2*offset)*runif(length(x)), y=x, cex=cex, ...)
}

##' @title Density plot in 1d
##' @param x n-vector of data
##' @param density.args A list of arguments for density()
##' @param offset A number in [0,0.5] determining the distance between the
##'        1d and 2d plots (for creating space between the two)
##' @param method A character specifying the density type used
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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 lines()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
density_1d_graphics <- function(x, density.args=list(), offset=0.25, method=c("single", "double"),
                                horizontal=TRUE, plotAsp=0.1, plotID, turn,
                                add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    stopifnot(0 <= offset, offset <= 0.5)
    dens <- do.call(density, args=c(list(x), density.args))
    xvals <- dens$x
    keepers <- (xvals >= min(x)) & ( xvals <= max(x))
    xvals <- xvals[keepers]
    xrange <- range(xvals)
    xvals <- (xvals - min(xrange))/diff(xrange)
    yvals <- dens$y[keepers]
    method <- match.arg(method)
    switch(method,
           "single" = {
               yvals <- yvals/max(yvals)
               if(horizontal) {
                   x <- c(min(xvals),xvals, max(xvals))
                   y <- c(0, yvals, 0)
               } else {
                   x <-  c(0, yvals, 0)
                   y <- c(min(xvals),xvals, max(xvals))
               }
           },
           "double" = {
               xvals <- rep(xvals, 2)
               yvals <- c(-yvals, yvals)
               yrange <- range(yvals)
               yvals <- (yvals - min(yrange))/diff(yrange)
               if(horizontal) {
                   x <- xvals
                   y <- yvals
               } else {
                   x <- yvals
                   y <- xvals
               }
           },
           stop("Wrong 'method'"))
    ## Scaling to avoid overplotting of plot2d()
    if(horizontal) {
        min.y <- min(y)
        max.y <- max(y)
        y <- (1-2*offset) * (y-min.y)/(max.y-min.y) + offset # scale to [offset, 1-offset]
    } else {
        min.x <- min(x)
        max.x <- max(x)
        x <- (1-2*offset) * (x-min.x)/(max.x-min.x) + offset # scale to [offset, 1-offset]
    }
    if(!add) plot(0, type="n", ann=ann, axes=axes, xlim=xlim, ylim=ylim) # set up plot region
    polygon(x=x, y=y, ...)
}

##' @title Box plot in 1d
##' @param x n-vector of data
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @param range numerical value used to determine how far the plot whiskers extend. If
##'        NULL, the whiskers (range) grows with sample size.
##' @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 axes A logicial indicating whether axes should be drawn
##' @param ... Additional parameters passed to boxplot()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
boxplot_1d_graphics <- function(x, horizontal=TRUE, cex=0.4, plotAsp=0.1, range=NULL,
                                plotID, turn, add=FALSE, axes=FALSE, ...)
{
    if(is.null(range)) { # choose 'range' depending on sample size
        n <- length(x)
        q25 <- qnorm(0.25)
        iqr <- qnorm(0.75) - q25
        range <- (q25 - qnorm(0.35/(2*n)))/iqr
    }
    boxplot(x, horizontal=horizontal, range=range, add=add, axes=axes, cex=cex, ...)
}

##' @title histogram as 1d plot
##' @param x n-vector of data
##' @param breaks Argument passed to hist() to get information on bins. Default
##'        is 20 equi-width bins covering the range of x
##' @param col A vector of colors for the bars or bar components; see ?barplot
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @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 rug() (e.g., to 'axis')
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##'       as they are not valid graphical parameters (when passed on to '...')
hist_1d_graphics <- function(x, breaks=NULL, col=NULL, plotAsp=0.1,
                             horizontal=TRUE, plotID, turn,
                             add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1),
                             ylim=c(0,1), ...)
{
    xRange <- range(x)
    if(is.null(breaks))
        breaks <- seq(from=xRange[1], to=xRange[2], length.out=21)
    binInfo <- hist(x, breaks=breaks, plot=FALSE)
    binBoundaries <- binInfo$breaks
    heights <- binInfo$counts
    widths <- diff(binBoundaries)
    barplot(heights, width=widths, space=0, horiz=!horizontal, axes=axes,
            main="", xlab="", col=col, border=col, add=add, ...)
}

##' @title Label plot in 1d
##' @param loc.x x-location of the label
##' @param loc.y y-location of the label
##' @param labels The label to be used
##' @param srt The rotation in degrees
##' @param cex The font size magnification factor
##' @param x n-vector of data
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @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_1d_graphics <- function(loc.x=0.5, loc.y=0.5, labels=NULL,
                              srt=if(horizontal) 0 else 90, cex=0.75,
                              x, plotAsp=0.1, horizontal=TRUE, 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("Index ",plotID$idx)
        } else {
            paste0("Var ",plotID$name)
        }
    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, srt=srt, ...)
}

##' @title Arrow plot in 1d
##' @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 horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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_1d_graphics <- function(loc=c(xlim[2], ylim[2])/2, length=0.6, angle=plotAsp*30,
                              x, horizontal=TRUE, plotAsp=0.1, plotID, turn,
                              add=FALSE, ann=FALSE, axes=FALSE, xlim=c(0,1), ylim=c(0,1), ...)
{
    arrow_2d_graphics(loc=loc, length=length, angle=angle,
                      x=x, plotID=plotID, turn=turn,
                      add=add, ann=ann, axes=axes, ...)
}

##' @title Rectangle plot in 1d
##' @param loc.x x-location of rectangle
##' @param loc.y y-location of rectangle
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @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 n-vector of data
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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 rect()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
rect_1d_graphics <- function(loc.x=0.5, loc.y=0.5, horizontal=TRUE,
                             width=if(horizontal) 1.04 else 0.4,
                             height=if(horizontal) 0.4 else 1.04,
                             x, plotAsp=0.1, 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, ...)
}

##' @title Line plot in 1d
##' @param loc.x x-coordinates of the points combined by lines
##' @param loc.y y-coordinates of the points combined by lines
##' @param x n-vector of data
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##'        vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##'        longer side of the plot region
##' @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 lines()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
lines_1d_graphics <- function(loc.x=if(horizontal) c(-0.04, 1.04) else c(0.5, 0.5),
                              loc.y=if(horizontal) c(0.5, 0.5) else c(-0.04, 1.04),
                              type="l", x, horizontal=TRUE, plotAsp=0.05, 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
    lines(loc.x, y=loc.y, type=type, ...)
}

Try the zenplots package in your browser

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

zenplots documentation built on May 2, 2019, 4:34 p.m.