merge selectVariables.R doc and selectiontotale.R code into selectVariables.R
authorBenjamin Auder <benjamin.auder@somewhere>
Thu, 23 Feb 2017 18:49:45 +0000 (19:49 +0100)
committerBenjamin Auder <benjamin.auder@somewhere>
Thu, 23 Feb 2017 18:49:45 +0000 (19:49 +0100)
R/selectVariables.R
R/selectiontotale.R [deleted file]

index 3f58ea3..92baec8 100644 (file)
@@ -1,6 +1,5 @@
-#' selectVaribles
-#' It is a function which construct, for a given lambda, the sets of
-#' relevant variables and irrelevant variables.
+#' selectVariables
+#' It is a function which construct, for a given lambda, the sets of relevant variables.
 #'
 #' @param phiInit an initial estimator for phi (size: p*m*k)
 #' @param rhoInit an initial estimator for rho (size: m*m*k)
 #' @param thres         threshold to consider a coefficient to be equal to 0
 #' @param tau           threshold to say that EM algorithm has converged
 #'
-#' @return TODO
+#' @return a list of outputs, for each lambda in grid: selected,Rho,Pi
 #'
 #' @examples TODO
 #'
 #' @export
-selectVariables <- function(phiInit,rhoInit,piInit,gamInit,
-       mini,maxi,gamma,glambda,X,Y,thres,tau)
+selectVariables = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau)
 {
-       dimphi <- dim(phiInit)
-       p <- dimPhi[1]
-       m <- dimPhi[2]
-       k <- dimPhi[3]
-       L <- length(glambda);
-       A1 <- array(0, dim <- c(p,m+1,L))
-       A2 <- array(0, dim <- c(p,m+1,L))
-       Rho <- array(0, dim <- c(m,m,k,L))
-       Pi <- array(0, dim <- c(k,L));
-
-       # For every lambda in gridLambda, comutation of the coefficients
-       for (lambdaIndex in c(1:L))
+       cl = parallel::makeCluster( parallel::detectCores() / 4 )
+       parallel::clusterExport(cl=cl,
+               varlist=c("phiInit","rhoInit","gamInit","mini","maxi","glambda","X","Y","seuil","tau"),
+               envir=environment())
+       #Pour chaque lambda de la grille, on calcule les coefficients
+       out = parLapply( 1:L, function(lambdaindex)
        {
-               Res <- EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi,
-                       gamma,glambda[lambdaIndex],X,Y,tau);
-               phi <- Res$phi
-               rho <- Res$rho
-               pi <- Res$pi
-
-               # If a coefficient is larger than the threshold, we keep it
-               selectedVariables <- array(0, dim = c(p,m))
-               discardedVariables <- array(0, dim = c(p,m))
-               atLeastOneSelectedVariable <- false
-               for (j in c(1:p))
-               {
-                       cpt <- 1
-                       cpt2 <-1
-                       for (mm in c(1:m))
-                       {
-                               if (max(abs(phi[j,mm,])) > thres)
-                               {
-                                       selectedVariables[j,cpt] <- mm
-                                       cpt <- cpt+1
-                                       atLeastOneSelectedVariable <- true
-                               } else
-                               {
-                                       discardedVariables[j,cpt2] <- mm
-                                       cpt2 <- cpt2+1
-                               }
-                       }
-               }
+               params = EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda[lambdaIndex],X,Y,tau)
 
-               # If no coefficients have been selected, we provide the zero matrix
-               # We delete zero coefficients: vec = indices of zero values
-               if (atLeastOneSelectedVariable)
-               {
-                       vec <- c()
-                       for (j in c(1:p))
-                       {
-                               if (selectedVariables(j,1) != 0)
-                                       vec <- c(vec,j)
-                               # Else ( NOTE: [auder] else ?! TODO: explain? )
-                               # we provide the indices of relevant coefficients
-                               A1[,1,lambdaIndex] <- c(vec,rep(0,p-length(vec)))
-                               A1[1:length(vec),2:(m+1),lambdaIndex] <- selectedVariables[vec,]
-                               A2[,1,lambdaIndex] <- 1:p
-                               A2[,2:(m+1),lambdaIndex] <- discardedVariables
-                               Rho[,,,lambdaIndex] <- rho
-                               Pi[,lambdaIndex] <- pi
-                       }
-               }
-       }
+               p = dim(phiInit)[1]
+               m = dim(phiInit)[2]
+               #selectedVariables: list where element j contains vector of selected variables in [1,m]
+               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,,]) > seuil, 1, any ) ]
+               })
 
-       return(res = list(A1 = A1, A2 = A2 , Rho = Rho, Pi = Pi))
+               list("selected"=selectedVariables,"Rho"=params$Rho,"Pi"=params$Pi)
+       })
+       parallel::stopCluster(cl)
 }
diff --git a/R/selectiontotale.R b/R/selectiontotale.R
deleted file mode 100644 (file)
index 673bc3b..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-#Return a list of outputs, for each lambda in grid: selected,Rho,Pi
-selectiontotale = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda,X,Y,seuil,tau)
-{
-       cl = parallel::makeCluster( parallel::detectCores() / 4 )
-       parallel::clusterExport(cl=cl,
-               varlist=c("phiInit","rhoInit","gamInit","mini","maxi","glambda","X","Y","seuil","tau"),
-               envir=environment())
-       #Pour chaque lambda de la grille, on calcule les coefficients
-       out = parLapply( 1:L, function(lambdaindex)
-       {
-               params = EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda[lambdaIndex],X,Y,tau)
-
-               p = dim(phiInit)[1]
-               m = dim(phiInit)[2]
-               #selectedVariables: list where element j contains vector of selected variables in [1,m]
-               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,,]) > seuil, 1, any ) ]
-               })
-
-               list("selected"=selectedVariables,"Rho"=params$Rho,"Pi"=params$Pi)
-       })
-       parallel::stopCluster(cl)
-}