使用 2 个（或可能更多）因子更改格子多面板图中条带的颜色

Question

我已经通过论坛和网络进行了相当广泛的检查，但找不到任何人已经提出了我的案例，所以问题来了：

我的目标：如果我有多个调节因子，我如何扩展 here 中的示例？

我已经尝试了几种方法来修改strip.default函数的which.panel变量，但我无法解决我的问题。

这是我目前正在使用的代码（带有注释）：

if (!require("plyr","lattice")) install.packages("plyr","lattice")
require("plyr")
require("lattice")

# dataframe structure (8 obs. of 6 variables)
data2 <- structure(list(
  COD = structure(c(1L, 1L, 1L, 1L, 2L, 2L,2L, 2L),  
                  .Label = c("A", "B"), class = "factor"),
  SPEC = structure(c(1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L), 
                   .Label = c("15/25-(15/06)", "15/26-(22/06)"), class = "factor"), 
  DATE = structure(c(16589, 16590, 16589, 16590, 16589, 16590, 16589, 16590), class = "Date"), 
  PM.BDG = c(1111.25, 1111.25, 1141.29, 1141.29, 671.26, 671.26, 707.99, 707.99), 
  PM = c(1033.14, 1038.4, 1181.48, 1181.48, 616.39, 616.39, 641.55, 641.55), 
  DELTA.PM = c(-78.12, -72.85, 40.19, 40.19, -54.87, -54.87, -66.44, -66.44)), 
  .Names = c("COD", "SPEC", "DATE", "PM.BDG", "PM", "DELTA.PM"), 
  row.names = c(NA, 8L), class = "data.frame")

# create a dataframe with a vector of colors 
# based on the value of DELTA.PM for the last 
# date available for each combination of COD and SPEC.
# Each color will be used for a specific panel, and it will
# forestgreen if DELTA.PM is higher than zero, red otherwise.
listaPM <- ddply(data2, .(COD,SPEC), summarize, ifelse(DELTA.PM[DATE=="2015-06-04"]<0, "red", "forestgreen"))
names(listaPM) <- c("COD","SPEC","COLOR")

# set a personalized strip, with bg color based on listaPM$COLOR 
# and text based on listaPM$COD and listaPM$SPEC 
myStripStylePM <- function(which.panel, factor.levels, ...) {
  panel.rect(0, 0, 1, 1,
             col = listaPM[which.panel,3],
             border = 1)
  panel.text(x = 0.5, y = 0.5,
             font=2,
             lab = paste(listaPM[which.panel,1],listaPM[which.panel,2], sep=" - "),
             col = "white")}

# prepare a xyplot function to plot that will be used later with dlply.
# Here I want to plot the values of PM.BDG and PM over time (DATE), 
# conditioning them on the SPEC (week) and COD (code) factors.
graficoPM <- function(df) {
  xyplot (PM.BDG + PM ~ DATE | SPEC + COD,
          data=df,
          type=c("l","g"),
          col=c("black", "red"),
          abline=c(h=0,v=0),
          strip = myStripStylePM
  )}

# create a trellis object that has a list of plots, 
# based on different COD (codes)
grafico.PM  <- dlply(data2, .(data2$COD), graficoPM)

# graphic output, 1st row should be COD "A", 
# 2nd row should be COD "B", each panel is a different SPEC (week)
par(mfrow=c(2,1))
print(grafico.PM[[1]], position=c(0,0.5,1,1), more=TRUE)
print(grafico.PM[[2]], position=c(0,0,1,0.5))

如您所见，第一行图是正确的：第一个条带的文本是 "A"（第一个 COD），显示周数 (SPEC)，颜色表示 PM 是否高于或在地块的最后日期 PM.BDG 以下

相反，第二行图只是重复了第一行的相同方案（从COD总是"A"和第二行中第二条带的背景颜色可以看出是绿色，当红色的 PM 线明显低于黑色的 PM.BDG 线时）。

虽然我想保留我的代码，但我很确定我的目标可以通过不同的策略实现。如果您能找到更好的方法来使用我的数据框，我将很乐意研究代码并查看它是否适用于我的数据。

Answer 1

问题是将当前面板数据与 listaPM 数据匹配。因为您在每个调用中都进行了不同的子设置，所以很难使用 which.panel() 来匹配数据集。

有一个 undocumented feature 允许您获取条件变量名称以使匹配更稳健。以下是您将如何在您的案例中使用它。

myStripStylePM <- function(which.panel, factor.levels, ...) {
  cp <- dimnames(trellis.last.object())
  ci <- arrayInd(packet.number(), .dim=sapply(cp, length))
  cv <- mapply(function(a,b) a[b], cp, as.vector(ci))

  idx<-which(apply(mapply(function(n, v) listaPM[, n] == v, names(cv), cv),1,all))
  stopifnot(length(idx)==1)

  panel.rect(0, 0, 1, 1,
             col = listaPM[idx,3],
             border = 1)
  panel.text(x = 0.5, y = 0.5,
             font=2,
             lab = paste(listaPM[idx,1],listaPM[idx,2], sep=" - "),
             col = "white")
}

当运行与您的其余代码一起使用时，它会生成此图

使用 2 个（或可能更多）因子更改格子多面板图中条带的颜色

changing strip's color in lattice multipanel plot with 2 (or possibly more) factors

r

lattice