# Pacotes necessários (ordem alfabética)
library(devtools)
library(dplyr)
library(ggplot2)
library(gridExtra)
library(httr)
library(knitr)
library(lmtest)
library(lubridate)
library(patchwork)
library(readxl)
library(sandwich)
library(stargazer)
library(tidyr)
library(tseries)
library(VARsignR)
library(varexternal)
library(varexternalinstrument)
library(vars)
library(zoo)
# Função auxiliar: extrai IRFs em data frame (Cholesky)
devtools::source_url('https://raw.githubusercontent.com/anguyen1210/var-tools/master/R/extract_varirf.R')
# Download único do Excel (GitHub)
.download_excel <- function(url){
tf <- tempfile(fileext = ".xlsx")
httr::GET(url, httr::write_disk(tf, overwrite = TRUE))
tf
}
DATA_URL_MAIN <- "https://github.com/josevictorsl/econometriaaplicadaeesp/raw/main/data_ea2_gk.xlsx"
# Função: tabela ADF para várias séries (colunas) (usa nomes p_value)
adf_tabela <- function(mat, alpha = 0.05) {
mat <- as.data.frame(mat)
if (is.null(colnames(mat))) colnames(mat) <- paste0("V", seq_len(ncol(mat)))
rows <- lapply(seq_along(mat), function(i) {
x <- mat[[i]]
x <- x[is.finite(x)]
teste <- tryCatch(tseries::adf.test(x), error = function(e) NULL)
if (is.null(teste)) {
data.frame(
Variavel = names(mat)[i],
Estatistica = NA_real_,
p_value = NA_real_,
Decisao = "Erro no teste"
)
} else {
data.frame(
Variavel = names(mat)[i],
Estatistica = unname(teste$statistic),
p_value = teste$p.value,
Decisao = ifelse(
teste$p.value < alpha,
"Estacionário",
"Não estacionário"
)
)
}
})
dplyr::bind_rows(rows) %>%
dplyr::mutate(
Estatistica = round(Estatistica, 4),
p_value = round(p_value, 4)
) %>%
dplyr::select(Variavel, Estatistica, p_value, Decisao)
}
set.seed(20092004) # Seed
#| label: util-graficos
# Rótulos amigáveis (séries e instrumentos)
rotulos_series <- c(
logip = "Produção Industrial (log)",
logcpi = "Índice de Preços (log)",
gs1 = "Juro 1 ano",
ebp = "Prêmio Excedente de Títulos (EBP)",
ff = "Fed Funds",
mortg_spread_m = "Spread Hipoteca",
cp3m_spread_m = "Spread CP 3m"
)
rotulos_instrumentos <- c(
ff1_tc = "Surpresa FF1",
ff4_tc = "Surpresa FF4",
ed2_tc = "Surpresa ED2",
ed3_tc = "Surpresa ED3",
ed4_tc = "Surpresa ED4"
)
# Função: plota IRF (nível ou acumulada) com intervalo
# Args: df, y, lower, upper, titulo, cumulativo
COR_LINHA_PADRAO <- "#07304bff"
COR_ZERO <- "#000000ff"
COR_RIBBON <- "#4da2dbff"
plot_irf_intervalo <- function(df, y, lower, upper, titulo, cumulativo = FALSE) {
if (cumulativo) {
df <- df %>%
dplyr::arrange(period) %>%
dplyr::mutate(
!!y := cumsum(.data[[y]]),
!!lower := cumsum(.data[[lower]]),
!!upper := cumsum(.data[[upper]])
)
}
ggplot(df, aes(x = period, y = .data[[y]], ymin = .data[[lower]], ymax = .data[[upper]])) +
geom_hline(yintercept = 0, color = COR_ZERO, linewidth = 0.5) +
geom_ribbon(fill = scales::alpha(COR_RIBBON, 0.10), colour = COR_LINHA_PADRAO, linewidth = 0.4, linetype = "dashed") +
geom_line(linewidth = 0.9, colour = COR_LINHA_PADRAO) +
ggtitle(titulo) + xlab("Horizonte") + ylab("Resposta")
}
# Tema global: opções de temas
temas_disponiveis <- list(
minimal = ggplot2::theme_minimal(base_size = 12),
bw = ggplot2::theme_bw(base_size = 12),
classic = ggplot2::theme_classic(base_size = 12),
light = ggplot2::theme_light(base_size = 12)
)
# Função: define tema global (centraliza título, formata tiras)
definir_tema <- function(nome = "minimal") {
base <- temas_disponiveis[[nome]]
if (is.null(base)) {
warning(sprintf("Tema '%s' não encontrado. Usando 'minimal'.", nome))
base <- temas_disponiveis$minimal
}
tema_final <- base +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
strip.background = element_rect(fill = "grey90", colour = "grey60"),
strip.text = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
theme_set(tema_final)
invisible(tema_final)
}
# Tema selecionado (alterar aqui para trocar)
definir_tema("bw")Econometria Aplicada - Exercício 2 (IV em VAR)
1 Introdução
O objetivo deste relatório é reproduzir os resultados de Gertler e Karadi, cuja contribuição reside em avançar a identificação de parâmetros estruturais usando variáveis instrumentais construídas a partir de surpresas de política monetária em janelas de alta frequência. A estratégia permite isolar efeitos causais sobre produção industrial, inflação e o prêmio excedente de títulos (excess bond premium). Além disso, o estudo original inclui diversos exercícios de robustez para verificar se as conclusões permanecem válidas sob especificações alternativas.
1.1 Ambiente e pacotes
2 Dados e instrumentalidade
O painel de dados tem periodicidade mensal e cobre o intervalo jul/1979–jun/2016. O ponto inicial coincide com a entrada de Paul Volcker no Federal Reserve, usualmente associada a uma inflexão na condução da política monetária. Entre as variáveis figuram: produção industrial e índices de preços em log; taxa dos fed funds; yields soberanos; a 5-year forward rate (5y5y); o excess bond premium (EBP); o commercial paper spread; e expectativas para a fed funds rate a 1 ano. A evolução dessas séries encontra-se sintetizada em Figura 1.
No caso dos instrumentos externos, a informação só está disponível após 1979 e algumas curvas começam mais tarde (por exemplo, determinadas séries apenas em 1984, outras em 1988 ou 1990). Utilizamos surpresas extraídas de contratos futuros de fed funds e de eurodólar em vários horizontes/maturidades, conforme ilustrado em Figura 2.
Por que recorrer a choques de alta frequência? Surpresas em janelas estreitas ao redor dos anúncios do FOMC funcionam como aproximações de variações não antecipadas de política, permitindo tratar o movimento observado como exógeno a outros choques macro no mesmo instante. Isso reduz substancialmente a probabilidade de desorientação por eventos simultâneos e mitiga problemas de endogeneidade associados a respostas previsíveis do banco central.
# Download do Excel (uma única vez)
tf_xlsx <- .download_excel(DATA_URL_MAIN)
# Leitura das abas
base_raw <- readxl::read_excel(tf_xlsx, sheet = "VAR_data")
instrumentos_raw <- readxl::read_excel(tf_xlsx, sheet = "Instruments")
# Normaliza datas
if (!"date" %in% names(base_raw)) {
if (all(c("year","month") %in% names(base_raw))) {
base <- base_raw %>% mutate(date = ym(paste0(year, "-", month)))
} else stop("A aba VAR_data precisa de 'year' e 'month' ou 'date'.")
} else {
base <- base_raw %>% mutate(date = ym(as.character(date)))
}
if (!"date" %in% names(instrumentos_raw)) {
if (all(c("year","month") %in% names(instrumentos_raw))) {
instrumentos <- instrumentos_raw %>% mutate(date = ym(paste0(year, "-", month)))
} else stop("A aba Instruments precisa de 'year' e 'month' ou 'date'.")
} else {
instrumentos <- instrumentos_raw %>% mutate(date = ym(as.character(date)))
}
# Gráfico: séries principais
label_safe <- function(x, mapa) {
unname(ifelse(x %in% names(mapa), mapa[x], x))
}
g_base <- base %>%
dplyr::select(-any_of(c("year","month"))) %>%
pivot_longer(cols = -date) %>%
mutate(name_lab = label_safe(name, rotulos_series)) %>%
ggplot(aes(x = date, y = value)) +
geom_line(color = COR_LINHA_PADRAO, linewidth = 0.7) +
xlab("") + ylab("Nível / Log / Spread") +
facet_wrap(~ name_lab, ncol = 3, scales = "free")
print(g_base)
g_instr <- instrumentos %>%
dplyr::select(-any_of(c("year","month"))) %>%
pivot_longer(cols = -date) %>%
ggplot(aes(x = date, y = value)) +
geom_line(color = COR_LINHA_PADRAO, linewidth = 0.7) +
xlab("") + ylab("Valor") +
facet_wrap(~ name, ncol = 3, scales = "free",
labeller = as_labeller(rotulos_instrumentos))
print(g_instr)
3 VAR
Iniciada a descrição das séries, avançamos para a etapa de estimação. O modelo de referência é um VAR com quatro blocos: produção industrial (logip), nível de preços (logcpi), taxa de juro de 1 ano (gs1) e excess bond premium (ebp), especificado com 12 defasagens e termo constante, replicando a configuração do estudo original. Como rotina de verificação, primeiro obtemos os resíduos de cada equação e aplicamos o teste ADF a eles; em seguida examinamos as funções ACF e PACF do choque monetário (resíduo da equação de gs1) para detectar eventuais padrões remanescentes de autocorrelação. A tabela ADF reportada abaixo resume estatística, p‑valor e decisão para cada equação, a leitura deve partir desses números, evitando conclusões ex ante sobre rejeição ou não da hipótese nula de raiz unitária.
# Estima VAR principal (12 defasagens, constante)
modelo_var <- base %>%
dplyr::select(logip, logcpi, gs1, ebp) %>%
VAR(p = 12, type = "const")
# Extração dos resíduos do VAR principal
residuos <- residuals(modelo_var)
# Tabela ADF dos resíduos para verificar estacionariedade
tabela_adf_residuos <- adf_tabela(residuos)
knitr::kable(
tabela_adf_residuos,
col.names = c("Variável", "Estatística", "p-valor", "Decisão"),
caption = "Teste ADF nos resíduos do VAR base (H0: raiz unitária)."
)| Variável | Estatística | p-valor | Decisão |
|---|---|---|---|
| logip | -6.5719 | 0.01 | Estacionário |
| logcpi | -7.3234 | 0.01 | Estacionário |
| gs1 | -7.0468 | 0.01 | Estacionário |
| ebp | -6.9637 | 0.01 | Estacionário |
choques <- modelo_var$varresult$gs1$residuals # Choques monetários (resíduo eq. gs1)
par(mfrow = c(1,2))
acf(choques, main = "ACF dos choques (gs1)")
pacf(choques, main = "PACF dos choques (gs1)")
par(mfrow = c(1,1))
Os resultados gráficos de ACF/PACF para o choque monetário aparecem em Figura 3 logo após a estimação, confirmando visualmente o diagnóstico complementar ao teste ADF.
De posse do VAR, introduzimos então o primeiro estágio do procedimento de variáveis instrumentais. Em termos gerais:
\[ \begin{aligned} X_t &= \alpha + \beta Z_t + \kappa W_t + \varepsilon_t, \\ Y_t &= \omega + \theta \hat{X}_t + \gamma S_t + \upsilon_t. \end{aligned} \]
Na interpretação adotada aqui, \(X_t\) corresponde ao choque monetário extraído (resíduo da equação da taxa de 1 ano, gs1), enquanto \(Y_t\) abrange as variáveis cujo comportamento dinâmico será avaliado por meio das IRFs (por exemplo, logip, logcpi, ebp). O vetor \(Z_t\) reúne os instrumentos de alta frequência (surpresas em futuros) e \(W_t, S_t\) representam potenciais controles adicionais quando presentes.
3.1 Força dos instrumentos
# Para alinhar p = 12, descartamos as 12 primeiras observações dos instrumentos
instrumentos_adj <- instrumentos %>% dplyr::slice(13:n())
reg_ff1 <- lm(choques ~ 0 + ff1_tc, data = instrumentos_adj)
reg_ff4 <- lm(choques ~ 0 + ff4_tc, data = instrumentos_adj)
reg_ed4 <- lm(choques ~ 0 + ed4_tc, data = instrumentos_adj)
reg_ff4_ed4 <- lm(choques ~ 0 + ff4_tc + ed4_tc, data = instrumentos_adj)
reg_all <- lm(choques ~ 0 + ff1_tc + ff4_tc + ed2_tc + ed3_tc + ed4_tc, data = instrumentos_adj)
stargazer(reg_ff1, reg_ff4, reg_ed4, reg_ff4_ed4, reg_all,
type = "text", header = FALSE, single.row = TRUE,
no.space = TRUE, column.sep.width = "0.5pt",
title = "Regressões de primeiro estágio (regra de bolso: F > 10)")
Regressões de primeiro estágio (regra de bolso: F > 10)
=========================================================================================================================================
Dependent variable:
---------------------------------------------------------------------------------------------------------------------
choques
(1) (2) (3) (4) (5)
-----------------------------------------------------------------------------------------------------------------------------------------
ff1_tc 0.890*** (0.194) 0.264 (0.374)
ff4_tc 1.062*** (0.236) 1.165*** (0.319) 1.138** (0.494)
ed2_tc 1.591 (1.180)
ed3_tc -4.190** (1.651)
ed4_tc 0.593*** (0.219) -0.149 (0.309) 2.373** (1.026)
-----------------------------------------------------------------------------------------------------------------------------------------
Observations 284 270 342 270 270
R2 0.069 0.070 0.021 0.071 0.097
Adjusted R2 0.066 0.067 0.018 0.064 0.079
Residual Std. Error 0.199 (df = 283) 0.194 (df = 269) 0.230 (df = 341) 0.195 (df = 268) 0.193 (df = 265)
F Statistic 21.060*** (df = 1; 283) 20.322*** (df = 1; 269) 7.342*** (df = 1; 341) 10.247*** (df = 2; 268) 5.663*** (df = 5; 265)
=========================================================================================================================================
Note: *p<0.1; **p<0.05; ***p<0.01# Tabela de estatísticas F (clássica, HC e HAC) para relevância dos instrumentos
extrai_F <- function(modelo, vars){
# F clássico
f_class <- unname(summary(modelo)$fstatistic[1])
# F robusto HC
f_hc <- if (length(vars) == 1) {
lmtest::waldtest(modelo, vars, vcov = sandwich::vcovHC)[2, "F"]
} else {
lmtest::waldtest(modelo, vars, vcov = sandwich::vcovHC)[2, "F"]
}
# F robusto HAC (Newey-West)
f_hac <- lmtest::waldtest(modelo, vars, vcov = sandwich::vcovHAC)[2, "F"]
c(F = f_class, F_HC = f_hc, F_HAC = f_hac)
}
f_mat <- rbind(
FF1 = extrai_F(reg_ff1, "ff1_tc"),
FF4 = extrai_F(reg_ff4, "ff4_tc"),
ED4 = extrai_F(reg_ed4, "ed4_tc"),
FF4_ED4 = extrai_F(reg_ff4_ed4, c("ff4_tc","ed4_tc")),
TODOS = extrai_F(reg_all, c("ff1_tc","ff4_tc","ed2_tc","ed3_tc","ed4_tc"))
)
f_df <- as.data.frame(f_mat) %>%
dplyr::select(everything()) %>%
dplyr::mutate(across(everything(), ~round(., 2)))
knitr::kable(
f_df,
caption = "Estatísticas F (clássica, HC e HAC) para testes de relevância dos instrumentos no primeiro estágio. {#tbl-fstats}",
col.names = c("F","F (HC)","F (HAC)")
)| F | F (HC) | F (HAC) | |
|---|---|---|---|
| FF1 | 21.06 | 18.43 | 26.28 |
| FF4 | 20.32 | 14.58 | 17.65 |
| ED4 | 7.34 | 5.98 | 6.22 |
| FF4_ED4 | 10.25 | 8.32 | 10.28 |
| TODOS | 5.66 | 5.53 | 7.60 |
Estatísticas F dos modelos de primeiro estágio
A relevância dos instrumentos externos foi examinada a partir de regressões do choque monetário (resíduos da equação de política para gs1) sobre cada surpresa de alta frequência (FF1, FF4, ED2, ED3, ED4) e sobre combinações selecionadas. Para cada especificação reportamos três versões da estatística F: (i) a forma “clássica” da decomposição ANOVA, (ii) a versão robusta a heterocedasticidade (HC) e (iii) a estatística robusta conjunta a heterocedasticidade e autocorrelação (HAC/Newey–West). Os valores estão sumarizados na Tabela 1.
Observa-se que FF1 e, sobretudo, FF4 exibem estatísticas F elevadas e bastante estáveis entre as correções HC e HAC, tanto isoladamente quanto quando FF4 é combinado a ED4. Isso sugere potência explicativa substantiva sobre a inovação monetária identificada. Em contraste, ED4 isolado e a especificação saturada com todos os instrumentos apresentam valores mais modestos, indicando possível diluição de sinal (redução de F típica quando a colinearidade entre instrumentos cresce). A regra de bolso usual (F > 10) é confortavelmente atendida pelos principais candidatos (FF1/FF4), alinhando-se à evidência recorrente de que surpresas de curto horizonte nos futuros de fed funds concentram a maior parte da informação de política de alta frequência.
4 Benchmark: Decomposição de Cholesky
Antes dos resultados com IV, estimamos um SVAR recursivo (Cholesky) com ordenação logip → logcpi → gs1 → ebp. Tradicionalmente, observa-se o price puzzle na inflação após um choque contracionista; os resultados abaixo servem de benchmark.
A0 <- matrix(NA, 4, 4) # Matriz de restrições contemporâneas
A0[1, 2:4] <- 0 # Produção não responde contemporaneamente às demais
A0[2, 3:4] <- 0 # Preços não respondem a gs1 e ebp no mesmo período
A0[3, 4] <- 0 # gs1 não responde a ebp no mesmo período
# Estimação do SVAR recursivo (Cholesky)
svar_cholesky <- SVAR(modelo_var, Amat = A0, Bmat = NULL)
# IRFs do SVAR (choque em gs1)
irf_cholesky_df <- irf(svar_cholesky, impulse = "gs1", n.ahead = 50,
ortho = TRUE, boot = TRUE) %>%
extract_varirf()
g_irf_juro <- plot_irf_intervalo(irf_cholesky_df, "irf_gs1_gs1", "lower_gs1_gs1", "upper_gs1_gs1", rotulos_series["gs1"])
g_irf_ip <- plot_irf_intervalo(irf_cholesky_df, "irf_gs1_logip", "lower_gs1_logip", "upper_gs1_logip", rotulos_series["logip"])
g_irf_cpi <- plot_irf_intervalo(irf_cholesky_df, "irf_gs1_logcpi", "lower_gs1_logcpi", "upper_gs1_logcpi", rotulos_series["logcpi"])
g_irf_ebp <- plot_irf_intervalo(irf_cholesky_df, "irf_gs1_ebp", "lower_gs1_ebp", "upper_gs1_ebp", rotulos_series["ebp"])
gridExtra::grid.arrange(g_irf_juro, g_irf_ip, g_irf_cpi, g_irf_ebp, top = "Choque monetário (Cholesky)")
Observa-se o price puzzle: pela teoria, um choque contracionista deveria reduzir preços, mas a IRF do CPI tende a subir no curto prazo, tornando-se negativa apenas após cerca de dois anos e meio. Para a atividade, também se esperaria retração. Esse tensionamento entre teoria e evidência motiva o uso de instrumentos externos para identificação.
Uma justificativa para a ordenação acima pode ser inspirada em um modelo novo-keynesiano com IS, Phillips e Taylor:
\[ \begin{aligned} x_t &= \mathbb{E}_t[x_{t+1}] - \frac{1}{\sigma}\Big(i_t - \mathbb{E}_t[\pi_{t+1}] - r_t\Big), \\ \pi_t &= \beta \, \mathbb{E}_t[\pi_{t+1}] + \kappa \, x_t, \\ i_t &= \rho + \phi_\pi \, \pi_t + \phi_y \, x_t + \upsilon_t. \end{aligned} \]
5 Variáveis instrumentais (IV) — resultados principais
Com base no primeiro estágio, usamos FF4 (e, como comparação, FF1) como instrumentos externos para identificar choques monetários. O painel Figura 4 ilustra as IRFs sem intervalos (apenas para visualização). As conclusões estatísticas devem ser baseadas em Figura 5, que apresenta intervalos de confiança. Nessa figura com ICs, costuma-se observar (quando estatisticamente significativo) a atenuação do price puzzle e resposta positiva do EBP após um aperto monetário, em linha com a literatura.
# Choques IV (externalinstrument)
IV_ff4 <- externalinstrument(modelo_var, instrument = instrumentos$ff4_tc, "gs1") # Vetor choque (FF4)
IV_ff1 <- externalinstrument(modelo_var, instrument = instrumentos$ff1_tc, "gs1") # Vetor choque (FF1)
Phi_50 <- Phi(modelo_var, 50) # Matrizes de impulso para 50 horizontes
# IRFs estruturais (FF4)
irf_instr_ff4 <- Phi_50 %>%
apply(3, function(x) x %*% IV_ff4) %>% # Multiplica cada Phi(h) pelo vetor estrutural
t() %>%
as.data.frame()
names(irf_instr_ff4) <- names(IV_ff4)
# IRFs estruturais (FF1)
irf_instr_ff1 <- Phi_50 %>%
apply(3, function(x) x %*% IV_ff1) %>%
t() %>%
as.data.frame()
names(irf_instr_ff1) <- names(IV_ff1)irf_instr_ff4 %>%
mutate(horizon = 0:50) %>%
pivot_longer(cols = -horizon, names_to = "variavel", values_to = "resposta") %>%
mutate(rotulo = label_safe(variavel, rotulos_series)) %>%
ggplot(aes(x = horizon, y = resposta)) +
geom_hline(yintercept = 0, colour = COR_ZERO, linewidth = 0.5) +
geom_line(colour = COR_LINHA_PADRAO, linewidth = 0.9) +
xlab("Horizonte") + ylab("Resposta") +
facet_wrap(~ rotulo, scales = "free")
Para intervalos de confiança, usamos SVARIV (pacote varexternal) com FF4 como instrumento.
# Prepara dados para SVARIV
varb <- cbind(base$logip, base$logcpi, base$gs1, base$ebp)
ff4_tc <- na.trim(instrumentos$ff4_tc)
varb <- as.data.frame(varb)
varbcut <- varb %>% dplyr::slice(127:n()) %>% ts()
IVp <- SVARIV(
ydata = varbcut,
z = ff4_tc,
p = 12,
confidence = c(0.8),
NWlags = 0,
norm = 3, # choque em gs1
scale = 1,
horizons = 50,
ci_type = c("msw"),
print_wald = TRUE,
instrument_name = "FF4"
)
sh.col <- COR_LINHA_PADRAO; names(sh.col) <- c("FF4")
plots <- pretty_irf(
data = list(IVp$irfs),
shock_names = "FF4",
pretty_names = unname(rotulos_series[c("logip","logcpi","gs1","ebp")]),
cum = FALSE,
confidence_type = "msw",
manual_color = sh.col,
legend = FALSE,
title = NULL,
same_scale = FALSE,
shock_sign = "positive"
) + patchwork::plot_layout(ncol = 2)
plots
6 Extensão: spreads de hipoteca e commercial paper
Em linha com a Figura 7 do paper, como extensão, ampliamos o VAR incluindo mortg_spread_m e cp3m_spread_m, e comparamos com a versão que usa fed funds no lugar de gs1. Mantemos FF4 como instrumento. Os resíduos seguem estacionários (vide ADFs abaixo). Em geral, gs1 mostra impactos relativamente maiores sobre variáveis de crédito.
var2 <- base %>%
dplyr::select(logip, logcpi, gs1, ebp, mortg_spread_m, cp3m_spread_m) %>%
VAR(p = 12, type = "const")
# ADF (resíduos) -> TABELA
resid2 <- residuals(var2)
adf_resid2_tbl <- adf_tabela(resid2)
knitr::kable(
adf_resid2_tbl,
col.names = c("Variável", "Estatística", "p-valor", "Decisão"),
caption = "Teste ADF nos resíduos do VAR com spreads (GS1)."
)| Variável | Estatística | p-valor | Decisão |
|---|---|---|---|
| logip | -6.6435 | 0.01 | Estacionário |
| logcpi | -7.2328 | 0.01 | Estacionário |
| gs1 | -7.1719 | 0.01 | Estacionário |
| ebp | -6.8767 | 0.01 | Estacionário |
| mortg_spread_m | -7.6531 | 0.01 | Estacionário |
| cp3m_spread_m | -6.7602 | 0.01 | Estacionário |
Extensão (GS1 no VAR) com FF4 como instrumento
# IRFs com IV + ICs (norm = 3 porque o choque é em gs1)
varb2 <- cbind(base$logip, base$logcpi, base$gs1, base$ebp,
base$mortg_spread_m, base$cp3m_spread_m)
varb2 <- as.data.frame(varb2)
varbcut2 <- varb2 %>% dplyr::slice(127:n()) %>% ts()
IVp2 <- SVARIV(
ydata = varbcut2,
z = ff4_tc,
p = 12,
confidence = c(0.8),
NWlags = 0,
norm = 3,
scale = 1,
horizons = 50,
ci_type = c("msw"),
print_wald = TRUE,
instrument_name = "FF4"
)
plots2 <- pretty_irf(
data = list(IVp2$irfs),
shock_names = "FF4",
pretty_names = c(rotulos_series["logip"], rotulos_series["logcpi"], rotulos_series["gs1"], rotulos_series["ebp"], rotulos_series["mortg_spread_m"], rotulos_series["cp3m_spread_m"]),
cum = FALSE,
confidence_type = "msw",
manual_color = sh.col,
legend = FALSE,
title = NULL,
same_scale = FALSE,
shock_sign = "positive"
) + patchwork::plot_layout(ncol = 2)
plots2
Para comparação, repetimos a extensão com fed funds (ff) no lugar de gs1.
varc <- cbind(
logip = base$logip,
logcpi = base$logcpi,
ff = base$ff,
ebp = base$ebp,
mortg_spread_m = base$mortg_spread_m,
cp3m_spread_m = base$cp3m_spread_m
)
var3 <- VAR(varc, p = 12, type = "const")
# ADF (resíduos) -> TABELA
resid3 <- residuals(var3)
adf_resid3_tbl <- adf_tabela(resid3)
knitr::kable(
adf_resid3_tbl,
col.names = c("Variável", "Estatística", "p-valor", "Decisão"),
caption = "Teste ADF nos resíduos do VAR com spreads (FF)."
)| Variável | Estatística | p-valor | Decisão |
|---|---|---|---|
| logip | -6.6597 | 0.01 | Estacionário |
| logcpi | -7.2717 | 0.01 | Estacionário |
| ff | -6.5786 | 0.01 | Estacionário |
| ebp | -6.8135 | 0.01 | Estacionário |
| mortg_spread_m | -6.8852 | 0.01 | Estacionário |
| cp3m_spread_m | -6.8318 | 0.01 | Estacionário |
Extensão (FF no VAR) com FF4 como instrumento
# IRFs (IV+ICs) — choque em FF (3ª posição) -> norm = 3
varc <- as.data.frame(varc)
varccut <- varc %>% dplyr::slice(127:n()) %>% ts()
IVff <- SVARIV(
ydata = varccut,
z = ff4_tc,
p = 12,
confidence = c(0.9),
NWlags = 0,
norm = 3,
scale = 1,
horizons = 50,
ci_type = c("msw"),
print_wald = TRUE,
instrument_name = "FF4"
)
plots3 <- pretty_irf(
data = list(IVff$irfs),
shock_names = "FF4",
pretty_names = c(rotulos_series["logip"], rotulos_series["logcpi"], rotulos_series["ff"], rotulos_series["ebp"], rotulos_series["mortg_spread_m"], rotulos_series["cp3m_spread_m"]),
cum = FALSE,
confidence_type = "msw",
manual_color = sh.col,
legend = FALSE,
title = NULL,
same_scale = FALSE,
shock_sign = "positive"
) + patchwork::plot_layout(ncol = 2)
plots3
7 Conclusão
Ao longo do relatório, replicamos a abordagem de Gertler e Karadi usando surpresas de alta frequência como instrumentos para isolar choques de política monetária. A sequência de passos, descrição dos dados, especificação do modelo e análise das respostas, buscou assegurar simultaneamente plausibilidade econômica e validade estatística. Pequenos desvios (por exemplo, diferenças no recorte temporal que abrangem a crise de 2008) não alteram a mensagem central: a qualidade da identificação IV precisa ser julgada pelas IRFs com IC (Figura 5), nas quais usualmente se nota mitigação do price puzzle e efeitos coerentes com a transmissão via crédito (EBP elevando-se quando significativo).
8 Apêndice — Instalação de pacotes (opcional)
# Repositório CRAN
options(repos = c(CRAN = "https://cran.rstudio.com/"))
# Pacotes do CRAN
install.packages(c("readxl","ggplot2","dplyr","tidyr","tseries","lubridate",
"vars","stargazer","gridExtra","patchwork","zoo","knitr","httr"))
# Pacotes externos (GitHub)
# install.packages("devtools")
devtools::install_github("martinbaumgaertner/varexternal")
devtools::install_github("matthieugomez/varexternalinstrument")
devtools::install_github("anguyen1210/var-tools")