R/tvIRF.R

In tvReg: Time-Varying Coefficient for Single and Multi-Equation Regressions

#' Time-Varying Impulse Response Function
#'
#' Computes the time-varying impulse response coefficients of an object 
#' of class \code{tvvar},  obtained with function \code{tvVAR} for \code{n.ahead} steps.
#'
#' @aliases tvirf-class tvirf.
#' @param x An object of class \code{tvvar}.
#' @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 IRF is computed.
#' @param ortho.cov A character indicating if the covariance matrix for the 
#' orthogonal tvIRF should be estimated as a constant or time varying. Either 
#' 'const' or 'tv' (default). This parameter is used only when ortho = TRUE.
#' @param bw.cov A scalar (optional) with the bandwidth to estimate the errors
#' variance-covariance matrix. If left NULL, it is estimated.
#' @param cumulative Logical, if TRUE the cumulated impulse response 
#' coefficients are computed. Default is FALSE.
#' @param ... Other parameters passed to specific methods.
#'
#' @return \code{tvIRF} returns and object of class \code{tvirf} with the 
#' following components:
#' \item{irf}{A list of length the number of impulse variable(s). Each element
#' of the list is an array of dim = c(obs x number 
#' of response variables x n.ahead).}
#' \item{Lower}{A list of length the number of impulse variable(s), containing
#'  the lower confidence line, if calculated.}
#' \item{Upper}{A list of length the number of impulse variable(s), containing
#'  the upper confidence line, if calculated.}
#' \item{response}{A character, a number of a vector with the names or 
#' positions of the response(s) variable(s).}
#' \item{impulse}{A character, a number of a vector with the names or 
#' positions of the impulse(s) variable(s).}
#' \item{x}{A object of class \code{tvvar}}.
#' \item{n.ahead}{Number of ahead impulse response functions.}
#' \item{ortho}{Logical, orthogonal or not impuluse response function.}
#' \item{ortho.cov}{Character, either 'const' or 'tv' (default). This 
#' parameter is used when the orthogonal TVIRF is calculated. The default 
#' is using an error time-varying variance-covariance.}
#' \item{bw.cov}{A scalar with the bandwidth to estimate the errors 
#' variance-covariance matrix. If NULL, it is calculated by cross-validation.}
#' \item{cumulative}{Logical, if TRUE the cumulated impulse response 
#' coefficients are computed. Default is FALSE.}
#' 
#' @seealso \code{\link{bw}}, \code{\link{tvVAR}}, \code{\link{confint}}, 
#' \code{\link{plot}}, \code{\link{print}} and \code{\link{summary}}
#' 
#' @examples
#' \dontrun{
#' ##Inflation rate, unemployment rate and treasury bill 
#' ##interest rate for the US as in Primiceri (2005). 
#' data(usmacro, package = "bvarsv")
#' TVVAR <- tvVAR(usmacro, p = 4, type = "const")
#' 
#' ##Estimate a the tvIRF with time-varying covariance function
#' TVIRF <- tvIRF(TVVAR)
#' 
#' ##Cumulative impulse response function
#' TVIRF2 <- tvIRF(TVVAR, cumulative = TRUE)
#' }
#' 
#' @rdname tvIRF
#' @export
tvIRF<-function (x, impulse = NULL, response = NULL, n.ahead = 10,
                       ortho = TRUE,  ortho.cov = c("tv", "const"), 
                       bw.cov = NULL, cumulative = FALSE, ...)
{
  if (!inherits(x, "tvvar")) 
    stop("\nPlease provide an object of class 'tvvar', 
         generated by 'tvVAR()'.\n")
  y.names <- colnames(x$y.orig)
  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\n
           that 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\n
           that are in the set of endogenous variables.\n")
    }
    response <- subset(y.names, subset = y.names %in% response)
  }
  ortho.cov <- match.arg(ortho.cov)
  irs <- .tvIRF(x = x, impulse = impulse, response = response,
              y.names = y.names, n.ahead = n.ahead, ortho = ortho,
              cumulative = cumulative, ortho.cov = ortho.cov, bw.cov = bw.cov)
  result <- list(irf = irs$irf, Lower = NULL, Upper = NULL, response = response,
                 impulse = impulse, x = x,  n.ahead = n.ahead, ortho = ortho,
                 ortho.cov = ortho.cov, bw.cov = irs$bw.cov, 
                 cumulative = cumulative, level = 0, runs = 0, 
                 tboot = NULL, BOOT = NULL, match = match.call())
  class(result) <- "tvirf"
  return(result)
}

#' @rdname tvReg-internals
#' @keywords internal
.tvIRF <- function (x, impulse, response, y.names, n.ahead, ortho, ortho.cov, bw.cov, 
                    cumulative)
{
  if (inherits(x, "tvvar"))
  {
    if (ortho)
    {
      result <-  tvPsi(x, nstep = n.ahead, ortho.cov, bw.cov = bw.cov)
      irf <- result$Psi
      bw.cov <- result$bw.cov
    }
    else
    {
      irf <- tvPhi(x, nstep = n.ahead)
    }
  }
  dimnames(irf) <- list(NULL, y.names, y.names, NULL)
  idx <- length(impulse)
  irs <- list()
  for (i in 1:idx)
  {
    irs[[i]] <- array(irf[, response, impulse[i], 1:(n.ahead + 1)], 
                      dim = c(x$obs, length(response), n.ahead + 1))
    if (cumulative)
      irs[[i]] <- aperm (apply(irs[[i]], 1:2, cumsum), c(2, 3, 1))
    dimnames (irs[[i]]) <- list(NULL, response, NULL)
  }
  names(irs) <- impulse
  result <- irs
  if(ortho)
    return(list(irf = result, bw.cov = bw.cov))
  return(list(irf = result, bw.cov = NULL))
}