# [R] sparklines in lattice

Deepayan Sarkar deepayan.sarkar at gmail.com
Fri Oct 6 20:32:46 CEST 2006

```On 10/6/06, Mark Difford <mark_difford at yahoo.co.uk> wrote:
> Dear R-help,
>
> Has anyone implemented sparklines in the strips of a lattice plot?  What I have in
> mind is, say, highlighting that part of a time series that one is examining in more
> detail in a set of lattice plots.

It's not particularly hard (at least for me :-)). Here's a possible
implementation, which could of course be improved in many ways. PDF
output (as well as the code, in case this gets wrapped) available at

http://www.stat.wisc.edu/~deepayan/R/spark/

-Deepayan

cutAndStack <-
function(x, number = 6, overlap = 0.1, type = 'l',
xlab = "Time",
ylab = deparse(substitute(x)),
...)
{
stopifnot(is.ts(x))
if (is.mts(x)) stop("mts not supported, use 'x[, 1]' etc")
stopifnot(require(grid))
stopifnot(require(lattice))
tdf <-
data.frame(.response = as.numeric(x),
.time = time(x),
.Time =
equal.count(as.numeric(time(x)),
number = number,
overlap = overlap))
strip.ts <-
function(which.given, which.panel, shingle.intervals,
bg = trellis.par.get("strip.background")\$col[1],
...)
{
pushViewport(viewport(xscale = range(tdf\$.time),
yscale = range(tdf\$.response)))
panel.fill(col = bg)
current.interval <- shingle.intervals[which.panel[which.given], ]
highlight <-
cut(tdf\$.time,
breaks =
c(min(shingle.intervals) - 1,
current.interval,
max(shingle.intervals) + 1))
with(tdf, panel.xyplot(.time, .response,
groups = highlight,
subscripts = seq(length = nrow(tdf)),
type = "l",
col = c("grey", "red", "grey"),
lwd = c(1, 2, 1)))
upViewport()
}
xyplot(.response ~ .time | .Time,
data = tdf,
type = type,
xlab = xlab, ylab = ylab,
strip = strip.ts,
default.scales =
list(x = list(relation = "free"),
y = list(relation = "free", rot = 0)),
...)
}

p <-
cutAndStack(EuStockMarkets[, 1], aspect = "xy",
scales = list(x = list(draw = FALSE)))

p

update(p[3], par.strip.text = list(lines = 3),
scales = list(x = list(draw = TRUE, at = 1991:1999)))

```