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

Question

有没有一种舒适的方法可以在格子图中的矩形内设置图例/键标签:(尽管重叠图/覆盖线、点、键中的矩形会很好)

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

虽然没有真正自动的方法，但可以做到。这是我想出的几个选项。两者都构造一个图例“grob”并通过 barchart() 的 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)))