Wie benutze ich bquote in qqmath?

Question

Basierend auf den Antworten auf diese Frage (In R, plotting random effects from lmer (lme4 package) using qqmath or dotplot: how to make it look fancy?) habe ich "Raupe Plots" mit qqmath aus der lattice Bibliothek erstellt. Aber ich stehe vor dem Problem, dass ich den Titel über den Plots nicht flexibel angeben kann. Ich möchte bquote für Formelausdrücke im Titel wie plot(x = 1, main = bquote(.("It works to write") ~ sigma [0]^2)) verwenden.

---

Hier ist mein Beispielcode:

require(lme4) ## for lmer(), sleepstudy 
require(lattice) ## for qqmath() 

fit <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) 

ranef_fit <- ranef(fit, condVar = TRUE) 
qqmath(ranef_fit) #has title "Subject" 

names(ranef_fit) <- "This works" 
qqmath(ranef_fit) #now has title "This works" 

names(ranef_fit) <- bquote(.("Doesn't work to write ") ~ sigma [0]^2) #doesn't work 

This Website gibt den Hinweis, dass ich qqmath(x, main = attr(x, "title") verwenden möchte. Aber für mich ist es unklar, was x sein muss: qqmath(ranef_fit, main = attr(x = qqmath(ranef_fit), "test title")) funktioniert nicht.

Answer 1

Nach dem Hinweis von @Roland änderte ich lme4:::qqmath.ranef.mer in der Weise, dass es flexible Titel erlaubt. Im Grunde nur ich hatte

mtit <- if (main) 
     nx 

zu

if(is.null(main)){ 
    mtit <- NULL 
}else if(is.expression(main)){ 
    mtit <- main 
}else if(main == TRUE){ 
    mtit <- nx 
}else{ 
    mtit <- main 
} 

---

Aus Gründen der Vollständigkeit zu ändern, hier ist der vollständige Code mit Beispiel:

require(lme4) ## for lmer(), sleepstudy 
require(lattice) ## for qqmath() 

test <- function (x, data, main = TRUE,...){ 
#Say nothing about main shall give the current status 
#(writing) the name of x) 

#Saying 'main = FALSE' shall give no title at all 

#Giving a specific main 
#(e.g. main = bquote(.("Let's write ") ~ sigma [0]^2)) 
#shall give this specific title 

prepanel.ci <- function(x, y, se, subscripts, ...) { 
    x <- as.numeric(x) 
    se <- as.numeric(se[subscripts]) 
    hw <- 1.96 * se 
    list(xlim = range(x - hw, x + hw, finite = TRUE)) 
} 
panel.ci <- function(x, y, se, subscripts, pch = 16, ...) { 
    panel.grid(h = -1, v = -1) 
    panel.abline(v = 0) 
    x <- as.numeric(x) 
    y <- as.numeric(y) 
    se <- as.numeric(se[subscripts]) 
    panel.segments(x - 1.96 * se, y, x + 1.96 * se, y, col = "black") 

    panel.xyplot(x, y, pch = pch, ...) 
    panel.xyplot(x, y, pch = pch, ...) 
} 
f <- function(nx) { 
    xt <- x[[nx]] 

    if(is.null(main)){ 
     mtit <- NULL 
    }else if(is.expression(main)){ 
     mtit <- main 
    }else if(main == TRUE){ 
     mtit <- nx 
    }else{ 
     mtit <- main 
    } 
    if (!is.null(pv <- attr(xt, "postVar"))) { 
     d <- dim(pv) 
     se <- vapply(seq_len(d[1]), function(i) sqrt(pv[i, 
      i, ]), numeric(d[3])) 
     nr <- nrow(xt) 
     nc <- ncol(xt) 
     ord <- unlist(lapply(xt, order)) + rep((0:(nc - 1)) * 
      nr, each = nr) 
     rr <- 1:nr 
     ind <- gl(nc, nr, labels = names(xt)) 

     xyplot(rep(qnorm((rr - 0.5)/nr), nc) ~ unlist(xt)[ord] | 
      ind[ord], se = se[ord], prepanel = prepanel.ci, 
      panel = panel.ci, scales = list(x = list(relation = "free")), 
      ylab = "Standard normal quantiles", xlab = NULL, main = mtit, ...) 
    } 
    else { 
     qqmath(~values | ind, stack(xt), scales = list(y = list(relation = "free")), 
      xlab = "Standard normal quantiles", ylab = NULL, main = mtit, ...) 
    } 
} 
sapply(names(x), f, simplify = FALSE) 
} 

fit <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) 

ranef_fit <- ranef(fit, condVar = TRUE) 

test(ranef_fit) #has title "Subject" 
test(ranef_fit, main = TRUE) #has title "Subject" 
test(ranef_fit, main = FALSE) #has no title 
test(ranef_fit, main = expression("Let's write " ~ sigma [0]^2))#has the expression as title 
test(ranef_fit, main = bquote(.("No this works") ~ sigma [0]^2))#has the bquote as title