for
loopDisclaimers:
glmnet
) contain built-in options for parallelising the required calculations.doParallel
and foreach
.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()
for
loopsystem.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
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)