R/Bcoef_sh.R

In VARshrink: Shrinkage Estimation Methods for Vector Autoregressive Models

#' Coefficient matrix of an estimated VAR(p)
#'
#' Returns the estimated coefficients of a VAR(p) model as a matrix.
#'
#' Consider VAR(p) model:
#' \deqn{\mathbf{y}_t = \mathbf{A}_1 \mathbf{y}_{t-1} + ... + \mathbf{A}_p
#' \mathbf{y}_{t-p} + \mathbf{C} \mathbf{d}_t + \mathbf{e}_t.}
#' The function returns the concatenated matrix \eqn{(\mathbf{A}_1, ...,
#' \mathbf{A}_p, \mathbf{C})} as a matrix object.
#'
#' This function modifies \code{vars::Bcoef()} for the class "varshrinkest",
#' preventing redundant copying of data matrix objects.
#'
#' @param x An object of class "varshrinkest" generated by \code{VARshrink()}.
#' @returns 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)
}