> -----Original Message----- > From: Sundar Dorai-Raj [mailto:[EMAIL PROTECTED] > Sent: Wednesday, February 15, 2006 1:40 PM > To: Andy Bunn > Cc: R-Help > Subject: Re: [R] shading under the lines in a lattice xyplot? > > > > > 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) > }) >
Sundar: That is exactly what I wanted. I had been trying something along those lines and just realized I needed to find the zeros when your email came in. That's perfect. Thanks, Andy ______________________________________________ [email protected] mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
