set key text inside key rectangle in lattice plots

Question

is there an comfortable way to set the legend/key label inside the rectanlge in latice plots: (although overplot/overlayer lines, points, rectangles in keys would be nice)

library(lattice)
barchart(yield ~ variety | site, data = barley,
         groups = year, layout = c(1,6), stack = TRUE,
         auto.key = list(space = "right"),
         ylab = "Barley Yield (bushels/acre)",
         scales = list(x = list(rot = 45)))

Answer 1

Well, there's no really automatic way, but it can be done. Here are a couple of options I came up with. Both construct a legend 'grob' and pass it in via the barchart()'s legend= argument. The first solution uses the nifty gtable package to construct a table grob. The second is a bit more programmatic, and uses grid's own frameGrob() and packGrob() functions to construct a similar legend.

Option 1: Construct legend using gtable()

library(lattice)
library(grid)
library(gtable)

## Extract group labels and their colors for use in gtable
ll <- levels(barley[["year"]])
cc <- trellis.par.get("superpose.polygon")[["col"]][seq_along(ll)]

## Prepare a grob for passing in to legend.
## Set up a two cell gtable , and 'paint' then annotate both cells
## (Note: this could be further "vectorized", as, e.g., at
##  http://stackoverflow.com/a/18033613/980833)
gt <- gtable(widths = unit(1.5,"cm"), heights = unit(rep(.7,2), "cm"))
gt <- gtable_add_grob(gt, rectGrob(gp=gpar(fill=cc[1])), 1, 1, name=1)
gt <- gtable_add_grob(gt, textGrob(ll[1]), 1, 1, name=2)
gt <- gtable_add_grob(gt, rectGrob(gp=gpar(fill=cc[2])), 2, 1, name=1)
gt <- gtable_add_grob(gt, textGrob(ll[2]), 2, 1, name=2)

## Plot barchart with legend
barchart(yield ~ variety | site, data = barley,
         groups = year, layout = c(1,6), stack = TRUE,
         legend = list(right=list(fun=gt)),
         ylab = "Barley Yield (bushels/acre)",
         scales = list(x = list(rot = 45)))

Option 2: Construct legend by packing a frameGrob()

library(lattice)
library(grid)

## A function for making grobs with text on a colored background
labeledRect <- function(text, color) {
    rg <- rectGrob(gp=gpar(fill=color))
    tg <- textGrob(text)
    gTree(children=gList(rg, tg), cl="boxedTextGrob")
}
## A function for constructing a legend consisting of several
## labeled rectangles
legendGrob <- function(labels, colors) {
    gf <- frameGrob()
    border <- unit(c(0,0.5,0,0.5), "cm")
    for (i in seq_along(labels)) {
        gf <- packGrob(gf, labeledRect(labels[i], colors[i]),
                       width = 1.1*stringWidth(labels[i]),
                       height = 1.5*stringHeight(labels[i]),
                       col = 1, row = i, border = border)
    }
    gf
}

## Use legendGrob() to prepare the legend
ll <- levels(barley[["year"]])
cc <- trellis.par.get("superpose.polygon")[["col"]][seq_along(ll)]
gf <- legendGrob(labels=ll, colors=cc)

## Put it all together
barchart(yield ~ variety | site, data = barley,
         groups = year, layout = c(1,6), stack = TRUE,
         legend = list(right=list(fun=gf)),
         ylab = "Barley Yield (bushels/acre)",
         scales = list(x = list(rot = 45)))