Condition layer across panels in lattice

Question

I would like to plot individual subject means for two different conditions in a lattice stripplot with two panels. I would also like to add within-subject confidence intervals that I have calculated and stored in separate data frame. I am trying to overlay these confidence intervals with latticeExtra's layer function. When I add the layer, either both sets of intervals display on both panels (as illustrated in code and first image below) or both sets of intervals display on only the first panel if I add [subscripts] to the x's and y's in the layer command (illustrated in second code clip and image below). How do I get the appropriate intervals to display on the appropriate panel?

library(latticeExtra)

raw_data <- data.frame(subject = rep(1:6, 4), cond1 = as.factor(rep(1:2, each = 12)), cond2 = rep(rep(c("A", "B"), each = 6), 2), response = c(2:7, 6:11, 3:8, 7:12))
summary_data <- data.frame(cond1 = as.factor(rep(1:2, each = 2)), cond2 = rep(c("A", "B"), times = 2), mean = aggregate(response ~ cond2 * cond1, raw_data, mean)$response, within_ci = c(0.57, 0.54, 0.6, 0.63))
summary_data$lci <- summary_data$mean - summary_data$within_ci
summary_data$uci <- summary_data$mean + summary_data$within_ci

subject_stripplot <- stripplot(response ~ cond1 | cond2, groups = subject, data = raw_data, 
  panel = function(x, y, ...) {
    panel.stripplot(x, y, type = "b", lty = 2, ...)
    panel.average(x, y, fun = mean, lwd = 2, col = "black", ...)    # plot line connecting means
  }
)
addWithinCI <- layer(panel.segments(x0 = cond1, y0 = lci, x1 = cond1, y1 = uci, subscripts = TRUE), data = summary_data, under = FALSE)
plot(subject_stripplot + addWithinCI)

Stripplot with both sets of intervals on both panels:

addWithinCI2 <- layer(panel.segments(x0 = cond1[subscripts], y0 = lci[subscripts], x1 = cond1[subscripts], y1 = uci[subscripts], subscripts = TRUE), data = summary_data, under = FALSE)
plot(subject_stripplot + addWithinCI2)

Stripplot with both sets of intervals on only the first panel

Answer 1

One possible solution would be to print the stripplot (e.g., inside a png or any other graphics device) and subsequently modify each sub-panel using trellis.focus.

## display stripplot
print(subject_stripplot)

## loop over grops
for (i in c("A", "B")) {

  # subset of current group
  dat <- subset(summary_data, cond2 == i)

  # add intervals to current panel
  trellis.focus(name = "panel", column = ifelse(i == "A", 1, 2), row = 1)
  panel.segments(x0 = dat$cond1, y0 = dat$lci, 
                 x1 = dat$cond1, y1 = dat$uci, subscripts = TRUE)
  trellis.unfocus()
}

Another (possibly more convenient) solution would be to create a separate xyplot and set the lower and upper y values (y0, y1) passed on to panel.segments manually in dependence of the current panel.number. In contrast to the initial approach using trellis.focus, the thus created plot can be stored in a variable and is hence available for subsequent processing inside R.

p_seg <- xyplot(lci ~ cond1 | cond2, data = summary_data, ylim = c(1, 13),
       panel = function(...) {
         # lower and upper y values
         y0 <- list(summary_data$lci[c(1, 3)], summary_data$lci[c(2, 4)])
         y1 <- list(summary_data$uci[c(1, 3)], summary_data$uci[c(2, 4)])
         # insert vertical lines depending on current panel
         panel.segments(x0 = 1:2, x1 = 1:2,
                        y0 = y0[[panel.number()]], 
                        y1 = y1[[panel.number()]])
       })

p_comb <- subject_stripplot + 
  as.layer(p_seg)

# print(p_comb)

Answer 2

Another solution that does not require latticeExtra (from Duncan Mackay):

summary_data$cond3 <- sapply(summary_data$cond2, pmatch, LETTERS)

mypanel <- function(x, y, ..., lci, uci, scond1, scond3, groups, type, lty){
pnl = panel.number()
panel.xyplot(x, y, ..., groups = groups, type = type, lty = lty)
panel.average(x, y, horizontal = FALSE, col = "black", lwd = 3)
panel.segments(x0 = scond1[scond3 == pnl],
               y0 = lci[scond3 == pnl],
               x1 = scond1[scond3 == pnl],
               y1 = uci[scond3 == pnl])
}
with(summary_data,
 stripplot(response ~ cond1 | cond2, data = raw_data,
           groups = subject,
           lci = lci,
           uci = uci,
           scond1 = summary_data$cond1,
           scond3 = cond3,
           type = "b",
           lty = 2,
           panel = mypanel)
)