# Re: [R] shading under the lines in a lattice xyplot?

From: Sundar Dorai-Raj <sundar.dorai-raj_at_pdf.com>
Date: Thu 16 Feb 2006 - 05:39:56 EST

Andy Bunn wrote:
> In the lattice plot below I want to fill-in the areas under each lines that
> are greater than zero in gray. Is there a straightforward way to go about
> this? Thanks, Andy
>
> library(lattice)
> foo <- data.frame(Yrs=rep(1:50,4), Y=rnorm(200),
> Id=unlist(lapply(letters[1:4],rep,50)))
> xyplot(Y~Yrs|Id, data = foo,
> panel = function(x,y) {
> panel.abline(h=0)
> panel.lines(x,y, col = "black")
> })
>

Hi, Andy,

The following seems to work. It relies on two functions I have in my personal package: find.zero, lpolygon. Let me know what you think.

library(lattice)

foo <- data.frame(Yrs = rep(1:50, 4), Y = rnorm(200),

```                   Id = unlist(lapply(letters[1:4], rep, 50)))

```

lpolygon <- function (x, y = NULL, border = NULL, col = NULL, ...) {

require(grid, TRUE)
xy <- xy.coords(x, y)
x <- xy\$x
y <- xy\$y
gp <- list(...)
if (!is.null(border)) gp\$col <- border    if (!is.null(col)) gp\$fill <- col
gp <- do.call("gpar", gp)
grid.polygon(x, y, gp = gp, default.units = "native") }

find.zero <- function(x, y) {

n <- length(y)
yy <- c(0, y)
wy <- which(yy[-1] * yy[-n - 1] < 0)
if(!length(wy)) return(NULL)
xout <- sapply(wy, function(i) {

```     n <- length(x)
ii <- c(i - 1, i)
approx(y[ii], x[ii], 0)\$y
```

})
xout
}

trellis.par.set(theme = col.whitebg())
xyplot(Y ~ Yrs | Id, data = foo,

```        panel = function(x,y) {
x.zero <- find.zero(x, y)
y.zero <- y > 0
yy <- c(y[y.zero], rep(0, length(x.zero)))
xx <- c(x[y.zero], x.zero)
ord <- order(xx)
xx <- xx[ord]
xx <- c(xx[1], xx, xx[length(xx)])
yy <- c(0, yy[ord], 0)
lpolygon(xx, yy, col = "gray")
yy <- c(y[!y.zero], rep(0, length(x.zero)))
xx <- c(x[!y.zero], x.zero)
ord <- order(xx)
xx <- xx[ord]
xx <- c(xx[1], xx, xx[length(xx)])
yy <- c(0, yy[ord], 0)
lpolygon(xx, yy, col = "red", border = FALSE)
panel.lines(x, y, col = "black")
panel.abline(h = 0)
})

______________________________________________
```
R-help@stat.math.ethz.ch mailing list