X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=pkg%2FR%2Fvalse.R;h=46a5fd045680bbc8f6e9246222706cda184210cd;hp=445ea263641256863777258e682c356de2f43a8e;hb=51485a7d0aafe7c31c9651fcc2e33ebd2f8a5e82;hpb=77fde6fc68ce70ca07a371be4511993d5516085d diff --git a/pkg/R/valse.R b/pkg/R/valse.R index 445ea26..46a5fd0 100644 --- a/pkg/R/valse.R +++ b/pkg/R/valse.R @@ -15,8 +15,8 @@ #' @return a list with estimators of parameters #' @export #----------------------------------------------------------------------- -valse = function(X,Y,procedure,selecMod,gamma = 1,mini = 10, - maxi = 100,eps = 1e-4,kmin = 2,kmax = 10, +valse = function(X,Y,procedure = 'LassoMLE',selecMod = 'BIC',gamma = 1,mini = 10, + maxi = 100,eps = 1e-4,kmin = 2,kmax = 5, rang.min = 1,rang.max = 10) { ################################## #core workflow: compute all models @@ -24,12 +24,14 @@ valse = function(X,Y,procedure,selecMod,gamma = 1,mini = 10, p = dim(phiInit)[1] m = dim(phiInit)[2] + n = dim(X)[1] + tableauRecap = array(, dim=c(1000,4)) + cpt = 0 print("main loop: over all k and all lambda") - for (k in kmin:kmax) - { + +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 @@ -39,14 +41,18 @@ valse = function(X,Y,procedure,selecMod,gamma = 1,mini = 10, rhoInit <<- init$rhoInit piInit <<- init$piInit gamInit <<- init$gamInit - + source('~/valse/pkg/R/gridLambda.R') gridLambda <<- gridLambda(phiInit, rhoInit, piInit, gamInit, X, Y, gamma, mini, maxi, eps) 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,gridLambda,X,Y,1e-8,eps) + + params = selectiontotale(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,gridLambda[seq(1,length(gridLambda), by=3)],X,Y,1e-8,eps) + params2 = selectVariables(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,gridLambda[seq(1,length(gridLambda), by=3)],X,Y,1e-8,eps) + ## etrange : params et params 2 sont différents ... + selected <<- params$selected Rho <<- params$Rho Pi <<- params$Pi @@ -55,36 +61,9 @@ valse = function(X,Y,procedure,selecMod,gamma = 1,mini = 10, print('run the procedure Lasso-MLE') #compute parameter estimations, with the Maximum Likelihood #Estimator, restricted on selected variables. - model = constructionModelesLassoMLE( - phiInit, rhoInit,piInit,tauInit,mini,maxi, - gamma,gridLambda,X,Y,thresh,eps,selected) - ################################################ - ### Regarder la SUITE - r1 = runProcedure1() - Phi2 = Phi - Rho2 = Rho - Pi2 = Pi - - if (is.null(dim(Phi2))) - #test was: size(Phi2) == 0 - { - Phi[, , 1:k] <<- r1$phi - Rho[, , 1:k] <<- r1$rho - Pi[1:k,] <<- r1$pi - } else - { - Phi <<- - array(0., dim = c(p, m, kmax, dim(Phi2)[4] + dim(r1$phi)[4])) - Phi[, , 1:(dim(Phi2)[3]), 1:(dim(Phi2)[4])] <<- Phi2 - Phi[, , 1:k, dim(Phi2)[4] + 1] <<- r1$phi - Rho <<- - array(0., dim = c(m, m, kmax, dim(Rho2)[4] + dim(r1$rho)[4])) - Rho[, , 1:(dim(Rho2)[3]), 1:(dim(Rho2)[4])] <<- Rho2 - Rho[, , 1:k, dim(Rho2)[4] + 1] <<- r1$rho - Pi <<- array(0., dim = c(kmax, dim(Pi2)[2] + dim(r1$pi)[2])) - Pi[1:nrow(Pi2), 1:ncol(Pi2)] <<- Pi2 - Pi[1:k, ncol(Pi2) + 1] <<- r1$pi - } + model[[k]] = constructionModelesLassoMLE(phiInit, rhoInit,piInit,gamInit,mini,maxi,gamma,X,Y,thresh,eps,selected) + LLH = unlist(model[[k]]$llh)[seq(1,2*length(model[[k]]),2)] + D = unlist(model[[k]]$llh)[seq(1,2*length(model[[k]]),2)+1] } else { print('run the procedure Lasso-Rank') #compute parameter estimations, with the Low Rank @@ -106,12 +85,18 @@ valse = function(X,Y,procedure,selecMod,gamma = 1,mini = 10, Phi[, , 1:k,-(1:(dim(Phi2)[4]))] <<- phi } } + tableauRecap[(cpt+1):(cpt+length(model[[k]])), ] = matrix(c(LLH, D, rep(k, length(model[[k]])), 1:length(model[[k]])), ncol = 4) + cpt = cpt+length(model[[k]]) } print('Model selection') + + tableauRecap = array(dim = c()) if (selecMod == 'SlopeHeuristic') { } else if (selecMod == 'BIC') { - + BIC = -2*tableauRecap[,1]+log(n)*tableauRecap[,2] + indMinBIC = which.min(BIC) + return(model[[tableauRecap[indMinBIC,3]]][[tableauRecap[indMinBIC,4]]]) } else if (selecMod == 'AIC') { }