如何有效地实现dplyr调用lmer函数?

时间:2017-08-22 17:56:48

标签: r dplyr lme4

我有一个包含~400000行的数据集,我试图使用R中的lme4 dplyr调用来提取do混合模型方差组件。函数是:

myfunc <- function(dat) {
    if (sum(!is.na(dat$value)) > 840) {  # >70% data present 
           v = data.frame(VarCorr(lmer(value ~ 0 + (1|gid) + (1|trial:rep) + (1|trial:rep:block), data=dat)))
           data.frame(a=round(v[1,4]/(v[1,4]+(v[4,4]/2)),2), b=round(v[1,4],2), c=round(v[4,4],2), n_obs=nrow(dat), na_obs=sum(is.na(dat$value))) 
    } else { 
        data.frame(a=NA, b=NA, c=NA, n_obs= nrow(dat), na_obs=sum(is.na(dat$value)))
    }
}

在通过四个分组变量对数据进行分组后,使用dplyr do调用调用此函数。最终的dplyr电话是:

system.time(out <- tst %>% group_by(iyear,ilocation,trait_id,date) %>% 
          do(myfunc(.)))

现在,当此代码在11000行的较小测试数据帧上运行时,大约需要25秒。但是在一整套443K行上运行它需要大约8-9个小时才能完成,这非常慢。很明显,有一部分代码会降低性能,但我似乎无法弄清楚是lmer部分还是导致速度减慢的dplyr。我觉得函数处理矢量化操作的方式有问题但不确定。我尝试在函数调用之外初始化'out'矩阵,但它没有提高性能 不幸的是,我没有较小的可重现数据集可供共享。但是想听听您对如何提高此代码效率的想法。

1 个答案:

答案 0 :(得分:0)

解决方案: 来自mclapply包的parallel功能得到了拯救。正如@gregor正确地指出的那样,可能lmer部分正在减慢速度。最后,我最终并行化了函数调用:

myfunc <- function(i) {
     dat = tst[tst$comb==unique(tst$comb)[i],]  #comb is concatenated iyear,ilocation....columns
     if (sum(!is.na(dat$value)) > 840) {  # >70% data present per column
         v = data.frame(VarCorr(lmer(value ~ 0 + rand_factor + nested_random_factor), data=dat)))
         data.frame(trait=unique(tst$comb)[i], a=round(v[1,4])/5, b=round(v[1,4],2), c=round(v[4,4],2), n_obs=nrow(dat), na_obs=sum(is.na(dat$value))) 
     } else {
          data.frame(trait=unique(tst$comb)[i], a=NA, b=NA, c=NA, n_obs= nrow(dat), na_obs=sum(is.na(dat$value))) 
     }
}

#initialize an empty matrix
out <- matrix(NA,length(unique(tst$comb)),6)

## apply function in parallel. output is list
n_cores = detectCores() - 2
system.time(my.h2 <- mclapply(1:length(unique(tst$comb)),FUN = myfunc, mc.cores = n_cores))

十二核unix机器需要约2分钟才能完成。