在R中加速双嵌套sapply + lmer函数

时间:2012-11-24 05:56:59

标签: r

我正在与lmer进行混合建模,并希望探索随机化数据的效果。可以在速度方面改进以下代码吗?按照目前的情况,我目前的规格将需要几天的时间来运行我的实际数据......从我能够找到的情况来看,是开始的方式。我希望我错了。

library(lme4)

##Generate real data
        real.data=data.frame(cat1=factor(rep(c("A","B","C","D"),500)),cat2=factor(rep(c("E","F","G","H"),500)), matrix(runif(12000),ncol=6))

##Apply lmer model for each data columm and extract variance estimates with VarCorr for 1000 randomizations of the real.data frame.

random=sapply(1:1000,function(z){print(z)

##Generate a randomized data set by sampling first two factor columns

    sample=data.frame(cat1=factor(sample(real.data$cat1)),cat2=factor(sample(real.data$cat2)), real.data[,3:8])

sapply(3:dim(sample)[2],function(y){print(y)

##Apply REML to each column of data, with 'cat1' and 'cat2' as random effects, including cat1:cat2 interaction

model=lmer(sample[,y]~(1|cat1)+(1|cat2)+(1|cat1:cat2), data=sample)

##Extract the estimates of the random effect terms
                c(as.numeric(VarCorr(model)$cat1),as.numeric(VarCorr(model)$cat2),as.numeric(VarCorr(model)$'cat1:cat2'))
})
})

1 个答案:

答案 0 :(得分:1)

sapply等等不会为你节省太多时间,他们只是 清洁(有时)。另一方面,一旦你有了 扰乱了您可以使用refit重新适合的因子列 一些人的不同反应数据(即列)的模型 节省时间。

我将plyr包用于以下几个方面。

我不清楚为什么你用sample来争抢 您安装不同响应的顺序 变量,所以我把那部分遗漏了......

预赛:

library(lme4)
library(plyr)
set.seed(101)
##Generate real data
real.data=data.frame(cat1=factor(rep(c("A","B","C","D"),500)),
cat2 <- factor(rep(c("E","F","G","H"),500)), matrix(runif(12000),ncol=6))

这是将因子列随机化并适合的函数 模型到基于第3到8列的每一个的响应...

sfun <- function() {
###Generate a randomized data set by sampling first two factor columns
    sampledat <- transform(real.data,
                           cat1=factor(sample(cat1)),
                           cat2=factor(sample(cat2)))
    ## fit first column
    m1 <- lmer(X1 ~ (1|cat1)+(1|cat2)+(1|cat1:cat2), data=sampledat)
    ## refit using every other column
    m_rest <- apply(real.data[,-(1:3)],2,
                     refit,object=m1)
    ## note this is 'laply' (from plyr), not 'lapply'
    laply(c(list(m1),m_rest),function(m) unlist(VarCorr(m)))
}

现在使用raply重复一次。结果是一个3D数组 维度(#smss)(#response columns)(#variance components)。

nsim <- 50
sres <- raply(nsim,sfun(),.progress="text")

我的笔记本电脑花了大约45秒钟,所以大约需要15分钟才能完成1000次重复...