Description Usage Arguments Details Value Author(s) See Also Examples
The 1d and 2d plotting functions based on the R package grid.
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, ...)
|
x |
An n- |
width |
The rectangle width passed to |
height |
The rectangle height passed to |
just |
The justification (see |
horizontal |
A |
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 |
type |
The plot type. |
col |
For
|
rot |
The rotation of the label in degrees. |
arrow |
See |
density.args |
A |
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 ( |
label |
The label to be used (with a useful default if
|
plotID |
The plot identification passed on from
|
check.overlap |
See |
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 |
cex |
The character expansion of the label. |
turn |
A |
pch |
The plot symbol for 2d plots. |
size |
The plot symbol size as passed to
|
lwd |
The line width. |
bpwidth |
The width of the boxplot (in |
range |
Determines how far the plot whiskers extend out of the box. If
|
breaks |
The break points for the histogram as passed to the
underlying |
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 |
vp |
The |
... |
Additional (graphical) parameters passed to
|
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()
).
An (invisibly) returned grob
.
Marius Hofert and Wayne Oldford
zenplot()
for how to use these functions.
plots_graphics for similar functions based
on the R package graphics.
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
|
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>
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.