[R] levelplot and unequal cell sizes

[Waichler, Scott R]

> You are right, panel.levelplot is indeed assuming that the 
> boundaries are between consecutive midpoints. There is no 
> built in way around that; there simply isn't enough 
> information available to the panel function.
> 
> The cleanest solution, in principle, is to write your own 
> panel function that ends up calling panel.polygon or grid.polygon.
> panel.levelplot is a good starting point (the only tricky 
> part is getting the colors right, almost everything else you 
> can get rid of).
> Maybe Hadley will have a simpler solution.
> 
> Here's a possible implementation using a panel function:
> 
> 
> my.panel.levelplot <-
>     function (x, y, z, subscripts, at = pretty(z),
>               col.regions = regions$col, ...,
>               w, h)
> {
>     regions <- trellis.par.get("regions")
>     numcol <- length(at) - 1
>     numcol.r <- length(col.regions)
>     col.regions <- if (numcol.r <= numcol)
>         rep(col.regions, length = numcol)
>     else col.regions[floor(1+(1:numcol-1) * (numcol.r-1)/(numcol-1))]
>     zcol <- findInterval(z, at, rightmost.closed = TRUE)
>     x <- as.numeric(x[subscripts])
>     y <- as.numeric(y[subscripts])
>     z <- as.numeric(z[subscripts])
>     w <- as.numeric(w[subscripts])
>     h <- as.numeric(h[subscripts])
>     zcol <- as.numeric(zcol[subscripts])
>     print(data.frame(z, x.node, y.node, w.node, h.node, 
> col.regions[zcol]))
>     panel.rect(x = x, y = y, width = w, height = h,
>                col = col.regions[zcol], ...) }

Deepayan, thanks so much for this solution.  It's great for my needs and
will allow me to keep using my existing lattice "infrastructure."  I
never would have arrived at using findInterval() and panel.rect() on my
own.  Users might find my slight modification below for handling NA
values useful.  It also hides the cell borders:


PANEL.LEVELPLOT1 <-
    function (x, y, z, subscripts, at = pretty(z),
              col.regions = regions$col, ...,
              w, h) {
    regions <- trellis.par.get("regions")
    numcol <- length(at) - 1
    numcol.r <- length(col.regions)
    col.regions <- if (numcol.r <= numcol)
        rep(col.regions, length = numcol)
    else col.regions[floor(1+(1:numcol-1) * (numcol.r-1)/(numcol-1))]
    zcol <- findInterval(z, at, rightmost.closed = TRUE)
    x <- as.numeric(x[subscripts])
    y <- as.numeric(y[subscripts])
    z <- as.numeric(z[subscripts])
    w <- as.numeric(w[subscripts])
    h <- as.numeric(h[subscripts])
    zcol <- as.numeric(zcol[subscripts])
    these.colors <- ifelse(!is.na(zcol), col.regions[zcol],
"transparent")  # my addition  :)
#    print(data.frame(z.vec, x.vec, y.vec, w.vec, h.vec, these.colors))
    panel.rect(x = x, y = y, width = w, height = h,
               col = these.colors, border=NA,...)
}  # end PANEL.LEVELPLOT1()

Regards,
Scott Waichler