X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=pkg%2FR%2FcomputeGridLambda.R;h=f4073d0881742f6c94af92d83854df4fef1a2ab5;hp=f89b2a3f6df6234e5f6fb29aadc9de37af493a00;hb=6af1d4897dbab92a7be05068e0e15823378965d9;hpb=086ca318ed5580e961ceda3f1e122a2da58e4427 diff --git a/pkg/R/computeGridLambda.R b/pkg/R/computeGridLambda.R index f89b2a3..f4073d0 100644 --- a/pkg/R/computeGridLambda.R +++ b/pkg/R/computeGridLambda.R @@ -3,34 +3,37 @@ #' Construct the data-driven grid for the regularization parameters used for the Lasso estimator #' #' @param phiInit value for phi -#' @param rhoInit value for rho -#' @param piInit value for pi +#' @param rhoInit for rho +#' @param piInit for pi #' @param gamInit value for gamma #' @param X matrix of covariates (of size n*p) #' @param Y matrix of responses (of size n*m) #' @param gamma power of weights in the penalty #' @param mini minimum number of iterations in EM algorithm #' @param maxi maximum number of iterations in EM algorithm -#' @param tau threshold to stop EM algorithm +#' @param eps threshold to stop EM algorithm +#' @param fast boolean to enable or not the C function call #' -#' @return the grid of regularization parameters +#' @return the grid of regularization parameters for the Lasso estimator. The output is a vector with nonnegative values that are relevant +#' to be considered as regularization parameter as they are equivalent to a 0 in the regression parameter. #' #' @export -computeGridLambda = function(phiInit, rhoInit, piInit, gamInit, X, Y, gamma, mini, maxi, tau) +computeGridLambda <- function(phiInit, rhoInit, piInit, gamInit, X, Y, gamma, mini, + maxi, eps, fast) { - n = nrow(X) - p = dim(phiInit)[1] - m = dim(phiInit)[2] - k = dim(phiInit)[3] + n <- nrow(X) + p <- ncol(X) + m <- ncol(Y) + k <- length(piInit) - list_EMG = EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi,1,0,X,Y,tau) - grid = array(0, dim=c(p,m,k)) - for (i in 1:p) - { - for (j in 1:m) - grid[i,j,] = abs(list_EMG$S[i,j,]) / (n*list_EMG$pi^gamma) - } - grid = unique(grid) - grid = grid[grid <=1] - grid + list_EMG <- EMGLLF(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda = 0, + X, Y, eps, fast) + + grid <- array(0, dim = c(p, m, k)) + for (j in 1:p) + { + for (mm in 1:m) + grid[j, mm, ] <- abs(list_EMG$S[j, mm, ])/(n * list_EMG$pi^gamma) + } + sort(unique(grid)) }