## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 4 ) ## ----libs--------------------------------------------------------------------- library(contagionchannels) library(xts) library(dplyr) ## ----contracts, eval = FALSE-------------------------------------------------- # str(my_returns_xts) # # An 'xts' object on 2010-01-04/2024-12-31 of 18 columns # # str(my_channels_df) # # 'data.frame' with Date + raw component columns ## ----periods, eval = FALSE---------------------------------------------------- # my_periods <- list( # Pre_Pandemic = as.Date(c("2018-01-02", "2020-01-31")), # Pandemic = as.Date(c("2020-02-01", "2021-12-31")), # Recovery = as.Date(c("2022-01-01", "2024-12-31")) # ) ## ----composites, eval = FALSE------------------------------------------------- # my_mapping <- list( # Trade = c("BDI_chg", "TradeWeightedFX_chg", "ContainerRate_chg"), # Financial = c("FRAOIS", "TEDspread", "CDS_lvl"), # Geopolitical = c("GPR_daily", "GPR_actions"), # Behavioral = c("VIX_innov", "VVIX_innov", "PutCallRatio"), # Monetary_Policy = c("ShadowRate_surp", "FF_futures_surp") # ) # # my_channels <- build_channel_composites( # proxy_grid = my_proxies_df, # mapping = my_mapping, # standardise = "rolling_252" # ) ## ----pipeline, eval = FALSE--------------------------------------------------- # results <- run_contagion_pipeline( # returns = my_returns_xts, # channels = my_channels, # periods = my_periods, # scale = 5, # tau = 0.50, # abs_threshold = NULL, # NULL => derive from first period Q75 # methods = c("iv2sls", "lp"), # bootstrap_B = 499, # n_cores = 4 # ) ## ----plotting, eval = FALSE--------------------------------------------------- # plot_attribution_stack( # shares_long = results$shares_long, # period_order = names(my_periods), # palette = c(Trade = "#1f77b4", Financial = "#d62728", # Geopolitical = "#9467bd", Behavioral = "#2ca02c", # Monetary_Policy = "#ff7f0e") # ) # # plot_qte_intensity( # F_matrix = results$F_matrices$Pandemic, # threshold = results$abs_threshold, # market_order = c("US", "EU", "JP", "EM_Asia", "EM_LatAm") # ) ## ----synthetic-data----------------------------------------------------------- set.seed(20260429) n_obs <- 1500 markets <- c("US", "EU", "JP", "EM_Asia", "EM_LatAm") dates <- seq.Date(from = as.Date("2018-01-02"), by = "day", length.out = n_obs) # Common factor + idiosyncratic shocks Fcom <- rnorm(n_obs, sd = 0.012) ret_mat <- sapply(markets, function(m) { loading <- runif(1, 0.4, 0.9) loading * Fcom + rnorm(n_obs, sd = 0.010) }) my_returns <- xts(ret_mat, order.by = dates) # Channel proxy raw components my_proxies <- data.frame( Date = dates, BDI_chg = rnorm(n_obs, sd = 0.5), TradeFX_chg = rnorm(n_obs, sd = 0.4), FRAOIS = arima.sim(list(ar = 0.95), n_obs) * 0.01, TEDspread = arima.sim(list(ar = 0.93), n_obs) * 0.01, GPR_daily = exp(rnorm(n_obs, sd = 0.2)), GPR_actions = exp(rnorm(n_obs, sd = 0.3)), VIX_innov = rnorm(n_obs, sd = 1.5), VVIX_innov = rnorm(n_obs, sd = 1.0), ShadowRate_surp = rnorm(n_obs, sd = 0.05), FF_futures_surp = rnorm(n_obs, sd = 0.04) ) my_mapping <- list( Trade = c("BDI_chg", "TradeFX_chg"), Financial = c("FRAOIS", "TEDspread"), Geopolitical = c("GPR_daily", "GPR_actions"), Behavioral = c("VIX_innov", "VVIX_innov"), Monetary_Policy = c("ShadowRate_surp", "FF_futures_surp") ) my_periods <- list( Calm = as.Date(c("2018-01-02", "2019-12-31")), Stress = as.Date(c("2020-01-01", "2021-12-31")) ) ## ----synthetic-composites, eval = FALSE--------------------------------------- # my_channels <- build_channel_composites( # proxy_grid = my_proxies, # mapping = my_mapping, # standardise = "rolling_252" # ) # # head(my_channels, 3) ## ----synthetic-stage1, eval = FALSE------------------------------------------- # calm_dates <- my_periods$Calm # returns_calm <- my_returns[paste0(calm_dates[1], "/", calm_dates[2])] # # F_calm <- compute_wqte_matrix( # returns = returns_calm, # scale = 5, # tau = 0.50, # n_cores = 1, # ) # # abs_thr_calm <- quantile( # F_calm[upper.tri(F_calm) | lower.tri(F_calm)], # probs = 0.75, na.rm = TRUE # ) # # links_calm <- which(F_calm >= abs_thr_calm, arr.ind = TRUE) # nrow(links_calm) ## ----synthetic-stage2, eval = FALSE------------------------------------------- # channels_calm <- my_channels[ # my_channels$Date >= calm_dates[1] & my_channels$Date <= calm_dates[2], ] # # iv_calm <- iv_2sls_attribute( # returns_period = returns_calm, # channels_period = channels_calm, # links = links_calm, # cluster_se = TRUE # ) # # iv_calm$shares ## ----synthetic-pipeline, eval = FALSE----------------------------------------- # synth_results <- run_contagion_pipeline( # returns = my_returns, # channels = my_channels, # periods = my_periods, # scale = 5, # tau = 0.50, # abs_threshold = abs_thr_calm, # methods = c("iv2sls"), # bootstrap_B = 199, # n_cores = 1 # ) # # synth_results$summary_table ## ----session------------------------------------------------------------------ sessionInfo()