如何在qqmath中使用bquote?

时间:2016-05-03 13:03:39

标签: r expression lattice

根据这个问题的答案(In R, plotting random effects from lmer (lme4 package) using qqmath or dotplot: how to make it look fancy?),我创建了" caterpillar情节"来自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"))不起作用。

1 个答案:

答案 0 :(得分:0)

在@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