X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=R%2FinitSmallEM.R;h=e2157b254b6bfdbd5e369e02d304962e0fb44197;hp=1fa2d9b9a5daf0b366b3314f35eba412200f2675;hb=31463ab809c0195273ff2760606ea65361d721ab;hpb=d1531659214edd6eaef0ac9ec835455614bba16c diff --git a/R/initSmallEM.R b/R/initSmallEM.R index 1fa2d9b..e2157b2 100644 --- a/R/initSmallEM.R +++ b/R/initSmallEM.R @@ -9,67 +9,65 @@ #' @export initSmallEM = function(k,X,Y,tau) { - n = nrow(Y) - m = ncol(Y) - p = ncol(X) + n = nrow(Y) + m = ncol(Y) + p = ncol(X) - betaInit1 = array(0, dim=c(p,m,k,20)) - sigmaInit1 = array(0, dim = c(m,m,k,20)) - phiInit1 = array(0, dim = c(p,m,k,20)) - rhoInit1 = array(0, dim = c(m,m,k,20)) - piInit1 = matrix(0,20,k) - gamInit1 = array(0, dim=c(n,k,20)) - LLFinit1 = list() - - require(MASS) #Moore-Penrose generalized inverse of matrix - for(repet in 1:20) - { - clusters = hclust(dist(y)) #default distance : euclidean - #cutree retourne les indices (? quel cluster indiv_i appartient) d'un clustering hierarchique - clusterCut = cutree(clusters,k) - Zinit1[,repet] = clusterCut - - for(r in 1:k) - { - Z = Zinit1[,repet] - Z_bin = vec_bin(Z,r) - Z_vec = Z_bin$Z #vecteur 0 et 1 aux endroits o? Z==r - Z_indice = Z_bin$indice #renvoit les indices o? Z==r - - betaInit1[,,r,repet] = - ginv(t(x[Z_indice,])%*%x[Z_indice,])%*%t(x[Z_indice,])%*%y[Z_indice,] - sigmaInit1[,,r,repet] = diag(m) - phiInit1[,,r,repet] = betaInit1[,,r,repet]/sigmaInit1[,,r,repet] - rhoInit1[,,r,repet] = solve(sigmaInit1[,,r,repet]) - piInit1[repet,r] = sum(Z_vec)/n - } - - for(i in 1:n) - { - for(r in 1:k) - { - dotProduct = (y[i,]%*%rhoInit1[,,r,repet]-x[i,]%*%phiInit1[,,r,repet]) %*% - (y[i,]%*%rhoInit1[,,r,repet]-x[i,]%*%phiInit1[,,r,repet]) - Gam[i,r] = piInit1[repet,r]*det(rhoInit1[,,r,repet])*exp(-0.5*dotProduct) - } - sumGamI = sum(gam[i,]) - gamInit1[i,,repet]= Gam[i,] / sumGamI - } - - miniInit = 10 - maxiInit = 11 - - new_EMG = .Call("EMGLLF",phiInit1[,,,repet],rhoInit1[,,,repet],piInit1[repet,], - gamInit1[,,repet],miniInit,maxiInit,1,0,x,y,tau) - LLFEessai = new_EMG$LLF - LLFinit1[repet] = LLFEessai[length(LLFEessai)] - } - - b = which.max(LLFinit1) - phiInit = phiInit1[,,,b] - rhoInit = rhoInit1[,,,b] - piInit = piInit1[b,] - gamInit = gamInit1[,,b] - - return (list(phiInit=phiInit, rhoInit=rhoInit, piInit=piInit, gamInit=gamInit)) + Zinit1 = array(0, dim=c(n,20)) + betaInit1 = array(0, dim=c(p,m,k,20)) + sigmaInit1 = array(0, dim = c(m,m,k,20)) + phiInit1 = array(0, dim = c(p,m,k,20)) + rhoInit1 = array(0, dim = c(m,m,k,20)) + Gam = matrix(0, n, k) + piInit1 = matrix(0,20,k) + gamInit1 = array(0, dim=c(n,k,20)) + LLFinit1 = list() + + require(MASS) #Moore-Penrose generalized inverse of matrix + for(repet in 1:20) + { + distance_clus = dist(X) + tree_hier = hclust(distance_clus) + Zinit1[,repet] = cutree(tree_hier, k) + + for(r in 1:k) + { + Z = Zinit1[,repet] + Z_indice = seq_len(n)[Z == r] #renvoit les indices où Z==r + + betaInit1[,,r,repet] = ginv(crossprod(X[Z_indice,])) %*% + crossprod(X[Z_indice,], Y[Z_indice,]) + sigmaInit1[,,r,repet] = diag(m) + phiInit1[,,r,repet] = betaInit1[,,r,repet] #/ sigmaInit1[,,r,repet] + rhoInit1[,,r,repet] = solve(sigmaInit1[,,r,repet]) + piInit1[repet,r] = mean(Z == r) + } + + for(i in 1:n) + { + for(r in 1:k) + { + dotProduct = tcrossprod(Y[i,]%*%rhoInit1[,,r,repet]-X[i,]%*%phiInit1[,,r,repet]) + Gam[i,r] = piInit1[repet,r]*det(rhoInit1[,,r,repet])*exp(-0.5*dotProduct) + } + sumGamI = sum(Gam[i,]) + gamInit1[i,,repet]= Gam[i,] / sumGamI + } + + miniInit = 10 + maxiInit = 11 + + new_EMG = .Call("EMGLLF_core",phiInit1[,,,repet],rhoInit1[,,,repet],piInit1[repet,], + gamInit1[,,repet],miniInit,maxiInit,1,0,X,Y,tau) + LLFEessai = new_EMG$LLF + LLFinit1[repet] = LLFEessai[length(LLFEessai)] + } + + b = which.max(LLFinit1) + phiInit = phiInit1[,,,b] + rhoInit = rhoInit1[,,,b] + piInit = piInit1[b,] + gamInit = gamInit1[,,b] + + return (list(phiInit=phiInit, rhoInit=rhoInit, piInit=piInit, gamInit=gamInit)) }