X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=R%2FconstructionModelesLassoMLE.R;fp=R%2FconstructionModelesLassoMLE.R;h=ed05b2a1c625a1735c5f99b031664bf5241e61ac;hp=0000000000000000000000000000000000000000;hb=7f1a6cf08a4d4d67e8a95b8c1c0cc74ff3deb5a4;hpb=31ef8a5c9bbaefcf40d2c2bad43b27d469c28c34 diff --git a/R/constructionModelesLassoMLE.R b/R/constructionModelesLassoMLE.R new file mode 100644 index 0000000..ed05b2a --- /dev/null +++ b/R/constructionModelesLassoMLE.R @@ -0,0 +1,56 @@ +constructionModelesLassoMLE = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,glambda, + X,Y,seuil,tau,A1,A2) +{ + n = dim(X)[1]; + p = dim(phiInit)[1] + m = dim(phiInit)[2] + k = dim(phiInit)[3] + L = length(glambda) + + #output parameters + phi = array(0, dim=c(p,m,k,L)) + rho = array(0, dim=c(m,m,k,L)) + pi = matrix(0, k, L) + llh = matrix(0, L, 2) #log-likelihood + + for(lambdaIndex in 1:L) + { + a = A1[,1,lambdaIndex] + a = a[a!=0] + if(length(a)==0) + next + + res = EMGLLF(phiInit[a,,],rhoInit,piInit,gamInit,mini,maxi,gamma,0.,X[,a],Y,tau) + + for (j in 1:length(a)) + phi[a[j],,,lambdaIndex] = res$phi[j,,] + rho[,,,lambdaIndex] = res$rho + pi[,lambdaIndex] = res$pi + + dimension = 0 + for (j in 1:p) + { + b = A2[j,2:dim(A2)[2],lambdaIndex] + b = b[b!=0] + if (length(b) > 0) + phi[A2[j,1,lambdaIndex],b,,lambdaIndex] = 0. + c = A1[j,2:dim(A1)[2],lambdaIndex] + dimension = dimension + sum(c!=0) + } + + #on veut calculer l'EMV avec toutes nos estimations + densite = matrix(0, nrow=n, ncol=L) + for (i in 1:n) + { + for (r in 1:k) + { + delta = Y[i,]%*%rho[,,r,lambdaIndex] - (X[i,a]%*%phi[a,,r,lambdaIndex]); + densite[i,lambdaIndex] = densite[i,lambdaIndex] + pi[r,lambdaIndex] * + det(rho[,,r,lambdaIndex])/(sqrt(2*base::pi))^m * exp(-tcrossprod(delta)/2.0) + } + } + llh[lambdaIndex,1] = sum(log(densite[,lambdaIndex])) + llh[lambdaIndex,2] = (dimension+m+1)*k-1 + } + return (list("phi"=phi, "rho"=rho, "pi"=pi, "llh" = llh)) +}