plots_grid: Grid-Based Plotting Functions

Description Usage Arguments Details Value Author(s) See Also Examples

Description

The 1d and 2d plotting functions based on the R package grid.

Usage

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
rug_1d_grid(x, width=if(horizontal) 0.001 else 0.3,
            height=if(horizontal) 0.3 else 0.001, just="centre",
            col=par("fg"), horizontal=TRUE,
            default.units="npc", name="rug_1d", draw=TRUE, vp=NULL, ...)
points_1d_grid(x, horizontal=TRUE, plotAsp=0.1, plotID, turn,
               pch=21, size=unit(0.2 * if(horizontal) plotAsp else 1, "npc"),
               default.units="npc", name="points_1d", draw=TRUE, vp=NULL, ...)
jitter_1d_grid(x, cex=0.4, offset=0.25, horizontal=TRUE, plotAsp=0.1, plotID, turn,
               pch=21, size=unit(0.2 * if(horizontal) plotAsp else 1, "npc"),
               default.units="npc", name="jitter_1d", draw=TRUE, vp=NULL, ... )
density_1d_grid(x, density.args=list(), offset=0.25,
                method=c("single", "double"), horizontal=TRUE,
                default.units="npc", name="density_1d",
                draw=TRUE, vp=NULL, ...)
boxplot_1d_grid(x, horizontal=TRUE, plotAsp=0.1,
                plotID, turn, pch=21,
                size=unit(0.2 * if(horizontal) plotAsp else 1, "npc"),
                default.units="npc",
                col=NULL, lwd=2, bpwidth=0.5, range=NULL,
                name="boxplot_1d", draw=TRUE, vp=NULL, ...)
hist_1d_grid(x, offset=0.25, method=c("single", "double"),
             breaks=NULL, col=NULL, fill=NULL, horizontal=TRUE,
             default.units="npc", name="hist_1d",
             draw=TRUE, vp=NULL, ...)
label_1d_grid(loc.x=0.5, loc.y=0.5, label=NULL,
              x, horizontal=TRUE, plotID,
              just=c("centre", "centre"), rot=if(horizontal) 0 else 90, cex=0.4,
              check.overlap=FALSE, default.units="npc", name="label_1d",
              draw=TRUE, vp=NULL, ...)
arrow_1d_grid(loc=c(0.5, 0.5), length=0.5, angle=plotAsp*30,
              plotAsp=0.1, turn, default.units="npc", name="arrow_1d",
              draw=TRUE, vp=NULL, ...)
rect_1d_grid(loc.x=0.5, loc.y=0.5, horizontal=TRUE,
             width=if(horizontal) 1 else 0.4,
             height=if(horizontal) 0.4 else 1,
             just="centre", default.units="npc",
             name="rect_1d", draw=TRUE, vp=NULL, ...)
lines_1d_grid(loc.x=NULL, loc.y=NULL, horizontal=TRUE,
              default.units="npc", arrow=NULL,
              name="lines_1d", draw=TRUE, vp=NULL, ...)

points_2d_grid(x, type=c("p", "l", "o"), pch=NULL, size=NULL,
               default.units="npc", name=NULL, draw=TRUE, vp=NULL, ...)
density_2d_grid(x, ngrids=25, ccol=NULL, clwd=1, clty=1,
                xlim=c(0,1), ylim=c(0,1), plotID, turn,
                default.units="npc", name="density_2d", draw=TRUE, vp=NULL,
                ...)
axes_2d_grid(angle=30, length=unit(0.05, "npc"), type="open", eps=0.02,
             default.units="npc", name=NULL, draw=TRUE, vp=NULL, ...)
label_2d_grid(loc.x=0.96, loc.y=0.04, label=NULL,
              x, plotID,
              just=c("right", "bottom"), rot=0, cex=0.5,
              check.overlap=FALSE, default.units="npc",
              name="label_2d", draw=TRUE, vp=NULL, ...)
