Quick parallelisation of a for loop

Disclaimers:

Data preparation

rm(list=ls())

#######################################################################################################
# Example taken from: https://rdrr.io/cran/glmmLasso/src/demo/glmmLasso-soccer.r
#######################################################################################################

library(glmmLasso)
data("soccer")
## generalized additive mixed model
## grid for the smoothing parameter

## center all metric variables so that also the starting values with glmmPQL are in the correct scaling

soccer[,c(4,5,9:16)]<-scale(soccer[,c(4,5,9:16)],center=T,scale=T)
soccer<-data.frame(soccer)


lambda <- seq(1000,0.1,by=-0.1)

family = poisson(link = log)


################## First Simple Method ############################################
## Using BIC (or AIC, respectively) to determine the optimal tuning parameter lambda

BIC_vec<-rep(Inf,length(lambda))

## first fit good starting model
library(MASS);library(nlme)
PQL<-glmmPQL(points~1,random = ~1|team,family=family,data=soccer)
## iteration 1
## iteration 2
## iteration 3
Delta.start<-c(as.numeric(PQL$coef$fixed),rep(0,6),as.numeric(t(PQL$coef$random$team)))
Q.start<-as.numeric(VarCorr(PQL)[1,1])
glm1 <- list()

Timing the for loop

system.time(for(j in 1:length(lambda))
{
  glm1[[j]] <- try(glmmLasso(points~transfer.spendings  
                        + ave.unfair.score + ball.possession
                        + tackles + ave.attend + sold.out, rnd = list(team=~1),  
                        family = family, data = soccer, lambda=lambda[j],switch.NR=T,final.re=TRUE,
                        control=list(start=Delta.start,q_start=Q.start)), silent=TRUE)  
})
##    user  system elapsed 
## 146.976   2.881 150.316

Timing the parallelised for loop

################## Parallelisation ############################################
library(foreach)
library(doParallel)
## Loading required package: iterators
## Loading required package: parallel
detectCores() # detect the number of CPU cores on the current host.
## [1] 8
cl <- parallel::makeCluster(4) # Let's use 4
doParallel::registerDoParallel(cl)
system.time(glm2 <- foreach(i = 1:length(lambda), .combine='c', .multicombine=TRUE,
                            .packages='glmmLasso') %dopar% {
                              out <- try(glmmLasso(points~transfer.spendings 
                                                   + ave.unfair.score + ball.possession
                                                   + tackles + ave.attend + sold.out, rnd = list(team=~1), 
                                                   family = family, data = soccer, lambda=lambda[i],switch.NR=T,final.re=TRUE,
                                                   control=list(start=Delta.start,q_start=Q.start)), silent=TRUE)
                              out <- as.list(out)
                              list(out)
                            })
##    user  system elapsed 
##  37.978   9.657  65.946
stopCluster(cl)

References