## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 4.5,
  fig.align = "center"
)

## ----dependencies-------------------------------------------------------------
library(contagionchannels)
library(xts)
library(dplyr)
library(tidyr)
library(ggplot2)
library(igraph)

## ----data-load----------------------------------------------------------------
data(g20_returns)
data(channel_proxies)
data(crisis_periods)

dim(g20_returns)
range(index(g20_returns))
length(crisis_periods)
names(crisis_periods)

## ----composites---------------------------------------------------------------
channels <- build_channel_composites(channel_proxies)
head(channels[, c("Date", "Trade", "Financial", "Geopolitical",
                  "Behavioral", "Monetary_Policy")], 3)

## ----stage1-full, eval = FALSE------------------------------------------------
# F_full <- compute_wqte_matrix(
#   returns = g20_returns,
#   scale   = 5,
#   tau     = 0.50,
#   n_cores = 4
# )

## ----stage1-precrisis---------------------------------------------------------
pc_dates  <- crisis_periods$PreCrisis
returns_pc <- g20_returns[paste0(pc_dates[1], "/", pc_dates[2])]

F_pc <- compute_wqte_matrix(
  returns = returns_pc,
  scale   = 5,
  tau     = 0.50,
  n_cores = 1
)

dim(F_pc)
round(F_pc[1:4, 1:4], 4)

## ----threshold----------------------------------------------------------------
F_pc_offdiag <- F_pc[upper.tri(F_pc) | lower.tri(F_pc)]
abs_thr <- quantile(F_pc_offdiag, probs = 0.75, na.rm = TRUE)
abs_thr

## ----stage1-table, eval = FALSE-----------------------------------------------
# stage1_tbl <- summarise_stage1(
#   returns_xts    = g20_returns,
#   periods        = crisis_periods,
#   scale          = 5,
#   tau            = 0.50,
#   abs_threshold  = abs_thr
# )
# stage1_tbl

## ----stage2-pc, eval = FALSE--------------------------------------------------
# links_pc <- which(F_pc >= abs_thr, arr.ind = TRUE)
# channels_pc <- channels[channels$Date >= pc_dates[1] &
#                           channels$Date <= pc_dates[2], ]
# 
# iv_pc <- iv_2sls_attribute(
#   returns_period  = returns_pc,
#   channels_period = channels_pc,
#   links           = links_pc,
#   cluster_se      = TRUE
# )
# 
# iv_pc$shares

## ----lp-rigobon, eval = FALSE-------------------------------------------------
# lp_pc <- local_projections(
#   returns_period  = returns_pc,
#   channels_period = channels_pc,
#   links           = links_pc,
#   horizons        = c(1, 5, 22)
# )
# 
# rig_pc <- rigobon_id(
#   returns_period  = returns_pc,
#   channels_period = channels_pc,
#   links           = links_pc,
#   regime_split    = "vix_high_low"
# )
# 
# lp_pc$shares_h5
# rig_pc$shares

## ----sargan-table, eval = FALSE-----------------------------------------------
# sargan_rates <- summarise_sargan(
#   returns_xts    = g20_returns,
#   channels       = channels,
#   periods        = crisis_periods,
#   abs_threshold  = abs_thr
# )
# sargan_rates[, c("Period", "RejectRate")]

## ----bootstrap, eval = FALSE--------------------------------------------------
# boot_pc <- bootstrap_attribution(
#   fit       = iv_pc,
#   B         = 999,
#   type      = "wild_cluster",
#   cluster   = "link"
# )
# boot_pc$ci_95

## ----rv, eval = FALSE---------------------------------------------------------
# rv_pc <- cinelli_hazlett_rv(
#   theta = iv_pc$shares,
#   se    = iv_pc$se,
#   df    = iv_pc$df_residual
# )
# round(rv_pc, 3)

## ----fig-attribution, eval = FALSE--------------------------------------------
# plot_attribution_stack(
#   shares_long = bind_rows(lapply(crisis_periods, function(p) iv_pc$shares)),
#   period_order = names(crisis_periods)
# )  # Figure 4: stacked attribution shares

## ----fig-qte, eval = FALSE----------------------------------------------------
# plot_qte_intensity(
#   F_matrix  = F_pc,
#   threshold = abs_thr
# )  # Figure 2: WQTE heatmap

## ----fig-rv, eval = FALSE-----------------------------------------------------
# plot_robustness_value(
#   rv_table = rv_pc,
#   period   = "PreCrisis"
# )  # Figure 7: RV bounding contours

## ----communities, eval = FALSE------------------------------------------------
# g_pc <- build_network(F_pc, threshold = abs_thr)
# comms_pc <- walktrap_communities(g_pc, steps = 4)
# table(membership(comms_pc))

## ----pipeline, eval = FALSE---------------------------------------------------
# results <- run_contagion_pipeline(
#   returns       = g20_returns,
#   channels      = channels,
#   periods       = crisis_periods,
#   scale         = 5,
#   tau           = 0.50,
#   abs_threshold = abs_thr,
#   methods       = c("iv2sls", "lasso_iv", "lp", "rigobon"),
#   bootstrap_B   = 999,
#   n_cores = 4
# )
# 
# names(results)
# results$summary_table

## ----session------------------------------------------------------------------
sessionInfo()