From: Benjamin Auder Date: Fri, 21 Apr 2017 15:14:10 +0000 (+0200) Subject: Merge branch 'master' of auder.net:valse X-Git-Url: https://git.auder.net/?p=valse.git;a=commitdiff_plain;h=c3bf2821bce67c75504e303fae23dd41c00f06c8;hp=-c Merge branch 'master' of auder.net:valse --- c3bf2821bce67c75504e303fae23dd41c00f06c8 diff --combined pkg/R/constructionModelesLassoMLE.R index 75ae679,c55035e..78e11ad --- a/pkg/R/constructionModelesLassoMLE.R +++ b/pkg/R/constructionModelesLassoMLE.R @@@ -40,10 -40,10 +40,10 @@@ constructionModelesLassoMLE <- function if (verbose) print(paste("Computations for lambda=", lambda)) - n <- dim(X)[1] - p <- dim(phiInit)[1] - m <- dim(phiInit)[2] - k <- dim(phiInit)[3] + n <- nrow(X) + p <- ncol(X) + m <- ncol(Y) + k <- length(piInit) sel.lambda <- S[[lambda]]$selected # col.sel = which(colSums(sel.lambda)!=0) #if boolean matrix col.sel <- which(sapply(sel.lambda, length) > 0) #if list of selected vars @@@ -51,8 -51,8 +51,8 @@@ return(NULL) # lambda == 0 because we compute the EMV: no penalization here - res <- EMGLLF(array(phiInit[col.sel, , ],dim=c(length(col.sel),m,k)), rhoInit, - piInit, gamInit, mini, maxi, gamma, 0, as.matrix(X[, col.sel]), Y, eps, fast) + res <- EMGLLF(array(phiInit,dim=c(p,m,k))[col.sel, , ], rhoInit, piInit, gamInit, + mini, maxi, gamma, 0, as.matrix(X[, col.sel]), Y, eps, fast) # Eval dimension from the result + selected phiLambda2 <- res$phi @@@ -65,7 -65,7 +65,7 @@@ ## Computation of the loglikelihood # Precompute det(rhoLambda[,,r]) for r in 1...k - detRho <- sapply(1:k, function(r) det(rhoLambda[, , r])) + detRho <- sapply(1:k, function(r) gdet(rhoLambda[, , r])) sumLogLLH <- 0 for (i in 1:n) { @@@ -77,11 -77,21 +77,10 @@@ logGam <- logGam - max(logGam) #adjust without changing proportions gam <- exp(logGam) - print(gam) norm_fact <- sum(gam) sumLogLLH <- sumLogLLH + log(norm_fact) - log((2 * base::pi)^(m/2)) } llhLambda <- c(sumLogLLH/n, (dimension + m + 1) * k - 1) - # densite <- vector("double", n) - # for (r in 1:k) - # { - # if (length(col.sel) == 1) - # { - # delta <- (Y %*% rhoLambda[, , r] - (X[, col.sel] %*% t(phiLambda[col.sel, , r]))) - # } else delta <- (Y %*% rhoLambda[, , r] - (X[, col.sel] %*% phiLambda[col.sel, , r])) - # densite <- densite + piLambda[r] * det(rhoLambda[, , r])/(sqrt(2 * base::pi))^m * - # exp(-rowSums(delta^2)/2) - # } - # llhLambda <- c(mean(log(densite)), (dimension + m + 1) * k - 1) list(phi = phiLambda, rho = rhoLambda, pi = piLambda, llh = llhLambda) }