Fill area to match the lines of with various 'type' arguments in lattice

Question

I know I can use panel.xyarea from latticeExtra to fill the area in the plot with any colour. Without defining a type argument in xyplot, such filling will follow the route of default type="p":

library(lattice)
library(latticeExtra)
data <- data.frame(time=1:24,value=rnorm(24))
xyplot(value~time, data, 
       panel=function(x,y,...){
             panel.xyarea(x,y,...)
             panel.xyplot(x,y,...)}) 

This plots both panel.xyarea and the points coming from default type="p" in panel.xyplot. Now the problem arise when I want to change the type of plotting line, for example making it step function type="S":

xyplot(value~time, data, type="S",
       panel=function(x,y,...){
             panel.xyarea(x,y,...)
             panel.xyplot(x,y,...)}

As you see on the example above, panel.xyarea doesn't fill the area underneath the new step function, but instead it plots both areas overlapping. It doesn't change anything if I move type="S" to the panel.xyarea - in fact it doesn't register type argument it at all and plots as it wouldn't be there.

Is there a way I can bypass this and have panel.xyarea fill my plots whatever type I define - be it step function (type="S"), loess (type="smooth") or regression (type="r")? Or maybe there is something better than panel.xyarea to use in such context?

Answer 1

For each value of type, you'll need to construct a custom panel function. Fortunately, if you model the functions closely on existing lattice code (starting out by having a look at panel.xyplot), that shouldn't be too hard. For example, the two custom panel functions below include many lines of code but only a couple of lines (marked with comments) that I had to write.

Once you've defined the panel functions (copying them in from the code blocks following the figure), use them like this:

library(lattice)
library(latticeExtra)
library(gridExtra)
set.seed(100)
data <- data.frame(time=1:24,value=rnorm(24))

## Filled version of xyplot(..., type="S")
a <- xyplot(value~time, data, panel=panel.filled_S) 
## Filled version of xyplot(..., type="smooth") 
b <- xyplot(value~time, data, panel=panel.filled_smooth) 
grid.arrange(a, b, ncol = 2)

For a filled version of type="S":

## Modeled on code in panel.xyplot, which is called when type=S"
panel.filled_S <-
function(x,y, ...) {
    horizontal <- FALSE                  ## Edited (may not want to hardcode)
    ord <- if (horizontal)
        sort.list(y)
    else sort.list(x)
    n <- length(x)
    xx <- numeric(2 * n - 1)
    yy <- numeric(2 * n - 1)
    xx[2 * 1:n - 1] <- x[ord]
    yy[2 * 1:n - 1] <- y[ord]
    xx[2 * 1:(n - 1)] <- x[ord][-n]
    yy[2 * 1:(n - 1)] <- y[ord][-1]
    panel.xyarea(x = xx, y = yy, ...)    ## Edited
    panel.lines(x = xx, y = yy, ...)     ## Edited
}
xyplot(value~time, data, panel=panel.filled_S, type="o")

For a filled version of type="smooth":

## Modeled on code in panel.loess, called by panel.xyplot when type="smooth"
panel.filled_smooth <-
function (x, y, span = 2/3, degree = 1, family = c("symmetric",
    "gaussian"), evaluation = 50, lwd = plot.line$lwd, lty = plot.line$lty,
    col, col.line = plot.line$col, type, horizontal = FALSE,
    ..., identifier = "loess")
{
    x <- as.numeric(x)
    y <- as.numeric(y)
    ok <- is.finite(x) & is.finite(y)
    if (sum(ok) < 1)
        return()
    if (!missing(col)) {
        if (missing(col.line))
            col.line <- col
    }
    plot.line <- trellis.par.get("plot.line")
    if (horizontal) {
        smooth <- loess.smooth(y[ok], x[ok], span = span, family = family,
            degree = degree, evaluation = evaluation)
        panel.lines(x = smooth$y, y = smooth$x, col = col.line,
            lty = lty, lwd = lwd, ..., identifier = identifier)
        panel.xyarea(smooth$y, smooth$x, ...)  ## Edited
    }
    else {
        smooth <- loess.smooth(x[ok], y[ok], span = span, family = family,
            degree = degree, evaluation = evaluation)
        panel.lines(x = smooth$x, y = smooth$y, col = col.line,
            lty = lty, lwd = lwd, ..., identifier = identifier)
        panel.xyarea(smooth$x, smooth$y, ...)  ## Edited
    }
    smooth
}