在lme4中获取残差方差 - 协方差矩阵

Question

我使用lme4拟合线性混合效果模型：

library(lme4)
data(Orthodont)
dent <- Orthodont
d.test <- lmer(distance ~ age + (1|Subject), data=dent)

如果我们一般说Y = X * B + Z * d + e是线性混合效果模型的形式，那么我试图从模型的结果中得到Var(Y) = Z * Var(d) * Z^t + Var(e)。

以下方法是否是正确的方法？

k <- table(dent$Subject)[1]
vars <- VarCorr(d.test)
v <- as.data.frame(vars)
sigma <- attr(vars, "sc")
s.tech <- diag(v$vcov[1], nrow=k)
icc <- v$vcov[1]/sum(v$vcov)
s.tech[upper.tri(s.tech)] <- icc
s.tech[lower.tri(s.tech)] <- icc
sI <- diag(sigma^2, nrow=length(dent$age))
var.b <- kronecker(diag(1, nrow=length(dent$age)/k), s.tech)
var.y <- sI + var.b

我认为这是一个简单的问题，但我无法找到执行此操作的任何代码，因此我会问我是否正确行事。

Answer 1

如果您了解getME()，这是一个通用的提取位 - { - 1}} - 拟合函数，则可以更轻松地执行此操作。特别是，您可以提取转置的Z矩阵（lmer）和转置的Lambda矩阵 - Lambda矩阵是条件模型（BLUP）的缩放方差 - 协方差矩阵的Cholesky因子;在您的符号中，getME(.,"Zt")是剩余差异乘以Lambda的交叉乘积。

引用的答案here相当不错，但下面的答案稍微一般（适用于任何Var(d)适合）。

适合模特：

lmer

提取组件：

library(lme4)
data(Orthodont,package="nlme")
d.test <- lmer(distance ~ age + (1|Subject), data=Orthodont)

结合它们：

var.d <- crossprod(getME(d.test,"Lambdat"))
Zt <- getME(d.test,"Zt")
vr <- sigma(d.test)^2

图片：

var.b <- vr*(t(Zt) %*% var.d %*% Zt)
sI <- vr * Diagonal(nrow(Orthodont))
var.y <- var.b + sI