Merge branch 'main' of https://github.com/bsvars/bsvarSIGNs

bsvars · Jul 19, 2024 · 40c755f · 40c755f
2 parents 1e02e23 + eced40a
commit 40c755f
Show file tree

Hide file tree

Showing 2 changed files with 42 additions and 2 deletions.
diff --git a/R/compute.R b/R/compute.R
@@ -185,6 +185,14 @@ compute_fitted_values.PosteriorBSVARSIGN <- function(posterior) {
 #' @export
 compute_impulse_responses.PosteriorBSVARSIGN <- function(posterior, horizon, standardise = FALSE) {
 
+  if ( 
+    any(diag(posterior$last_draw$identification$sign_irf[,,1]) == 0) &
+    !is.na(any(diag(posterior$last_draw$identification$sign_irf[,,1]) == 0))
+  ) {
+    standardise = FALSE
+    message("Argument standardise is forcibly set to FALSE due to zero restrictions imposed on the diagonal element(s) of the on-impact impulse response matrix.")
+  }
+
   posterior_Theta0  = posterior$posterior$Theta0
   posterior_A       = posterior$posterior$A
   posterior_A       = aperm(posterior_A, c(2, 1, 3))
@@ -272,8 +280,16 @@ compute_historical_decompositions.PosteriorBSVARSIGN <- function(posterior, show
   p                 = posterior$last_draw$p
   S                 = dim(posterior_A)[3]
 
+  standardise       = TRUE
+  if ( 
+    any(diag(posterior$last_draw$identification$sign_irf[,,1]) == 0) &
+    !is.na(any(diag(posterior$last_draw$identification$sign_irf[,,1]) == 0))
+  ) {
+    standardise     = FALSE
+  }
+
   ss                = .Call(`_bsvarSIGNs_bsvarSIGNs_structural_shocks`, posterior_B, posterior_A, Y, X)
-  ir                = .Call(`_bsvarSIGNs_bsvarSIGNs_ir`, posterior_At, posterior_Theta0, T, p, TRUE)
+  ir                = .Call(`_bsvarSIGNs_bsvarSIGNs_ir`, posterior_At, posterior_Theta0, T, p, standardise)
   qqq               = .Call(`_bsvarSIGNs_bsvarSIGNs_hd`, ir, ss, show_progress)
 
   hd                = array(NA, c(N, N, T, S))
@@ -346,7 +362,15 @@ compute_variance_decompositions.PosteriorBSVARSIGN <- function(posterior, horizo
   p                 = posterior$last_draw$p
   S                 = dim(posterior_A)[3]
 
-  posterior_irf     = .Call(`_bsvarSIGNs_bsvarSIGNs_ir`, posterior_A, posterior_Theta0, horizon, p, TRUE)
+  standardise       = TRUE
+  if ( 
+    any(diag(posterior$last_draw$identification$sign_irf[,,1]) == 0) &
+    !is.na(any(diag(posterior$last_draw$identification$sign_irf[,,1]) == 0))
+  ) {
+    standardise     = FALSE
+  }
+
+  posterior_irf     = .Call(`_bsvarSIGNs_bsvarSIGNs_ir`, posterior_A, posterior_Theta0, horizon, p, standardise)
   qqq               = .Call(`_bsvarSIGNs_bsvarSIGNs_fevd`, posterior_irf)
 
   fevd              = array(NA, c(N, N, horizon + 1, S))

diff --git a/inst/tinytest/test_compute_impulse_responses.R b/inst/tinytest/test_compute_impulse_responses.R
@@ -60,3 +60,19 @@ expect_identical(
   info = "compute_impulse_responses: identical for normal and pipe workflow."
 )
 
+
+# zero IRF on the main diagonal 
+
+set.seed(1)
+suppressMessages(
+  specification_no1 <- specify_bsvarSIGN$new(optimism, sign_irf = matrix(c(0,rep(NA, 24)),5,5))
+)
+run_no1             <- estimate(specification_no1, 3, 1, show_progress = FALSE)
+
+expect_message(
+  compute_impulse_responses(run_no1, horizon = 2, standardise = TRUE),
+  pattern = "zero",
+  info = "compute_impulse_responses: zero IRF on the main diagonal and IRF standarisation"
+)
+
+