Re: [R] sparklines in lattice

From: Deepayan Sarkar <deepayan.sarkar_at_gmail.com>
Date: Fri 06 Oct 2006 - 18:32:46 GMT

On 10/6/06, Mark Difford <mark_difford@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)))



R-help@stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code. Received on Sat Oct 07 04:37:13 2006

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.1.8, at Fri 06 Oct 2006 - 19:30:09 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.