R/Bcoef_sh.R

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

#' Coefficient matrix
#'
#' Returns the estimated coefficients of a VAR(p) model as a matrix.
#' This is a modification of vars::Bcoef() for the class "varshrinkest".
#'
#' Consider VAR(p) model:
#' \deqn{y_t = A_1 y_{t-1} + ... + A_p y_{t-p} + C d_t + e_t .}
#' The function returns the concatenated matrix (A_1, ..., A_p, C) as a matrix
#' object.
#'
#' @param x An object of class "varshrinkest" generated by VARshrink().
#' @return A matrix holding the estimated coefficients of a VAR.
#' @importFrom stats coef
#' @examples
#' data(Canada, package = "vars")
#' y <- diff(Canada)
#' estim <- VARshrink(y, p = 2, type = "const", method = "ridge")
#' Bcoef_sh(estim)
#' @seealso \code{\link[vars]{Bcoef}}
#' @export
Bcoef_sh <- function (x) {

  if (!inherits(x, "varest")) {
    stop("\nPlease provide an object inheriting class 'varest'.\n")
  }
  y.names <- names(x$varresult)
  x.names <- if (x$K > 0) {
    names(coef(x$varresult[[1]]))
  } else {
    character(0)
  }
  B <- matrix(0, nrow = x$K, ncol = length(x.names))
  if (is.null(x$restriction)) {
    for (i in 1:x$K) {
      B[i, ] <- coef(x$varresult[[i]])
    }
  }
  else if (!(is.null(x$restriction))) {
    for (i in 1:x$K) {
      restrictions <- x$restrictions
      restrictions[i, restrictions[i, ] == TRUE] <- coef(x$varresult[[i]])
      temp <- restrictions[i, ]
      B[i, ] <- temp
    }
  }
  colnames(B) <- x.names
  rownames(B) <- y.names
  return(B)
}