R/fevd.varest.R

In frbl/vars: VAR Modelling

"fevd.varest" <-
function(x, n.ahead=10, ...){
  if(!(class(x)=="varest")){
    stop("\nPlease provide an object of class 'varest', generated by 'VAR()'.\n")
  }
  n.ahead <- abs(as.integer(n.ahead))
  K <- x$K
  p <- x$p
  ynames <- colnames(x$datamat[, 1 : K])
  msey <- .fecov(x, n.ahead = n.ahead)
  Psi <- Psi(x, nstep = n.ahead, ...)
  mse <- matrix(NA, nrow = n.ahead, ncol = K)
  Omega <- array(0, dim = c(n.ahead, K, K))
  for(i in 1 : n.ahead){
    mse[i, ] <- diag(msey[, , i])
    temp <- matrix(0, K, K)
      for(l in 1 : K){
        for(m in 1 : K){
          for(j in 1 : i){
            temp[l, m] <- temp[l, m] + Psi[l , m, j]^2
        }
      }
    }
    temp <- temp / mse[i, ]
    for(j in 1 : K){
      Omega[i, ,j] <- temp[j, ]
    }
  }
  result <- list()
  for(i in 1 : K){
    result[[i]] <- matrix(Omega[, , i], nrow = n.ahead, ncol = K)
    colnames(result[[i]]) <- ynames
  }
  names(result) <- ynames
  class(result) <- "varfevd"
  return(result)
}