修正lme4中方差值的值

4
我正在使用lme4 R软件包,使用lmer()函数创建线性混合模型。在此模型中,我有四个随机效应和一个固定效应(截距)。我的问题是关于随机效应的估计方差。是否可以像在SAS中使用PARMS参数一样指定协方差参数的初始值。
在下面的示例中,估计的方差为:
c(0.00000, 0.03716, 0.00000, 0.02306)

我希望你能把这些(例如)修正为:
c(0.09902947, 0.02460464, 0.05848691, 0.06093686)

因此,它们没有被估计。

    > summary(mod1)
    Linear mixed model fit by maximum likelihood  ['lmerMod']
    Formula: log_cumcover_mod ~ (1 | kildestationsnavn) + (1 | year) + (1 |  
        kildestationsnavn:year) + (1 | proevetager)
       Data: res

         AIC      BIC   logLik deviance df.resid 
       109.9    122.9    -48.9     97.9       59 

    Scaled residuals: 
        Min      1Q  Median      3Q     Max 
    -2.1056 -0.6831  0.2094  0.8204  1.7574 

    Random effects:
     Groups                 Name        Variance Std.Dev.
     kildestationsnavn:year (Intercept) 0.00000  0.0000  
     kildestationsnavn      (Intercept) 0.03716  0.1928  
     proevetager            (Intercept) 0.00000  0.0000  
     year                   (Intercept) 0.02306  0.1518  
     Residual                           0.23975  0.4896  
    Number of obs: 65, groups:  
    kildestationsnavn:year, 6; kildestationsnavn, 3; proevetager, 2; year, 2

    Fixed effects:
                Estimate Std. Error t value
    (Intercept)   4.9379     0.1672   29.54

1
“Fix” 是什么意思?你能在问题描述中说明吗?外部资源的链接可能不受到通知就会失效。 - Roman Luštrik
2个回答

5
这是可能的,虽然有点hacky。下面是一个可重现的例子:
拟合原始模型:
library(lme4)
set.seed(101)
ss <- sleepstudy[sample(nrow(sleepstudy),size=round(0.9*nrow(sleepstudy))),]
m1 <- lmer(Reaction~Days+(1|Subject)+(0+Days|Subject),ss)
fixef(m1)
## (Intercept)        Days 
##   251.55172    10.37874 

恢复偏差函数(在这种情况下是REML准则):

dd <- as.function(m1)

我将把标准差设为零,以便与常规线性模型的系数进行比较。(dd的参数向量是包含模型中缩放的随机效应项的按列拼接的下三角形式的Cholesky因子。如果您只有标量/截距随机效应(例如(1|x)),那么这些对应于随机效应标准差,按模型标准差缩放)。)
(ff <- dd(c(0,0)))  ## new REML: 1704.708
environment(dd)$pp$beta(1)  ## new parameters
##    [1] 251.11920  10.56979

匹配:

coef(lm(Reaction~Days,ss))
## (Intercept)        Days 
##   251.11920    10.56979 

如果您想构建一个新的merMod对象,可以按以下方式进行...
opt <- list(par=c(0,0),fval=ff,conv=0)
lmod <- lFormula(Reaction~Days+(1|Subject)+(0+Days|Subject),ss)
m1X <- mkMerMod(environment(dd), opt, lmod$reTrms, fr = lmod$fr,
         mc = quote(hacked_lmer()))

现在假设我们想将方差设置为特定的非零值(比如(700,30))。由于残差标准差的缩放,这可能会有点棘手...

newvar <- c(700,30)
ff2 <- dd(sqrt(newvar)/sigma(m1))
opt2 <- list(par=c(0,0),fval=ff,conv=0)
m2X <- mkMerMod(environment(dd), opt, lmod$reTrms, fr = lmod$fr,
         mc = quote(hacked_lmer()))
VarCorr(m2X)
unlist(VarCorr(m2X))
##   Subject Subject.1 
## 710.89304  30.46684

所以这并没有完全达到我们的期望(因为剩余方差发生了变化...)

buildMM <- function(theta) {
   dd <- as.function(m1)
   ff <- dd(theta)
   opt <- list(par=c(0,0),fval=ff,conv=0)
   mm <- mkMerMod(environment(dd), opt, lmod$reTrms, fr = lmod$fr,
         mc = quote(hacked_lmer()))
   return(mm)
}

objfun <- function(x,target=c(700,30)) {
   mm <- buildMM(sqrt(x))
   return(sum((unlist(VarCorr(mm))-target)^2))
}
s0 <- c(700,30)/sigma(m1)^2
opt <- optim(fn=objfun,par=s0)
mm_final <- buildMM(sqrt(opt$par))
summary(mm_final)
##  Random effects:
##  Groups    Name        Variance Std.Dev.
##  Subject   (Intercept) 700      26.458  
##  Subject.1 Days         30       5.477  
##  Residual              700      26.458  
## Number of obs: 162, groups:  Subject, 18
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)  251.580      7.330   34.32
## Days          10.378      1.479    7.02

顺便说一下,当分组变量只有很少的级别(例如<5或6)时,通常不建议使用随机效应:请参见此处...


1
我不确定我完全理解这里的机制。您示例中计算的随机效应差异为c(703.38, 35.34)。我想要做的是将这些值固定为c(700, 30),以便仅估计固定效应。 - Philippe Massicotte
1
运行良好,environment(dd)$pp$beta(1) 给出了新的估计值。是否还可以访问这些估计值的标准误差? - Philippe Massicotte
1
是的:按照我答案中的最后三行代码构建新模型,然后执行(例如coef(summary(m1X)))。 - Ben Bolker
在倒数第三行使用optim(fn=objfun,par=s0, method = "L-BFGS-B", lower = 0)可能很有用,因为theta不应该小于0。我有一个应用程序需要这样做,否则会出现错误。 - retodomax

1

对于较大的数据集,值得注意的是Ben Bolkers answer中的优化步骤可以简化为一维优化问题。最终的theta将始终是c(700,30)的标量。

特别是如果存在更多的标量/截距随机效应,值得按以下方式更改objfun

objfun <- function(x,target=c(700,30)) {
  scaled_theta <- s0*x
  mm <- buildMM(scaled_theta)
  return(sum((unlist(VarCorr(mm))-target)^2))
}
s0 <- sqrt(c(700,30)/sigma(m1)^2)
opt <- optim(fn=objfun,par=1, method = "L-BFGS-B", lower = 0)

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接