R/fevd.varshrinkest.R

In namgillee/VARshrink: Shrinkage Estimation Methods for Vector Autoregressive Models

#' Forecast Error Variance Decomposition
#'
#' Computes the forecast error variance decomposition of a VAR(p) for
#' n.ahead steps.
#' This is a modification of vars::fevd() for the class "varshrinkest".
#'
#' @param x Object of class 'varshrinkest';
#' generated by \code{VARshrink()}.
#' @param n.ahead Integer specifying the steps.
#' @param ... Currently not used.
#' @seealso \code{\link[vars]{fevd}}
#' @export
fevd.varshrinkest <-
function (x, n.ahead = 10, ...) {
  if (!inherits(x, "varest")) {
    stop("\nPlease provide an object inheriting class 'varest'.\n")
  }
  n.ahead <- abs(as.integer(n.ahead))
  K <- x$K
  p <- x$p
  ynames <- names(x$varresult)
  msey <- h_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)
}