r - 在具有嵌套因子的条形图中删除每个面板未使用的因子

Question

前段时间我问了一个关于如何删除条形图中未使用的因素的问题，感谢@Aaron，我得到了一个有用的解决方案。现在，我面临一个非常相似的问题，但我过去使用的解决方案不适用于这种情况。

这是重现我正在使用的数据框的代码：

set.seed(17)
df <- data.frame(BENCH = sprintf('bench-%s', sort(rep(letters[1:8], 4))),
                 CLASS.CFG = sprintf('class-%s',
                     c(rep('C', 4), rep('A', 4), rep('B', 8),
                       rep('C', 8), rep('A', 4), rep('D', 4))),
                 EXEC.CFG = rep(c('st', 'st', 'dyn', 'dyn'), 8),
                 METRIC = rep(c('ipc', 'pwr'), 16),
                 VALUE = runif(32))

绘制此数据框的直接命令是：

library(lattice)
barchart(VALUE ~ BENCH | EXEC.CFG + CLASS.CFG, df, groups = METRIC,
         scales = list(x = list(rot = 45, relation = 'free')),
         auto.key = list(columns = 2))

如您所见，我正在为每个 BENCH 绘制 VALUE，这些 BENCH 受限于 EXEC.CFG 和 CLASS.CFG 的每个可能组合（这就是我对嵌套因子的意思），并使用 METRIC 创建组。

这是我得到的结果：

即使我对 X 轴使用“自由”比例，在图中，某些条形之间（例如，在bench-b和之间）之间也存在一些（不必要的）间隙bench-g。

我尝试通过以下方式应用我为上一个问题获得的解决方案：

pl1 <- barchart(VALUE ~ BENCH | EXEC.CFG + CLASS.CFG,
    subset(df, CLASS.CFG == 'class-A'), groups = METRIC,
    auto.key = list(columns = 2))
pl2 <- barchart(VALUE ~ BENCH | EXEC.CFG + CLASS.CFG,
    subset(df, CLASS.CFG == 'class-B'), groups = METRIC)
pl3 <- barchart(VALUE ~ BENCH | EXEC.CFG + CLASS.CFG,
    subset(df, CLASS.CFG == 'class-C'), groups = METRIC)
pl4 <- barchart(VALUE ~ BENCH | EXEC.CFG + CLASS.CFG,
    subset(df, CLASS.CFG == 'class-D'), groups = METRIC)

pls <- c(pl1, pl2, pl3, pl4)
pls <- update(pls, scales = list(y = 'same'))
pls

这是我得到的结果：

你会注意到，这个情节是不正确的。它不尊重嵌套因素，混合来自面板标题中的 CLASS.CFG 和 EXEC.CFG 的值。

我已经为此奋斗了一段时间，但没有成功。有谁知道如何做到这一点？（基本上，我想要获得的是一个像第一个一样的情节，但没有条形之间的间隙）。

Answer 1

为此，您需要提供修改后的prepanel函数（设置每个面板的绘图区域的限制）和修改后的panel函数（负责绘制数据）。在这两种情况下，关键修改是用于x[, drop=TRUE]删除未使用的级别：

library(lattice)

barchart(VALUE ~ BENCH | EXEC.CFG + CLASS.CFG, df, groups = METRIC,
         scales = list(x = list(rot = 45, relation = 'free')),
         prepanel = function(x,y,...) {
             xx <- x[, drop = TRUE]
             list(xlim = levels(xx),
                  xat=sort(unique(as.numeric(xx))))
         },
         panel = function(x,y,...) {
             xx <- x[, drop = TRUE]
             panel.barchart(xx, y, ...)
         },
         auto.key = list(columns = 2))