r doParallel qbeta vs RcppParallel - comment utiliser les cœurs à pleine capacité

Question

Je lance l'exemple de code suivant pour simuler des valeurs et ci-dessous est l'instantané de l'utilisation de 4 cœurs. Il faut un certain temps pour utiliser tous les cœurs à pleine capacité, je voudrais comprendre ce qui se passe et, finalement, comment le rendre plus rapide.

library(doParallel) 
library(data.table) 

data<-data.table(a=runif(10000000),b=runif(10000000),quantile=runif(10000000)) 

e <- nrow(data)%/%1000000+1 
dataSplit<-split(data[],seq_len(nrow(data))%/%1000000) 
qbetaVec<-function(lossvalues) qbeta(lossvalues$quantile,lossvalues$a,lossvalues$b) 

cl <- makeCluster(4) 
registerDoParallel(cl) 
res2<-foreach(i=1:e) %dopar% qbetaVec(dataSplit[[i]]) 
res3<-unlist(res2) 

Il faut environ 67 secondes pour terminer sur ma machine. J'ai regardé le moniteur de performances pendant que res2 était en cours d'exécution et il semble que cela prenne un certain temps pour utiliser les 4 coeurs à pleine capacité. Je voudrais comprendre quelle est la raison de cela. Est-ce inévitable? Que se passe-t-il avant que tous les cœurs soient utilisés à pleine capacité? Serait-il plus rapide d'essayer cela avec RcppParallel?

Answer 1

parallélisation implique des frais généraux, notamment le transfert de données vers et des travailleurs. En outre, si vous n'utilisez que quatre travailleurs et que chaque tâche prend à peu près autant de temps, il n'est pas logique de diviser cela en plus de quatre tâches.

library(microbenchmark) 

microbenchmark(
    OP = { 
    e <- nrow(data)%/%1000000+1 
    dataSplit<-split(data[],seq_len(nrow(data))%/%1000000) 
    qbetaVec<-function(lossvalues) qbeta(lossvalues$quantile,lossvalues$a,lossvalues$b) 

    cl <- makeCluster(4) 
    registerDoParallel(cl) 
    res2<-foreach(i=1:e) %dopar% qbetaVec(dataSplit[[i]]) 
    res3<-unlist(res2) 
    stopCluster(cl) 
    }, 
    OP_4split = { 
    e <- 4 
    dataSplit<-split(data[],seq_len(nrow(data)) %% e) #note this change 
    qbetaVec<-function(lossvalues) qbeta(lossvalues$quantile,lossvalues$a,lossvalues$b) 

    cl <- makeCluster(e) 
    registerDoParallel(cl) 
    res2<-foreach(i=1:e) %dopar% qbetaVec(dataSplit[[i]]) 
    res3<-unlist(res2) 
    stopCluster(cl) 
    }, 
    serial = { 
    res3 <- data[, qbeta(quantile, a, b)] 
    }, 
    times = 3 
) 

#Unit: seconds 
#  expr  min  lq  mean median  uq  max neval 
#  OP 17.31950 17.35962 17.37491 17.39975 17.40262 17.40549  3 
# OP_4split 15.98415 16.03414 16.10776 16.08413 16.16957 16.25500  3 
# serial 22.62642 22.64165 22.66247 22.65689 22.68050 22.70411  3 

C'est seulement légèrement meilleur avec 4 morceaux. Cependant, il y a vraiment beaucoup de données qui doivent être transférées et réassemblées. La division des données est également une opération coûteuse. Je ne voudrais pas déranger avec la parallélisation ici.