From: devijvee Date: Mon, 10 Feb 2020 12:31:37 +0000 (+0100) Subject: Emilie update X-Git-Url: https://git.auder.net/%7B%7B%20asset%28%27mixstore/css/static/pieces/cq.svg?a=commitdiff_plain;h=6775f5b98ffc7eae7ce9d4081b23b39ce66d3c0b;p=valse.git Emilie update --- diff --git a/.gitignore b/.gitignore index a84520a..d8cc23d 100644 --- a/.gitignore +++ b/.gitignore @@ -19,3 +19,4 @@ Rprof.out *.o *.so *.exe +.Rproj.user diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index 65ed448..b620b65 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -27,7 +27,7 @@ Suggests: testthat URL: http://git.auder.net/?p=valse.git License: MIT + file LICENSE -RoxygenNote: 6.0.1 +RoxygenNote: 7.0.2 Collate: 'plot_valse.R' 'main.R' diff --git a/pkg/R/EMGLLF.R b/pkg/R/EMGLLF.R index e393ec8..93012fb 100644 --- a/pkg/R/EMGLLF.R +++ b/pkg/R/EMGLLF.R @@ -39,8 +39,8 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, # Function in C n <- nrow(X) #nombre d'echantillons p <- ncol(X) #nombre de covariables - m <- ncol(Y) #taille de Y (multivarié) - k <- length(piInit) #nombre de composantes dans le mélange + m <- ncol(Y) #taille de Y (multivarie) + k <- length(piInit) #nombre de composantes dans le melange .Call("EMGLLF", phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, X, Y, eps, phi = double(p * m * k), rho = double(m * m * k), pi = double(k), llh = double(1), S = double(p * m * k), affec = integer(n), n, p, m, k, diff --git a/pkg/R/EMGrank.R b/pkg/R/EMGrank.R index 09171ac..2dc6c37 100644 --- a/pkg/R/EMGrank.R +++ b/pkg/R/EMGrank.R @@ -30,8 +30,8 @@ EMGrank <- function(Pi, Rho, mini, maxi, X, Y, eps, rank, fast = TRUE) # Function in C n <- nrow(X) #nombre d'echantillons p <- ncol(X) #nombre de covariables - m <- ncol(Y) #taille de Y (multivarié) - k <- length(Pi) #nombre de composantes dans le mélange + m <- ncol(Y) #taille de Y (multivarie) + k <- length(Pi) #nombre de composantes dans le melange .Call("EMGrank", Pi, Rho, mini, maxi, X, Y, eps, as.integer(rank), phi = double(p * m * k), LLF = double(1), n, p, m, k, PACKAGE = "valse") } diff --git a/pkg/R/constructionModelesLassoRank.R b/pkg/R/constructionModelesLassoRank.R index 9df8168..6e18409 100644 --- a/pkg/R/constructionModelesLassoRank.R +++ b/pkg/R/constructionModelesLassoRank.R @@ -33,10 +33,10 @@ constructionModelesLassoRank <- function(S, k, mini, maxi, X, Y, eps, rank.min, for (r in 1:k) { # On veut le tableau de toutes les combinaisons de rangs possibles, et des - # lambdas Dans la première colonne : on répète (rank.max-rank.min)^(k-1) chaque - # chiffre : ça remplit la colonne Dans la deuxieme : on répète - # (rank.max-rank.min)^(k-2) chaque chiffre, et on fait ça (rank.max-rank.min)^2 - # fois ... Dans la dernière, on répète chaque chiffre une fois, et on fait ça + # lambdas Dans la premiere colonne : on repete (rank.max-rank.min)^(k-1) chaque + # chiffre : ca remplit la colonne Dans la deuxieme : on repete + # (rank.max-rank.min)^(k-2) chaque chiffre, et on fait ca (rank.max-rank.min)^2 + # fois ... Dans la derniere, on repete chaque chiffre une fois, et on fait ca # (rank.min-rank.max)^(k-1) fois. RankLambda[, r] <- rep(rank.min + rep(0:(deltaRank - 1), deltaRank^(r - 1), each = deltaRank^(k - r)), each = L) diff --git a/pkg/R/initSmallEM.R b/pkg/R/initSmallEM.R index 7e9cce5..937ea73 100644 --- a/pkg/R/initSmallEM.R +++ b/pkg/R/initSmallEM.R @@ -34,7 +34,7 @@ initSmallEM <- function(k, X, Y, fast) for (r in 1:k) { Z <- Zinit1[, repet] - Z_indice <- seq_len(n)[Z == r] #renvoit les indices où Z==r + Z_indice <- seq_len(n)[Z == r] #renvoit les indices ou Z==r if (length(Z_indice) == 1) { betaInit1[, , r, repet] <- MASS::ginv(crossprod(t(X[Z_indice, ]))) %*% crossprod(t(X[Z_indice, ]), Y[Z_indice, ]) diff --git a/pkg/R/selectVariables.R b/pkg/R/selectVariables.R index f991f6d..a4bc0f4 100644 --- a/pkg/R/selectVariables.R +++ b/pkg/R/selectVariables.R @@ -69,9 +69,7 @@ selectVariables <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma 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 + # Suppress models which are computed twice # sha1_array <- lapply(out, digest::sha1) out[ duplicated(sha1_array) ] selec <- lapply(out, function(model) model$selected) ind_dup <- duplicated(selec)