https://github.com/cran/graphicalVAR
Tip revision: 19ab2d14a3bb5e3488ed946dc4191d32c64bcf52 authored by Sacha Epskamp on 19 June 2015, 00:00:00 UTC
version 0.1.3
version 0.1.3
Tip revision: 19ab2d1
Rothmana.R
Rothmana <-
function(X, Y, lambda_beta, lambda_kappa, convergence = 1e-4, gamma = 0.5, maxit.in = 100, maxit.out = 100){
# Algorithm 2 of Rothmana, Levinaa & Ji Zhua
Nvar <- ncol(X)
n <- nrow(X)
beta_ridge <- beta_ridge_C(X, Y, lambda_beta)
# Starting values:
beta <- matrix(0, Nvar, Nvar)
# Algorithm:
it <- 0
repeat{
it <- it + 1
kappa <- Kappa(beta, X, Y, lambda_kappa)
beta_old <- beta
beta <- Beta_C(kappa, beta, X, Y, lambda_beta, convergence, maxit.in)
if (sum(abs(beta - beta_old)) < (convergence * sum(abs(beta_ridge)))){
break
}
if (it > maxit.out){
warning("Model did NOT converge in outer loop")
break
}
}
## Compute unconstrained kappa (codes from SparseTSCGM):
ZeroIndex <- which(kappa==0, arr.ind=TRUE) ## Select the path of zeros
WS <- (t(Y)%*%Y - t(t(X)%*%Y) %*% beta - t(beta) %*% t(X)%*%Y + t(beta) %*% t(X)%*%X %*% beta)/(nrow(X))
if (nrow(ZeroIndex)==0){
out4 <- suppressWarnings(glasso(WS, rho = 0, trace = FALSE))
} else {
out4 <- suppressWarnings(glasso(WS, rho = 0, zero = ZeroIndex,trace = FALSE))
}
lik1 = determinant( out4$wi)$modulus[1]
lik2 <- sum(diag( out4$wi%*%WS))
pdO = sum(sum(kappa[upper.tri(kappa,diag=FALSE)] !=0))
pdB = sum(sum(beta !=0))
LLk <- (n/2)*(lik1-lik2)
LLk0 <- (n/2)*(-lik2)
EBIC <- -2*LLk + (log(n))*(pdO +pdB) + (pdO + pdB)*4*gamma*log(2*Nvar)
### TRANSPOSE BETA!!!
return(list(beta=t(beta), kappa=kappa, EBIC = EBIC))
}
