R/stability.R

In alexanderlange53/svars: Data-Driven Identification of SVAR Models

#' Structural stability of a VAR(p)
#'
#'  Computes an empirical fluctuation process according to a specified
#'  method from the generalized fluctuation test framework. The test
#'  utilises the function \command{efp()} and its methods from
#'  package \sQuote{\code{strucchange}}. Additionally, the function provides the option to
#'  compute a multivariate chow test.
#'
#' @param x Object of class \sQuote{\code{varest}}; generated by \command{VAR()}.
#' @param type Specifies which type of fluctuation process will be computed, the default is \sQuote{\code{OLS-CUSUM}}.
#' For details see:\code{\link[strucchange]{efp}} and \code{\link[svars]{chow.test}}.
#' @param h A numeric from interval (0,1) specifying the bandwidth. Determines the size of the data window
#' relative to sample size (for \sQuote{\code{MOSUM}}, \sQuote{\code{ME}} and \sQuote{\code{mv-chow-test}} only).
#' @param dynamic Logical. If \sQuote{\code{TRUE}} the lagged observations are included as a regressor
#' (not if  \sQuote{\code{type}} is \sQuote{\code{mv-chow-test}}).
#' @param rescale Logical. If \sQuote{\code{TRUE}} the estimates will be standardized by the regressor matrix of the corresponding subsample;
#' if \sQuote{\code{FALSE}} the whole regressor matrix will be used. (only if \sQuote{\code{type}} is either \sQuote{\code{RE}} or
#' \sQuote{\code{E}}).
#' @param ... Ellipsis, is passed to \code{strucchange::sctest()}, as default.
#'
#' @details For details, please refer to documentation \code{\link[strucchange]{efp}} and \code{\link[svars]{chow.test}}.
#'
#' @return A list with either class attribute \sQuote{\code{varstabil}} or \sQuote{\code{chowpretest}} holding the following elements
#' in case of class \sQuote{\code{varstabil}}:
#' \item{stability}{A list with objects of class \sQuote{\code{efp}}; length is equal to the dimension of the VAR.}
#' \item{names}{Character vector containing the names of the endogenous variables.}
#' \item{K}{An integer of the VAR dimension.}
#'
#' In case of class \sQuote{\code{chowpretest}} the list consists of the following elements:
#' \item{teststat_bp}{A vector containing the calculated break point test statistics for all considered break points.}
#' \item{teststat_sp}{A vector containing the calculated sample split test statistics for all considered sample splits.}
#' \item{from}{An integer sepcifying the first observation as possible break date.}
#' \item{to}{An integer sepcifying the last observation as possible break date.}
#' \item{var}{A list with objects of class \sQuote{\code{varest}}}
#' \item{break_point}{Logical, if the break point test should be the benchmark for later analysis.}
#'
#' @author Bernhard Pfaff, Alexander Lange, Bernhard Dalheimer, Simone Maxand, Helmut Herwartz
#'
#' @references Zeileis, A., F. Leisch, K. Hornik and C. Kleiber (2002), strucchange: An R Package for Testing for Structural Change in Linear Regression
#' Models, \emph{Journal of Statistical Software}, \bold{7(2)}: 1-38, \doi{10.18637/jss.v007.i02}\cr
#'
#' and see the references provided in the reference section of \code{\link[strucchange]{efp}} and \code{\link[svars]{chow.test}}, too.
#'
#' @seealso \code{\link{VAR}}, \code{\link{plot}}, \code{\link[strucchange]{efp}}, \code{\link[svars]{chow.test}}
#'
#' @examples
#' \donttest{
#' data(Canada)
#' var.2c <- VAR(Canada, p = 2, type = "const")
#' var.2c.stabil <- stability(var.2c, type = "OLS-CUSUM")
#' var.2c.stabil
#' plot(var.2c.stabil)
#'
#' data(USA)
#' v1 <- VAR(USA, p = 6)
#' x1 <- stability(v1, type = "mv-chow-test")
#' plot(x1)
#'
#' }
#' @keywords regression VAR "Vector autoregressive model" "Structural Stability" "Structural Stability" "efp" "Empirical Fluctuation Process"
#'
#' @rdname stability
#' @name stability
#' @aliases stability.varest
#' @importFrom strucchange efp
#' @importFrom methods is
#'
#' @export

stability.varest <- function(x, type = c("OLS-CUSUM", "Rec-CUSUM", "Rec-MOSUM",
                                  "OLS-MOSUM", "RE", "ME", "Score-CUSUM",
                                  "Score-MOSUM", "fluctuation", "mv-chow-test"),
                      h = 0.15, dynamic = FALSE, rescale = TRUE, ...){

  if(type != "mv-chow-test"){
  if(!(is(x, "varest"))){
    stop("\nPlease provide an object of class 'varest', generated by 'var()'.\n")
  }
  type <- match.arg(type)
  K <- x$K
  stability <- list()
  endog <- colnames(x$datamat)[1 : K]
  for(i in 1 : K){
    formula <- formula(x$varresult[[i]])
    data <- x$varresult[[i]]$model
    stability[[endog[i]]] <- efp(formula = formula, data = data, type = type, h = h, dynamic = dynamic, rescale = rescale)
  }
  result <- list(stability = stability, names = endog, K = K)
  class(result) <- "varstabil"


}else{
  if(!(is(x, "varest"))){
    stop("\nPlease provide an object of class 'varest', generated by 'var()'.\n")
  }
  from <- ceiling(h*x$totobs) + x$p
  to <- floor((1-h)*x$totobs)

  teststat_bp <- rep(NA, times = x$obs)
  teststat_sp <- rep(NA, times = x$obs)
  for(i in from : to){
    chowres <- suppressWarnings(tryCatch(chow.test(x, SB = i, nboot = NULL), error = function(e) NA))
    if(!is.infinite(chowres$lambda_bp) & !is.nan(chowres$lambda_bp)){
      teststat_bp[i] <- chowres$lambda_bp
    }else{
      teststat_bp[i] <- NA
    }
    if(!is.infinite(chowres$lambda_sp) & !is.nan(chowres$lambda_sp)){
      teststat_sp[i] <- chowres$lambda_sp
    }else{
      teststat_sp[i] <- NA
    }
  }
  result <- list(teststat_bp = teststat_bp,
                 teststat_sp = teststat_sp,
                 from = unname(from),
                 to = unname(to),
                 var = x,
                 break_point = TRUE)
  class(result) <- "chowpretest"
}

return(result)
}