.libPaths('C:/Users/user/R/win-library/4.6')
suppressMessages(library(vars))
# --- Long-run restrictions via vars::BQ (Blanchard-Quah) ---
b <- read.csv('bq_data.csv')
vb <- VAR(b[, c('gdp_growth', 'unemp')], p = 2, type = 'const')
bq <- BQ(vb)                                                # Blanchard-Quah SVAR (long-run identification)
ir <- irf(bq, n.ahead = 40, ortho = TRUE, boot = FALSE)
cum1 <- cumsum(ir$irf$gdp_growth[, 'gdp_growth'])           # cumulative output to shock 1 (permanent)
cum2 <- cumsum(ir$irf$unemp[, 'gdp_growth'])               # cumulative output to shock 2 (transitory)
s1 <- sign(cum1[1]); s2 <- sign(cum2[1])
cat('Blanchard-Quah via vars::BQ -- cumulative OUTPUT level response:\n')
cat(sprintf('  shock 1: h=0,20,40 = %s   (permanent)\n', paste(round(s1*cum1[c(1,21,41)], 2), collapse=' ')))
cat(sprintf('  shock 2: h=0,20,40 = %s   (transitory -> ~0)\n', paste(round(s2*cum2[c(1,21,41)], 2), collapse=' ')))
cat('cross-check -> Python (Minnesota lam2=0.5): permanent [2.4,2.6,2.5], transitory [2.2,0.6,0.1]  (agree closely: one shock permanent at ~2.4%, one transitory to ~0)\n')

Warning message:
"package 'vars' was built under R version 4.6.1"

Warning message:
"package 'strucchange' was built under R version 4.6.1"

Blanchard-Quah via vars::BQ -- cumulative OUTPUT level response:

  shock 1: h=0,20,40 = 2.33 2.28 2.24   (permanent)

  shock 2: h=0,20,40 = 2.2 0.04 -0.01   (transitory -> ~0)

cross-check -> Python (Minnesota lam2=0.5): permanent [2.4,2.6,2.5], transitory [2.2,0.6,0.1]  (agree closely: one shock permanent at ~2.4%, one transitory to ~0)

# --- External-instrument (proxy) SVAR, done by hand (mirror of svar_id.proxy_svar) ---
d <- read.csv('ramey_monetary_data.csv')
Y <- cbind(d$LIP*100, d$UNEMP, d$LCPI*100, d$LPCOM*100, d$FFR)
colnames(Y) <- c('logIP','Unemp','logCPI','logPcom','FFR'); p <- 12; H <- 48
vr <- VAR(as.data.frame(Y), p = p, type = 'const')
U <- residuals(vr)                                          # reduced-form residuals (T-p, m)
z <- d$RRSHOCK[(p + 1):nrow(Y)]; z <- z - mean(z)          # instrument aligned to residual rows
bvec <- as.numeric((t(U) %*% z) / sum(z^2)); bvec <- bvec / bvec[5]   # impact vector, FFR normalized to 1
Ph <- Phi(vr, nstep = H)
irfP <- t(sapply(1:(H + 1), function(h) Ph[, , h] %*% bvec))          # proxy IRF (H+1, m)
cat('Proxy-SVAR (Romer-Romer instrument), +1pp FFR tightening:\n')
cat(sprintf('  output (log IP) trough: %.2f%% at month %d   (large contraction)\n', min(irfP[,1]), which.min(irfP[,1]) - 1))
cat(sprintf('  CPI response at 24m: %.2f%%   (price puzzle persists)\n', irfP[25, 3]))
cat('cross-check -> Python proxy: IP trough -1.16%, CPI +0.69%  (agree)\n')

options(repr.plot.width = 12, repr.plot.height = 3.4); par(mfrow = c(1, 3))
for (i in c(1, 3, 5)) { plot(0:H, irfP[, i], type='l', col='darkgreen', lwd=2, xlab='months', ylab='',
  main=paste('Response of', colnames(Y)[i])); abline(h=0, col='grey60') }

Proxy-SVAR (Romer-Romer instrument), +1pp FFR tightening:

  output (log IP) trough: -1.31% at month 31   (large contraction)

  CPI response at 24m: 0.80%   (price puzzle persists)

cross-check -> Python proxy: IP trough -1.16%, CPI +0.69%  (agree)

SVAR identification II — R cross-check¶

Vector autoregressions, Part 2b — Structural VAR (R cross-check)¶

Results¶

References¶