if (interactive()) {
options(device.ask.default = FALSE)
## Scatterplot (Lattice graphics).
## Labels are taken from rownames of data.
## Just click on the plot to identify points.
playwith(xyplot(Income ~ log(Population / Area),
data = data.frame(state.x77), groups = state.region,
type = c("p", "smooth"), span = 1, auto.key = TRUE,
ylab = "Income per capita, 1974"))
## Scatterplot (base graphics); similar.
urbAss <- USArrests[,c("UrbanPop", "Assault")]
playwith(plot(urbAss, panel.first = lines(lowess(urbAss)),
col = "blue", main = "Assault vs urbanisation",
xlab = "Percent urban population, 1973",
ylab = "Assault arrests (per 100,000), 1973"))
## Time series plot (Lattice).
## Date-time range can be entered directly in "time mode"
## (supports numeric, Date, POSIXct, yearmon and yearqtr).
## Click and drag to zoom in; right-click to zoom out;
## and use the scrollbar to move along the x-axis.
library(zoo)
playwith(xyplot(sunspots ~ yearmon(time(sunspots)),
xlim = c(1900, 1930), type = "l"))
## Time series plot (base graphics); similar.
## Custom labels are passed directly to playwith.
## Label style can also be set with playwith.options(),
## or from a menu item inside the window.
tt <- time(treering)
treeyears <- paste(abs(tt) + (tt <= 0),
ifelse(tt > 0, "CE", "BCE"))
playwith(plot(treering, xlim = c(1000, 1300)),
labels = treeyears, label.style = gpar(col="red",
fontfamily = "HersheySans", cex = 0.7))
## Multi-panel Lattice plot.
## Need subscripts=TRUE to correctly identify points.
## Scales are "same" so zooming affects all panels.
Depth <- equal.count(quakes$depth, number = 3, overlap = 0.1)
playwith(xyplot(lat ~ long | Depth, data = quakes,
subscripts = TRUE, aspect = "iso", pch = ".", cex = 2),
labels = paste("mag", quakes$mag))
## Interactive control of a parameter with a slider.
xx <- rnorm(50)
playwith(plot(density(xx, bw = bandwidth), panel.last = rug(xx)),
parameters = list(bandwidth = seq(0.05, 1, by = 0.01)))
## The same with a spinbutton (use I() to force spinbutton).
## Initial value is set as the first in the vector of values.
## This also shows a combobox for selecting text options.
xx <- rnorm(50)
kernels <- c("gaussian", "epanechnikov", "rectangular",
"triangular", "biweight", "cosine", "optcosine")
playwith(plot(density(xx, bw = bandwidth, kern = kernel), lty = lty),
parameters = list(bandwidth = I(c(0.1, 5:100/100)),
kernel = kernels, lty = 1:6))
## More parameters (logical, numeric, text).
playwith(stripplot(yield ~ site, data = barley,
jitter = TRUE, type = c("p", "a"),
aspect = aspect, groups = barley[[groups]],
scales = list(abbreviate = abbrev),
par.settings = list(plot.line = list(col = linecol))),
parameters = list(abbrev = FALSE, aspect = 0.5,
groups = c("none", "year", "variety"),
linecol = "red"))
## Composite plot (base graphics).
## Adapted from an example in help("legend").
## In this case, the initial plot() call is detected correctly;
## in more complex cases may need e.g. main.function="plot".
## Here we also construct data points and labels manually.
x <- seq(-4*pi, 4*pi, by = pi/24)
pts <- data.frame(x = x, y = c(sin(x), cos(x), tan(x)))
labs <- rep(c("sin", "cos", "tan"), each = length(x))
labs <- paste(labs, round(180 * x / pi) %% 360)
playwith( {
plot(x, sin(x), type = "l", xlim = c(-pi, pi),
ylim = c(-1.2, 1.8), col = 3, lty = 2)
points(x, cos(x), pch = 3, col = 4)
lines(x, tan(x), type = "b", lty = 1, pch = 4, col = 6)
legend("topright", c("sin", "cos", "tan"), col = c(3,4,6),
lty = c(2, -1, 1), pch = c(-1, 3, 4),
merge = TRUE, bg = 'gray90')
}, data.points = pts, labels = labs)
## Simple spin and zoom for a 3D Lattice plot (slow).
playwith(wireframe(volcano, drape = TRUE))
## Brushing a multivariate scatterplot.
playwith(splom(environmental))
## A ggplot example.
## NOTE: only qplot()-based calls will work.
## Labels are taken from rownames of the data.
library(ggplot2)
playwith(qplot(qsec, wt, data = mtcars) + stat_smooth())
## A minimalist grid plot.
## This shows how to get playwith to work with custom plots:
## accept xlim/ylim and pass "viewport" to enable zooming.
myGridPlot <- function(x, y, xlim = NULL, ylim = NULL, ...)
{
if (is.null(xlim)) xlim <- extendrange(x)
if (is.null(ylim)) ylim <- extendrange(y)
grid.newpage()
pushViewport(plotViewport())
grid.rect()
pushViewport(viewport(xscale = xlim, yscale = ylim,
name = "theData"))
grid.points(x, y, ...)
grid.xaxis()
grid.yaxis()
upViewport(0)
}
playwith(myGridPlot(1:10, 11:20, pch = 17), viewport = "theData")
## Presenting the window as a modal dialog box.
## When the window is closed, ask user to confirm.
## Use only a subset of the default tools, and hide plot call.
subTools <- list("identify", "clear", "zoom", "zoomout", "zoomfit")
confirmClose <- function(playState) {
if (gWidgets::gconfirm("Close window and report IDs?")) {
cat("Indices of identified data points:
")
print(playGetIDs(playState))
return(FALSE) ## close
} else TRUE ## don't close
}
xy <- data.frame(x = 1:20, y = rnorm(20), row.names = letters[1:20])
playwith(plot(xy), on.close = confirmClose, modal = TRUE,
width = 4, height = 3.5, show.call = FALSE,
top = NULL, left = subTools)
## Demonstrate cacheing of objects in local environment.
## By default, only local variables in the plot call are stored.
x_global <- rnorm(100)
doLocalStuff <- function(...) {
y_local <- rnorm(100)
angle <- (atan2(y_local, x_global) / (2*pi)) + 0.5
color <- hsv(h = angle, v = 0.75)
mkpolys <- function(z) {
p <- runif(4*length(z), -0.05, 0.05)
p[4*seq(z)-3] <- z
p[4*seq(z)] <- NA; p
}
playwith(plot(x_global, y_local, pch = 8, col = color,
panel.first = polygon(mkpolys(x_global), mkpolys(y_local),
col = color, border = NA)),
...)
}
doLocalStuff(title = "locals only") ## eval.args = NA is default
## List objects that have been copied and stored:
sapply(playDevCur()$env, object.size)
## i.e. if you rm(x_global) now, redraws will fail.
## Next: store all data objects (in a new window):
doLocalStuff(title = "all stored", eval.args = TRUE, new = TRUE)
sapply(playDevCur()$env, object.size)
## Now there are two devices open:
playDevList()
playDevCur()
playDevOff()
playDevCur()
## Memory usage test.
## Big data object, do not try to guess labels or time.mode.
gc()
bigobj <- rpois(5000000, 1)
object.size(bigobj) / 1048576 ## in MB
gc()
playwith(qqmath(~ bigobj, f.value=ppoints(500)),
data.points=NA, labels=NA, time.mode=FALSE)
playDevOff()
gc()
## or generate the trellis object first:
trel <- qqmath(~ bigobj, f.value=ppoints(500))
playwith(update(trel))
rm(trel)
## in this case, better to compute the sample first:
subobj <- quantile(foo, ppoints(500), na.rm=TRUE)
playwith(qqmath(~ subobj))
rm(subobj)
rm(bigobj)
## See help(playwith.API) for examples of new tools.
}Run the code above in your browser using DataLab