From: Benjamin Auder Date: Sun, 2 Apr 2017 12:28:17 +0000 (+0200) Subject: fix/improve selectVariables.R X-Git-Url: https://git.auder.net/variants/current/doc/css/assets/rpsls.css?a=commitdiff_plain;h=4e8267487c83c27273305b1379e44bc7abebf4b5;p=valse.git fix/improve selectVariables.R --- diff --git a/pkg/R/selectVariables.R b/pkg/R/selectVariables.R index e4ed179..b4fc0ab 100644 --- a/pkg/R/selectVariables.R +++ b/pkg/R/selectVariables.R @@ -41,13 +41,10 @@ selectVariables = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambd m = dim(phiInit)[2] #selectedVariables: list where element j contains vector of selected variables in [1,m] - selectedVariables = sapply(1:p, function(j) { ## je me suis permise de changer le type, - ##une liste de liste ca devenait compliqué je trouve pour choper ce qui nous intéresse + selectedVariables = lapply(1:p, function(j) { #from boolean matrix mxk of selected variables obtain the corresponding boolean m-vector, #and finally return the corresponding indices - #seq_len(m)[ apply( abs(params$phi[j,,]) > thresh, 1, any ) ] - c(seq_len(m)[ apply( abs(params$phi[j,,]) > thresh, 1, any ) ], - rep(0, m-length(seq_len(m)[ apply( abs(params$phi[j,,]) > thresh, 1, any ) ] ) )) + seq_len(m)[ apply( abs(params$phi[j,,]) > thresh, 1, any ) ] }) list("selected"=selectedVariables,"Rho"=params$rho,"Pi"=params$pi) @@ -55,10 +52,15 @@ selectVariables = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambd # Pour chaque lambda de la grille, on calcule les coefficients out <- - if (ncores > 1){ - parLapply(cl, seq_along(glambda, computeCoefs))} - else lapply(seq_along(glambda), computeCoefs) - if (ncores > 1){ - parallel::stopCluster(cl)} + if (ncores > 1) + parLapply(cl, glambda, computeCoefs) + else lapply(glambda, computeCoefs) + if (ncores > 1) + parallel::stopCluster(cl) + + # Suppression doublons + sha1_array <- lapply(out, digest::sha1) + out[ !duplicated(sha1_array) ] + out }