X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FselectVariables.R;h=bab45cccee4f7bf1d39aa48dc8f13a33d04eaae9;hb=923ed737d0fa335b858204b813c964432488abbe;hp=bfe4042d1ec639173b38bd65ac9cb113c186b564;hpb=a3cbbaea1cc3c107e5ca62ed1ffe7b9499de0a91;p=valse.git diff --git a/pkg/R/selectVariables.R b/pkg/R/selectVariables.R index bfe4042..bab45cc 100644 --- a/pkg/R/selectVariables.R +++ b/pkg/R/selectVariables.R @@ -4,16 +4,16 @@ #' #' @param phiInit an initial estimator for phi (size: p*m*k) #' @param rhoInit an initial estimator for rho (size: m*m*k) -#' @param piInit\tan initial estimator for pi (size : k) +#' @param piInit an initial estimator for pi (size : k) #' @param gamInit an initial estimator for gamma -#' @param mini\t\tminimum number of iterations in EM algorithm -#' @param maxi\t\tmaximum number of iterations in EM algorithm -#' @param gamma\t power in the penalty +#' @param mini minimum number of iterations in EM algorithm +#' @param maxi maximum number of iterations in EM algorithm +#' @param gamma power in the penalty #' @param glambda grid of regularization parameters -#' @param X\t\t\t matrix of regressors -#' @param Y\t\t\t matrix of responses +#' @param X matrix of regressors +#' @param Y matrix of responses #' @param thresh real, threshold to say a variable is relevant, by default = 1e-8 -#' @param eps\t\t threshold to say that EM algorithm has converged +#' @param eps threshold to say that EM algorithm has converged #' @param ncores Number or cores for parallel execution (1 to disable) #' #' @return a list of outputs, for each lambda in grid: selected,Rho,Pi @@ -37,15 +37,22 @@ selectVariables <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma params <- EMGLLF(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, X, Y, eps, fast) - p <- dim(phiInit)[1] - m <- dim(phiInit)[2] + p <- ncol(X) + m <- ncol(Y) # 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, , ]) > thresh, 1, any)] + if (m>1) { + seq_len(m)[apply(abs(params$phi[j, , ]) > thresh, 1, any)] + } else { + if (any(params$phi[j, , ] > thresh)) + 1 + else + numeric(0) + } }) list(selected = selectedVariables, Rho = params$rho, Pi = params$pi) @@ -60,6 +67,8 @@ selectVariables <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma } if (ncores > 1) parallel::stopCluster(cl) + + print(out) # Suppress models which are computed twice En fait, ca ca fait la comparaison de # tous les parametres On veut juste supprimer ceux qui ont les memes variables # sélectionnées