Как использовать bquote в qqmath?

Question

На основании ответов на этот вопрос (In R, plotting random effects from lmer (lme4 package) using qqmath or dotplot: how to make it look fancy?) Я создал «гусеничные участки» с qqmath из библиотеки lattice. Но я сталкиваюсь с проблемой, что я не могу указать заголовок выше графиков гибким способом. Я хочу использовать bquote для выражений формулы в названии, например plot(x = 1, main = bquote(.("It works to write") ~ sigma [0]^2)).

---

Вот мой пример кода:

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 дает подсказку, что я мог бы использовать qqmath(x, main = attr(x, "title"). Но для меня непонятно, что должно быть x: qqmath(ranef_fit, main = attr(x = qqmath(ranef_fit), "test title")) не работает.

Answer 1

После намека на @Roland, я изменил lme4:::qqmath.ranef.mer таким образом, чтобы он позволял гибкий заголовок. В основном я только должен был изменить

mtit <- if (main) 
     nx 

в

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

---

Из соображений полноты, вот полный код с примером:

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