Question

我有每日死亡和各种环境因素的时间序列数据，有大约8000个数据点，11个结果和6个污染物。当我单独运行模型时没有收敛问题，但每个运行大约需要20分钟。在循环中，整个模型从未完成并因未知原因而终止。下面显示的代码是针对两种结果和两种污染物执行的，经过的时间是4123.59。

我正在开发一台具有4个处理器和16 GB RAM的相当快的Windows PC，但整个过程仍然非常缓慢。我将不胜感激任何关于如何使代码高效和快速的建议。我已经检查了论坛的一些相关答案，但没有一个适用于我的具体问题。

我的数据上运行的代码

outcome<-c("cardva" ,"respir") 
pollut1<-c("o3","no2")

m1 <- lapply(outcome, function(o){
  lapply(pollut1,function(v) {
    f<- sprintf("%s ~  s(trend,k=21*50,fx=F,bs='cr')+ s(temp,k=6,fx=F,bs='cr') + rh + 
   as.factor(dow) + s(fluepi,k=4,fx=F, bs='cr') + as.factor(holiday) + %s",o, v)
    gam(as.formula(f),family=quasipoisson, na.action=na.omit,data=mortdf)

  })
})

示例代码和数据如下所示：

library(quantmod)
 library(mgcv)
 library(dlnm) 
 df <- chicagoNMMAPS
 outcome<- c("death", "cvd", "resp ")
 pollut1<-c("pm10" , "o3" ) 

 ptm <- proc.time()

 mod1<- lapply(outcome, function(o){
   lapply(pollut1,function(v) {
     f <- sprintf("%s~ s(time,bs='cr',k=14*50)+ s(temp,k=6, bs='cr') + as.factor(dow)   + %s",o, v) 
     gam(as.formula(f),family=quasipoisson,na.action=na.omit,data=df) 
  })}) 

 proc.time() - ptm
 user  system elapsed 
 991.02    8.89 1002.00

Answer 1

您的基准套件中是否真的需要14 * 50 = 700个尺寸？这就是它花了这么长时间的原因。它看起来像t ~ O(k^2)。

# 700 dimensions: 8 minutes, gcv = 1.22
f = death~ s(time,bs='cr',k=14*50)+ s(temp, bs='cr', k=6) + as.factor(dow)+pm10
system.time(g <- gam(f,family=quasipoisson,na.action=na.omit,data=df)) 
   user  system elapsed 
 457.66    2.17  461.90 
g$gcv
[1] 1.222779

# 200 dimentsions: 48 seconds; gcv = 1.25
f.new = death~ s(time,bs='cr',k=200)+ s(temp, bs='cr', k=6) + as.factor(dow)+pm10
system.time(g <- gam(f.new,family=quasipoisson,na.action=na.omit,data=df)) 
   user  system elapsed 
  47.93    0.07   48.04 
g$gcv
[1] 1.252921

# 100 dimensions: 15 seconds, gcv - 1.30
f.new = death~ s(time,bs='cr',k=100)+ s(temp, bs='cr', k=6) + as.factor(dow)+pm10
system.time(g <- gam(f.new,family=quasipoisson,na.action=na.omit,data=df))
   user  system elapsed 
  15.31    0.05   15.39 
g$gcv
[1] 1.297332

Answer 2

您可以使用各种R软件包之一在多个处理器上并行运行lapply。例如，请参阅snowfall package中的sfLapply()。如果您使用的是Linux，则还可以轻松使用mclapply()代替lapply()

Answer 3

我不熟悉您正在使用的功能，因此我生成的功能实际上并不起作用（主要是 - 尝试使用结果等似乎不存在于示例数据集中），但希望如此illsutrative。

doParallel（doMC可以用于linux）就像@ f3lix的答案中的降雪包，foreach提供了一些优秀的并行迭代器。我已经准备了一个用于检查已使用的foreach的组合列表，因为我认为它比嵌套lapply更简单。希望它能为您提供一些有用的材料来进行此计算。

library(quantmod)
 library(mgcv)
 library(dlnm) 
 df <- chicagoNMMAPS
 outcome<- c("death", "cvd", "resp ")
 pollut1<-c("pm10" , "o3" ) 

library("doParallel")
library("foreach")
registerDoParallel(cores=8)

combinations<-expand.grid(outcome,pollut1)
mod1<- foreach(o=combinations, .combine='list') %dopar% {
    f <- as.formula(paste0("~ s(time,bs='cr',k=14*50)+ s(temp,k=6, bs='cr') + as.factor(dow) + ",o["Var1"], o["Var2"]) )
    gam(f,family=quasipoisson,na.action=na.omit,data=df) 
}

http://cran.r-project.org/web/packages/doParallel/vignettes/gettingstartedParallel.pdf

如何提高慢循环的效率

3 个答案: