merge with remote

[valse.git] / pkg / R / main.R

diff --git a/pkg/R/main.R b/pkg/R/main.R
index 387d553..8649342 100644 (file)
--- a/pkg/R/main.R
+++ b/pkg/R/main.R
@@ -1,4 +1,4 @@
-#' valse 
+#' valse
 #'
 #' Main function
 #'
@@ -27,8 +27,8 @@
 #' @examples
 #' #TODO: a few examples
 #' @export
-valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mini = 10, 
-  maxi = 50, eps = 1e-04, kmin = 2, kmax = 3, rank.min = 1, rank.max = 5, ncores_outer = 1, 
+valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mini = 10,
+  maxi = 50, eps = 1e-04, kmin = 2, kmax = 3, rank.min = 1, rank.max = 5, ncores_outer = 1,
   ncores_inner = 1, thresh = 1e-08, grid_lambda = numeric(0), size_coll_mod = 10,
   fast = TRUE, verbose = FALSE, plot = TRUE)
 {
@@ -36,24 +36,24 @@ valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mi
   p <- ncol(X)
   m <- ncol(Y)
 
-  if (verbose) 
+  if (verbose)
     print("main loop: over all k and all lambda")
 
   if (ncores_outer > 1) {
     cl <- parallel::makeCluster(ncores_outer, outfile = "")
-    parallel::clusterExport(cl = cl, envir = environment(), varlist = c("X", 
-      "Y", "procedure", "selecMod", "gamma", "mini", "maxi", "eps", "kmin", 
-      "kmax", "rank.min", "rank.max", "ncores_outer", "ncores_inner", "thresh", 
+    parallel::clusterExport(cl = cl, envir = environment(), varlist = c("X",
+      "Y", "procedure", "selecMod", "gamma", "mini", "maxi", "eps", "kmin",
+      "kmax", "rank.min", "rank.max", "ncores_outer", "ncores_inner", "thresh",
       "size_coll_mod", "verbose", "p", "m"))
   }
 
   # Compute models with k components
   computeModels <- function(k)
   {
-    if (ncores_outer > 1) 
+    if (ncores_outer > 1)
       require("valse") #nodes start with an empty environment
 
-    if (verbose) 
+    if (verbose)
       print(paste("Parameters initialization for k =", k))
     # smallEM initializes parameters by k-means and regression model in each
     # component, doing this 20 times, and keeping the values maximizing the
@@ -61,32 +61,32 @@ valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mi
     P <- initSmallEM(k, X, Y, fast)
     if (length(grid_lambda) == 0)
     {
-      grid_lambda <- computeGridLambda(P$phiInit, P$rhoInit, P$piInit, P$gamInit, 
+      grid_lambda <- computeGridLambda(P$phiInit, P$rhoInit, P$piInit, P$gamInit,
                                        X, Y, gamma, mini, maxi, eps, fast)
     }
-    if (length(grid_lambda) > size_coll_mod) 
+    if (length(grid_lambda) > size_coll_mod)
       grid_lambda <- grid_lambda[seq(1, length(grid_lambda), length.out = size_coll_mod)]
 
-    if (verbose) 
+    if (verbose)
       print("Compute relevant parameters")
     # select variables according to each regularization parameter from the grid:
     # S$selected corresponding to selected variables
-    S <- selectVariables(P$phiInit, P$rhoInit, P$piInit, P$gamInit, mini, maxi, 
+    S <- selectVariables(P$phiInit, P$rhoInit, P$piInit, P$gamInit, mini, maxi,
       gamma, grid_lambda, X, Y, thresh, eps, ncores_inner, fast)
 
     if (procedure == "LassoMLE") {
-      if (verbose) 
+      if (verbose)
         print("run the procedure Lasso-MLE")
       # compute parameter estimations, with the Maximum Likelihood Estimator,
       # restricted on selected variables.
-      models <- constructionModelesLassoMLE(P$phiInit, P$rhoInit, P$piInit, 
+      models <- constructionModelesLassoMLE(P$phiInit, P$rhoInit, P$piInit,
         P$gamInit, mini, maxi, gamma, X, Y, eps, S, ncores_inner, fast, verbose)
     } else {
-      if (verbose) 
+      if (verbose)
         print("run the procedure Lasso-Rank")
       # compute parameter estimations, with the Low Rank Estimator, restricted on
       # selected variables.
-      models <- constructionModelesLassoRank(S, k, mini, maxi, X, Y, eps, rank.min, 
+      models <- constructionModelesLassoRank(S, k, mini, maxi, X, Y, eps, rank.min,
         rank.max, ncores_inner, fast, verbose)
     }
     # warning! Some models are NULL after running selectVariables
@@ -101,7 +101,7 @@ valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mi
     } else {
       lapply(kmin:kmax, computeModels)
     }
-  if (ncores_outer > 1) 
+  if (ncores_outer > 1)
     parallel::stopCluster(cl)
 
   if (!requireNamespace("capushe", quietly = TRUE))
@@ -117,9 +117,9 @@ valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mi
     # For a collection of models (same k, several lambda):
     LLH <- sapply(models, function(model) model$llh[1])
     k <- length(models[[1]]$pi)
-    sumPen <- sapply(models, function(model) k * (dim(model$rho)[1] + sum(model$phi[, 
+    sumPen <- sapply(models, function(model) k * (dim(model$rho)[1] + sum(model$phi[,
       , 1] != 0) + 1) - 1)
-    data.frame(model = paste(i, ".", seq_along(models), sep = ""), pen = sumPen/n, 
+    data.frame(model = paste(i, ".", seq_along(models), sep = ""), pen = sumPen/n,
       complexity = sumPen, contrast = -LLH)
   }))
   tableauRecap <- tableauRecap[which(tableauRecap[, 4] != Inf), ]
@@ -127,16 +127,16 @@ valse <- function(X, Y, procedure = "LassoMLE", selecMod = "DDSE", gamma = 1, mi
   if (verbose == TRUE)
     print(tableauRecap)
   modSel <- capushe::capushe(tableauRecap, n)
-  indModSel <- if (selecMod == "DDSE") 
+  indModSel <- if (selecMod == "DDSE")
   {
     as.numeric(modSel@DDSE@model)
-  } else if (selecMod == "Djump") 
+  } else if (selecMod == "Djump")
   {
     as.numeric(modSel@Djump@model)
-  } else if (selecMod == "BIC") 
+  } else if (selecMod == "BIC")
   {
     modSel@BIC_capushe$model
-  } else if (selecMod == "AIC") 
+  } else if (selecMod == "AIC")
   {
     modSel@AIC_capushe$model
   }