lme4：展开单个顶点？

Question

这似乎应该很简单，但我似乎无法弄清如何做到。

如果我有一个带有双竖杠的公式，表示随机斜率和截距不相关，我可以使用lme4的expandDoubleVerts()函数将随机效应扩展为单独的项。

> f <- y ~ x * w + (1 + x * w || z)
> expandDoubleVerts(f)
y ~ x * w + ((1 | z) + (0 + x | z) + (0 + w | z) + (0 + x:w | z))

我能否针对具有相关随机斜率和截距的公式做类似的事情，以获得类似的结果？

> f <- y ~ x * w + (1 + x * w | z)
> expandSingleVerts(f)
y ~ x * w + (1 + x + w + x:w | z)

没有名为expandSingleVerts的函数，但类似的功能正是我想要的。如果有更通用的函数可以接受一个语言对象，例如x * w并将其扩展为x + w + x:w，那也可以。

- Jigsaw

Answer 1

根据您需要的结果格式，我建议从以下开始：

tt <- attr(terms(~x*w), "term.labels")
res <- paste(tt, collapse = "+")

这将带您到 "x+w+x:w"。难点可能是从任何您开始的内容转换并返回某种语言对象。例如，如果您从 qq <- quote(x*w) 开始，则 bquote(~.(qq)) 将带您到 ~x+w。 parse(text = res) 将带您到 expression(x + w + x:w)。

• this file 有很多处理公式的机制
• 没有为扩展随机效应的术语（即 (x*w|g) 中竖线左侧的内容）提供机制的原因是，在处理混合模型公式时，我们通常可以直接将该组件传递给 model.matrix() 而不是自己扩展它

- Ben Bolker

Answer 2

感谢Ben Bolker的回答，我已经能够做到以下操作，以获取在单个（和双重）垂直术语中展开效果的公式。

最终我得出了以下结果：

library(lme4) # used for `findbars`, `nobars`
# note that this will expand both single and double vert terms,
# because `findbars` expands the double verts 
expandVerts <- function(formula) {
    bars <- findbars(formula)
    groups <- lapply(bars, \(x) x[[3]])
    # found looking in the lme4 source
    bars <- lapply(
        bars, 
        \(x) {
            eval(
                substitute(~ foo, list(foo = x[[2]])),
                envir = environment(formula)
            )
        }
    )
    terms <- lapply(bars, terms)
    intercepts <- lapply(terms, \(x) attr(x, 'intercept'))
    # thanks to Ben Bolker!
    terms <- lapply(terms, \(x) attr(x, 'term.labels'))
    expanded <- mapply(
        \(intercept, term, group) {
            group.sep <- ifelse(length(group), ' | ', '')
            intercept.sep <- ifelse(length(term), ' + ', '')
            paste0(
                '(', 
                    intercept, intercept.sep,
                    paste(term, collapse = ' + '), group.sep,
                    group,
                ')'
            )
        },
        intercepts,
        terms, 
        groups
    )
    
    nobar <- deparse1(nobars(formula))
    nobar.sep <- ifelse(length(expanded), ' + ', '')
    reconstructed <- as.formula(
        paste0(nobar, nobar.sep, paste(expanded, collapse = ' + ')),
        env = environment(formula)
    )
    reconstructed
}

然后：

> f <- y ~ x * w + (1 + x * w | z)
> expandVerts(f)
y ~ x * w + (1 + x + w + x:w | z)

> f <- y ~ x * w + (1 + x * w | z) + (1 + x * w || a)
> expandVerts(f)
y ~ x * w + (1 + x + w + x:w | z) + (1 | a) + (0 + x | a) + (0 + 
    w | a) + (0 + x:w | a)

另外，作为一种合理性检查：

> f <- y ~ x * w
> expandVerts(f)
y ~ x * w

- Jigsaw