[R] Custom strips in lattice

[Deepayan Sarkar]

On 6/18/08, Jim Price <price_ja at hotmail.com> wrote:
>
>  I've recently been playing with strip functions for a data presentation I'd
>  like to use, and have a couple questions. I've cannibalised the
>  useOuterStrips function from latticeExtra to give me the following sample
>  code:
>
>
>
>  library(lattice)
>
>
>  myData <- expand.grid(
>         type = c('First 3 days','Whole profile'),
>         sub = paste('Subject', 1:3, '\nDescription'),
>         time = 1:10
>  )
>  myData$resp <- rnorm(nrow(myData))
>
>
>  y.limits <- rep(with(myData, by(resp, sub, function(.x)
>  range(pretty(range(.x))))), each = 2)
>
>
>  xyplot(
>         resp ~ time | type * sub,
>         data = myData,
>         strip.left = function(which.given, which.panel, var.name, par.strip.text,
>  ...)
>                 if(which.given == 1)
>                         strip.default(which.given = 1, which.panel = which.panel[1], var.name =
>  var.name[1], par.strip.text = list(cex = 0.75), ...),
>         strip = function(which.given, which.panel, var.name, par.strip.text, ...)
>                 if(which.given == 2)
>                         strip.default(which.given = 1, which.panel = which.panel[2], var.name =
>  var.name[2], par.strip.text = list(cex = 0.75), ...),
>         as.table = T,
>         scales = list(
>                 x = list(relation = 'free', limits = list(c(1,3), c(1,10))),
>                 y = list(relation = 'free', limits = y.limits)
>         )
>  )
>
>
>  There are 2 changes I'd like to make:
>
>  Firstly, I'd like to expand the top strip only, so I can add more (than 2)
>  rows of text. Normally I'd do that through calling par.strip.text with the
>  lines argument. However, this appears to effect both strips. As above, I
>  could define a par.strip.text inside each custom function, but this doesn't
>  appear to work; indeed, the default for strip.default,
>  trellis.par.get('add.text'), doesn't include this as an option, so I assume
>  that there is some preprocessing that goes on (in the prepanel function?).

Yes, using par.strip.text$lines seemed like a good idea at the time,
but it's not very elegant (or generalizable). Here's one option using
the "layout.widths" setting:

my.strip.left <-
    function(which.given, which.panel, var.name,
             par.strip.text, ...)
{
    if(which.given == 1)
        strip.default(which.given = 1, which.panel = which.panel[1],
                      var.name = var.name[1],
                      par.strip.text = list(cex = 0.75), ...)
}

my.strip <-
    function(which.given, which.panel, var.name, par.strip.text, ...)
{
    if(which.given == 2)
        strip.default(which.given = 1, which.panel = which.panel[2],
                      var.name = var.name[2],
                      par.strip.text = list(cex = 0.75), ...)
}

xyplot(resp ~ time | type * sub,
       data = myData,
       strip.left = my.strip.left,
       strip = my.strip,
       as.table = TRUE,
       par.settings = list(layout.widths = list(strip.left = 0.6)),
       scales =
       list(
            x = list(relation = 'free', limits = list(c(1,3), c(1,10))),
            y = list(relation = 'free', limits = y.limits)
            )
       )


But wouldn't a better option be


library(latticeExtra)

useOuterStrips(
    xyplot(resp ~ time | type * sub,
           data = myData,
           as.table = TRUE,
           ## par.settings = list(layout.widths = list(strip.left = 2)),
           lattice.options = list(layout.widths = list(strip.left =
list(x = 2))),
           scales =
           list(
                x = list(relation = 'free', limits = list(c(1,3), c(1,10))),
                y = list(relation = 'free', limits = y.limits)
                )
           )
)

There is a buglet in useOuterStrips, in that it does not allow a
specification of the strip height (which is why we need to use the
more low-level 'lattice.options'). I will fix this in the next update.

>  Secondly, although I have custom y-axis ranges, you can see from the graph
>  that the rows represent the same subject; hence, in the interest of saving
>  space, I'd prefer to have no gap between columns. This isn't a show stopper
>  though, so if it's not possible it's no great loss.

This is possible, albeit by brute force. Here's one way using the
second example above; it applies in the first case too:


useOuterStrips(
    xyplot(resp ~ time | type * sub,
           data = myData,
           as.table = TRUE,
           ## par.settings = list(layout.widths = list(strip.left = 2)),
           par.settings =
           list(layout.widths = list(axis.panel = c(1, 0)),
                layout.heights = list(axis.panel = c(0, 0, 1))),
           lattice.options = list(layout.widths = list(strip.left =
list(x = 2))),
           scales =
           list(
                x = list(relation = 'free', limits = list(c(1,3), c(1,10)),
                         at = list(NULL, NULL, NULL, NULL, TRUE, TRUE)),
                y = list(relation = 'free', limits = y.limits,
                         at = list(TRUE, NULL, TRUE, NULL, TRUE, NULL))
                )
           )
)

-Deepayan