arrow_2d_grid(loc=c(0.5, 0.5), length=0.2, angle=30, turn,
              default.units="npc", name="arrow_2d", draw=TRUE, vp=NULL, ...)
rect_2d_grid(loc.x=0.5, loc.y=0.5, width=1, height=1, just="centre",
             default.units="npc", name="rect_2d", draw=TRUE, vp=NULL, ...)

Arguments

x

An n-vector (for 1d plots) or (n,2)-matrix (for 2d plots) containing the data. It is passed from zenplot().

width

The rectangle width passed to grid.rect().

height

The rectangle height passed to grid.rect().

just

The justification (see grid.rect() for rect_1d_grid(), rect_1d_grid(), rect_1d_grid() or grid.text() for label_1d_grid(), label_2d_grid()).

horizontal

A logical indicating whether the 1d plot is horizontal or vertical. It is passed from zenplot() (for 1d plots only).

loc

The location of the center of the arrow.

loc.x,loc.y

x-coordinates and y-coordinates of the points combined by lines (for lines_1d_grid()) or of the label (for label_1d_grid(), label_2d_grid()) or of the center of the rectangle (for rect_1d_grid(), rect_2d_grid()).

type

The plot type.

col

For

rug_1d_grid:

The color and fill color of the rectangels forming the rugs.

boxplot_1d_grid:

The color of the box, whiskers and points.

hist_1d_grid:

The color of the bins.

rot

The rotation of the label in degrees.

arrow

See grid.lines().

density.args

A list() of arguments for density().

offset

A number in [0,0.5] determining the distance between the 1d and 2d plots (for creating space between the two).

method

The type of plot used (single or double; the latter being reflected at the axis located in the middle of the 1d plot and pointing in the direction as given by horizontal).

label

The label to be used (with a useful default if NULL).

plotID

The plot identification passed on from zenplot(). This is a list containing the variable name(s), the column index(es) and the plotNo (among either all 1d or all 2d plots). It is passed from zenplot().

check.overlap

See grid.text().

length

The length of the arrow.

angle

The angle between the shaft and one of the edges of the arrow head.

plotAsp

The fraction (in [0,1]) of the shorter side divided by the longer side of the plot region. It is passed from zenplot() (for 1d plots only).

cex

The character expansion of the label.

turn

A character (in "l" (for “left”), "r" (for “right”), "d" (for “down”), "u" (for “up”)) giving the turn as passed from zenplot().

pch

The plot symbol for 2d plots.

size

The plot symbol size as passed to grid.points().

lwd

The line width.

bpwidth

The width of the boxplot (in default.units).

range

Determines how far the plot whiskers extend out of the box. If range=NULL, this will be automatically determined depending on the sample size.

breaks

The break points for the histogram as passed to the underlying hist(). If NULL, the default is to use 20 equi-width bins covering the range of the data.

fill

The fill color of the bins.

ngrids

The number of grid points in each dimension (a scalar or an integer vector of length two).

ccol, clwd, clty

The colors (col), line widths (lwd) and line types (lty) of the contour lines. These can be single values or vectors (which are then recycled).

eps

The distance by which the axes are moved away from the plot region.

xlim,ylim

The x and y limits of the plotting region.

default.units

The default units passed to the underlying grid functions.

name

The character identifier for grid graphics.

draw

A logical indicating whether graphics output should be produced.

vp

The viewport(). It is passed from zenplot().

...

Additional (graphical) parameters passed to gpar().

Details

These functions based on the R package grid are provided as useful choices for the arguments plot1d and plot2d of zenplot(). See zenplot() how to use them, their source code for how to adjust them or how to write your own plot1d or plot2d. The main idea is that major arguments are passed to the underlying grid functions as formal arguments and the ellipsis argument is used to pass graphical paramaters (via gpar()). Hereby it is important to note that besides the ellipsis arguments (which are passed to both plot1d and plot2d), zenplot() passes further arguments to plot1d and plot2d. For plot1d, they are x, horizontal, plotAsp, plotID, turn (as described above) and vp (the argument vp1d of zenplot()). For plot2d, they are x, plotID, turn (as described above) and vp (the argument vp2d of zenplot()).

