X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=pkg%2FR%2FEMGrank.R;h=f2bf58e05b50a04e6a9c341dbc78978186cdf0bd;hp=db0b8f2df276684c352601778e9fb6ac43396f80;hb=6279ba8656582370e7242ff9e77d22c23fe8ca04;hpb=96b591b7a76da9780e766ead693eb065281b6d62 diff --git a/pkg/R/EMGrank.R b/pkg/R/EMGrank.R index db0b8f2..f2bf58e 100644 --- a/pkg/R/EMGrank.R +++ b/pkg/R/EMGrank.R @@ -8,7 +8,7 @@ #' @param maxi Nombre maximal d'itérations dans l'algorithme EM #' @param X Régresseurs #' @param Y Réponse -#' @param tau Seuil pour accepter la convergence +#' @param eps Seuil pour accepter la convergence #' @param rank Vecteur des rangs possibles #' #' @return A list ... @@ -16,12 +16,12 @@ #' LLF : log vraisemblance associé à cet échantillon, pour les valeurs estimées des paramètres #' #' @export -EMGrank <- function(Pi, Rho, mini, maxi, X, Y, tau, rank, fast = TRUE) +EMGrank <- function(Pi, Rho, mini, maxi, X, Y, eps, rank, fast = TRUE) { if (!fast) { # Function in R - return(.EMGrank_R(Pi, Rho, mini, maxi, X, Y, tau, rank)) + return(.EMGrank_R(Pi, Rho, mini, maxi, X, Y, eps, rank)) } # Function in C @@ -29,7 +29,7 @@ EMGrank <- function(Pi, Rho, mini, maxi, X, Y, tau, rank, fast = TRUE) p <- ncol(X) #nombre de covariables m <- ncol(Y) #taille de Y (multivarié) k <- length(Pi) #nombre de composantes dans le mélange - .Call("EMGrank", Pi, Rho, mini, maxi, X, Y, tau, rank, phi = double(p * m * k), + .Call("EMGrank", Pi, Rho, mini, maxi, X, Y, eps, rank, phi = double(p * m * k), LLF = double(1), n, p, m, k, PACKAGE = "valse") } @@ -43,13 +43,13 @@ matricize <- function(X) } # R version - slow but easy to read -.EMGrank_R <- function(Pi, Rho, mini, maxi, X, Y, tau, rank) +.EMGrank_R <- function(Pi, Rho, mini, maxi, X, Y, eps, rank) { # matrix dimensions - n <- dim(X)[1] - p <- dim(X)[2] - m <- dim(Rho)[2] - k <- dim(Rho)[3] + n <- nrow(X) + p <- ncol(X) + m <- ncol(Y) + k <- length(Pi) # init outputs phi <- array(0, dim = c(p, m, k)) @@ -64,7 +64,7 @@ matricize <- function(X) # main loop ite <- 1 - while (ite <= mini || (ite <= maxi && sumDeltaPhi > tau)) + while (ite <= mini || (ite <= maxi && sumDeltaPhi > eps)) { # M step: update for Beta ( and then phi) for (r in 1:k) @@ -92,7 +92,7 @@ matricize <- function(X) for (r in seq_len(k)) { dotProduct <- tcrossprod(Y[i, ] %*% Rho[, , r] - X[i, ] %*% phi[, , r]) - logGamIR <- log(Pi[r]) + log(det(Rho[, , r])) - 0.5 * dotProduct + logGamIR <- log(Pi[r]) + log(gdet(Rho[, , r])) - 0.5 * dotProduct # Z[i] = index of max (gam[i,]) if (logGamIR > maxLogGamIR) {