- # Get summary "tableauRecap" from models
- tableauRecap = do.call( rbind, lapply( seq_along(models_list), function(i) {
- models <- models_list[[i]]
- #Pour un groupe de modeles (même k, différents lambda):
- LLH <- sapply( models, function(model) model$llh[1] )
- k = length(models[[1]]$pi)
- # TODO: chuis pas sûr du tout des lignes suivantes...
- # J'ai l'impression qu'il manque des infos
- ## C'est surtout que la pénalité est la mauvaise, la c'est celle du Lasso, nous on veut ici
- ##celle de l'heuristique de pentes
- #sumPen = sapply( models, function(model)
- # sum( model$pi^gamma * sapply(1:k, function(r) sum(abs(model$phi[,,r]))) ) )
- 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, complexity=sumPen, contrast=LLH)
- } ) )
-print(tableauRecap)
- modSel = capushe::capushe(tableauRecap, n)
- indModSel <-
- if (selecMod == 'DDSE')
- as.numeric(modSel@DDSE@model)
- else if (selecMod == 'Djump')
- as.numeric(modSel@Djump@model)
- else if (selecMod == 'BIC')
- modSel@BIC_capushe$model
- else if (selecMod == 'AIC')
- modSel@AIC_capushe$model
+ # Get summary 'tableauRecap' from models
+ tableauRecap <- do.call(rbind, lapply(seq_along(models_list), function(i)
+ {
+ models <- models_list[[i]]
+ # 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[,
+ , 1] != 0) + 1) - 1)
+ data.frame(model = paste(i, ".", seq_along(models), sep = ""), pen = sumPen/n,
+ complexity = sumPen, contrast = -LLH)
+ }))
+ tableauRecap <- tableauRecap[which(tableauRecap[, 4] != Inf), ]
+ if (verbose)
+ print(tableauRecap)