pkg/R/selectVariables.R

   1 #' selectVariables
   2 #'
   3 #' It is a function which construct, for a given lambda, the sets of relevant variables.
   4 #'
   5 #' @param phiInit an initial estimator for phi (size: p*m*k)
   6 #' @param rhoInit an initial estimator for rho (size: m*m*k)
   7 #' @param piInit    an initial estimator for pi (size : k)
   8 #' @param gamInit an initial estimator for gamma
   9 #' @param mini      minimum number of iterations in EM algorithm
  10 #' @param maxi      maximum number of iterations in EM algorithm
  11 #' @param gamma  power in the penalty
  12 #' @param glambda grid of regularization parameters
  13 #' @param X          matrix of regressors
  14 #' @param Y          matrix of responses
  15 #' @param thres  threshold to consider a coefficient to be equal to 0
  16 #' @param tau        threshold to say that EM algorithm has converged
  17 #'
  18 #' @return a list of outputs, for each lambda in grid: selected,Rho,Pi
  19 #'
  20 #' @examples TODO
  21 #'
  22 #' @export
  23 #'
  24 selectVariables = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,
  25     X,Y,thresh,tau, ncores=1) #ncores==1 ==> no //
  26 {
  27     if (ncores > 1)
  28     {
  29         cl = parallel::makeCluster(ncores)
  30         parallel::clusterExport(cl=cl,
  31             varlist=c("phiInit","rhoInit","gamInit","mini","maxi","glambda","X","Y","thresh","tau"),
  32             envir=environment())
  33     }
  34
  35     # Calcul pour un lambda
  36     computeCoefs <-function(lambda)
  37     {
  38         params = EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau)
  39
  40         p = dim(phiInit)[1]
  41         m = dim(phiInit)[2]
  42
  43         #selectedVariables: list where element j contains vector of selected variables in [1,m]
  44         selectedVariables = lapply(1:p, function(j) {
  45             #from boolean matrix mxk of selected variables obtain the corresponding boolean m-vector,
  46             #and finally return the corresponding indices
  47           seq_len(m)[ apply( abs(params$phi[j,,]) > thresh, 1, any ) ]
  48         })
  49
  50         list("selected"=selectedVariables,"Rho"=params$rho,"Pi"=params$pi)
  51     }
  52
  53     # Pour chaque lambda de la grille, on calcule les coefficients
  54     out <-
  55         if (ncores > 1)
  56             parLapply(cl, glambda, computeCoefs)
  57         else lapply(glambda, computeCoefs)
  58     if (ncores > 1)
  59         parallel::stopCluster(cl)
  60
  61     # Suppression doublons
  62     sha1_array <- lapply(out, digest::sha1)
  63     out[ !duplicated(sha1_array) ]
  64
  65     out
  66 }