Conditionner la couche à travers les panneaux en treillis

Question

Je voudrais tracer des moyens de sujet individuels pour deux conditions différentes dans un treillis stripplot avec deux panneaux. Je voudrais également ajouter des intervalles de confiance intra-sujets que j'ai calculés et stockés dans une trame de données séparée. J'essaie de superposer ces intervalles de confiance avec la fonction layer de latticeExtra. Lorsque j'ajoute la couche, les deux ensembles d'intervalles apparaissent sur les deux panneaux (comme illustré dans le code et la première image ci-dessous) ou les deux ensembles d'intervalles sur le premier panneau si j'ajoute [subscripts] aux x et y dans la commande layer (illustré dans le deuxième clip de code et l'image ci-dessous). Comment puis-je obtenir les intervalles appropriés à afficher sur le panneau approprié?

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 avec les deux ensembles d'intervalles sur les deux panneaux:

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 avec les deux ensembles d'intervalles que sur le premier panneau

Answer 1

One solution possible serait t o print le stripplot (par exemple, à l'intérieur d'un png ou tout autre périphérique graphique) et de modifier ensuite chaque sous-panneau en utilisant 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() 
} 

Une autre solution (éventuellement plus commode) serait de créer un xyplot séparée et régler les valeurs de y inférieure et supérieure (y0, y1) transmis à panel.segments manuellement en fonction de la panel.number courant . Contrairement à l'approche initiale à l'aide trellis.focus, la parcelle ainsi créée peut être stocké dans une variable et est donc disponible pour un traitement ultérieur à l'intérieur 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

Une autre solution qui ne nécessite pas latticeextra (de 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) 
)