| 1 | #' selectVaribles |
| 2 | #' It is a function which construct, for a given lambda, the sets of |
| 3 | #' relevant variables and irrelevant variables. |
| 4 | #' |
| 5 | #' @param phiInit an initial estimator for phi (size: p*m*k) |
| 6 | #' @param rhoInit an initial estimator for rho (size: m*m*k) |
| 7 | #' @param piInit an initial estimator for pi (size : k) |
| 8 | #' @param gamInit an initial estimator for gamma |
| 9 | #' @param mini minimum number of iterations in EM algorithm |
| 10 | #' @param maxi maximum number of iterations in EM algorithm |
| 11 | #' @param gamma power in the penalty |
| 12 | #' @param glambda grid of regularization parameters |
| 13 | #' @param X matrix of regressors |
| 14 | #' @param Y matrix of responses |
| 15 | #' @param thres threshold to consider a coefficient to be equal to 0 |
| 16 | #' @param tau threshold to say that EM algorithm has converged |
| 17 | #' |
| 18 | #' @return |
| 19 | #' @export |
| 20 | #' |
| 21 | #' @examples |
| 22 | selectVariables <- function(phiInit,rhoInit,piInit,gamInit, |
| 23 | mini,maxi,gamma,glambda,X,Y,thres,tau){ |
| 24 | |
| 25 | dimphi <- dim(phiInit) |
| 26 | p <- dimPhi[1] |
| 27 | m <- dimPhi[2] |
| 28 | k <- dimPhi[3] |
| 29 | L <- length(glambda); |
| 30 | A1 <- array(0, dim <- c(p,m+1,L)) |
| 31 | A2 <- array(0, dim <- c(p,m+1,L)) |
| 32 | Rho <- array(0, dim <- c(m,m,k,L)) |
| 33 | Pi <- array(0, dim <- c(k,L)); |
| 34 | |
| 35 | # For every lambda in gridLambda, comutation of the coefficients |
| 36 | for (lambdaIndex in c(1:L)) { |
| 37 | Res <- EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi, |
| 38 | gamma,glambda[lambdaIndex],X,Y,tau); |
| 39 | phi <- Res$phi |
| 40 | rho <- Res$rho |
| 41 | pi <- Res$pi |
| 42 | |
| 43 | # If a coefficient is larger than the threshold, we keep it |
| 44 | selectedVariables <- array(0, dim = c(p,m)) |
| 45 | discardedVariables <- array(0, dim = c(p,m)) |
| 46 | atLeastOneSelectedVariable <- false |
| 47 | for (j in c(1:p)){ |
| 48 | cpt <- 1 |
| 49 | cpt2 <-1 |
| 50 | for (mm in c(1:m)){ |
| 51 | if (max(abs(phi[j,mm,])) > thres){ |
| 52 | selectedVariables[j,cpt] <- mm |
| 53 | cpt <- cpt+1 |
| 54 | atLeastOneSelectedVariable <- true |
| 55 | } else{ |
| 56 | discardedVariables[j,cpt2] <- mm |
| 57 | cpt2 <- cpt2+1 |
| 58 | } |
| 59 | } |
| 60 | } |
| 61 | |
| 62 | # If no coefficients have been selected, we provide the zero matrix |
| 63 | # We delete zero coefficients: vec = indices of zero values |
| 64 | if atLeastOneSelectedVariable{ |
| 65 | vec <- c() |
| 66 | for (j in c(1:p)){ |
| 67 | if (selectedVariables(j,1) =! 0){ |
| 68 | vec <- c(vec,j) |
| 69 | } |
| 70 | } |
| 71 | # Else, we provide the indices of relevant coefficients |
| 72 | A1[,1,lambdaIndex] <- c(vec,rep(0,p-length(vec))) |
| 73 | A1[1:length(vec),2:(m+1),lambdaIndex] <- selectedVariables[vec,] |
| 74 | A2[,1,lambdaIndex] <- 1:p |
| 75 | A2[,2:(m+1),lambdaIndex] <- discardedVariables |
| 76 | Rho[,,,lambdaIndex] <- rho |
| 77 | Pi[,lambdaIndex] <- pi |
| 78 | } |
| 79 | |
| 80 | } |
| 81 | return(res = list(A1 = A1, A2 = A2 , Rho = Rho, Pi = Pi)) |
| 82 | } |