Bagging en Paralelo con foreach+doParallel

Si se quiere entrenar un modelo usando la tecnica de bagging (ver concepto de bagging AQUI) y se tienen muchos datos, puede que el proceso demore mucho tiempo.

Una forma de reducir el tiempo es paralelizando los procesos, asignando a cada procesador una parte de los modelos a entrenar y luego unificar los resultados en un único modelo.

Conceptuelmente seria así:

El siguiente bagging tiene una duracion de 1 minuto y 24 segundos sin paralelizar. Luego de paralelizar, la ejecución demora 8 segundos


Script de Bagging SIN paralelizar. Duración: 30 segundos.

library(rpart);library(C50);data(churn);library(foreach);
Train        <- churnTrain[sample(3333,1e5,replace = T), ]
Iteraciones  <- 4  
n            <- nrow(Train)
inicio       <- Sys.time()
modelo       <- foreach(i=1:Iteraciones) %do% {
                    muestra    <- sample(n, n, replace = T)  
                    rpart(churn ~ .,data = Train[muestra, ])   
}  
(duracion <- Sys.time()-inicio)

Script de Bagging PARALELIZADO. Duración: 20 segundos

#============================================
# BAGGING EN PARALELO
#============================================
 
 
 
# CARGAR DATOS Y LIBRERIAS
# -----------------------------------------------------------
library(C50);data(churn);library(foreach);library(doParallel)         
Train        <- churnTrain[sample(3333,1e5,replace = T), ]
Test         <- churnTest
 
 
 
# CREA MODELOS EN PARALELO
# -----------------------------------------------------------
inicio       <- Sys.time()
Iteraciones  <- 4  
n            <- nrow(Train)
cl           <- makeCluster(4) 
registerDoParallel(cl)
 
modelo <- foreach(i = 1:Iteraciones) %dopar% {  
  library(rpart) 
  muestra   <- sample(n, n, replace = T)  
  rpart(churn ~ ., data = churnTrain[muestra, ])   
}
stopCluster(cl)
print(duracion <- Sys.time() - inicio)
 
 
 
# PREDICCION
# -----------------------------------------------------------
Prediccion <- foreach(i=1:Iteraciones, .combine=cbind) %do% {
  as.character(predict(modelo[[i]], churnTest, type = "class"))
}
Prediccion <- as.data.frame(Prediccion)  
 
 
# PREDICCION POR VOTO MAYORITARIO
# -----------------------------------------------------------
Prediccion$Cantidad_yes <- rowSums(Prediccion [, 1:Iteraciones] == "yes")
Prediccion$Cantidad_no  <- rowSums(Prediccion [, 1:Iteraciones] == "no")
Prediccion$Prediccion   <- ifelse(Prediccion$Cantidad_yes>Prediccion$Cantidad_no,"yes","no")
 
 
 
# MATRIZ CONFUSION
# -----------------------------------------------------------
MC  <- table(Test[, "churn"], Prediccion[, "Prediccion"])
print(MC)

(duracion <- Sys.time()-inicio)