https://github.com/cran/lattice
Tip revision: c2514b8d0b4857ea4f44f170d71e7be5a82bc645 authored by Deepayan Sarkar on 21 September 2006, 00:00:00 UTC
version 0.14-6
version 0.14-6
Tip revision: c2514b8
lattice.R
require(grid)
old.prompt <- grid.prompt(TRUE)
## store current settings, to be restored later
old.settings <- trellis.par.get()
## changing settings to new 'theme'
trellis.par.set(theme = col.whitebg())
## simulated example, histogram and kernel density estimate superposed
x <- rnorm(500)
densityplot(~x)
histogram(x, type = "density",
panel = function(x, ...) {
panel.histogram(x, ...)
panel.densityplot(x, col = "brown", plot.points = FALSE)
})
## Using a custom panel function to superpose a fitted normal density
## on a Kernel Density Estimate
densityplot( ~ height | voice.part, data = singer, layout = c(2, 4),
xlab = "Height (inches)",
ylab = "Kernel Density\n with Normal Fit",
main = list("Estimated Density", cex = 1.4, col = "DarkOliveGreen"),
panel = function(x, ...) {
panel.densityplot(x, ...)
panel.mathdensity(dmath = dnorm,
args = list(mean=mean(x),sd=sd(x)))
} )
## user defined panel functions and fonts
states <- data.frame(state.x77,
state.name = dimnames(state.x77)[[1]],
state.region = factor(state.region))
xyplot(Murder ~ Population | state.region, data = states,
groups = state.name,
panel = function(x, y, subscripts, groups)
ltext(x = x, y = y, label = groups[subscripts],
cex=.9, fontfamily = "HersheySans", fontface = "italic"),
par.strip.text = list(cex = 1.3, font = 4, col = "brown"),
xlab = list("Estimated Population, July 1, 1975", font = 2),
ylab = list("Murder Rate (per 100,000 population), 1976", font = 2),
main = list("Murder Rates in US states", col = "brown", font = 4))
##graphical parameters for xlab etc can also be changed permanently
trellis.par.set(list(par.xlab.text = list(font = 2),
par.ylab.text = list(font = 2),
par.main.text = list(font = 4, col = "brown")))
## Same with some multiple line text
levels(states$state.region) <-
c("Northeast", "South", "North\n Central", "West")
xyplot(Murder ~ Population | state.region, data = states,
groups = as.character(state.name),
panel = function(x, y, subscripts, groups)
ltext(x = x, y = y, label = groups[subscripts], srt = -50, col = "blue",
cex=.9, fontfamily = "HersheySans"),
par.strip.text = list(cex = 1.3, font = 4, col = "brown", lines = 2),
xlab = "Estimated Population\nJuly 1, 1975",
ylab = "Murder Rate \n(per 100,000 population)\n 1976",
main = "Murder Rates in US states")
##setting these back to their defaults
trellis.par.set(list(par.xlab.text = list(font = 1),
par.ylab.text = list(font = 1),
par.main.text = list(font = 2, col = "black")))
##levelplot
levelplot(volcano, colorkey = list(space = "top"),
sub = "Maunga Whau volcano", aspect = "iso")
## wireframe
wireframe(volcano, shade = TRUE,
aspect = c(61/87, 0.4),
screen = list(z = -120, x = -45),
light.source = c(0,0,10), distance = .2,
shade.colors = function(irr, ref, height, w = .5)
grey(w * irr + (1 - w) * (1 - (1-ref)^.4)))
## 3-D surface parametrized on a 2-D grid
n <- 50
tx <- matrix(seq(-pi, pi, len = 2*n), 2*n, n)
ty <- matrix(seq(-pi, pi, len = n) / 2, 2*n, n, byrow = T)
xx <- cos(tx) * cos(ty)
yy <- sin(tx) * cos(ty)
zz <- sin(ty)
zzz <- zz
zzz[,1:12 * 4] <- NA
wireframe(zzz ~ xx * yy, shade = TRUE, light.source = c(3,3,3))
## Example with panel.superpose.
xyplot(Petal.Length~Petal.Width, data = iris, groups=Species,
panel = panel.superpose,
type = c("p", "smooth"), span=.75,
col.line = trellis.par.get("strip.background")$col,
col.symbol = trellis.par.get("strip.shingle")$col,
key = list(title = "Iris Data", x = .15, y=.85, corner = c(0,1),
border = TRUE,
points = list(col=trellis.par.get("strip.shingle")$col[1:3],
pch = trellis.par.get("superpose.symbol")$pch[1:3],
cex = trellis.par.get("superpose.symbol")$cex[1:3]
),
text = list(levels(iris$Species))))
## Demo of expressions
x <- rnorm(400)
y <- rnorm(400)
a <- gl(4, 100)
xyplot(y~x | a, aspect = "fill",
strip = function(factor.levels, strip.names, var.name, ...) {
strip.default(factor.levels = expression(alpha, beta, gamma, delta),
strip.names = TRUE,
var.name = expression(frac(epsilon, 2)),
...) },
par.strip.text = list(lines = 2),
xlab=list(expression(sigma[i]), cex = 2),
ylab=expression(gamma^2),
main=expression(pi*sum(x, i=0, n)),
scales=
list(relation = "free",
x=list(at=c(-2, 0, 2), labels=expression(frac(-pi, 2), 0, frac(pi, 2))),
y=list(at=c(-2, 0, 2), labels=expression(alpha, beta, gamma))),
key = list(space="right", transparent = TRUE,
title = expression(e[i[1]]^{alpha + 2 ^ beta}),
cex.title = 2,
points=list(pch=1:2),
text = list(c('small', 'BIG'), cex = c(.8, 3)),
lines = list(lty = 1:2),
text=list(expression(theta, zeta))),
sub=expression(frac(demonstrating, expressions)))
## grob's as xlab, ylab
qq(gl(2, 100) ~ c(runif(100, min = -2, max = 2), rnorm(100)),
xlab =
textGrob(rep("Uniform", 2),
x = unit(.5, "npc") + unit(c(.5, 0), "mm"),
y = unit(.5, "npc") + unit(c(0, .5), "mm"),
gp = gpar(col = c("black", "red"), cex = 3)),
ylab =
textGrob(rep("Normal", 2), rot = 90,
x = unit(.5, "npc") + unit(c(.5, 0), "mm"),
y = unit(.5, "npc") + unit(c(0, .5), "mm"),
gp = gpar(col = c("black", "red"), cex = 3)),
main = "Q-Q plot")
## non-trivial strip function
barchart(variety ~ yield | year * site, barley,
layout = c(4, 3),
between = list(x = c(0, 0.5, 0)),
strip =
function(which.given,
which.panel,
factor.levels,
bg = trellis.par.get("strip.background")$col[which.given],
...) {
axis.line <- trellis.par.get("axis.line")
if (which.given == 1)
{
grid.rect(x = .26, just = "right",
gp = gpar(fill = bg, col = "transparent"))
ltext(factor.levels[which.panel[which.given]],
x = .24, y = .5, adj = 1)
}
if (which.given == 2)
{
grid.rect(x = .26, just = "left",
gp = gpar(fill = bg, col = "transparent"))
ltext(factor.levels[which.panel[which.given]],
x = .28, y = .5, adj = 0)
}
grid.rect(gp =
gpar(col = axis.line$col,
lty = axis.line$lty,
lwd = axis.line$lwd,
alpha = axis.line$alpha,
fill = "transparent"))
}, par.strip.text = list(lines = 0.4))
trellis.par.set(theme = old.settings)
grid.prompt(old.prompt)