Structural VARs

A * X_t = β₀ + β₁ * X_{t−1} + u_t -> shock ortogonal u_t (Based on economic theory)

library(dplyr)
library(zoo)
library(vars)
library(ggplot2)
library(gridExtra)
library(tibble)
data <- read.csv("M5_Vector_Autoregression/MFx Module 5, Part II SVAR Workfile/MFx_Module 5_Part II_SVAR_Workfile_Sims.csv")

data$date <- as.yearqtr(as.Date(data$dateid01))

data <- data %>%
  mutate(
    ly = log(y),
    lm = log(m1),
    lp = log(cpi),
    lxr = log(xr),
    lcp = log(cmp)
  )

sample_data <- data %>%
  filter(date >= as.yearqtr("1958 Q4") & date <= as.yearqtr("1991 Q2"))


Background: Christopher Sims’ Price Puzzle

Sims argued that the shocks he had initially identified as exogenous were probably not totally exogenous, and that the Fed was probably reacting to other variables or leading indicators he had not considered in his first estimation. 

var1_data <- sample_data %>%
  dplyr::select(ly, lm, lp, ff) %>%
  na.omit()

var1_model <- VAR(var1_data, p = 14, type = "const")

# Compute impulse response functions
irf_var1 <- irf(var1_model, n.ahead = 35, boot = TRUE)
vars <- colnames(var1_data)

# Create IRF grid plots
plot_list <- list()
for (i in seq_along(vars)) {
  for (j in seq_along(vars)) {
    # Point estimate
    response <- irf_var1$irf[[vars[j]]][, i]
    
    # Estimate 1 S.E. from 95% CI, then scale to ±2 S.E.
    stderr <- (irf_var1$Upper[[vars[j]]][, i] - irf_var1$Lower[[vars[j]]][, i]) / 4
    
    df <- tibble(
      period = 1:length(response),
      response = response,
      upper = response + 2 * stderr,
      lower = response - 2 * stderr
    )
    
    p <- ggplot(df, aes(x = period, y = response)) +
      geom_line(color = "blue", size = 0.5) +
      geom_ribbon(aes(ymin = lower, ymax = upper), fill = "red", alpha = 0.3) +
      geom_hline(yintercept = 0, color = "black", linewidth = 0.4) +
      labs(title = paste("Response of", vars[i], "to", vars[j])) +
      theme_minimal(base_size = 9) +
      theme(
        plot.title = element_text(size = 9),
        axis.text = element_text(size = 7),
        axis.title = element_blank()
      )
    
    plot_list[[length(plot_list) + 1]] <- p
  }
}

# Combine in 4x4 grid
grid.arrange(grobs = plot_list, ncol = 4,
             top = "Response to Cholesky One S.D. Innovations ±2 S.E. (VAR1: ly, lm, lp, ff)")


The impulse response functions align with Sims’ interpretation that monetary policy shocks are not fully exogenous. The Federal Funds rate responds systematically to shocks, suggesting that the Fed adjusts interest rates in reaction to broader economic conditions—consistent with Sims’ later view that what appeared to be exogenous policy shifts may in fact reflect endogenous responses to variables or indicators omitted from the initial model.

Sims modifed the VAR by including commodity prices and exchange rate to better isolate purely exogenous shocks and mitigate the price puzzle. 

var2_data <- sample_data %>%
  dplyr::select(ly, lm, lp, lxr, lcp, ff) %>%
  na.omit()

var2_model <- VAR(var2_data, p = 14, type = "const")
irf_var2 <- irf(var2_model, n.ahead = 35, boot = TRUE)
vars <- colnames(var2_data)

plot_list <- list()
for (i in seq_along(vars)) {
  for (j in seq_along(vars)) {
    response <- irf_var2$irf[[vars[j]]][, i]
    
    # Estimate 1 S.E. and then ±2 S.E. bounds
    stderr <- (irf_var2$Upper[[vars[j]]][, i] - irf_var2$Lower[[vars[j]]][, i]) / 4
    
    df <- tibble(
      period = 1:length(response),
      response = response,
      upper = response + 2 * stderr,
      lower = response - 2 * stderr
    )
    
    p <- ggplot(df, aes(x = period, y = response)) +
      geom_line(color = "blue", size = 0.5) +
      geom_ribbon(aes(ymin = lower, ymax = upper), fill = "red", alpha = 0.3) +
      geom_hline(yintercept = 0, color = "black", linewidth = 0.4) +
      labs(title = paste("Response of", vars[i], "to", vars[j])) +
      theme_minimal(base_size = 8) +
      theme(
        plot.title = element_text(size = 8),
        axis.text = element_text(size = 6),
        axis.title = element_blank()
      )
    
    plot_list[[length(plot_list) + 1]] <- p
  }
}

grid.arrange(grobs = plot_list, ncol = 6,
             top = "Response to Cholesky One S.D. Innovations +/- 2 S.E. (VAR2: ly, lm, lp, lxr, lcp, ff)")

resp1 <- irf_var1$irf$ff[1:35, 3]
stderr1 <- (irf_var1$Upper$ff[1:35, 3] - irf_var1$Lower$ff[1:35, 3]) / 4

resp2 <- irf_var2$irf$ff[1:35, 3]
stderr2 <- (irf_var2$Upper$ff[1:35, 3] - irf_var2$Lower$ff[1:35, 3]) / 4

df1 <- tibble(
  period = 1:35,
  response = resp1,
  upper = resp1 + 2 * stderr1,
  lower = resp1 - 2 * stderr1
)

df2 <- tibble(
  period = 1:35,
  response = resp2,
  upper = resp2 + 2 * stderr2,
  lower = resp2 - 2 * stderr2
)

p1 <- ggplot(df1, aes(x = period, y = response)) +
  geom_line(color = "blue", linewidth = 0.6) +
  geom_ribbon(aes(ymin = lower, ymax = upper), fill = "red", alpha = 0.3) +
  geom_hline(yintercept = 0, color = "black", linewidth = 0.4) +
  labs(title = "Response of lp to ff\nVAR1: No CP/XR", y = "IRF", x = "Period") +
  theme_minimal(base_size = 10)

p2 <- ggplot(df2, aes(x = period, y = response)) +
  geom_line(color = "blue", linewidth = 0.6) +
  geom_ribbon(aes(ymin = lower, ymax = upper), fill = "red", alpha = 0.3) +
  geom_hline(yintercept = 0, color = "black", linewidth = 0.4) +
  labs(title = "Response of lp to ff\nVAR2: With CP/XR", y = "IRF", x = "Period") +
  theme_minimal(base_size = 10)

grid.arrange(p1, p2, ncol = 2,
             top = "Price Response to Monetary Policy Shock (Cholesky IRF +/- 2 S.E., 35 Periods")

This is still WIP. It seems that Var2 which includes commodity prices and exchange rate did not resolve the price puzzle.