pkg/R/constructionModelesLassoRank.R

   1 #' constructionModelesLassoRank
   2 #'
   3 #' TODO: description
   4 #'
   5 #' @param ...
   6 #'
   7 #' @return ...
   8 #'
   9 #' export
  10 constructionModelesLassoRank = function(pi, rho, mini, maxi, X, Y, tau, A1, rangmin,
  11     rangmax, ncores, verbose=FALSE)
  12 {
  13   #get matrix sizes
  14   n = dim(X)[1]
  15   p = dim(X)[2]
  16   m = dim(rho)[2]
  17   k = dim(rho)[3]
  18   L = dim(A1)[2]
  19
  20     # On cherche les rangs possiblement intéressants
  21   deltaRank = rangmax - rangmin + 1
  22   Size = deltaRank^k
  23   Rank = matrix(0, nrow=Size, ncol=k)
  24   for(r in 1:k)
  25     {
  26         # On veut le tableau de toutes les combinaisons de rangs possibles
  27         # Dans la première colonne : on répète (rangmax-rangmin)^(k-1) chaque chiffre :
  28         #   ça remplit la colonne
  29         # Dans la deuxieme : on répète (rangmax-rangmin)^(k-2) chaque chiffre,
  30         #   et on fait ça (rangmax-rangmin)^2 fois
  31         # ...
  32         # Dans la dernière, on répète chaque chiffre une fois,
  33         #   et on fait ça (rangmin-rangmax)^(k-1) fois.
  34     Rank[,r] = rangmin + rep(0:(deltaRank-1), deltaRank^(r-1), each=deltaRank^(k-r))
  35   }
  36
  37     # output parameters
  38   phi = array(0, dim=c(p,m,k,L*Size))
  39   llh = matrix(0, L*Size, 2) #log-likelihood
  40
  41     # TODO: // loop
  42     for(lambdaIndex in 1:L)
  43     {
  44     # on ne garde que les colonnes actives
  45     # 'active' sera l'ensemble des variables informatives
  46     active = A1[,lambdaIndex]
  47     active = active[-(active==0)]
  48     if (length(active) > 0)
  49         {
  50       for (j in 1:Size)
  51             {
  52         res = EMGrank(Pi[,lambdaIndex], Rho[,,,lambdaIndex], mini, maxi,
  53                     X[,active], Y, tau, Rank[j,])
  54         llh[(lambdaIndex-1)*Size+j,] =
  55                     c( res$LLF, sum(Rank[j,] * (length(active)- Rank[j,] + m)) )
  56         phi[active,,,(lambdaIndex-1)*Size+j] = res$phi
  57       }
  58     }
  59   }
  60   return (list("phi"=phi, "llh" = llh))
  61 }