[R] levelplot and unequal cell sizes

[Deepayan Sarkar]

On 4/25/07, Waichler, Scott R <Scott.Waichler at pnl.gov> wrote:
> Hadley and Deepayan,
>
> Thank you for responding.  Here is a simple example of what I'm talking
> about.  It is a grid that is 5 cells wide by 2 cells tall.  The width of
> the cells in the x-direction is variable; the cells at either end have
> width = 4 units, and the three cells in the middle have width = 2 units.
> My objective is to have the color contour boundaries fall on the cell
> boundaries instead of equidistant between cell nodes.  In the plot, I
> want the cyan/blue and orange/gray boundaries to be located at the red
> cell boundary lines.  Also, the colored regions should extend to the
> ends of the domain (x = 0, 14).
>
>
> library(lattice)
>
> x.node <- rep(c(2, 5, 7, 9, 12), 2)
> y.node <- c(rep(0.5, 5), rep(1.5, 5))
> z <- rep(1:5, 2)
> contour.levels <- seq(0.5, 5.5, by=1)
> x.cell.boundary <- c(0, 4, 6, 8, 10, 14)
> contour.colors <- c("cyan", "blue", "green", "orange", "gray")
>
> print(
>   levelplot(z ~ x.node * y.node,
>      panel = function(z,...) {
>         panel.levelplot(z,...)
>         panel.abline(v = x.cell.boundary, col="red")
>      },
>      xlim = range(x.cell.boundary),
>      at=contour.levels,
>      colorkey = list(space="top", width=1, height=0.9,
>                      at=1:5,
>                      col=contour.colors,
>                      labels=list(labels=z, at=z)
>                     ),
>      col.regions=contour.colors,
>      region = T,
>      contour = F
>   )
> )

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], ...)
}



x.node <- rep(c(2, 5, 7, 9, 12), 2)
y.node <- c(rep(0.5, 5), rep(1.5, 5))
z <- rep(1:5, 2)
contour.levels <- seq(0.5, 5.5, by=1)
x.cell.boundary <- c(0, 4, 6, 8, 10, 14)
contour.colors <- c("cyan", "blue", "green", "orange", "gray")


w.node <- rep(diff(x.cell.boundary), 2)
h.node <- rep(1, 10)


levelplot(z ~ x.node * y.node, h = h.node, w = w.node,
          panel = function(...) {
              my.panel.levelplot(...)
              panel.abline(v = x.cell.boundary, col="red")
          },
          xlim = range(x.cell.boundary),
          at=contour.levels,
          colorkey =
          list(space="top", width=1, height=0.9,
               at=contour.levels,
               col=contour.colors,
               labels=list(labels=z, at=z)),
          col.regions=contour.colors)


-Deepayan