From: emilie Date: Fri, 14 Apr 2017 11:12:42 +0000 (+0200) Subject: fix few things X-Git-Url: https://git.auder.net/variants/current/doc/css/app_dev.php/R.css?a=commitdiff_plain;h=7ac88d643dac3dccb17c3e81c7b3d3d1aa87c1af;p=valse.git fix few things --- diff --git a/pkg/R/EMGLLF.R b/pkg/R/EMGLLF.R index 13a08da..92351d7 100644 --- a/pkg/R/EMGLLF.R +++ b/pkg/R/EMGLLF.R @@ -28,7 +28,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, if (!fast) { # Function in R - return (.EMGLLF_R(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau)) + return (.EMGLLF_R(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,eps)) } # Function in C @@ -37,7 +37,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, m = ncol(Y) #taille de Y (multivarié) k = length(piInit) #nombre de composantes dans le mélange .Call("EMGLLF", - phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, X, Y, tau, + 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, @@ -45,7 +45,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, } # R version - slow but easy to read -.EMGLLF_R = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X2,Y,tau) +.EMGLLF_R = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X2,Y,eps) { # Matrix dimensions n = dim(Y)[1] @@ -184,7 +184,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, Dist3 = max( (abs(pi-Pi)) / (1+abs(Pi)) ) dist2 = max(Dist1,Dist2,Dist3) - if (ite >= mini && (dist >= tau || dist2 >= sqrt(tau))) + if (ite >= mini && (dist >= eps || dist2 >= sqrt(eps))) break } diff --git a/pkg/R/main.R b/pkg/R/main.R index 238160c..6b683a5 100644 --- a/pkg/R/main.R +++ b/pkg/R/main.R @@ -124,38 +124,36 @@ valse = function(X, Y, procedure='LassoMLE', selecMod='DDSE', gamma=1, mini=10, print(tableauRecap) tableauRecap = tableauRecap[which(tableauRecap[,4]!= Inf),] - return(tableauRecap) - - # modSel = capushe::capushe(tableauRecap, n) - # indModSel <- - # if (selecMod == 'DDSE') - # as.numeric(modSel@DDSE@model) - # else if (selecMod == 'Djump') - # as.numeric(modSel@Djump@model) - # else if (selecMod == 'BIC') - # modSel@BIC_capushe$model - # else if (selecMod == 'AIC') - # modSel@AIC_capushe$model - # - # mod = as.character(tableauRecap[indModSel,1]) - # listMod = as.integer(unlist(strsplit(mod, "[.]"))) - # modelSel = models_list[[listMod[1]]][[listMod[2]]] - # - # ##Affectations - # Gam = matrix(0, ncol = length(modelSel$pi), nrow = n) - # for (i in 1:n){ - # for (r in 1:length(modelSel$pi)){ - # sqNorm2 = sum( (Y[i,]%*%modelSel$rho[,,r]-X[i,]%*%modelSel$phi[,,r])^2 ) - # Gam[i,r] = modelSel$pi[r] * exp(-0.5*sqNorm2)* det(modelSel$rho[,,r]) - # } - # } - # Gam = Gam/rowSums(Gam) - # modelSel$affec = apply(Gam, 1,which.max) - # modelSel$proba = Gam - # - # if (plot){ - # print(plot_valse(X,Y,modelSel,n)) - # } - # - # return(modelSel) + modSel = capushe::capushe(tableauRecap, n) + indModSel <- + if (selecMod == 'DDSE') + as.numeric(modSel@DDSE@model) + else if (selecMod == 'Djump') + as.numeric(modSel@Djump@model) + else if (selecMod == 'BIC') + modSel@BIC_capushe$model + else if (selecMod == 'AIC') + modSel@AIC_capushe$model + + mod = as.character(tableauRecap[indModSel,1]) + listMod = as.integer(unlist(strsplit(mod, "[.]"))) + modelSel = models_list[[listMod[1]]][[listMod[2]]] + + ##Affectations + Gam = matrix(0, ncol = length(modelSel$pi), nrow = n) + for (i in 1:n){ + for (r in 1:length(modelSel$pi)){ + sqNorm2 = sum( (Y[i,]%*%modelSel$rho[,,r]-X[i,]%*%modelSel$phi[,,r])^2 ) + Gam[i,r] = modelSel$pi[r] * exp(-0.5*sqNorm2)* det(modelSel$rho[,,r]) + } + } + Gam = Gam/rowSums(Gam) + modelSel$affec = apply(Gam, 1,which.max) + modelSel$proba = Gam + + if (plot){ + print(plot_valse(X,Y,modelSel,n)) + } + + return(modelSel) }