Value

An (invisibly) returned grob.

Author(s)

Marius Hofert and Wayne Oldford

See Also

zenplot() for how to use these functions. plots_graphics for similar functions based on the R package graphics.

Examples

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
## Implementation of 1d functions (for plot1d of zenplot())
rug_1d_grid
points_1d_grid
jitter_1d_grid
density_1d_grid
boxplot_1d_grid
label_1d_grid
arrow_1d_grid
rect_1d_grid
lines_1d_grid

## Implementation of 2d functions (for plot2d of zenplot())
points_2d_grid
density_2d_grid
label_2d_grid
arrow_2d_grid
rect_2d_grid

Example output

Warning message:
no DISPLAY variable so Tk is not available 
function (zargs, loc = 0.5, length = 0.5, width = 0.001, col = par("fg"), 
    draw = FALSE, ...) 
{
    r <- extract_1d(zargs)
    x <- as.matrix(r$x)
    horizontal <- r$horizontal
    lim <- r$xlim
    check_zargs(zargs, "num", "turns", "ispace")
    turn.out <- zargs$turns[zargs$num]
    if (turn.out == "d" || turn.out == "l") 
        loc <- 1 - loc
    if (horizontal) {
        xlim <- lim
        ylim <- 0:1
        x <- x
        y <- loc
        height <- length
        width <- width
    }
    else {
        xlim <- 0:1
        ylim <- lim
        y <- x
        x <- loc
        height <- width
        width <- length
    }
    vp <- vport(zargs$ispace, xlim = xlim, ylim = ylim)
    res <- rectGrob(x = x, y = y, width = width, height = height, 
        default.units = "native", name = "rug_1d", gp = gpar(fill = col, 
            col = col, ...), vp = vp)
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = 0.5, pch = 21, size = 0.02, draw = FALSE, 
    ...) 
{
    r <- extract_1d(zargs)
    x <- as.matrix(r$x)
    horizontal <- r$horizontal
    lim <- r$xlim
    check_zargs(zargs, "num", "turns", "ispace", "width1d", "width2d")
    turn.out <- zargs$turns[zargs$num]
    if (turn.out == "d" || turn.out == "l") 
        loc <- 1 - loc
    width1d <- zargs$width1d
    width2d <- zargs$width2d
    if (length(loc) == 1) 
        loc <- rep(loc, length(x))
    if (horizontal) {
        xlim <- lim
        ylim <- 0:1
        x <- x
        y <- loc
        size <- size
    }
    else {
        ylim <- lim
        xlim <- 0:1
        y <- x
        x <- loc
        size <- size * width2d/width1d
    }
    vp <- vport(zargs$ispace, xlim = xlim, ylim = ylim)
    res <- pointsGrob(x = x, y = y, pch = pch, size = unit(size, 
        units = "npc"), default.units = "native", name = "points_1d", 
        gp = gpar(...), vp = vp)
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = 0.5, offset = 0.25, pch = 21, size = 0.02, 
    draw = FALSE, ...) 
{
    r <- extract_1d(zargs)
    x <- r$x
    stopifnot(0 <= offset, offset <= 0.5, 0 <= loc, loc <= 1, 
        offset <= min(loc, 1 - loc))
    loc. <- loc + runif(length(x), min = -offset, max = offset)
    points_1d_grid(zargs, loc = loc., pch = pch, size = size, 
        draw = draw, ...)
}
<environment: namespace:zenplots>
function (zargs, density... = NULL, offset = 0.08, draw = FALSE, 
    ...) 
{
    r <- extract_1d(zargs)
    x <- r$x[!is.na(r$x)]
    horizontal <- r$horizontal
    check_zargs(zargs, "num", "turns", "ispace")
    turn.out <- zargs$turns[zargs$num]
    lim <- r$xlim
    res <- if (length(x) == 0) {
        nullGrob()
    }
    else {
        stopifnot(0 <= offset, offset <= 0.5)
        dens <- do.call(density, args = c(list(x), density...))
        xvals <- dens$x
        keepers <- (min(x) <= xvals) & (xvals <= max(x))
        x. <- xvals[keepers]
        y. <- dens$y[keepers]
        if (turn.out == "d" || turn.out == "l") 
            y. <- -y.
        if (horizontal) {
            xlim <- range(x.)
            ylim <- range(0, y.)
            x <- c(xlim[1], x., xlim[2])
            y <- c(0, y., 0)
            y <- (1 - 2 * offset) * y + offset * if (turn.out == 
                "d") 
                ylim[1]
            else ylim[2]
        }
        else {
            xlim <- range(0, y.)
            ylim <- range(x.)
            x <- c(0, y., 0)
            y <- c(ylim[1], x., ylim[2])
            x <- (1 - 2 * offset) * x + offset * if (turn.out == 
                "l") 
                xlim[1]
            else xlim[2]
        }
        vp <- vport(zargs$ispace, xlim = xlim, ylim = ylim)
        polygonGrob(x = x, y = y, name = "density_1d", default.units = "native", 
            gp = gpar(...), vp = vp)
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, pch = 21, size = 0.02, col = NULL, lwd = 2, 
    bpwidth = 0.5, range = NULL, draw = FALSE, ...) 
{
    r <- extract_1d(zargs)
    x <- as.matrix(r$x)
    horizontal <- r$horizontal
    lim <- r$xlim
    check_zargs(zargs, "width1d", "width2d", "ispace")
    width1d <- zargs$width1d
    width2d <- zargs$width2d
    res <- if (all(is.na(x))) {
        nullGrob()
    }
    else {
        if (is.null(range)) {
            n <- length(x)
            q25 <- qnorm(0.25)
            iqr <- qnorm(0.75) - q25
            range <- (q25 - qnorm(0.35/(2 * n)))/iqr
        }
        if (is.null(col)) 
            col <- "grey"
        medCol <- if (col == "black") 
            "white"
        else "black"
        med <- median(x, na.rm = TRUE)
        Q1 <- quantile(x, 0.25, na.rm = TRUE)
        Q3 <- quantile(x, 0.75, na.rm = TRUE)
        IQR <- Q3 - Q1
        upper.fence <- Q3 + (range * IQR)
        lower.fence <- Q1 - (range * IQR)
        upper.adjacent.value <- max(x[x <= upper.fence])
        lower.adjacent.value <- min(x[x >= lower.fence])
        outliers <- x[(x < lower.adjacent.value) | (x > upper.adjacent.value)]
        existOutliers <- length(outliers) != 0
        if (horizontal) {
            vp <- vport(zargs$ispace, xlim = lim)
            highbox <- rectGrob(x = med, width = Q3 - med, height = bpwidth, 
                default.units = "native", just = c("left", "center"), 
                gp = gpar(fill = col, col = col, ...), vp = vp)
            medLine <- linesGrob(x = c(med, med), y = c(0.5 - 
                bpwidth/2, 0.5 + bpwidth/2), default.units = "native", 
                gp = gpar(fill = medCol, col = medCol, lwd = lwd, 
                  ...), vp = vp)
            lowbox <- rectGrob(x = med, width = med - Q1, height = bpwidth, 
                default.units = "native", just = c("right", "center"), 
                gp = gpar(fill = col, col = col, ...), vp = vp)
            highadjacent <- linesGrob(x = c(upper.adjacent.value, 
                upper.adjacent.value), y = c(0.5 - bpwidth/5, 
                0.5 + bpwidth/5), default.units = "native", gp = gpar(fill = col, 
                col = col, lwd = lwd, ...), vp = vp)
            highwhisker <- linesGrob(x = c(Q3, upper.adjacent.value), 
                y = c(0.5, 0.5), default.units = "native", gp = gpar(fill = col, 
                  col = col, lwd = lwd, ...), vp = vp)
            lowadjacent <- linesGrob(x = c(lower.adjacent.value, 
                lower.adjacent.value), y = c(0.5 - bpwidth/5, 
                0.5 + bpwidth/5), default.units = "native", gp = gpar(fill = col, 
                col = col, lwd = lwd, ...), vp = vp)
            lowwhisker <- linesGrob(x = c(Q1, lower.adjacent.value), 
                y = c(0.5, 0.5), default.units = "native", gp = gpar(fill = col, 
                  col = col, lwd = lwd, ...), vp = vp)
            if (existOutliers) 
                outlierpoints <- pointsGrob(x = outliers, y = rep(0.5, 
                  length(outliers)), pch = pch, size = unit(size, 
                  units = "npc"), default.units = "native", gp = gpar(fill = col, 
                  col = col, ...), vp = vp)
        }
        else {
            vp <- vport(zargs$ispace, ylim = lim)
            highbox <- rectGrob(y = med, height = Q3 - med, width = bpwidth, 
                default.units = "native", just = c("center", 
                  "bottom"), gp = gpar(fill = col, col = col, 
                  ...), vp = vp)
            medLine <- linesGrob(x = c(0.5 - bpwidth/2, 0.5 + 
                bpwidth/2), y = c(med, med), default.units = "native", 
                gp = gpar(fill = medCol, col = medCol, lwd = lwd, 
                  ...), vp = vp)
            lowbox <- rectGrob(y = med, height = med - Q1, width = bpwidth, 
                default.units = "native", just = c("center", 
                  "top"), gp = gpar(fill = col, col = col, ...), 
                vp = vp)
            highadjacent <- linesGrob(x = c(0.5 - bpwidth/5, 
                0.5 + bpwidth/5), y = c(upper.adjacent.value, 
                upper.adjacent.value), default.units = "native", 
                gp = gpar(fill = col, col = col, lwd = lwd, ...), 
                vp = vp)
            highwhisker <- linesGrob(x = c(0.5, 0.5), y = c(Q3, 
                upper.adjacent.value), default.units = "native", 
                gp = gpar(fill = col, col = col, lwd = lwd, ...), 
                vp = vp)
            lowadjacent <- linesGrob(x = c(0.5 - bpwidth/5, 0.5 + 
                bpwidth/5), y = c(lower.adjacent.value, lower.adjacent.value), 
                default.units = "native", gp = gpar(fill = col, 
                  col = col, lwd = lwd, ...), vp = vp)
            lowwhisker <- linesGrob(x = c(0.5, 0.5), y = c(Q1, 
                lower.adjacent.value), default.units = "native", 
                gp = gpar(fill = col, col = col, lwd = lwd, ...), 
                vp = vp)
            if (existOutliers) 
                outlierpoints <- pointsGrob(x = rep(0.5, length(outliers)), 
                  y = outliers, pch = pch, size = unit(size * 
                    width2d/width1d, units = "npc"), default.units = "native", 
                  gp = gpar(fill = col, col = col, ...), vp = vp)
        }
        boxplotGrobs <- if (existOutliers) 
            gList(lowadjacent, lowwhisker, lowbox, highbox, medLine, 
                highwhisker, highadjacent, outlierpoints)
        else gList(lowadjacent, lowwhisker, lowbox, highbox, 
            medLine, highwhisker, highadjacent)
        gTree(children = boxplotGrobs, name = "boxplot_1d")
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.5, 0.5), label = NULL, cex = 0.66, 
    box = FALSE, box.width = 1, box.height = 1, draw = FALSE, 
    ...) 
{
    r <- extract_1d(zargs)
    horizontal <- r$horizontal
    if (is.null(label)) 
        label <- names(r$x)
    check_zargs(zargs, "num", "turns", "ispace")
    turn.out <- zargs$turns[zargs$num]
    if (turn.out == "d") 
        loc <- 1 - loc
    if (turn.out == "r") {
        loc <- rev(loc)
        loc[2] <- 1 - loc[2]
    }
    if (turn.out == "l") {
        loc <- rev(loc)
        loc[1] <- 1 - loc[1]
    }
    rot <- if (horizontal) {
        0
    }
    else {
        if (turn.out == "r") 
            -90
        else 90
    }
    vp <- vport(zargs$ispace)
    gText <- textGrob(label = label, x = loc[1], y = loc[2], 
        rot = rot, default.units = "npc", name = "label_1d", 
        gp = gpar(cex = cex, ...), vp = vp)
    res <- if (box) {
        gBox <- rectGrob(x = 0.5, y = 0.5, width = box.width, 
            height = box.height, default.units = "npc", name = "box_2d", 
            gp = gpar(fill = 0, ...), vp = vp)
        gTree(children = gList(gBox, gText))
    }
    else {
        gTree(children = gList(gText))
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.5, 0.5), angle = 60, length = 0.6, 
    draw = FALSE, ...) 
{
    check_zargs(zargs, "num", "turns", "width1d", "width2d", 
        "ispace")
    turn.out <- zargs$turns[zargs$num]
    horizontal <- turn.out %in% c("d", "u")
    if (turn.out == "d") 
        loc <- 1 - loc
    if (turn.out == "r") {
        loc <- rev(loc)
        loc[2] <- 1 - loc[2]
    }
    if (turn.out == "l") {
        loc <- rev(loc)
        loc[1] <- 1 - loc[1]
    }
    width1d <- zargs$width1d
    width2d <- zargs$width2d
    arrow <- zenarrow(turn.out, angle = angle, length = length, 
        coord.scale = width1d/width2d)
    arr <- loc + arrow
    vp <- vport(zargs$ispace)
    res <- linesGrob(x = arr[1, ], y = arr[2, ], default.units = "npc", 
        name = "arrow_1d", gp = gpar(...), vp = vp)
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.5, 0.5), width = 1, height = 1, draw = FALSE, 
    ...) 
{
    check_zargs(zargs, "num", "turns", "ispace")
    turn.out <- zargs$turns[zargs$num]
    horizontal <- turn.out %in% c("d", "u")
    if (turn.out == "d") 
        loc <- 1 - loc
    if (turn.out == "r") {
        loc <- rev(loc)
        loc[2] <- 1 - loc[2]
    }
    if (turn.out == "l") {
        loc <- rev(loc)
        loc[1] <- 1 - loc[1]
    }
    if (!horizontal) {
        tmp <- width
        width <- height
        height <- tmp
    }
    vp <- vport(zargs$ispace)
    res <- rectGrob(x = loc[1], y = loc[2], width = width, height = height, 
        default.units = "npc", name = "rect_1d", gp = gpar(...), 
        vp = vp)
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.5, 0.5), length = 1, arrow = NULL, 
    draw = FALSE, ...) 
{
    check_zargs(zargs, "num", "turns", "ispace")
    turn.out <- zargs$turns[zargs$num]
    horizontal <- turn.out %in% c("d", "u")
    if (turn.out == "d") 
        loc <- 1 - loc
    if (turn.out == "r") {
        loc <- rev(loc)
        loc[2] <- 1 - loc[2]
    }
    if (turn.out == "l") {
        loc <- rev(loc)
        loc[1] <- 1 - loc[1]
    }
    if (horizontal) {
        x <- c(loc[1] - length/2, loc[1] + length/2)
        y <- rep(loc[2], 2)
    }
    else {
        x <- rep(loc[1], 2)
        y <- c(loc[2] - length/2, loc[2] + length/2)
    }
    vp <- vport(zargs$ispace)
    res <- linesGrob(x = x, y = y, arrow = arrow, default.units = "npc", 
        name = "lines_1d", gp = gpar(...), vp = vp)
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, type = c("p", "l", "o"), pch = NULL, size = 0.02, 
    box = FALSE, box.width = 1, box.height = 1, group... = list(cex = 0.66), 
    draw = FALSE, ...) 
{
    r <- extract_2d(zargs)
    xlim <- r$xlim
    ylim <- r$ylim
    x <- as.matrix(r$x)
    y <- as.matrix(r$y)
    same.group <- r$same.group
    check_zargs(zargs, "ispace")
    res <- if (same.group) {
        vp <- vport(zargs$ispace, xlim = xlim, ylim = ylim)
        if (box) 
            gBox <- rectGrob(x = 0.5, y = 0.5, width = box.width, 
                height = box.height, just = "centre", default.units = "npc", 
                name = "box_2d", gp = gpar(...), vp = vp)
        type <- match.arg(type)
        switch(type, p = {
            if (is.null(pch)) pch <- 21
            gPoints <- pointsGrob(x = x, y = y, pch = pch, size = unit(size, 
                units = "npc"), default.units = "native", name = "points_2d", 
                gp = gpar(...), vp = vp)
            if (box) {
                gTree(children = gList(gBox, gPoints))
            } else {
                gTree(children = gList(gPoints))
            }
        }, l = {
            gLines <- linesGrob(x = x, y = y, default.units = "native", 
                name = "lines_2d", gp = gpar(...), vp = vp)
            if (box) {
                gTree(children = gList(gBox, gLines))
            } else {
                gTree(children = gList(gLines))
            }
        }, o = {
            if (is.null(pch)) pch <- 20
            gLines <- linesGrob(x = x, y = y, default.units = "native", 
                name = "lines_2d", gp = gpar(...), vp = vp)
            gPoints <- pointsGrob(x = x, y = y, pch = pch, size = unit(size, 
                units = "npc"), default.units = "native", name = "points_2d", 
                gp = gpar(...), vp = vp)
            if (box) {
                gTree(children = gList(gBox, gLines, gPoints))
            } else {
                gTree(children = gList(gLines, gPoints))
            }
        }, stop("Wrong 'type'"))
    }
    else {
        args <- c(list(zargs = zargs), group...)
        do.call(group_2d_grid, args)
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, ngrids = 25, ccol = NULL, clwd = 1, clty = 1, 
    box = FALSE, box.width = 1, box.height = 1, group... = list(cex = 0.66), 
    draw = FALSE, ...) 
{
    r <- extract_2d(zargs)
    xlim <- r$xlim
    ylim <- r$ylim
    x <- r$x
    y <- r$y
    same.group <- r$same.group
    check_zargs(zargs, "ispace")
    res <- if (same.group) {
        data <- na.omit(data.frame(x, y))
        colnames(data) <- c("x", "y")
        dens <- kde2d(data$x, data$y, n = ngrids, lims = c(xlim, 
            ylim))
        contours <- contourLines(dens$x, dens$y, dens$z)
        levels <- sapply(contours, function(contour) contour$level)
        nLevels <- length(levels)
        uniqueLevels <- unique(levels)
        nuLevels <- length(uniqueLevels)
        if (is.null(ccol)) {
            basecol <- c("grey80", "grey0")
            palette <- colorRampPalette(basecol, space = "Lab")
            ccol <- palette(nuLevels)
        }
        ccol <- rep_len(ccol, nuLevels)
        clwd <- rep_len(clwd, nuLevels)
        clty <- rep_len(clty, nuLevels)
        ccol. <- numeric(nLevels)
        clwd. <- numeric(nLevels)
        clty. <- numeric(nLevels)
        for (i in 1:nuLevels) {
            idx <- (1:nLevels)[levels == uniqueLevels[i]]
            ccol.[idx] <- ccol[i]
            clwd.[idx] <- clwd[i]
            clty.[idx] <- clty[i]
        }
        vp <- vport(zargs$ispace, xlim = xlim, ylim = ylim, x = x, 
            y = y)
        if (box) 
            gBox <- rectGrob(x = 0.5, y = 0.5, width = box.width, 
                height = box.height, just = "centre", default.units = "npc", 
                name = "box_2d", gp = gpar(...), vp = vp)
        contourGrobs <- lapply(1:length(contours), function(i) {
            contour <- contours[[i]]
            linesGrob(x = contour$x, y = contour$y, gp = gpar(col = ccol.[i], 
                lwd = clwd.[i], lty = clty.[i], ...), default.units = "native", 
                name = paste0("contour_", i), vp = vp)
        })
        if (box) {
            gTree(children = do.call(gList, args = c(contourGrobs, 
                list(gBox))))
        }
        else {
            gTree(children = do.call(gList, args = contourGrobs))
        }
    }
    else {
        args <- c(list(zargs = zargs), group...)
        do.call(group_2d_grid, args)
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.98, 0.05), label = NULL, cex = 0.66, 
    just = c("right", "bottom"), rot = 0, box = FALSE, box.width = 1, 
    box.height = 1, group... = list(cex = cex), draw = FALSE, 
    ...) 
{
    r <- extract_2d(zargs)
    same.group <- r$same.group
    vlabs <- r$vlabs
    check_zargs(zargs, "vars", "num", "ispace")
    vars <- zargs$vars
    num <- zargs$num
    res <- if (same.group) {
        xlab <- vlabs[vars[num, 1]]
        ylab <- vlabs[vars[num, 2]]
        if (is.null(label)) 
            label <- paste0("(", xlab, ", ", ylab, ")")
        vp <- vport(zargs$ispace)
        gText <- textGrob(label = label, x = loc[1], y = loc[2], 
            just = just, rot = rot, default.units = "npc", name = "label_2d", 
            gp = gpar(cex = cex, ...), vp = vp)
        if (box) {
            gBox <- rectGrob(x = 0.5, y = 0.5, width = box.width, 
                height = box.height, default.units = "npc", name = "box_2d", 
                gp = gpar(...), vp = vp)
            gTree(children = gList(gBox, gText))
        }
        else {
            gTree(children = gList(gText))
        }
    }
    else {
        args <- c(list(zargs = zargs), group...)
        do.call(group_2d_grid, args)
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.5, 0.5), angle = 60, length = 0.2, 
    group... = list(cex = 0.66), draw = FALSE, ...) 
{
    r <- extract_2d(zargs)
    same.group <- r$same.group
    check_zargs(zargs, "num", "turns", "ispace")
    turn.out <- zargs$turns[zargs$num]
    res <- if (same.group) {
        vp <- vport(zargs$ispace)
        arrow <- zenarrow(turn.out, angle = angle, length = length, 
            coord.scale = 1)
        arr <- loc + arrow
        linesGrob(x = arr[1, ], y = arr[2, ], default.units = "npc", 
            name = "arrow_2d", gp = gpar(...), vp = vp)
    }
    else {
        args <- c(list(zargs = zargs), group...)
        do.call(group_2d_grid, args)
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>
function (zargs, loc = c(0.5, 0.5), width = 1, height = 1, group... = list(cex = 0.66), 
    draw = FALSE, ...) 
{
    r <- extract_2d(zargs)
    same.group <- r$same.group
    check_zargs(zargs, "ispace")
    res <- if (same.group) {
        vp <- vport(zargs$ispace)
        rectGrob(x = loc[1], y = loc[2], width = width, height = height, 
            default.units = "npc", name = "rect_2d", gp = gpar(...), 
            vp = vp)
    }
    else {
        args <- c(list(zargs = zargs), group...)
        do.call(group_2d_grid, args)
    }
    if (draw) 
        grid.draw(res)
    invisible(res)
}
<environment: namespace:zenplots>

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