- p = dim(X)[2]
- m = dim(Y)[2]
- n = dim(X)[1]
-
- model = list()
- tableauRecap = array(0, dim=c(1000,4))
- cpt = 0
- print("main loop: over all k and all lambda")
-
- for (k in kmin:kmax)
- {
- print(k)
- print("Parameters initialization")
- #smallEM initializes parameters by k-means and regression model in each component,
- #doing this 20 times, and keeping the values maximizing the likelihood after 10
- #iterations of the EM algorithm.
- init = initSmallEM(k, X, Y)
- phiInit <- init$phiInit
- rhoInit <- init$rhoInit
- piInit <- init$piInit
- gamInit <- init$gamInit
- grid_lambda <- computeGridLambda(phiInit, rhoInit, piInit, gamInit, X, Y, gamma, mini, maxi, eps)
-
- if (length(grid_lambda)>100)
- grid_lambda = grid_lambda[seq(1, length(grid_lambda), length.out = 100)]
- print("Compute relevant parameters")
- #select variables according to each regularization parameter
- #from the grid: A1 corresponding to selected variables, and
- #A2 corresponding to unselected variables.
-
- params = selectiontotale(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,grid_lambda,X,Y,1e-8,eps)
- #params2 = selectVariables(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,grid_lambda[seq(1,length(grid_lambda), by=3)],X,Y,1e-8,eps)
- ## etrange : params et params 2 sont différents ...
- selected <- params$selected
- Rho <- params$Rho
- Pi <- params$Pi
-
- if (procedure == 'LassoMLE')
- {
- print('run the procedure Lasso-MLE')
- #compute parameter estimations, with the Maximum Likelihood
- #Estimator, restricted on selected variables.
- model[[k]] = constructionModelesLassoMLE(phiInit, rhoInit,piInit,gamInit,mini,maxi,gamma,X,Y,thresh,eps,selected)
- llh = matrix(ncol = 2)
- for (l in seq_along(model[[k]]))
- llh = rbind(llh, model[[k]][[l]]$llh)
- LLH = llh[-1,1]
- D = llh[-1,2]
+ 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",
+ "size_coll_mod", "verbose", "p", "m"))
+ }
+
+ # Compute models with k components
+ computeModels <- function(k)
+ {
+ if (ncores_outer > 1)
+ require("valse") #nodes start with an empty environment
+
+ 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
+ # likelihood after 10 iterations of the EM algorithm.
+ P <- initSmallEM(k, X, Y, fast)
+ if (length(grid_lambda) == 0)
+ {
+ 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)
+ grid_lambda <- grid_lambda[seq(1, length(grid_lambda), length.out = size_coll_mod)]
+
+ 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,
+ gamma, grid_lambda, X, Y, thresh, eps, ncores_inner, fast)
+
+ if (procedure == "LassoMLE") {
+ 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,
+ P$gamInit, mini, maxi, gamma, X, Y, eps, S, ncores_inner, fast, verbose)
+ } else {
+ 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,
+ rank.max, ncores_inner, fast, verbose)
+ }
+ # warning! Some models are NULL after running selectVariables
+ models <- models[sapply(models, function(cell) !is.null(cell))]
+ models
+ }
+
+ # List (index k) of lists (index lambda) of models
+ models_list <-
+ if (ncores_outer > 1) {
+ parLapply(cl, kmin:kmax, computeModels)
+ } else {
+ lapply(kmin:kmax, computeModels)