Merge branch 'master' of auder.net:valse

diff --git a/R/.Rhistory b/R/.Rhistory
new file mode 100644 (file)
index 0000000..29f5836
--- /dev/null
+++ b/R/.Rhistory
@@ -0,0 +1,94 @@
+install.packages("shock")
+library("shock", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
+source('~/Dropbox/GLLiM-shock/code prediction intervals/IC inverse intercept.R')
+mean(res[1,])
+source('~/Dropbox/GLLiM-shock/code prediction intervals/IC inverse intercept.R')
+mean(res[1,])
+&e-2
+1e-2
+library("devtools", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
+library("roxygen2", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
+setwd("~/valse")
+document()
+document()
+document()
+document()
+document()
+document()
+document()
+document()
+setwd("~/")
+document()
+setwd("~/valse")
+document()
+setwd("~/")
+install('valse')
+install('valse')
+?valse
+install("valse")
+?kmeans
+x = rnorm(50)
+kmeans(x)
+library("mclust", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
+install.packages("Rmixmod")
+A = matrix(0,dim = c(2,3))
+A = matrix(0,dim = c(2,3))
+A = matrix(0,ncol=3,nrow=2
+)
+dim(A)
+dim(A)[1]
+mclust(x)
+Mclust(x)
+x
+A
+B = matrix(2,nrow=2,ncol=2)
+matrix(c(A,B))
+matrix(c(A,B),nrow=2)
+C =matrix(c(A,B),nrow=2)
+Mclust(C,k=2)
+Mclust(C)
+Mclust(A)
+A
+Mclust(x)
+Mclust(x,2)
+class = Mclust(x,2)
+names(class)
+class$classification
+generateI0default(10,5,5,2)
+setwd("~/valse/R")
+generateI0default(10,5,5,2)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIOdefault.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIOdefault.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIOdefault.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIOdefault.R', echo=TRUE)
+A = generateIOdefault(10,5,5,2)
+source('~/valse/R/generateIO.R', echo=TRUE)
+A = generateIOdefault(10,5,5,2)
+A
+A = generateIOdefault(10,5,6,2)
+A
+Mclust(A$Y)
+library("mclust", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
+Mclust(A$Y)
+X = A$X
+Y = A$Y
+X
+Y
+save(X,Y,file="data.RData")
+load("~/valse/R/data.RData")

diff --git a/R/selectVariables.R b/R/selectVariables.R
new file mode 100644 (file)
index 0000000..be53d85
--- /dev/null
+++ b/R/selectVariables.R
@@ -0,0 +1,82 @@
+#' selectVaribles 
+#' It is a function which construct, for a given lambda, the sets of 
+#' relevant variables and irrelevant variables.
+#'
+#' @param phiInit an initial estimator for phi (size: p*m*k)
+#' @param rhoInit an initial estimator for rho (size: m*m*k)
+#' @param piInit  an initial estimator for pi (size : k)
+#' @param gamInit an initial estimator for gamma
+#' @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       matrix of regressors
+#' @param Y       matrix of responses
+#' @param thres   threshold to consider a coefficient to be equal to 0
+#' @param tau     threshold to say that EM algorithm has converged
+#'
+#' @return
+#' @export
+#'
+#' @examples
+selectVariables <- function(phiInit,rhoInit,piInit,gamInit,
+                            mini,maxi,gamma,glambda,X,Y,thres,tau){
+  
+  dimphi <- dim(phiInit)
+  p <- dimPhi[1]
+  m <- dimPhi[2]
+  k <- dimPhi[3]
+  L <- length(glambda);
+  A1 <- array(0, dim <- c(p,m+1,L))
+  A2 <- array(0, dim <- c(p,m+1,L))
+  Rho <- array(0, dim <- c(m,m,k,L))
+  Pi <- array(0, dim <- c(k,L));
+  
+  # For every lambda in gridLambda, comutation of the coefficients
+  for (lambdaIndex in c(1:L)) {
+    Res <- EMGLLF(phiInit,rhoInit,piInit,gamInit,mini,maxi,
+                  gamma,glambda[lambdaIndex],X,Y,tau);
+    phi <- Res$phi
+    rho <- Res$rho
+    pi <- Res$pi
+    
+    # If a coefficient is larger than the threshold, we keep it
+    selectedVariables <- array(0, dim = c(p,m))
+    discardedVariables <- array(0, dim = c(p,m))
+    atLeastOneSelectedVariable <- false
+    for (j in c(1:p)){
+      cpt <- 1
+      cpt2 <-1
+      for (mm in c(1:m)){
+        if (max(abs(phi[j,mm,])) > thres){
+          selectedVariables[j,cpt] <- mm
+          cpt <- cpt+1
+          atLeastOneSelectedVariable <- true
+        } else{
+          discardedVariables[j,cpt2] <- mm
+          cpt2 <- cpt2+1
+        }
+      }
+    }
+    
+    # If no coefficients have been selected, we provide the zero matrix
+    # We delete zero coefficients: vec = indices of zero values                
+    if atLeastOneSelectedVariable{
+      vec <- c()
+      for (j in c(1:p)){
+        if (selectedVariables(j,1) =! 0){
+          vec <- c(vec,j)  
+        }
+      }
+      # Else, we provide the indices of relevant coefficients
+      A1[,1,lambdaIndex] <- c(vec,rep(0,p-length(vec)))
+      A1[1:length(vec),2:(m+1),lambdaIndex] <- selectedVariables[vec,]
+      A2[,1,lambdaIndex] <- 1:p
+      A2[,2:(m+1),lambdaIndex] <- discardedVariables
+      Rho[,,,lambdaIndex] <- rho
+      Pi[,lambdaIndex] <- pi
+    }
+    
+  }
+  return(res = list(A1 = A1, A2 = A2 , Rho = Rho, Pi = Pi))
+}
\ No newline at end of file