Revision 19ab2d14a3bb5e3488ed946dc4191d32c64bcf52 authored by Sacha Epskamp on 19 June 2015, 00:00:00 UTC, committed by Gabor Csardi on 19 June 2015, 00:00:00 UTC
1 parent c678bf0
graphicalVAR.R
computePCC <- function(x)
{
x <- -cov2cor(x)
diag(x) <- 0
x <- as.matrix(forceSymmetric(x))
return(x)
}
computePDC <- function(beta,kappa){
sigma <- solve(kappa)
t(beta / sqrt(diag(sigma) %o% diag(kappa) + beta^2))
}
graphicalVAR <-
function(
data, # A n by p data frame containing repeated measures
nLambda = 50, # Either single value or vector of two corresponding to c(kappa, beta)
verbose = TRUE,
gamma = 0.5,
lambda_beta,
lambda_kappa, maxit.in = 100, maxit.out = 100
){
# Check input:
if (is.data.frame(data)){
data <- as.matrix(data)
}
stopifnot(is.matrix(data))
Nvar <- ncol(data)
Ntime <- nrow(data)
# Center data:
data <- scale(data, TRUE, FALSE)
# Compute current and lagged data:
data_c <- data[-1,,drop=FALSE]
data_l <- data[-nrow(data),,drop=FALSE]
# Generate lambdas (from SparseTSCGM package):
if (missing(lambda_beta) | missing(lambda_kappa)){
lams <- SparseTSCGM_lambdas(data_l, data_c, nLambda)
if (missing(lambda_beta)){
lambda_beta <- lams$lambda_beta
}
if (missing(lambda_kappa)){
lambda_kappa <- lams$lambda_kappa
}
}
Nlambda_beta <- length(lambda_beta)
Nlambda_kappa <- length(lambda_kappa)
# Expand lambda grid:
lambdas <- expand.grid(kappa = lambda_kappa, beta = lambda_beta)
Estimates <- vector("list", nrow(lambdas))
### Algorithm 2 of Rothmana, Levinaa & Ji Zhua
if (verbose){
pb <- txtProgressBar(0, nrow(lambdas), style = 3)
}
for (i in seq_len(nrow(lambdas))){
Estimates[[i]] <- Rothmana(data_l, data_c, lambdas$beta[i],lambdas$kappa[i], gamma=gamma,maxit.in=maxit.in, maxit.out = maxit.out)
if (verbose){
setTxtProgressBar(pb, i)
}
}
if (verbose){
close(pb)
}
#
# logandbic <- LogLik_and_BIC(data_l, data_c, Estimates)
# lambdas$bic <- logandbic$BIC
# lambdas$loglik <- logandbic$logLik
lambdas$ebic <- sapply(Estimates,'[[','EBIC')
# Which minimal BIC:
min <- which.min(lambdas$ebic)
Results <- Estimates[[min]]
# Standardize matrices (Wild et al. 2010)
# partial contemporaneous correlation (PCC)
Results$PCC <- computePCC(Results$kappa)
Results$PDC <- computePDC(Results$beta, Results$kappa)
Results$path <- lambdas
Results$labels <- colnames(data)
colnames(Results$beta) <- rownames(Results$beta) <- colnames(Results$kappa) <- rownames(Results$kappa) <-
colnames(Results$PCC) <- rownames(Results$PCC) <- colnames(Results$PDC) <- rownames(Results$PDC) <-
Results$labels
Results$gamma <- gamma
class(Results) <- "graphicalVAR"
return(Results)
}

Computing file changes ...