| 1 | #' Discard models which have the same relevant variables - for EMGLLF |
| 2 | #' |
| 3 | #' @param B1 array of relevant coefficients (of size p*m*length(gridlambda)) |
| 4 | #' @param B2 array of irrelevant coefficients (of size p*m*length(gridlambda)) |
| 5 | #' @param glambda grid of regularization parameters (vector) |
| 6 | #' @param rho covariance matrix (of size m*m*K*size(gridLambda)) |
| 7 | #' @param pi weight parameters (of size K*size(gridLambda)) |
| 8 | #' |
| 9 | #' @return a list with update B1, B2, glambda, rho and pi, and ind the vector of indices |
| 10 | #' of selected models. |
| 11 | #' @export |
| 12 | discardSimilarModels_EMGLLF = function(B1,B2,glambda,rho,pi) |
| 13 | { |
| 14 | ind = c() |
| 15 | for (j in 1:length(glambda)) |
| 16 | { |
| 17 | for (ll in 1:(l-1)) |
| 18 | { |
| 19 | if(B1[,,l] == B1[,,ll]) |
| 20 | ind = c(ind, l) |
| 21 | } |
| 22 | } |
| 23 | ind = unique(ind) |
| 24 | B1 = B1[,,-ind] |
| 25 | glambda = glambda[-ind] |
| 26 | B2 = B2[,,-ind] |
| 27 | rho = rho[,,,-ind] |
| 28 | pi = pi[,-ind] |
| 29 | |
| 30 | return (list("B1"=B1,"B2"=B2,"glambda"=glambda,"rho"=rho,"pi"=pi,"ind"=ind)) |
| 31 | } |
| 32 | |
| 33 | #' Discard models which have the same relevant variables |
| 34 | #' - for Lasso-rank procedure (focus on columns) |
| 35 | #' |
| 36 | #' @param B1 array of relevant coefficients (of size p*m*length(gridlambda)) |
| 37 | #' @param rho covariance matrix |
| 38 | #' @param pi weight parameters |
| 39 | #' |
| 40 | #' @return a list with B1, in, rho, pi |
| 41 | #' @export |
| 42 | discardSimilarModels_EMGrank = function(B1,rho,pi) |
| 43 | { |
| 44 | ind = c() |
| 45 | dim_B1 = dim(B1) |
| 46 | B2 = array(0,dim=c(dim_B1[1],dim_B1[2],dim_B1[3])) |
| 47 | sizeLambda=dim_B1[3] |
| 48 | glambda = rep(0,sizeLambda) |
| 49 | |
| 50 | suppressmodel = discardSimilarModels_EMGLLF(B1,B2,glambda,rho,pi) |
| 51 | return (list("B1" = suppressmodel$B1, "ind" = suppressmodel$ind, |
| 52 | "rho" = suppressmodel$rho, "pi" = suppressmodel$pi)) |
| 53 | } |