Question

我正在模拟R中的线性混合效应，但有时模型无法收敛。因此，我将其包装在try函数中，以便即使模型失败，仿真也可以继续运行。但是，我的模拟非常慢，我认为这是由于我的代码。我将模型包装在try中，如果它可以工作，那么我会再次做模型，我知道这会浪费我的时间。必须有一个更好的方法来做到这一点。有什么想法吗？

以下是一些示例代码：

set.seed(16420)
y=rnorm(10000,100,15)
x=rnorm(10000,100,15)
t=rep(seq(1,100,1),100)
i=sort(rep(seq(1,100,1),100))
my.data=data.frame(i,t,x,y)
if(!inherits(try(lme(y~x+t,random=~x+t|i,data=my.data),
                 silent=T),"try-error"))
{
  m1=lme(y~x+t,random=~x+t|i,data=my.data)
}
summary(m1)

Answer 1

您可以采取的一个简单的第一步（将近100％）加快代码速度：不要两次运行lme()模型；将try(lme(...))的结果分配给m1并进行 then 测试以查看其是否继承了错误；使用这种方法将您上面的代码（放入函数中）与函数进行比较：

sim_slow <- function() {
    y=rnorm(10000,100,15)
    x=rnorm(10000,100,15)
    t=rep(seq(1,100,1),100)
    i=sort(rep(seq(1,100,1),100))
    my.data=data.frame(i,t,x,y)
    if(!inherits(try(nlme::lme(y~x+t,random=~x+t|i,data=my.data), silent=T),"try-error"))
    {
        return(nlme::lme(y~x+t,random=~x+t|i,data=my.data))
    }
    return(NULL)
}

sim_fast <- function(no_warn = TRUE) {
    if ( no_warn ) { # If you also don't want the warnings
        warn_option <- getOption("warn")
        options(warn = -1)
        on.exit(options(warn = warn_option))
    }
    y <- rnorm(10000, 100, 15)
    x <- rnorm(10000, 100, 15)
    t <- rep(seq(1, 100,1), 100)
    i <- sort(rep(seq(1, 100, 1), 100))
    my.data <- data.frame(i, t, x, y)
    m1 <- try(nlme::lme(y ~ x + t, random = ~x + t|i, data = my.data), silent = TRUE)
    return("if"(inherits(m1, "try-error"), NULL, m1))
}

^{由reprex package（v0.2.1）于2018-10-26创建}

现在让我们看看是否存在速度差异：

set.seed(16420)
system.time(slow_sims <- replicate(10, sim_slow()))
#> Warning in logLik.lmeStructInt(lmeSt, lmePars): Singular precision matrix
#> in level -1, block 1

#> Warning in logLik.lmeStructInt(lmeSt, lmePars): Singular precision matrix
#> in level -1, block 1

#> (Many similar warnings are omitted here for space)

#>    user  system elapsed 
#>  19.612   0.008  19.621
set.seed(16420)
system.time(fast_sims <- replicate(10, sim_fast()))
#>    user  system elapsed 
#>  11.704   0.000  11.703
sum(sapply(slow_sims, is.null))
#> [1] 3
sum(sapply(fast_sims, is.null))
#> [1] 3
all.equal(slow_sims, fast_sims)
#> [1] TRUE

^{由reprex package（v0.2.1）于2018-10-26创建}

尝试捕获使线性混合效果的模拟变慢

1 个答案: