在格子图中设置关键矩形内的关键文本

Question

是否有一种舒适的方法可以在latice图中的rectanlge中设置图例/键标签:(虽然过度绘图/覆盖层线，点，矩形在键中会很好）

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

嗯，没有真正的自动方式，但可以做到。以下是我提出的几个选项。两者都构建了一个传奇＆＃39; grob＆＃39;并通过barchart()＆＃39; legend=参数传递给它。第一个解决方案使用漂亮的 gtable 包来构造表格grob。第二个是更具编程性的，并使用 grid 自己的frameGrob()和packGrob()函数来构建类似的图例。

选项1：使用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)))

选项2：打包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)))