R/irf.varshrinkest.R

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

#' Impulse response function
#'
#' Computes the impulse response coefficients of a VAR(p)
#' (or transformed VECM to VAR(p)) for n.ahead steps.
#' This is a modification of vars::irf() for the class "varshrinkest".
#'
#' @param x Object of class 'varshrinkest';
#' generated by \code{VARshrink()}
#' @param impulse A character vector of the impulses,
#' default is all variables.
#' @param response A character vector of the responses,
#' default is all variables.
#' @param n.ahead Integer specifying the steps.
#' @param ortho Logical, if TRUE (the default) the
#' orthogonalised impulse response coefficients are
#' computed (only for objects of class 'varshrinkest').
#' @param cumulative Logical, if TRUE the cumulated impulse
#' response coefficients are computed. The default value
#' is false.
#' @param boot Logical, if TRUE (the default) bootstrapped
#' error bands for the imuplse response coefficients are
#' computed.
#' @param ci Numeric, the confidence interval for the
#' bootstrapped errors bands.
#' @param runs An integer, specifying the runs for the
#' bootstrap.
#' @param seed An integer, specifying the seed for the
#' rng of the bootstrap.
#' @param ... Currently not used.
#' @seealso \code{\link[vars]{irf}}
#' @export
irf.varshrinkest <-
  function (x, impulse = NULL, response = NULL, n.ahead = 10, ortho = TRUE,
          cumulative = FALSE, boot = TRUE, ci = 0.95, runs = 100, seed = NULL,
          ...)
{
  if (!inherits(x, "varest")) {
    stop("\nPlease provide an object inheriting class 'varest'.\n")
  }
  y.names <- names(x$varresult)
  if (is.null(impulse)) {
    impulse <- y.names
  }
  else {
    impulse <- as.vector(as.character(impulse))
    if (any(!(impulse %in% y.names))) {
      stop("\nPlease provide variables names in impulse\nthat are in the set of endogenous variables.\n")
    }
    impulse <- subset(y.names, subset = y.names %in% impulse)
  }
  if (is.null(response)) {
    response <- y.names
  }
  else {
    response <- as.vector(as.character(response))
    if (any(!(response %in% y.names))) {
      stop("\nPlease provide variables names in response\nthat are in the set of endogenous variables.\n")
    }
    response <- subset(y.names, subset = y.names %in% response)
  }
  irs <- h_irf(x = x, impulse = impulse, response = response,
               y.names = y.names, n.ahead = n.ahead, ortho = ortho,
               cumulative = cumulative)
  Lower <- NULL
  Upper <- NULL
  if (boot) {
    ci <- as.numeric(ci)
    if ((ci <= 0) | (ci >= 1)) {
      stop("\nPlease provide a number between 0 and 1 for the confidence interval.\n")
    }
    ci <- 1 - ci
    BOOT <- h_boot(x = x, n.ahead = n.ahead, runs = runs,
                   ortho = ortho, cumulative = cumulative, impulse = impulse,
                   response = response, ci = ci, seed = seed, y.names = y.names)
    Lower <- BOOT$Lower
    Upper <- BOOT$Upper
  }
  result <- list(irf = irs, Lower = Lower, Upper = Upper, response = response,
                 impulse = impulse, ortho = ortho, cumulative = cumulative,
                 runs = runs, ci = ci, boot = boot, model = class(x))
  class(result) <- c("varshirf", "varirf")
  return(result)
}