X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FEMGLLF.R;h=0d8607cb7d31273fe4befea28492e340925ef6fa;hb=23b9fb13bc6e82d7ca43bfb83aa85b6cd69c52c0;hp=bf4476b63d839fc1f260ff7b005309f32e80d4af;hpb=228ee602a972fcac6177db0d539bf9d0c5fa477f;p=valse.git diff --git a/pkg/R/EMGLLF.R b/pkg/R/EMGLLF.R index bf4476b..0d8607c 100644 --- a/pkg/R/EMGLLF.R +++ b/pkg/R/EMGLLF.R @@ -19,7 +19,8 @@ #' rho : parametre de variance renormalisé, calculé par l'EM #' pi : parametre des proportions renormalisé, calculé par l'EM #' LLF : log vraisemblance associée à cet échantillon, pour les valeurs estimées des paramètres -#' S : ... affec : ... +#' S : ... +#' affec : ... #' #' @export EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, @@ -41,6 +42,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, X, Y, eps, phi = double(p * m * k), rho = double(m * m * k), pi = double(k), LLF = double(maxi), S = double(p * m * k), affec = integer(n), n, p, m, k, PACKAGE = "valse") + list(phi = phi, rho = rho, pi = pi, llh = llh, S = S, affec=affec) } # R version - slow but easy to read @@ -72,7 +74,6 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, ps2 <- array(0, dim = c(p, m, k)) X2 <- array(0, dim = c(n, p, k)) Y2 <- array(0, dim = c(n, m, k)) - EPS <- 1e-15 for (ite in 1:maxi) { @@ -190,5 +191,6 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, break } - list(phi = phi, rho = rho, pi = pi, llh = llh, S = S) + affec = apply(gam, 1, which.max) + list(phi = phi, rho = rho, pi = pi, llh = llh, S = S, affec=affec) }