Borrowing at Par: Bank Selection into Emergency Lending Facilities
Data Preparation — Cleaned & Revised
February 24, 2026
Extensive Margin (Three empirical models):
Base Model \[\text{Borrower}_i = \alpha + \beta_1 \cdot \text{MTM\_total}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 (\text{MTM\_total}_i \times \text{UninsuredLev}_i) + \gamma \mathbf{X}_i + \varepsilon_i\]
OMO-Only Model \[\text{Borrower}_i = \alpha + \beta_1 \cdot \text{MTM}^{OMO}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 (\text{MTM}^{OMO}_i \times \text{UninsuredLev}_i) + \gamma \mathbf{X}_i + \varepsilon_i\]
Deposit Beta Model \[\text{Borrower}_i = \alpha + \beta_1 \cdot \text{MTM\_total}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 \cdot \text{DepositBeta}_i + \beta_4 (\text{MTM\_total}_i \times \text{UninsuredLev}_i \times \text{DepositBeta}_i) + \gamma \mathbf{X}_i + \varepsilon_i\]
Controls: ln_assets,
cash_ratio, loan_to_deposit,
book_equity_ratio, wholesale, roa
We estimate this across the Acute and Post-Acute periods (3 model*2
period) for BTFP, DW borrowers.
Threshold Gradient At low levels of mark-to-market (MTM) losses, banks with higher uninsured leverage are expected to borrow more to preempt run risk. We test this threshold effect by splitting the sample into MTM Loss terciles (Low, Medium, High) and estimating the extensive margin separately for each group \(k \in \{L, M, H\}\):
\[ \text{Borrower}_i = \alpha^{(k)} + \beta^{(k)} \cdot \text{UninsuredLev}_i + \gamma \mathbf{X}_i + \varepsilon_i \]
Prediction: \(\beta^H > \beta^M > \beta^L\)
A steeper gradient in the high-fragility (High MTM loss) group indicates a lower threshold for emergency borrowing, implying these banks seek liquidity at better fundamental levels to front-run potential deposit flight. We estimate this across the Acute and Post-Acute periods for BTFP, DW, Both, and Any Facility borrowers.
Intensive Margin
Among borrowers only:
\[\text{Borrow_Amt} = \alpha + \beta_1 \cdot \text{MTM\_total}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 (\text{MTM\_total}_i \times \text{UninsuredLev}_i) + \gamma \mathbf{X}_i + \varepsilon_i\]
Purpose: Conditional on borrowing, did fragile banks borrow more at higher adjusted equity? Do this by Acute, post-acute (1 model*2 period) across BTFP, DW, both, all borrower
Robustness: Temporal Crisis (acute U post-acute) Vs Arbitrage Repeat Extensive Margin for BTFP (3 model*2 period).
*** Falsefiction Test FHLB borrower(abnormal 10pct)** Repeat Extensive Margin for FHLB Prediction: results will be insignificant or week.
** Other clean test** Add the below for robustness: 1. Another powerful test would be to use insured deposits. run three regression. First, include insured deporit in the basline specification that has uninsured and the interaction with mtm. second replace the uninsured in the baseline regression with insured and see what happens to the main effects. Third run one with just MTM and insured with no interaction.
- We have some repeat borrowers. How many borrowers during the crisis period (or during the acute phase) and then borrowed again during some post-crisis period? It would interesting to see if these same borrowers display different characteristics during the crisis vs. non-crisis periods - this would be a clean test (same bank, two different time periods!).
1 SETUP
1.1 Packages
rm(list = ls())
# Core
library(data.table)
library(dplyr)
library(tidyr)
library(stringr)
library(lubridate)
library(purrr)
library(tibble)
library(ggrepel)
# Econometrics
library(fixest)
library(marginaleffects)
library(nnet)
library(broom)
# Tables
library(modelsummary)
library(knitr)
library(kableExtra)
# Statistics
library(DescTools)
# Visualization
library(ggplot2)
library(gridExtra)
library(scales)
library(patchwork)
# I/O
library(readr)
library(readxl)
cat("All packages loaded.\n")## All packages loaded.1.2 Helper Functions
# ==============================================================================
# CORE HELPERS
# ==============================================================================
# Replaces values outside the specified probability bounds with NA
trim_outliers <- function(x, probs = c(0.025, 0.975)) {
if (all(is.na(x))) return(x)
q <- quantile(x, probs = probs, na.rm = TRUE, names = FALSE)
# If a value is less than the lower bound or greater than the upper bound, make it NA
ifelse(x < q[1] | x > q[2], NA_real_, x)
}
standardize_z <- function(x) {
if (all(is.na(x))) return(x)
(x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
}
safe_div <- function(num, denom, default = NA_real_) {
ifelse(is.na(denom) | denom == 0, default, num / denom)
}
create_size_category_3 <- function(assets_thousands) {
assets_millions <- assets_thousands / 1000
case_when(
assets_millions >= 100000 ~ "Large (>$100B)",
assets_millions >= 1000 ~ "Medium ($1B-$100B)",
TRUE ~ "Small (<$1B)"
)
}
size_levels_3 <- c("Small (<$1B)", "Medium ($1B-$100B)", "Large (>$100B)")
format_pval <- function(p) {
case_when(
is.na(p) ~ "",
p < 0.01 ~ "***",
p < 0.05 ~ "**",
p < 0.10 ~ "*",
TRUE ~ ""
)
}
# ==============================================================================
# SUMMARY STATISTICS
# ==============================================================================
summary_stats_function <- function(df, column_list, group_by = NULL) {
summary_stat_df <- df %>% select(all_of(column_list)) %>% data.table()
calc_stats <- function(data) {
data %>%
summarise(across(everything(), list(
N = ~ sum(!is.na(.)),
Mean = ~ round(mean(., na.rm = TRUE), 3),
SD = ~ round(sd(., na.rm = TRUE), 3),
P10 = ~ round(quantile(., 0.10, na.rm = TRUE), 3),
P25 = ~ round(quantile(., 0.25, na.rm = TRUE), 3),
P50 = ~ round(quantile(., 0.50, na.rm = TRUE), 3),
P75 = ~ round(quantile(., 0.75, na.rm = TRUE), 3),
P90 = ~ round(quantile(., 0.90, na.rm = TRUE), 3)
), .names = "{col}__{fn}")) %>%
pivot_longer(cols = everything(),
names_to = c("Variable", ".value"),
names_sep = "__")
}
if (!is.null(group_by)) {
summary_stat_df %>%
group_by(across(all_of(group_by))) %>%
calc_stats()
} else {
calc_stats(summary_stat_df)
}
}
# ==============================================================================
# FILE I/O
# ==============================================================================
safe_writeLines <- function(text, con, max_retries = 5, wait_sec = 2) {
for (i in seq_len(max_retries)) {
result <- tryCatch(
{ writeLines(text, con); TRUE },
error = function(e) {
if (i < max_retries) Sys.sleep(wait_sec)
FALSE
}
)
if (isTRUE(result)) return(invisible(NULL))
}
warning("Failed to write ", con, " after ", max_retries, " attempts.")
}
save_table <- function(tbl, filename, caption_text = "") {
latex_file <- file.path(TABLE_PATH, paste0(filename, ".tex"))
latex_content <- knitr::kable(
tbl, format = "latex", caption = caption_text, booktabs = TRUE
)
safe_writeLines(as.character(latex_content), latex_file)
message("Saved: ", filename, ".tex")
}
save_figure <- function(plot_obj, filename, width = 12, height = 8) {
ggsave(
file.path(FIG_PATH, paste0(filename, ".pdf")),
plot = plot_obj, width = width, height = height, device = "pdf"
)
message("Saved: ", filename, ".pdf")
}1.3 Paths
# ==============================================================================
# PATHS — EDIT THIS BLOCK ONLY
# ==============================================================================
BASE_PATH <- "C:/Users/mohua/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025"
DATA_PROC <- file.path(BASE_PATH, "01_data/processed")
OUTPUT_PATH <- file.path(BASE_PATH, "03_documentation/GExam_results")
TABLE_PATH <- file.path(OUTPUT_PATH, "tables")
FIG_PATH <- file.path(OUTPUT_PATH, "figures")
for (path in c(TABLE_PATH, FIG_PATH)) {
if (!dir.exists(path)) dir.create(path, recursive = TRUE)
}1.4 Key Dates and Analysis Windows
# ==============================================================================
# KEY DATES AND PERIODS
# ==============================================================================
BASELINE_MAIN <- "2022Q4"
BASELINE_ARB <- "2023Q3"
BASELINE_WIND <- "2023Q4"
# --- Key event dates ---
DATE_MAR01 <- as.Date("2023-03-01") # Optional "before run" marker
DATE_MAR08 <- as.Date("2023-03-08") # SVB announces securities sale + capital raise
DATE_MAR09 <- as.Date("2023-03-09") # Run day
DATE_MAR10 <- as.Date("2023-03-10") # SVB closed
DATE_MAR12 <- as.Date("2023-03-12") # Signature closed + BTFP announced
DATE_MAR13 <- as.Date("2023-03-13") # BTFP operational, DW starts accepting OMO-eligible securities at no-haircut
DATE_MAR15 <- as.Date("2023-03-15") # End of Acute window
DATE_MAY01 <- as.Date("2023-05-01") # First Republic closed
DATE_OCT31 <- as.Date("2023-10-31") # DW Ends accepting OMO-eligible securities at no-haircut
DATE_NOV06 <- as.Date("2023-11-06") # BTFP rate first dips below IORB
DATE_NOV15 <- as.Date("2023-11-15") # Sustained sub-IORB starts (main arb start)
DATE_JAN24 <- as.Date("2024-01-24") # Pricing floor announced
DATE_JAN25 <- as.Date("2024-01-25") # Pricing floor effective
DATE_MAR11_2024 <- as.Date("2024-03-11") # BTFP ends
# --- Analysis windows (non-overlapping) ---
PRE_CRISIS_START <- as.Date("2023-01-01")
PRE_CRISIS_END <- as.Date("2023-03-07")
ACUTE_START <- DATE_MAR08 # Crisis begins with SVB announcement
ACUTE_END <- DATE_MAR15 # End of acute panic window
POST_ACUTE_START <- as.Date("2023-03-16")
POST_ACUTE_END <- as.Date("2023-05-04") # Through First Republic resolution
STAB_START <- as.Date("2023-05-02")
STAB_END <- as.Date("2023-10-31")
# Crisis ≡ Acute ∪ Post-Acute
CRISIS_START <- ACUTE_START
CRISIS_END <- POST_ACUTE_END
# Arbitrage window: sustained sub-IORB (main definition)
ARB_START_MAIN <- DATE_NOV15
ARB_START_ALT1 <- as.Date("2023-11-01") # Looser definition
ARB_START_ALT2 <- DATE_NOV06 # First dip below IORB
ARB_END <- DATE_JAN24
# Wind-down
WIND_START <- DATE_JAN25
WIND_END <- DATE_MAR11_2024
# Use ARB_START_MAIN as default throughout
ARB_START <- ARB_START_MAIN
# --- Dataset bounds ---
DW_DATA_END <- as.Date("2023-12-31") # DW data available through here
# --- Plotting bounds ---
OVERALL_START <- PRE_CRISIS_START
OVERALL_END_TIGHT <- WIND_END # Analysis-aligned (2024-03-11)
OVERALL_END_PAD <- as.Date("2024-03-31") # Padded for label spacing
cat("=== DATE CONSTANTS SET ===\n")## === DATE CONSTANTS SET ===cat("Acute window: ", format(ACUTE_START), "to", format(ACUTE_END), "\n")## Acute window: 2023-03-08 to 2023-03-15cat("Post-Acute window: ", format(POST_ACUTE_START), "to", format(POST_ACUTE_END), "\n")## Post-Acute window: 2023-03-16 to 2023-05-04cat("Arbitrage window: ", format(ARB_START), "to", format(ARB_END), "\n")## Arbitrage window: 2023-11-15 to 2024-01-24cat("Wind-down window: ", format(WIND_START), "to", format(WIND_END), "\n")## Wind-down window: 2024-01-25 to 2024-03-112 DATA LOADING
2.1 Load Raw Data
# ==============================================================================
# LOAD ALL RAW DATA FILES
# ==============================================================================
# --- Call Reports (quarterly bank financials) ---
call_q <- read_csv(
file.path(DATA_PROC, "final_call_gsib.csv"),
show_col_types = FALSE
) %>%
mutate(idrssd = as.character(idrssd))
# --- Deposit Betas ---
# Pooled beta: one stable estimate per bank over full 2022-2024 sample.
# Used for 2022Q4 baseline (pre-crisis, avoids forward contamination).
deposit_beta_pooled <- read_csv(
file.path(DATA_PROC, "deposit_beta_pooled.csv"),
show_col_types = FALSE
) %>%
mutate(idrssd = as.character(rssd_id)) %>%
select(idrssd, beta_pooled, rsquared_pooled, n_obs_pooled)
# Yearly betas: year-specific estimates.
# Used for 2023Q3 (beta_2023) and 2023Q4 (beta_2023) baselines —
# captures the repricing sensitivity as known at that point in time.
deposit_beta_yearly <- read_csv(
file.path(DATA_PROC, "deposit_beta_yearly.csv"),
show_col_types = FALSE
) %>%
mutate(idrssd = as.character(rssd_id)) %>%
select(idrssd,
beta_2022, rsquared_2022, n_obs_2022,
beta_2023, rsquared_2023, n_obs_2023,
beta_2024, rsquared_2024, n_obs_2024)
# --- BTFP Loan-Level Data ---
btfp_loans_raw <- read_csv(
file.path(DATA_PROC, "btfp_loan_bank_only.csv"),
show_col_types = FALSE
) %>%
mutate(
rssd_id = as.character(rssd_id),
btfp_loan_date = mdy(btfp_loan_date)
)
# --- Discount Window Loan-Level Data ---
dw_loans_raw <- read_csv(
file.path(DATA_PROC, "dw_loan_bank_2023.csv"),
show_col_types = FALSE
) %>%
mutate(
rssd_id = as.character(rssd_id),
dw_loan_date = ymd(dw_loan_date)
)
cat("=== DATA LOADED ===\n")## === DATA LOADED ===cat("Call Report: ", nrow(call_q), "obs |",
n_distinct(call_q$idrssd), "banks\n")## Call Report: 75989 obs | 5074 bankscat("Deposit Beta (pooled):", nrow(deposit_beta_pooled), "banks\n")## Deposit Beta (pooled): 4781 bankscat("Deposit Beta (yearly):", nrow(deposit_beta_yearly), "banks\n")## Deposit Beta (yearly): 4781 bankscat("BTFP Loans: ", nrow(btfp_loans_raw), "loans\n")## BTFP Loans: 6734 loanscat("DW Loans: ", nrow(dw_loans_raw), "loans\n")## DW Loans: 10008 loans2.2 Exclude Failed Banks and G-SIBs
# ==============================================================================
# EXCLUSIONS: Failed banks and G-SIBs
# Identified at BASELINE_MAIN (2022Q4) to keep the exclusion list stable
# ==============================================================================
excluded_banks <- call_q %>%
filter(period == BASELINE_MAIN, failed_bank == 1 | gsib == 1) %>%
pull(idrssd)
cat("Excluded banks (failed + G-SIBs):", length(excluded_banks), "\n")## Excluded banks (failed + G-SIBs): 41# Apply exclusions to loan data
btfp_loans <- btfp_loans_raw %>% filter(!rssd_id %in% excluded_banks)
dw_loans <- dw_loans_raw %>% filter(!rssd_id %in% excluded_banks)
cat("BTFP loans after exclusions:", nrow(btfp_loans), "\n")## BTFP loans after exclusions: 6695cat("DW loans after exclusions: ", nrow(dw_loans), "\n")## DW loans after exclusions: 99353 BORROWER INDICATOR FACTORY
# ==============================================================================
# CREATE PERIOD-SPECIFIC BORROWER INDICATORS FROM LOAN-LEVEL DATA
#
# Returns a data frame with:
# idrssd — bank identifier
# {prefix} — binary indicator (1 = borrowed in window)
# {prefix}_amt — total amount borrowed in window
# {prefix}_first — date of first loan in window
# ==============================================================================
create_borrower_indicator <- function(loans_df, date_col, id_col, amount_col,
start_date, end_date, prefix) {
loans_df %>%
filter(
!!sym(date_col) >= start_date,
!!sym(date_col) <= end_date
) %>%
group_by(!!sym(id_col)) %>%
summarise(
"{prefix}" := 1L,
"{prefix}_amt" := sum(!!sym(amount_col), na.rm = TRUE),
"{prefix}_first" := min(!!sym(date_col)),
.groups = "drop"
) %>%
rename(idrssd = !!sym(id_col))
}
# ------------------------------------------------------------------------------
# BTFP BORROWER INDICATORS
# ------------------------------------------------------------------------------
# Pre-crisis / narrow windows (for falsification)
btfp_mar10 <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
DATE_MAR10, DATE_MAR10, "btfp_mar10"
)## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `btfp_mar10_first = min(btfp_loan_date)`.
## Caused by warning in `min.default()`:
## ! no non-missing arguments to min; returning Infbtfp_mar10_13 <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
DATE_MAR10, DATE_MAR13, "btfp_mar10_13"
)
# Main analysis windows
btfp_acute <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
ACUTE_START, ACUTE_END, "btfp_acute"
)
btfp_post <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
POST_ACUTE_START, POST_ACUTE_END, "btfp_post"
)
btfp_arb <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
ARB_START, ARB_END, "btfp_arb"
)
btfp_wind <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
WIND_START, WIND_END, "btfp_wind"
)
btfp_overall <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
OVERALL_START, OVERALL_END_TIGHT, "btfp_overall"
)
# ------------------------------------------------------------------------------
# DISCOUNT WINDOW BORROWER INDICATORS
# Note: DW data available through DW_DATA_END (2023-12-31) only
# ------------------------------------------------------------------------------
dw_prebtfp <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
DATE_MAR01, DATE_MAR12, "dw_prebtfp"
)
dw_mar10 <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
DATE_MAR10, DATE_MAR10, "dw_mar10"
)
dw_mar10_13 <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
DATE_MAR10, DATE_MAR13, "dw_mar10_13"
)
dw_acute <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
ACUTE_START, min(ACUTE_END, DW_DATA_END), "dw_acute"
)
dw_post <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
POST_ACUTE_START, min(POST_ACUTE_END, DW_DATA_END), "dw_post"
)
dw_overall <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
OVERALL_START, DW_DATA_END, "dw_overall"
)
cat("=== BORROWER COUNTS ===\n")## === BORROWER COUNTS ===cat("BTFP: Acute=", nrow(btfp_acute),
" Post=", nrow(btfp_post),
" Arb=", nrow(btfp_arb),
" Wind=", nrow(btfp_wind), "\n")## BTFP: Acute= 27 Post= 515 Arb= 780 Wind= 237cat("DW: PreBTFP=", nrow(dw_prebtfp),
" Acute=", nrow(dw_acute),
" Post=", nrow(dw_post), "\n")## DW: PreBTFP= 106 Acute= 165 Post= 3724 VARIABLE CONSTRUCTION
4.1 Core Variable Builder
# ==============================================================================
# Variable naming convention:
# *_raw — original scale (for descriptive tables)
# *_w — winsorized at [2.5%, 97.5%]
# * — z-standardized (mean 0, SD 1) — used in all regressions
# ==============================================================================
construct_analysis_vars <- function(baseline_data) {
baseline_data %>%
mutate(
# ======================================================================
# 1. RAW VARIABLES (original scale, for descriptive tables)
# ======================================================================
mtm_total_raw = mtm_loss_to_total_asset,
mtm_btfp_raw = mtm_loss_omo_eligible_to_total_asset,
mtm_other_raw = mtm_loss_non_omo_eligible_to_total_asset,
uninsured_lev_raw = uninsured_deposit_to_total_asset,
insured_lev_raw = r_insured_deposit,
uninsured_share_raw = uninsured_to_deposit,
# Controls
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
securities_ratio_raw = security_to_total_asset,
loan_ratio_raw = total_loan_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
tier1_ratio_raw = tier1cap_to_total_asset,
roa_raw = roa,
fhlb_ratio_raw = fhlb_to_total_asset,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(
fed_fund_purchase + repo +
replace_na(other_borrowed_less_than_1yr, 0),
total_liability, 0
) * 100,
# Deposit outflows (forward-looking)
uninsured_outflow_raw = change_uninsured_fwd_q,
insured_outflow_raw = change_insured_deposit_fwd_q,
total_outflow_raw = change_total_deposit_fwd_q,
# Deposit beta (raw — already merged in as beta_pooled)
deposit_beta_raw = beta_pooled,
# ======================================================================
# 2. SOLVENCY MEASURES
# ======================================================================
# Adjusted Equity: Book Equity minus MTM losses (% of assets)
# This is the theta in Goldstein-Pauzner — the bank's true economic position
adjusted_equity_raw = book_equity_to_total_asset - mtm_loss_to_total_asset,
# Market-value assets (for IDCR measures)
mv_assets = total_asset * (1 - mtm_loss_to_total_asset / 100),
# Jiang et al. (2023) insolvency measures
idcr_1 = safe_div(
mv_assets - 0.5 * uninsured_deposit - insured_deposit,
insured_deposit, NA_real_
),
idcr_2 = safe_div(
mv_assets - uninsured_deposit - insured_deposit,
insured_deposit, NA_real_
),
# Binary solvency indicators
mtm_insolvent = as.integer(adjusted_equity_raw < 0),
mtm_solvent = as.integer(adjusted_equity_raw >= 0),
insolvent_idcr_s50 = as.integer(idcr_1 < 0),
insolvent_idcr_s100 = as.integer(idcr_2 < 0),
# ======================================================================
# 3. TRIMMED VARIABLES [2.5%, 97.5%] (Replaces outliers with NA)
# ======================================================================
# Primary explanatory
mtm_total_w = trim_outliers(mtm_total_raw),
mtm_btfp_w = trim_outliers(mtm_btfp_raw),
mtm_other_w = trim_outliers(mtm_other_raw),
uninsured_lev_w = trim_outliers(uninsured_lev_raw),
insured_lev_w = trim_outliers(r_insured_deposit),
adjusted_equity_w = trim_outliers(adjusted_equity_raw),
# Deposit beta
deposit_beta_w = trim_outliers(deposit_beta_raw),
# Controls
ln_assets_w = trim_outliers(ln_assets_raw),
cash_ratio_w = trim_outliers(cash_ratio_raw),
book_equity_ratio_w = trim_outliers(book_equity_ratio_raw),
roa_w = trim_outliers(roa_raw),
loan_to_deposit_w = trim_outliers(loan_to_deposit_raw),
wholesale_w = trim_outliers(wholesale_raw),
# Deposit outflows
uninsured_outflow_w = trim_outliers(uninsured_outflow_raw),
insured_outflow_w = trim_outliers(insured_outflow_raw),
total_outflow_w = trim_outliers(total_outflow_raw),
# ======================================================================
# 4. Z-STANDARDIZED VARIABLES (mean = 0, SD = 1)
# All regression variables use this scale — coefficients are
# interpreted as the effect of a 1-SD increase.
# ======================================================================
# Primary explanatory
mtm_total = standardize_z(mtm_total_w),
mtm_btfp = standardize_z(mtm_btfp_w),
mtm_other = standardize_z(mtm_other_w),
uninsured_lev = standardize_z(uninsured_lev_w),
insured_lev = standardize_z(insured_lev_w),
adjusted_equity = standardize_z(adjusted_equity_w),
# Deposit beta
deposit_beta = standardize_z(deposit_beta_w),
# Controls
ln_assets = standardize_z(ln_assets_w),
cash_ratio = standardize_z(cash_ratio_w),
book_equity_ratio = standardize_z(book_equity_ratio_w),
roa = standardize_z(roa_w),
loan_to_deposit = standardize_z(loan_to_deposit_w),
wholesale = standardize_z(wholesale_w),
# Deposit outflows (standardized)
uninsured_outflow = standardize_z(uninsured_outflow_w),
insured_outflow = standardize_z(insured_outflow_w),
total_outflow = standardize_z(total_outflow_w),
# ======================================================================
# 5. INTERACTION TERMS
#
# Model 1 (Base): MTM_total × UninsuredLev
# Model 2 (OMO-only): MTM_btfp × UninsuredLev
# Model 3 (Deposit Beta): MTM_total × UninsuredLev × DepositBeta
#
# All built from z-standardized components.
# ======================================================================
# Base model interaction
mtm_x_uninsured = mtm_total * uninsured_lev,
# OMO-only model interaction
mtm_omo_x_uninsured = mtm_btfp * uninsured_lev,
mtm_nonomo_x_uninsured = mtm_other * uninsured_lev,
# Deposit beta model interactions
# β₃: main effect of deposit beta (separate from interaction)
# β₄: three-way MTM × UninsuredLev × DepositBeta
mtm_x_depbeta = mtm_total * deposit_beta,
unins_x_depbeta = uninsured_lev * deposit_beta,
mtm_x_unins_x_depbeta = mtm_total * uninsured_lev * deposit_beta,
# insured model
mtm_x_insured = mtm_total * insured_lev,
# ======================================================================
# 6. PAR BENEFIT AND COLLATERAL CAPACITY
# ======================================================================
par_benefit_raw = safe_div(
mtm_btfp_raw,
mtm_btfp_raw + 100 * safe_div(omo_eligible, total_asset * 1000, 0),
NA_real_
),
collateral_capacity_raw = safe_div(
omo_eligible, total_asset * 1000, 0
) * 100,
# ======================================================================
# 7. CATEGORICAL / GROUPING VARIABLES
# ======================================================================
size_cat = factor(
create_size_category_3(total_asset),
levels = size_levels_3
),
state = if ("state" %in% names(.)) state else NA_character_,
fed_district = if ("fed_district" %in% names(.)) fed_district else NA_character_
) %>%
# Par benefit needs prior columns to exist — computed in second mutate pass
mutate(
par_benefit_w = trim_outliers(par_benefit_raw),
par_benefit = standardize_z(par_benefit_w),
par_x_uninsured = par_benefit * uninsured_lev
)
}4.2 Quartile Dummies and Run-Risk Categories
# ==============================================================================
# ADD_RUN_RISK_DUMMIES()
#
# Adds quartile dummies and 2×2 median-split risk categories.
# Cutpoints are computed within the supplied dataset (so they are
# sample-specific — do NOT apply 2022Q4 cutpoints to 2023Q3 data).
# ==============================================================================
add_run_risk_dummies <- function(data) {
# --- Median splits for 2×2 risk categories (MTM-based) ---
medians <- data %>%
summarise(
median_mtm = median(mtm_total_w, na.rm = TRUE),
median_uninsured = median(uninsured_lev_w, na.rm = TRUE)
)
# --- Quartile breakpoints ---
quartiles <- data %>%
summarise(
adj_eq_q1 = quantile(adjusted_equity_w, 0.25, na.rm = TRUE),
adj_eq_q2 = quantile(adjusted_equity_w, 0.50, na.rm = TRUE),
adj_eq_q3 = quantile(adjusted_equity_w, 0.75, na.rm = TRUE),
unins_lev_q1 = quantile(uninsured_lev_w, 0.25, na.rm = TRUE),
unins_lev_q2 = quantile(uninsured_lev_w, 0.50, na.rm = TRUE),
unins_lev_q3 = quantile(uninsured_lev_w, 0.75, na.rm = TRUE),
mtm_q1 = quantile(mtm_total_w, 0.25, na.rm = TRUE),
mtm_q2 = quantile(mtm_total_w, 0.50, na.rm = TRUE),
mtm_q3 = quantile(mtm_total_w, 0.75, na.rm = TRUE),
depbeta_q1 = quantile(deposit_beta_w, 0.25, na.rm = TRUE),
depbeta_q2 = quantile(deposit_beta_w, 0.50, na.rm = TRUE),
depbeta_q3 = quantile(deposit_beta_w, 0.75, na.rm = TRUE)
)
data %>%
mutate(
# ---- 2×2 Median-split Run-Risk Dummies (reference = Risk 1: low MTM, low UL) ----
run_risk_1 = replace_na(as.integer(
mtm_total_w < medians$median_mtm &
uninsured_lev_w < medians$median_uninsured), 0L),
run_risk_2 = replace_na(as.integer(
mtm_total_w < medians$median_mtm &
uninsured_lev_w >= medians$median_uninsured), 0L),
run_risk_3 = replace_na(as.integer(
mtm_total_w >= medians$median_mtm &
uninsured_lev_w < medians$median_uninsured), 0L),
run_risk_4 = replace_na(as.integer(
mtm_total_w >= medians$median_mtm &
uninsured_lev_w >= medians$median_uninsured), 0L),
# ---- Adjusted Equity Quartiles (reference = Q4: strongest solvency) ----
adj_equity_q1 = replace_na(as.integer(
adjusted_equity_w <= quartiles$adj_eq_q1), 0L),
adj_equity_q2 = replace_na(as.integer(
adjusted_equity_w > quartiles$adj_eq_q1 &
adjusted_equity_w <= quartiles$adj_eq_q2), 0L),
adj_equity_q3 = replace_na(as.integer(
adjusted_equity_w > quartiles$adj_eq_q2 &
adjusted_equity_w <= quartiles$adj_eq_q3), 0L),
# ---- Uninsured Leverage Quartiles (reference = Q1: lowest fragility) ----
unins_lev_q2 = replace_na(as.integer(
uninsured_lev_w > quartiles$unins_lev_q1 &
uninsured_lev_w <= quartiles$unins_lev_q2), 0L),
unins_lev_q3 = replace_na(as.integer(
uninsured_lev_w > quartiles$unins_lev_q2 &
uninsured_lev_w <= quartiles$unins_lev_q3), 0L),
unins_lev_q4 = replace_na(as.integer(
uninsured_lev_w > quartiles$unins_lev_q3), 0L),
# Uninsured leverage tercile (for threshold gradient figures)
unins_lev_tercile = cut(
uninsured_lev_w,
breaks = quantile(uninsured_lev_w, c(0, 1/3, 2/3, 1), na.rm = TRUE),
labels = c("Low", "Med", "High"),
include.lowest = TRUE
),
# ---- MTM Quartiles (reference = Q1: lowest loss) ----
mtm_q2 = replace_na(as.integer(
mtm_total_w > quartiles$mtm_q1 &
mtm_total_w <= quartiles$mtm_q2), 0L),
mtm_q3 = replace_na(as.integer(
mtm_total_w > quartiles$mtm_q2 &
mtm_total_w <= quartiles$mtm_q3), 0L),
mtm_q4 = replace_na(as.integer(
mtm_total_w > quartiles$mtm_q3), 0L),
# ---- Deposit Beta Quartiles (reference = Q1: lowest beta) ----
depbeta_q2 = replace_na(as.integer(
deposit_beta_w > quartiles$depbeta_q1 &
deposit_beta_w <= quartiles$depbeta_q2), 0L),
depbeta_q3 = replace_na(as.integer(
deposit_beta_w > quartiles$depbeta_q2 &
deposit_beta_w <= quartiles$depbeta_q3), 0L),
depbeta_q4 = replace_na(as.integer(
deposit_beta_w > quartiles$depbeta_q3), 0L),
# Deposit beta tercile (for gradient figures)
depbeta_tercile = cut(
deposit_beta_w,
breaks = quantile(deposit_beta_w, c(0, 1/3, 2/3, 1), na.rm = TRUE),
labels = c("Low", "Med", "High"),
include.lowest = TRUE
),
# Store cutoff values for reporting
median_mtm_used = medians$median_mtm,
median_uninsured_used = medians$median_uninsured
)
}5 BUILD BASELINE DATASETS
# ==============================================================================
# BUILD BASELINE DATASETS
#
# Each baseline merges the appropriate deposit beta BEFORE calling
# construct_analysis_vars(), so beta_pooled is available inside that function.
#
# Baseline → Deposit Beta used:
# 2022Q4 → beta_pooled (full-period stable estimate, pre-crisis)
# 2023Q3 → beta_2023 (year-specific, known at arbitrage start)
# 2023Q4 → beta_2023 (year-specific, same year as wind-down)
# ==============================================================================
# Helper: prepare yearly beta for a specific year to reuse the same column name
prep_yearly_beta <- function(year) {
deposit_beta_yearly %>%
select(
idrssd,
beta_pooled = paste0("beta_", year),
rsquared_pooled = paste0("rsquared_", year),
n_obs_pooled = paste0("n_obs_", year)
)
}
# --- 2022Q4 Baseline (main crisis analysis) ---
df_2022q4 <- call_q %>%
filter(
period == BASELINE_MAIN,
!idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0
) %>%
left_join(deposit_beta_pooled, by = "idrssd") %>%
construct_analysis_vars() %>%
add_run_risk_dummies()
# --- 2023Q3 Baseline (arbitrage period) ---
df_2023q3 <- call_q %>%
filter(
period == BASELINE_ARB,
!idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0
) %>%
left_join(prep_yearly_beta("2023"), by = "idrssd") %>%
construct_analysis_vars() %>%
add_run_risk_dummies()
# --- 2023Q4 Baseline (wind-down period) ---
df_2023q4 <- call_q %>%
filter(
period == BASELINE_WIND,
!idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0
) %>%
left_join(prep_yearly_beta("2023"), by = "idrssd") %>%
construct_analysis_vars() %>%
add_run_risk_dummies()
cat("=== BASELINE DATASETS ===\n")## === BASELINE DATASETS ===cat("2022Q4:", nrow(df_2022q4), "banks |",
"Insolvent (AE<0):", sum(df_2022q4$mtm_insolvent, na.rm = TRUE), "\n")## 2022Q4: 4292 banks | Insolvent (AE<0): 825cat("2023Q3:", nrow(df_2023q3), "banks\n")## 2023Q3: 4214 bankscat("2023Q4:", nrow(df_2023q4), "banks\n")## 2023Q4: 4197 bankscat("\n=== DEPOSIT BETA COVERAGE (2022Q4) ===\n")##
## === DEPOSIT BETA COVERAGE (2022Q4) ===cat("Banks with beta_pooled:", sum(!is.na(df_2022q4$deposit_beta_raw)), "\n")## Banks with beta_pooled: 4256cat("Missing beta_pooled: ", sum( is.na(df_2022q4$deposit_beta_raw)), "\n")## Missing beta_pooled: 36cat("Mean beta (pooled): ", round(mean(df_2022q4$deposit_beta_raw, na.rm = TRUE), 3), "\n")## Mean beta (pooled): 0.08cat("SD beta (pooled): ", round(sd(df_2022q4$deposit_beta_raw, na.rm = TRUE), 3), "\n")## SD beta (pooled): 0.1416 BUILD PERIOD DATASETS
6.1 Helper: Join All Borrower Indicators
# ==============================================================================
# JOIN_ALL_BORROWERS()
#
# Merges borrower indicator frames onto a baseline, then creates:
# fhlb_user — abnormal FHLB borrowing indicator
# user_group — factor: Neither / BTFP_Only / DW_Only / Both
# any_fed — 1 if used BTFP or DW
# non_user — 1 if used none of BTFP, DW, FHLB
# ==============================================================================
join_all_borrowers <- function(df_base, btfp_df, dw_df, btfp_var, dw_var) {
df_base %>%
left_join(btfp_df %>% select(idrssd, starts_with(btfp_var)), by = "idrssd") %>%
left_join(dw_df %>% select(idrssd, starts_with(dw_var)), by = "idrssd") %>%
mutate(
"{btfp_var}" := replace_na(!!sym(btfp_var), 0L),
"{dw_var}" := replace_na(!!sym(dw_var), 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
user_group = factor(
case_when(
!!sym(btfp_var) == 1 & !!sym(dw_var) == 1 ~ "Both",
!!sym(btfp_var) == 1 ~ "BTFP_Only",
!!sym(dw_var) == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
),
any_fed = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1),
non_user = as.integer(
!!sym(btfp_var) == 0 & !!sym(dw_var) == 0 & fhlb_user == 0
)
)
}6.2 Build All Period Datasets
# ==============================================================================
# ACUTE PERIOD (2022Q4 baseline)
# ==============================================================================
df_acute <- join_all_borrowers(
df_2022q4, btfp_acute, dw_acute, "btfp_acute", "dw_acute"
) %>%
mutate(
# Intensive-margin variables (amount relative to bank size)
btfp_pct = ifelse(
btfp_acute == 1 & btfp_acute_amt > 0,
100 * btfp_acute_amt / (total_asset * 1000), NA_real_
),
dw_pct = ifelse(
dw_acute == 1 & dw_acute_amt > 0,
100 * dw_acute_amt / (total_asset * 1000), NA_real_
),
log_btfp_amt = ifelse(
btfp_acute == 1 & btfp_acute_amt > 0, log(btfp_acute_amt), NA_real_
),
log_dw_amt = ifelse(
dw_acute == 1 & dw_acute_amt > 0, log(dw_acute_amt), NA_real_
)
)
# ==============================================================================
# PRE-BTFP / NARROW WINDOWS (2022Q4 baseline)
# For falsification: before par-value subsidy existed
# ==============================================================================
# Mar 1 – Mar 12 (any DW before BTFP announcement)
btfp_prebtfp <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
DATE_MAR01, DATE_MAR12, "btfp_prebtfp"
)## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `btfp_prebtfp_first = min(btfp_loan_date)`.
## Caused by warning in `min.default()`:
## ! no non-missing arguments to min; returning Infdf_prebtfp <- join_all_borrowers(
df_2022q4, btfp_prebtfp, dw_prebtfp, "btfp_prebtfp", "dw_prebtfp"
)
# SVB closure day only (Mar 10)
df_mar10 <- join_all_borrowers(
df_2022q4, btfp_mar10, dw_mar10, "btfp_mar10", "dw_mar10"
)
# Mar 10 – Mar 13 (SVB closure through BTFP launch)
df_mar10_13 <- join_all_borrowers(
df_2022q4, btfp_mar10_13, dw_mar10_13, "btfp_mar10_13", "dw_mar10_13"
)
# ==============================================================================
# POST-ACUTE PERIOD (2022Q4 baseline)
# ==============================================================================
df_post <- df_2022q4 %>%
left_join(btfp_post %>% select(idrssd, btfp_post, btfp_post_amt), by = "idrssd") %>%
left_join(dw_post %>% select(idrssd, dw_post, dw_post_amt), by = "idrssd") %>%
mutate(
btfp_post = replace_na(btfp_post, 0L),
dw_post = replace_na(dw_post, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = as.integer(btfp_post == 1 | dw_post == 1),
non_user = as.integer(btfp_post == 0 & dw_post == 0 & fhlb_user == 0),
user_group = factor(
case_when(
btfp_post == 1 & dw_post == 1 ~ "Both",
btfp_post == 1 ~ "BTFP_Only",
dw_post == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
)
)
# ==============================================================================
# ARBITRAGE PERIOD (2023Q3 baseline)
# No DW data in this window
# ==============================================================================
df_arb <- df_2023q3 %>%
left_join(btfp_arb %>% select(idrssd, btfp_arb, btfp_arb_amt), by = "idrssd") %>%
mutate(
btfp_arb = replace_na(btfp_arb, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = btfp_arb,
non_user = as.integer(btfp_arb == 0 & fhlb_user == 0),
user_group = factor(
ifelse(btfp_arb == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
)
)
# ==============================================================================
# WIND-DOWN PERIOD (2023Q4 baseline)
# No DW data in this window
# ==============================================================================
df_wind <- df_2023q4 %>%
left_join(btfp_wind %>% select(idrssd, btfp_wind, btfp_wind_amt), by = "idrssd") %>%
mutate(
btfp_wind = replace_na(btfp_wind, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = btfp_wind,
non_user = as.integer(btfp_wind == 0 & fhlb_user == 0),
user_group = factor(
ifelse(btfp_wind == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
)
)
cat("=== PERIOD DATASET COUNTS ===\n")## === PERIOD DATASET COUNTS ===cat("Acute: ", nrow(df_acute),
" | BTFP=1:", sum(df_acute$btfp_acute),
" | DW=1:", sum(df_acute$dw_acute),
" | Non-user:", sum(df_acute$non_user), "\n")## Acute: 4292 | BTFP=1: 26 | DW=1: 154 | Non-user: 3829cat("Post-Acute:", nrow(df_post),
" | BTFP=1:", sum(df_post$btfp_post),
" | DW=1:", sum(df_post$dw_post), "\n")## Post-Acute: 4292 | BTFP=1: 490 | DW=1: 352cat("Arb: ", nrow(df_arb),
" | BTFP=1:", sum(df_arb$btfp_arb), "\n")## Arb: 4214 | BTFP=1: 749cat("Wind-down: ", nrow(df_wind),
" | BTFP=1:", sum(df_wind$btfp_wind), "\n")## Wind-down: 4197 | BTFP=1: 2297 REGRESSION SAMPLES
# ==============================================================================
# PURE COMPARISON SAMPLES
# Each sample contains only: {facility borrowers} UNION {pure non-borrowers}
# This is the cleanest comparison — avoids contamination from
# banks that used a *different* facility.
# ==============================================================================
# --- Acute: BTFP, DW, FHLB vs. pure non-borrowers ---
df_btfp_s <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
df_dw_s <- df_acute %>% filter(dw_acute == 1 | non_user == 1)
df_fhlb_s <- df_acute %>% filter(fhlb_user == 1 | non_user == 1)
# --- Solvency splits (Acute) ---
df_btfp_sol <- df_btfp_s %>% filter(mtm_solvent == 1)
df_btfp_ins <- df_btfp_s %>% filter(mtm_insolvent == 1)
df_dw_sol <- df_dw_s %>% filter(mtm_solvent == 1)
df_dw_ins <- df_dw_s %>% filter(mtm_insolvent == 1)
df_fhlb_sol <- df_fhlb_s %>% filter(mtm_solvent == 1)
df_fhlb_ins <- df_fhlb_s %>% filter(mtm_insolvent == 1)
# --- Pre-BTFP DW ---
df_dw_pre_s <- df_prebtfp %>% filter(dw_prebtfp == 1 | non_user == 1)
df_dw_mar10_s <- df_mar10 %>% filter(dw_mar10 == 1 | non_user == 1)
df_dw_mar10_13_s <- df_mar10_13 %>% filter(dw_mar10_13 == 1 | non_user == 1)
# --- Post-Acute ---
df_btfp_post_s <- df_post %>% filter(btfp_post == 1 | non_user == 1)
df_dw_post_s <- df_post %>% filter(dw_post == 1 | non_user == 1)
df_fhlb_post_s <- df_post %>% filter(fhlb_user == 1 | non_user == 1)
# --- Arbitrage ---
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_fhlb_arb_s <- df_arb %>% filter(fhlb_user == 1 | non_user == 1)
# --- Wind-down ---
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
df_fhlb_wind_s <- df_wind %>% filter(fhlb_user == 1 | non_user == 1)
# --- Intensive margin (BTFP borrowers only, with valid amount data) ---
df_btfp_int <- df_acute %>% filter(btfp_acute == 1, !is.na(btfp_pct))
df_btfp_int_sol <- df_btfp_int %>% filter(mtm_solvent == 1)
df_btfp_int_ins <- df_btfp_int %>% filter(mtm_insolvent == 1)
# --- Solvency splits: Post-Acute ---
df_btfp_post_sol <- df_btfp_post_s %>% filter(mtm_solvent == 1)
df_btfp_post_ins <- df_btfp_post_s %>% filter(mtm_insolvent == 1)
df_dw_post_sol <- df_dw_post_s %>% filter(mtm_solvent == 1)
df_dw_post_ins <- df_dw_post_s %>% filter(mtm_insolvent == 1)
# --- Solvency splits: Arbitrage ---
df_btfp_arb_sol <- df_btfp_arb_s %>% filter(mtm_solvent == 1)
df_btfp_arb_ins <- df_btfp_arb_s %>% filter(mtm_insolvent == 1)
# --- Solvency splits: Wind-down ---
df_btfp_wind_sol <- df_btfp_wind_s %>% filter(mtm_solvent == 1)
df_btfp_wind_ins <- df_btfp_wind_s %>% filter(mtm_insolvent == 1)
cat("=== REGRESSION SAMPLES (Acute) ===\n")## === REGRESSION SAMPLES (Acute) ===cat("BTFP vs Non-user: ", nrow(df_btfp_s),
" (BTFP=1:", sum(df_btfp_s$btfp_acute), ")\n")## BTFP vs Non-user: 3855 (BTFP=1: 26 )cat("DW vs Non-user: ", nrow(df_dw_s),
" (DW=1:", sum(df_dw_s$dw_acute), ")\n")## DW vs Non-user: 3983 (DW=1: 154 )cat("FHLB vs Non-user: ", nrow(df_fhlb_s),
" (FHLB=1:", sum(df_fhlb_s$fhlb_user), ")\n")## FHLB vs Non-user: 4131 (FHLB=1: 302 )cat("BTFP Solvent: ", nrow(df_btfp_sol),
" | BTFP Insolvent:", nrow(df_btfp_ins), "\n")## BTFP Solvent: 3094 | BTFP Insolvent: 751cat("Intensive margin N: ", nrow(df_btfp_int), "\n")## Intensive margin N: 268 MODEL INFRASTRUCTURE
# ==============================================================================
# CONTROLS STRING
# book_equity_ratio included here (not collinear in MTM framework)
# ==============================================================================
CONTROLS <- "ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa"
# ==============================================================================
# FORMULA STRINGS FOR THREE MODELS
#
# Model 1 — Base:
# BTFP ~ MTM_total + UninsLev + MTM×UninsLev + controls
#
# Model 2 — OMO-Only:
# BTFP ~ MTM_btfp + UninsLev + MTM_btfp×UninsLev + controls
#
# Model 3 — Deposit Beta:
# BTFP ~ MTM_total + UninsLev + DepBeta +
# MTM×UninsLev×DepBeta + controls
# Note: three-way interaction automatically implies all lower-order
# terms; we include them explicitly for interpretability.
# ==============================================================================
# --- Model 1: Base ---
EXPL_BASE <- "mtm_total + uninsured_lev + mtm_x_uninsured"
# --- Model 2: OMO-Only ---
EXPL_OMO <- "mtm_btfp + uninsured_lev + mtm_omo_x_uninsured"
# OMO decomposition (OMO vs. non-OMO losses side by side)
EXPL_OMO_DECOMP <- "mtm_btfp + mtm_other + uninsured_lev + mtm_omo_x_uninsured + mtm_nonomo_x_uninsured"
# --- Model 3: Deposit Beta ---
# All constituent terms of the three-way interaction included explicitly:
# main effects: mtm_total, uninsured_lev, deposit_beta
# two-way interactions: mtm_x_uninsured, mtm_x_depbeta, unins_x_depbeta
# three-way: mtm_x_unins_x_depbeta
EXPL_DEPBETA <- paste(
"mtm_total + uninsured_lev + deposit_beta",
"+ mtm_x_uninsured + mtm_x_depbeta + unins_x_depbeta",
"+ mtm_x_unins_x_depbeta"
)
# Robustness: insured deposit specifications
EXPL_INSURED_HORSE <- "mtm_total + uninsured_lev + insured_lev + mtm_x_uninsured"
EXPL_INSURED_SWAP <- "mtm_total + insured_lev + mtm_x_insured"
EXPL_INSURED_NOINT <- "mtm_total + insured_lev"
# Par Benefit (mechanism test — separate from three main models)
EXPL_PAR <- "par_benefit + uninsured_lev + par_x_uninsured"
# ==============================================================================
# FIXEST VARIABLE DICTIONARY (display labels for etable)
# ==============================================================================
setFixest_dict(c(
# Primary explanatory
mtm_total = "MTM Loss (z)",
uninsured_lev = "Uninsured Leverage (z)",
mtm_btfp = "MTM Loss OMO (z)",
mtm_other = "MTM Loss Non-OMO (z)",
deposit_beta = "Deposit Beta (z)",
# Two-way interactions
mtm_x_uninsured = "MTM $\\times$ Uninsured",
mtm_omo_x_uninsured = "MTM OMO $\\times$ Uninsured",
mtm_nonomo_x_uninsured = "MTM Non-OMO $\\times$ Uninsured",
mtm_x_depbeta = "MTM $\\times$ Dep. Beta",
unins_x_depbeta = "Uninsured $\\times$ Dep. Beta",
# Three-way interaction
mtm_x_unins_x_depbeta = "MTM $\\times$ Uninsured $\\times$ Dep. Beta",
# Insured model
insured_lev = "Insured Leverage (z)",
mtm_x_insured = "MTM $\\times$ Insured",
# Par Benefit
par_benefit = "Par Benefit (z)",
par_x_uninsured = "Par Benefit $\\times$ Uninsured",
# Controls
ln_assets = "Log(Assets)",
cash_ratio = "Cash Ratio",
loan_to_deposit = "Loan-to-Deposit",
book_equity_ratio = "Book Equity Ratio",
wholesale = "Wholesale Funding",
roa = "ROA"
))
# ==============================================================================
# COEFFICIENT DISPLAY ORDER (for etable order = argument)
# ==============================================================================
COEF_ORDER <- c(
"Constant",
"MTM Loss",
"Uninsured Leverage",
"Insured Leverage",
"Deposit Beta",
"MTM.*Uninsured",
"MTM.*Dep",
"Uninsured.*Dep",
"MTM.*Uninsured.*Dep",
"MTM Loss OMO",
"MTM Loss Non-OMO",
"MTM OMO.*Uninsured",
"MTM Non-OMO.*Uninsured",
"MTM.*Insured",
"Par Benefit",
"Par Benefit.*Uninsured"
)
# ==============================================================================
# GENERIC MODEL RUNNERS
# ==============================================================================
# Single model
run_one <- function(data, dv, explanatory,
family_type = "lpm", controls = CONTROLS) {
ff <- as.formula(paste(dv, "~", explanatory, "+", controls))
if (family_type == "lpm") {
feols(ff, data = data, vcov = "hetero")
} else {
feglm(ff, data = data, family = binomial("logit"), vcov = "hetero")
}
}
# Run all three models for a given DV and sample
run_three_models <- function(data, dv, family_type = "lpm") {
list(
base = run_one(data, dv, EXPL_BASE, family_type, CONTROLS),
omo = run_one(data, dv, EXPL_OMO, family_type, CONTROLS),
depbeta = run_one(data, dv, EXPL_DEPBETA, family_type, CONTROLS)
)
}
# ==============================================================================
# ETABLE SAVER
# ==============================================================================
save_etable <- function(models, filename, title_text, notes_text,
fitstat_use = ~ n + r2,
extra_lines = NULL) {
etable(
models,
title = title_text,
notes = notes_text,
fitstat = fitstat_use,
order = COEF_ORDER,
extralines = extra_lines,
se.below = TRUE,
tex = TRUE,
file = file.path(TABLE_PATH, paste0(filename, ".tex")),
replace = TRUE,
style.tex = style.tex("aer")
)
message("Saved: ", filename, ".tex")
}
# ==============================================================================
# VISUALIZATION THEME
# ==============================================================================
theme_paper <- theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 13, hjust = 0),
plot.subtitle = element_text(size = 10, color = "grey40", hjust = 0),
legend.position = "bottom",
panel.grid.minor = element_blank(),
strip.text = element_text(face = "bold", size = 11)
)
pal_user <- c(
"DW" = "#D62828",
"BTFP" = "#003049",
"FHLB" = "#F77F00",
"Pure Non-Borrower" = "grey70",
"Both" = "#7209B7"
)
cat("=== MODEL INFRASTRUCTURE READY ===\n")## === MODEL INFRASTRUCTURE READY ===cat("Three models defined: Base | OMO-Only | Deposit Beta\n")## Three models defined: Base | OMO-Only | Deposit Betacat("Controls:", CONTROLS, "\n")## Controls: ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa9 EMERGENCY LENDING FACILITY ACTIVITY BY PERIOD
# ==============================================================================
# TABLE: EMERGENCY LENDING FACILITY ACTIVITY BY PERIOD
# Panel A: Discount Window | Panel B: BTFP | Panel C: FHLB
#
# Run AFTER analysis_dataprep.Rmd so these objects exist:
# btfp_loans, dw_loans, call_q, excluded_banks
# All date constants, TABLE_PATH, safe_writeLines()
# ==============================================================================
# ==============================================================================
# 1. PERIOD DEFINITIONS
# ==============================================================================
# Loan-level windows (used for DW and BTFP)
periods <- list(
"Pre-BTFP" = list(start = DATE_MAR01, end = DATE_MAR12),
"Acute" = list(start = ACUTE_START, end = ACUTE_END),
"Post-Acute" = list(start = POST_ACUTE_START, end = POST_ACUTE_END),
"Arbitrage" = list(start = ARB_START, end = ARB_END),
"Entire BTFP" = list(start = DATE_MAR13, end = WIND_END)
)
col_names <- names(periods)
# FHLB uses Call Report quarters — map each period to quarter(s) to include.
# Entire BTFP: aggregate ALL quarters that fall within the program window
# (2023Q1 through 2023Q4), then compute statistics on the bank-level sums.
fhlb_period_quarters <- list(
"Pre-BTFP" = c("2022Q4"),
"Acute" = c("2022Q4"),
"Post-Acute" = c("2023Q1"),
"Arbitrage" = c("2023Q3"),
"Entire BTFP" = c("2023Q1", "2023Q2", "2023Q3", "2023Q4")
)
# ==============================================================================
# 2. FORMATTERS
# ==============================================================================
fmt_num <- function(x, digits = 2) {
ifelse(
is.na(x) | is.nan(x) | is.infinite(x), "---",
formatC(x, format = "f", digits = digits, big.mark = ",")
)
}
fmt_int <- function(x) {
ifelse(
is.na(x) | is.nan(x), "---",
formatC(as.integer(round(x)), format = "d", big.mark = ",")
)
}
# ==============================================================================
# 3. PANEL A: DISCOUNT WINDOW
#
# Source: dw_loans (loan-level)
# DW data available through DW_DATA_END (Dec 31, 2023) only.
# Periods that start after DW_DATA_END → "---" (data unavailable)
# ==============================================================================
build_dw_panel <- function() {
rows <- list()
for (col in col_names) {
s <- periods[[col]]$start
e <- periods[[col]]$end
e_capped <- min(e, DW_DATA_END)
# Period starts after DW data ends → mark as unavailable
if (s > DW_DATA_END) {
rows[[col]] <- list(
banks = NA, loans = NA, total_b = NA, mean_m = NA,
median_m = NA, avg_rate = NA, avg_term = NA,
avg_effmat = NA, loan_coll = NA
)
next
}
df <- dw_loans %>%
filter(dw_loan_date >= s, dw_loan_date <= e_capped)
if (nrow(df) == 0) {
rows[[col]] <- list(
banks = 0, loans = 0, total_b = 0, mean_m = NA,
median_m = NA, avg_rate = NA, avg_term = NA,
avg_effmat = NA, loan_coll = NA
)
next
}
rows[[col]] <- list(
banks = n_distinct(df$rssd_id),
loans = nrow(df),
total_b = sum(df$dw_loan_amount, na.rm = TRUE) / 1e9,
mean_m = mean(df$dw_loan_amount, na.rm = TRUE) / 1e6,
median_m = median(df$dw_loan_amount, na.rm = TRUE) / 1e6,
avg_rate = mean(df$dw_interest_rate, na.rm = TRUE),
avg_term = mean(df$dw_term, na.rm = TRUE),
avg_effmat = mean(df$dw_effective_maturity_days, na.rm = TRUE),
loan_coll = mean(
safe_div(df$dw_loan_amount, df$dw_total_collateral) * 100,
na.rm = TRUE
)
)
}
metrics <- c(
"Banks (N)", "Loans (N)", "Total ($B)",
"Mean ($M)", "Median ($M)", "Avg. Rate (%)",
"Avg. Term (Days)", "Avg. Eff. Maturity (Days)", "Loan/Collateral (%)"
)
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(
Metric = metrics,
Period = col,
Value = c(
fmt_int(r$banks), fmt_int(r$loans),
fmt_num(r$total_b), fmt_num(r$mean_m), fmt_num(r$median_m),
fmt_num(r$avg_rate), fmt_num(r$avg_term), fmt_num(r$avg_effmat),
fmt_num(r$loan_coll)
)
)
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
select(Metric, all_of(col_names))
}
# ==============================================================================
# 4. PANEL B: BTFP
#
# Source: btfp_loans (loan-level)
# BTFP did not exist before Mar 13, 2023 → Pre-BTFP column = "N/A"
# ==============================================================================
build_btfp_panel <- function() {
rows <- list()
for (col in col_names) {
# BTFP didn't exist in pre-BTFP window
if (col == "Pre-BTFP") {
rows[[col]] <- list(
banks = NA, loans = NA, total_b = NA, mean_m = NA,
median_m = NA, avg_rate = NA, avg_term = NA,
avg_effmat = NA, loan_coll = NA
)
next
}
s <- periods[[col]]$start
e <- periods[[col]]$end
df <- btfp_loans %>% filter(btfp_loan_date >= s, btfp_loan_date <= e)
if (nrow(df) == 0) {
rows[[col]] <- list(
banks = 0, loans = 0, total_b = 0, mean_m = NA,
median_m = NA, avg_rate = NA, avg_term = NA,
avg_effmat = NA, loan_coll = NA
)
next
}
rows[[col]] <- list(
banks = n_distinct(df$rssd_id),
loans = nrow(df),
total_b = sum(df$btfp_loan_amount, na.rm = TRUE) / 1e9,
mean_m = mean(df$btfp_loan_amount, na.rm = TRUE) / 1e6,
median_m = median(df$btfp_loan_amount, na.rm = TRUE) / 1e6,
avg_rate = mean(df$btfp_interest_rate, na.rm = TRUE),
avg_term = mean(df$btfp_term, na.rm = TRUE),
avg_effmat = mean(df$btfp_effective_maturity_days, na.rm = TRUE),
loan_coll = mean(
safe_div(df$btfp_loan_amount, df$btfp_total_collateral) * 100,
na.rm = TRUE
)
)
}
metrics <- c(
"Banks (N)", "Loans (N)", "Total ($B)",
"Mean ($M)", "Median ($M)", "Avg. Rate (%)",
"Avg. Term (Days)", "Avg. Eff. Maturity (Days)", "Loan/Collateral (%)"
)
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(
Metric = metrics,
Period = col,
Value = c(
fmt_int(r$banks), fmt_int(r$loans),
fmt_num(r$total_b), fmt_num(r$mean_m), fmt_num(r$median_m),
fmt_num(r$avg_rate), fmt_num(r$avg_term), fmt_num(r$avg_effmat),
fmt_num(r$loan_coll)
)
)
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
mutate(`Pre-BTFP` = "N/A") %>% # BTFP did not exist yet
select(Metric, all_of(col_names))
}
# ==============================================================================
# 5. PANEL C: FHLB
#
# Source: call_q (quarterly Call Report snapshots)
# Borrower: fhlb_adv > 0 (after aggregation)
# Abnormal: abnormal_fhlb_borrowing_10pct == 1 in ANY quarter in window
#
# Single-quarter periods: one snapshot, no aggregation needed.
# Entire BTFP (2023Q1–2023Q4):
# — pull all four quarters
# — sum advances per bank across quarters (group_by idrssd)
# — unique bank count = distinct banks with any positive advances
# — weighted avg term computed on aggregated maturity buckets
#
# Unit: fhlb_adv and maturity buckets in call_q are in $000s
# → divide by 1e6 for $B, by 1e3 for $M
# ==============================================================================
build_fhlb_panel <- function() {
rows <- list()
for (col in col_names) {
qtrs <- fhlb_period_quarters[[col]]
# Pull all relevant quarters, excluding failed/GSIB banks
df_q <- call_q %>%
filter(
period %in% qtrs,
!idrssd %in% excluded_banks,
!is.na(fhlb_adv)
)
if (nrow(df_q) == 0) {
rows[[col]] <- list(
banks_any = NA, banks_abn = NA, total_b = NA,
mean_m = NA, median_m = NA, wa_term = NA
)
next
}
# Collapse to bank level across all quarters in the window.
# For single-quarter periods this is a pass-through (one row per bank).
# For Entire BTFP this sums four quarters so each bank appears once.
df_bank <- df_q %>%
group_by(idrssd) %>%
summarise(
fhlb_adv = sum(fhlb_adv, na.rm = TRUE),
fhlb_less_than_1yr = sum(fhlb_less_than_1yr, na.rm = TRUE),
fhlb_1to3yr = sum(fhlb_1to3yr, na.rm = TRUE),
fhlb_3to5yr = sum(fhlb_3to5yr, na.rm = TRUE),
fhlb_more_than_5yr = sum(fhlb_more_than_5yr, na.rm = TRUE),
# Flagged as abnormal in at least one quarter
abnormal_fhlb = max(
abnormal_fhlb_borrowing_10pct, na.rm = TRUE
),
.groups = "drop"
)
# Restrict to banks with positive advances
df_bor <- df_bank %>% filter(fhlb_adv > 0)
total_adv <- sum(df_bor$fhlb_adv, na.rm = TRUE) # $000s
# Weighted average term using maturity-bucket midpoints
wa_term <- if (total_adv > 0) {
sum(
replace_na(df_bor$fhlb_less_than_1yr, 0) * 0.5 +
replace_na(df_bor$fhlb_1to3yr, 0) * 2.0 +
replace_na(df_bor$fhlb_3to5yr, 0) * 4.0 +
replace_na(df_bor$fhlb_more_than_5yr, 0) * 7.0,
na.rm = TRUE
) / total_adv
} else {
NA_real_
}
rows[[col]] <- list(
banks_any = nrow(df_bor),
banks_abn = sum(df_bank$abnormal_fhlb == 1, na.rm = TRUE),
total_b = total_adv / 1e6, # $000s → $B
mean_m = mean(df_bor$fhlb_adv, na.rm = TRUE) / 1e3, # $000s → $M
median_m = median(df_bor$fhlb_adv, na.rm = TRUE) / 1e3,
wa_term = wa_term
)
}
metrics <- c(
"Banks with Advances (N)", "Abnormal Borrowers (N)",
"Total ($B)", "Mean ($M)", "Median ($M)", "Wtd. Avg. Term (Years)"
)
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(
Metric = metrics,
Period = col,
Value = c(
fmt_int(r$banks_any), fmt_int(r$banks_abn),
fmt_num(r$total_b), fmt_num(r$mean_m),
fmt_num(r$median_m), fmt_num(r$wa_term)
)
)
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
select(Metric, all_of(col_names))
}
# ==============================================================================
# 6. BUILD ALL THREE PANELS
# ==============================================================================
panel_a <- build_dw_panel()
panel_b <- build_btfp_panel()
panel_c <- build_fhlb_panel()
# ==============================================================================
# 7. HTML DISPLAY
# ==============================================================================
html_col_names <- c(
"Metric",
"Pre-BTFP<br><small>(Mar 1–12)</small>",
"Acute<br><small>(Mar 8–15)</small>",
"Post-Acute<br><small>(Mar 16–May 4)</small>",
"Arbitrage<br><small>(Nov 15–Jan 24)</small>",
"Entire BTFP<br><small>(Mar 13 '23 – Mar 11 '24)</small>"
)
display_panel <- function(df, panel_title) {
kable(
df, format = "html", escape = FALSE,
caption = panel_title,
col.names = html_col_names,
align = c("l", rep("r", 5))
) %>%
kable_styling(
bootstrap_options = c("striped", "condensed", "hover"),
full_width = FALSE, font_size = 12
) %>%
row_spec(0, bold = TRUE)
}
display_panel(panel_a, "Panel A: Discount Window Borrowing Activity")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks (N) | 106 | 165 | 372 | 389 | 1,389 |
| Loans (N) | 296 | 336 | 1,506 | 1,037 | 8,069 |
| Total (\(B) </td> <td style="text-align:right;"> 19.56 </td> <td style="text-align:right;"> 138.32 </td> <td style="text-align:right;"> 399.88 </td> <td style="text-align:right;"> 14.90 </td> <td style="text-align:right;"> 669.02 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | 66.08 | 411.67 | 265.52 | 14.37 | 82.91 |
| Median ($M) | 10.00 | 10.00 | 9.00 | 3.50 | 5.50 |
| Avg. Rate (%) | 4.75 | 4.75 | 4.96 | 5.50 | 5.31 |
| Avg. Term (Days) | 4.72 | 5.72 | 4.11 | 5.47 | 5.23 |
| Avg. Eff. Maturity (Days) | 3.69 | 3.38 | 3.00 | 3.87 | 3.84 |
| Loan/Collateral (%) | 23.41 | 23.34 | 27.43 | 17.38 | 22.70 |
display_panel(panel_b, "Panel B: BTFP Borrowing Activity")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks (N) | N/A | 27 | 515 | 780 | 1,316 |
| Loans (N) | N/A | 33 | 1,270 | 3,098 | 6,695 |
| Total (\(B) </td> <td style="text-align:right;"> N/A </td> <td style="text-align:right;"> 6.25 </td> <td style="text-align:right;"> 125.24 </td> <td style="text-align:right;"> 219.45 </td> <td style="text-align:right;"> 410.36 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | N/A | 189.35 | 98.61 | 70.84 | 61.29 |
| Median ($M) | N/A | 20.80 | 12.60 | 15.00 | 10.00 |
| Avg. Rate (%) | N/A | 4.55 | 4.71 | 4.95 | 5.02 |
| Avg. Term (Days) | N/A | 289.15 | 317.22 | 338.00 | 311.14 |
| Avg. Eff. Maturity (Days) | N/A | 144.70 | 157.89 | 88.10 | 104.47 |
| Loan/Collateral (%) | N/A | 65.16 | 51.06 | 50.45 | 45.13 |
display_panel(panel_c, "Panel C: FHLB Borrowing Activity")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks with Advances (N) | 2,481 | 2,481 | 2,530 | 2,639 | 3,043 |
| Abnormal Borrowers (N) | 325 | 325 | 350 | 212 | 707 |
| Total (\(B) </td> <td style="text-align:right;"> 446.95 </td> <td style="text-align:right;"> 446.95 </td> <td style="text-align:right;"> 646.65 </td> <td style="text-align:right;"> 462.93 </td> <td style="text-align:right;"> 2,092.48 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | 180.15 | 180.15 | 255.59 | 175.42 | 687.64 |
| Median ($M) | 15.50 | 15.50 | 16.41 | 18.00 | 55.00 |
| Wtd. Avg. Term (Years) | 1.10 | 1.10 | 1.05 | 1.37 | 1.26 |
# ==============================================================================
# 8. LATEX SAVE
# ==============================================================================
build_latex_table <- function(pa, pb, pc, filename) {
# Helper: convert panel data frame into LaTeX row strings
panel_to_rows <- function(df) {
apply(df, 1, function(r) {
paste0(
"\\quad ", r["Metric"], " & ",
r["Pre-BTFP"], " & ",
r["Acute"], " & ",
r["Post-Acute"], " & ",
r["Arbitrage"], " & ",
r["Entire BTFP"], " \\\\\n"
)
})
}
rows_a <- panel_to_rows(pa)
rows_b <- panel_to_rows(pb)
rows_c <- panel_to_rows(pc)
latex_out <- paste0(
"% =================================================================\n",
"% Table: Emergency Lending Facility Activity by Crisis Period\n",
"% Preamble: \\usepackage{booktabs,threeparttable,multirow}\n",
"% =================================================================\n",
"\\begin{table}[htbp]\n",
"\\centering\n",
"\\caption{Emergency Lending Facility Activity by Crisis Period}\n",
"\\label{tab:borrowing_activity}\n",
"\\small\n",
"\\begin{threeparttable}\n",
"\\begin{tabular}{l rrrrr}\n",
"\\toprule\n",
# ---- Row 1: top-level spanning header ----
" & Pre-BTFP",
" & \\multicolumn{2}{c}{Crisis Period}",
" & Arbitrage",
" & Entire BTFP \\\\\n",
"\\cmidrule(lr){3-4}\n",
# ---- Row 2: date sub-headers ----
" & (Mar 1--12)",
" & Acute",
" & Post-Acute",
" & (Nov 15--Jan 24)",
" & (Mar 13, `23--Mar 11, `24) \\\\\n",
# ---- Row 3: detailed date sub-headers ----
" & ",
" & (Mar 8--15)",
" & (Mar 16--May 4)",
" & ",
" & \\\\\n",
"\\midrule\n",
# ---- Panel A ----
"\\multicolumn{6}{l}{\\textbf{Panel A: Discount Window}} \\\\\n",
paste(rows_a, collapse = ""),
"\\midrule\n",
# ---- Panel B ----
"\\multicolumn{6}{l}{\\textbf{Panel B: Bank Term Funding Program (BTFP)}} \\\\\n",
paste(rows_b, collapse = ""),
"\\midrule\n",
# ---- Panel C ----
"\\multicolumn{6}{l}{\\textbf{Panel C: Federal Home Loan Bank (FHLB)}} \\\\\n",
paste(rows_c, collapse = ""),
"\\bottomrule\n",
"\\end{tabular}\n",
# ---- Notes ----
"\\begin{tablenotes}[flushleft]\n",
"\\footnotesize\n",
"\\item \\textit{Notes:} ",
"Sample excludes failed banks and G-SIBs. ",
"All dollar amounts in billions (\\$B) or millions (\\$M). ",
"\\textbf{Panel A --- Discount Window:} ",
"Loan-level data available through December 31, 2023; ",
"Arbitrage and Entire BTFP columns show \\texttt{---} (data unavailable). ",
"Avg.\\ Rate is the annualized interest rate on new originations. ",
"Avg.\\ Effective Maturity reflects realized term accounting for early repayments. ",
"Loan/Collateral = loan amount $\\div$ pledged collateral $\\times 100$. ",
"\\textbf{Panel B --- BTFP:} ",
"BTFP launched March 13, 2023; Pre-BTFP column shows N/A. ",
"Rate, Term, Effective Maturity, and Loan/Collateral defined identically to Panel A. ",
"\\textbf{Panel C --- FHLB:} ",
"Statistics computed from quarterly Call Report snapshots. ",
"Pre-BTFP and Acute use 2022Q4; Post-Acute uses 2023Q1; Arbitrage uses 2023Q3. ",
"Entire BTFP aggregates four quarters (2023Q1--2023Q4): ",
"advances are summed at the bank level so each bank is counted once. ",
"Banks with Advances = banks where \\texttt{fhlb\\_adv} $> 0$ after aggregation. ",
"Abnormal Borrowers = banks whose quarter-over-quarter change in FHLB advances exceeds a bank-specific Z-score of 1.28 (top 10th percentile, one-tailed), where the Z-score is standardized using each bank's mean and standard deviation of advance changes over the eight-quarter baseline period 2021Q1–2022Q4 ",
"increase threshold in at least one quarter. ",
"Weighted average term uses midpoints: ",
"$<$1yr $= 0.5$, 1--3yr $= 2.0$, 3--5yr $= 4.0$, $>$5yr $= 7.0$ years.",
"\\end{tablenotes}\n",
"\\end{threeparttable}\n",
"\\end{table}\n"
)
safe_writeLines(latex_out, file.path(TABLE_PATH, paste0(filename, ".tex")))
message("Saved: ", filename, ".tex")
invisible(latex_out)
}
build_latex_table(panel_a, panel_b, panel_c, "Table_Borrowing_Activity_ByPeriod")
# ==============================================================================
# 9. VERIFICATION
# ==============================================================================
cat("\n=== BORROWING ACTIVITY TABLE COMPLETE ===\n")##
## === BORROWING ACTIVITY TABLE COMPLETE ===cat("Panel A (DW): ", nrow(panel_a), "metrics x", ncol(panel_a) - 1, "periods\n")## Panel A (DW): 9 metrics x 5 periodscat("Panel B (BTFP): ", nrow(panel_b), "metrics x", ncol(panel_b) - 1, "periods\n")## Panel B (BTFP): 9 metrics x 5 periodscat("Panel C (FHLB): ", nrow(panel_c), "metrics x", ncol(panel_c) - 1, "periods\n")## Panel C (FHLB): 6 metrics x 5 periodscat("\n--- FHLB quarter mapping ---\n")##
## --- FHLB quarter mapping ---for (col in col_names) {
cat(sprintf(" %-14s -> %s\n", col,
paste(fhlb_period_quarters[[col]], collapse = " + ")))
}## Pre-BTFP -> 2022Q4
## Acute -> 2022Q4
## Post-Acute -> 2023Q1
## Arbitrage -> 2023Q3
## Entire BTFP -> 2023Q1 + 2023Q2 + 2023Q3 + 2023Q410 Descriptive Evidence
10.1 MEAN CHARACTERISTICS — Crisis Period, Crisis vs. Arbitrage
# ==============================================================================
# MEAN CHARACTERISTICS — TWO WIDE TABLES
#
# TABLE 1: Crisis Period (8 columns total)
# Acute: BTFP Only | DW Only | Both
# Post-Acute: BTFP Only | DW Only | Both
# Non-Borrower (shared reference, one column, 2022Q4 baseline)
# t-test: each group vs. the shared Non-Borrower column
#
# TABLE 2: Crisis vs. Arbitrage (9 columns total)
# Crisis (Acute): BTFP Only | DW Only | Both | Non-Borrower
# Arbitrage: BTFP Only | DW Only | Both | Non-Borrower
# t-test: each group vs. its OWN period's Non-Borrower
# Note: Arbitrage DW = partial coverage (Nov 15 – Dec 31, 2023 only)
#
# Rows in each table:
# N (banks)
# N with adjusted equity < 0
# [12 characteristic means with t-tests]
# ==============================================================================
# ==============================================================================
# 1. VARIABLE LIST AND LABELS
# ==============================================================================
mean_vars <- c(
"total_asset_b", # Total Assets ($B) — computed inline below
"cash_ratio_raw",
"securities_ratio_raw",
"loan_ratio_raw",
"mtm_total_raw",
"mtm_btfp_raw",
"mtm_other_raw",
"book_equity_ratio_raw",
"insured_lev_raw", # r_insured_deposit — added in construct_analysis_vars
"uninsured_lev_raw",
"uninsured_share_raw",
"wholesale_raw",
"fhlb_ratio_raw",
"roa_raw",
"adjusted_equity_raw"
)
mean_labels_tex <- c(
"Total Assets (\\$B)",
"Cash / TA (\\%)",
"Securities / TA (\\%)",
"Loans / TA (\\%)",
"Total MTM Loss / TA (\\%)",
"OMO MTM Loss / TA (\\%)",
"Non-OMO MTM Loss / TA (\\%)",
"Book Equity / TA (\\%)",
"Insured Dep.\\ / TA (\\%)",
"Uninsured Dep.\\ / TA (\\%)",
"Uninsured / Total Dep.\\ (\\%)",
"Wholesale Funding (\\%)",
"FHLB Advances / TA (\\%)",
"ROA (\\%)",
"Adjusted Equity / TA (\\%)"
)
# ==============================================================================
# 2. HELPERS
# ==============================================================================
fmt_mean <- function(x, digits = 3) {
if (is.na(x) | is.nan(x) | is.infinite(x)) return("---")
sprintf(paste0("%.", digits, "f"), x)
}
fmt_int_cell <- function(x) {
if (is.na(x)) return("---")
formatC(as.integer(x), format = "d", big.mark = ",")
}
# "mean [t-stat]***" cell — tests x_g vs x_ref (Welch)
mean_ttest_cell <- function(x_g, x_ref) {
x_g <- x_g[!is.na(x_g)]
x_ref <- x_ref[!is.na(x_ref)]
m_g <- mean(x_g, na.rm = TRUE)
if (length(x_g) < 2 | length(x_ref) < 2) return(fmt_mean(m_g))
tt <- tryCatch(t.test(x_g, x_ref), error = function(e) NULL)
if (is.null(tt)) return(fmt_mean(m_g))
stars <- case_when(
tt$p.value < 0.01 ~ "$^{***}$",
tt$p.value < 0.05 ~ "$^{**}$",
tt$p.value < 0.10 ~ "$^{*}$",
TRUE ~ ""
)
paste0(fmt_mean(m_g), " [", sprintf("%.2f", tt$statistic), "]", stars)
}
# Attach user_type: keeps BTFP Only / DW Only / Both / Non-Borrower
# drops FHLB-only banks
make_user_type <- function(df, btfp_var, dw_var) {
df %>%
mutate(
user_type = case_when(
!!sym(btfp_var) == 1 & !!sym(dw_var) == 1 ~ "Both",
!!sym(btfp_var) == 1 ~ "BTFP Only",
!!sym(dw_var) == 1 ~ "DW Only",
non_user == 1 ~ "Non-Borrower",
TRUE ~ NA_character_
)
) %>%
filter(!is.na(user_type))
}
pull_group <- function(df, grp, var) df %>% filter(user_type == grp) %>% pull(all_of(var))
count_group <- function(df, grp) sum(df$user_type == grp, na.rm = TRUE)
count_insol <- function(df, grp) sum(df$user_type == grp & df$mtm_insolvent == 1, na.rm = TRUE)
# ==============================================================================
# 3. PREPARE TYPED DATASETS
#
# Add two display-only columns to each period dataset before typing:
# total_asset_b = total_asset ($000s) / 1e6 → $B
# insured_lev_raw = r_insured_deposit (insured dep / TA, %)
# If insured_lev_raw already exists in construct_analysis_vars
# this is a safe no-op; otherwise falls back to r_insured_deposit
# ==============================================================================
add_display_vars <- function(df) {
df %>%
mutate(
total_asset_b = total_asset / 1e6,
insured_lev_raw = if ("insured_lev_raw" %in% names(.))
insured_lev_raw
else
r_insured_deposit
)
}
df_acute_t <- df_acute %>% add_display_vars() %>% make_user_type("btfp_acute", "dw_acute")
df_post_t <- df_post %>% add_display_vars() %>% make_user_type("btfp_post", "dw_post")
# Crisis = Acute UNION Post-Acute (Mar 8 – May 4)
# A bank is a Crisis borrower if it used the facility in EITHER window.
# Characteristics are still from 2022Q4 baseline (same as df_acute / df_post).
# Build by merging both borrower indicators onto df_acute (2022Q4 baseline),
# then classifying: BTFP/DW/Both = used in acute OR post-acute.
df_crisis_t <- df_acute %>%
add_display_vars() %>%
left_join(
df_post %>% select(idrssd, btfp_post, dw_post),
by = "idrssd"
) %>%
mutate(
btfp_post = replace_na(btfp_post, 0L),
dw_post = replace_na(dw_post, 0L),
# Union: borrower in either acute or post-acute
btfp_crisis = as.integer(btfp_acute == 1 | btfp_post == 1),
dw_crisis = as.integer(dw_acute == 1 | dw_post == 1)
) %>%
make_user_type("btfp_crisis", "dw_crisis")
# Arbitrage: build DW borrower indicator for partial window
# (Nov 15 – Dec 31, 2023 — data ends Dec 31)
dw_arb_partial <- dw_loans %>%
filter(
dw_loan_date >= ARB_START,
dw_loan_date <= DW_DATA_END
) %>%
group_by(rssd_id) %>%
summarise(dw_arb_partial = 1L, .groups = "drop") %>%
rename(idrssd = rssd_id)
df_arb_t <- df_arb %>%
add_display_vars() %>%
left_join(dw_arb_partial, by = "idrssd") %>%
mutate(dw_arb_partial = replace_na(dw_arb_partial, 0L)) %>%
make_user_type("btfp_arb", "dw_arb_partial")
# ==============================================================================
# 4. TABLE 1: CRISIS PERIOD
# 8 columns: [Acute] BTFP | DW | Both | [Post-Acute] BTFP | DW | Both |
# Non-Borrower (shared — Acute Non-Borrower, 2022Q4 baseline)
# ==============================================================================
build_table1 <- function() {
# Shared reference: Non-Borrower from Acute period (2022Q4)
xr <- setNames(
lapply(mean_vars, function(v) pull_group(df_acute_t, "Non-Borrower", v)),
mean_vars
)
# N row
n_row <- tibble(
Variable = "\\textit{N}",
`aB` = fmt_int_cell(count_group(df_acute_t, "BTFP Only")),
`aD` = fmt_int_cell(count_group(df_acute_t, "DW Only")),
`aBo` = fmt_int_cell(count_group(df_acute_t, "Both")),
`pB` = fmt_int_cell(count_group(df_post_t, "BTFP Only")),
`pD` = fmt_int_cell(count_group(df_post_t, "DW Only")),
`pBo` = fmt_int_cell(count_group(df_post_t, "Both")),
`NB` = fmt_int_cell(count_group(df_acute_t, "Non-Borrower"))
)
# N insolvent row
insol_row <- tibble(
Variable = "\\textit{N adj.\\ equity $<$ 0}",
`aB` = fmt_int_cell(count_insol(df_acute_t, "BTFP Only")),
`aD` = fmt_int_cell(count_insol(df_acute_t, "DW Only")),
`aBo` = fmt_int_cell(count_insol(df_acute_t, "Both")),
`pB` = fmt_int_cell(count_insol(df_post_t, "BTFP Only")),
`pD` = fmt_int_cell(count_insol(df_post_t, "DW Only")),
`pBo` = fmt_int_cell(count_insol(df_post_t, "Both")),
`NB` = fmt_int_cell(count_insol(df_acute_t, "Non-Borrower"))
)
# Variable rows
var_rows <- map2_dfr(mean_vars, mean_labels_tex, function(v, lbl) {
r <- xr[[v]]
tibble(
Variable = lbl,
`aB` = mean_ttest_cell(pull_group(df_acute_t, "BTFP Only", v), r),
`aD` = mean_ttest_cell(pull_group(df_acute_t, "DW Only", v), r),
`aBo` = mean_ttest_cell(pull_group(df_acute_t, "Both", v), r),
`pB` = mean_ttest_cell(pull_group(df_post_t, "BTFP Only", v), r),
`pD` = mean_ttest_cell(pull_group(df_post_t, "DW Only", v), r),
`pBo` = mean_ttest_cell(pull_group(df_post_t, "Both", v), r),
`NB` = fmt_mean(mean(r, na.rm = TRUE))
)
})
bind_rows(n_row, insol_row, var_rows)
}
# ==============================================================================
# 5. TABLE 2: CRISIS vs. ARBITRAGE
# 9 columns: [Crisis] BTFP | DW | Both | Non-Borrower |
# [Arb] BTFP | DW | Both | Non-Borrower
# Crisis = Acute UNION Post-Acute (Mar 8 – May 4, 2023)
# t-test each group vs its OWN period's Non-Borrower
# ==============================================================================
build_table2 <- function() {
xrc <- setNames(
lapply(mean_vars, function(v) pull_group(df_crisis_t, "Non-Borrower", v)),
mean_vars
)
xra <- setNames(
lapply(mean_vars, function(v) pull_group(df_arb_t, "Non-Borrower", v)),
mean_vars
)
# N row
n_row <- tibble(
Variable = "\\textit{N}",
`cB` = fmt_int_cell(count_group(df_crisis_t, "BTFP Only")),
`cD` = fmt_int_cell(count_group(df_crisis_t, "DW Only")),
`cBo` = fmt_int_cell(count_group(df_crisis_t, "Both")),
`cNB` = fmt_int_cell(count_group(df_crisis_t, "Non-Borrower")),
`aB` = fmt_int_cell(count_group(df_arb_t, "BTFP Only")),
`aD` = fmt_int_cell(count_group(df_arb_t, "DW Only")),
`aBo` = fmt_int_cell(count_group(df_arb_t, "Both")),
`aNB` = fmt_int_cell(count_group(df_arb_t, "Non-Borrower"))
)
# N insolvent row
insol_row <- tibble(
Variable = "\\textit{N adj.\\ equity $<$ 0}",
`cB` = fmt_int_cell(count_insol(df_crisis_t, "BTFP Only")),
`cD` = fmt_int_cell(count_insol(df_crisis_t, "DW Only")),
`cBo` = fmt_int_cell(count_insol(df_crisis_t, "Both")),
`cNB` = fmt_int_cell(count_insol(df_crisis_t, "Non-Borrower")),
`aB` = fmt_int_cell(count_insol(df_arb_t, "BTFP Only")),
`aD` = fmt_int_cell(count_insol(df_arb_t, "DW Only")),
`aBo` = fmt_int_cell(count_insol(df_arb_t, "Both")),
`aNB` = fmt_int_cell(count_insol(df_arb_t, "Non-Borrower"))
)
# Variable rows
var_rows <- map2_dfr(mean_vars, mean_labels_tex, function(v, lbl) {
rc <- xrc[[v]]; ra <- xra[[v]]
tibble(
Variable = lbl,
`cB` = mean_ttest_cell(pull_group(df_crisis_t, "BTFP Only", v), rc),
`cD` = mean_ttest_cell(pull_group(df_crisis_t, "DW Only", v), rc),
`cBo` = mean_ttest_cell(pull_group(df_crisis_t, "Both", v), rc),
`cNB` = fmt_mean(mean(rc, na.rm = TRUE)),
`aB` = mean_ttest_cell(pull_group(df_arb_t, "BTFP Only", v), ra),
`aD` = mean_ttest_cell(pull_group(df_arb_t, "DW Only", v), ra),
`aBo` = mean_ttest_cell(pull_group(df_arb_t, "Both", v), ra),
`aNB` = fmt_mean(mean(ra, na.rm = TRUE))
)
})
bind_rows(n_row, insol_row, var_rows)
}
# ==============================================================================
# 6. BUILD BOTH TABLES
# ==============================================================================
tab1 <- build_table1()
tab2 <- build_table2()
# ==============================================================================
# 7. HTML DISPLAY
# ==============================================================================
strip_tex <- function(df) {
df %>% mutate(across(everything(), ~ {
x <- gsub("\\\\textit\\{(.+?)\\}", "<i>\\1</i>", .)
x <- gsub("\\\\%", "%", x)
x <- gsub("\\\\\\.", ".", x)
x <- gsub("\\$\\^\\{(\\*+)\\}\\$", "\\1", x)
x <- gsub("\\$<\\$", "<", x)
x
}))
}
shared_fn <- paste(
"Welch two-sample t-test vs. Non-Borrower; t-statistics in brackets.",
"*** p<0.01, ** p<0.05, * p<0.10.",
"Non-Borrower = no BTFP, no DW, no abnormal FHLB borrowing (FHLB-only banks excluded).",
"Both = used BTFP and DW in the same period.",
"Total Assets in $B. TA = total assets. MTM = mark-to-market.",
"Uninsured Share = uninsured / total deposits.",
"Wholesale = fed funds + repos + short-term borrowings as % of total liabilities.",
"Adjusted equity = book equity minus MTM losses as % of TA."
)
# Table 1
kable(
strip_tex(tab1),
format = "html",
escape = FALSE,
caption = "Table 1: Mean Bank Characteristics by User Type — Crisis Period",
col.names = c("Variable",
"BTFP Only", "DW Only", "Both",
"BTFP Only", "DW Only", "Both",
"Non-Borrower"),
align = c("l", rep("r", 8))
) %>%
kable_styling(
bootstrap_options = c("striped", "condensed", "hover"),
full_width = TRUE, font_size = 10
) %>%
add_header_above(c(
" " = 1,
"Acute (Mar. 8–15, 2023)" = 3,
"Post-Acute (Mar. 16–May 4, 2023)" = 3,
" " = 1
)) %>%
row_spec(0, bold = TRUE) %>%
row_spec(1:2, italic = TRUE, background = "#f0f0f0") %>%
footnote(
general = paste(shared_fn,
"t-tests for all groups use the Acute Non-Borrower as reference (2022Q4 baseline)."),
general_title = "Notes: ", footnote_as_chunk = TRUE
)| Variable | BTFP Only | DW Only | Both | BTFP Only | DW Only | Both | Non-Borrower |
|---|---|---|---|---|---|---|---|
| N | 23 | 151 | 3 | 408 | 270 | 82 | 3,829 |
| N adj. equity < 0 | 6 | 31 | 1 | 124 | 50 | 19 | 744 |
| Total Assets ($B) | 32.693 [1.20] | 6.617 [2.94]*** | 27.296 [0.97] | 3.644 [1.64] | 3.140 [1.43] | 16.307 [1.94]* | 2.253 |
| Cash / TA (%) | 3.427 [-10.44]*** | 4.978 [-7.38]*** | 11.862 [0.34] | 4.634 [-14.48]*** | 5.782 [-6.79]*** | 4.999 [-5.50]*** | 8.541 |
| Securities / TA (%) | 26.073 [0.01] | 25.465 [-0.46] | 19.552 [-0.92] | 28.339 [3.08]*** | 23.839 [-2.50]** | 28.905 [1.69]* | 26.061 |
| Loans / TA (%) | 64.111 [2.28]** | 63.473 [3.16]*** | 60.690 [0.18] | 61.319 [2.79]*** | 64.495 [5.64]*** | 60.575 [0.80] | 59.192 |
| Total MTM Loss / TA (%) | 6.216 [2.15]** | 5.643 [1.20] | 4.631 [-0.87] | 6.161 [6.99]*** | 5.824 [3.10]*** | 5.866 [1.99]** | 5.436 |
| OMO MTM Loss / TA (%) | 0.902 [1.13] | 0.838 [2.12]** | 0.836 [0.49] | 0.882 [3.86]*** | 0.725 [0.77] | 0.923 [2.15]** | 0.685 |
| Non-OMO MTM Loss / TA (%) | 5.191 [1.84]* | 4.807 [1.57] | 4.021 [-0.42] | 5.040 [5.03]*** | 5.039 [4.10]*** | 4.816 [1.25] | 4.555 |
| Book Equity / TA (%) | 7.501 [-5.88]*** | 8.819 [-4.77]*** | 9.277 [-0.48] | 8.194 [-9.78]*** | 9.057 [-5.32]*** | 8.125 [-6.64]*** | 10.322 |
| Insured Dep. / TA (%) | 55.412 [-2.37]** | 54.849 [-6.00]*** | 36.338 [-1.89] | 59.537 [-3.87]*** | 59.194 [-3.78]*** | 53.564 [-5.62]*** | 62.114 |
| Uninsured Dep. / TA (%) | 27.932 [2.11]** | 30.726 [6.61]*** | 45.429 [1.70] | 26.596 [5.37]*** | 26.303 [4.34]*** | 31.153 [5.23]*** | 23.254 |
| Uninsured / Total Dep. (%) | 33.828 [2.39]** | 36.433 [6.81]*** | 55.983 [1.75] | 31.028 [5.35]*** | 30.986 [4.60]*** | 36.654 [5.40]*** | 27.142 |
| Wholesale Funding (%) | 1.911 [1.02] | 1.593 [2.72]*** | 7.034 [2.50] | 1.489 [3.04]*** | 1.719 [2.91]*** | 1.854 [2.57]** | 0.970 |
| FHLB Advances / TA (%) | 5.742 [3.47]*** | 3.817 [3.66]*** | 0.770 [-4.07]* | 3.804 [5.35]*** | 3.289 [2.66]*** | 4.256 [2.41]** | 2.542 |
| ROA (%) | 1.083 [-1.11] | 1.122 [-0.87] | 1.224 [0.37] | 1.060 [-2.28]** | 1.117 [-1.02] | 1.087 [-1.15] | 1.177 |
| Adjusted Equity / TA (%) | 1.285 [-4.84]*** | 3.175 [-4.02]*** | 4.646 [-0.05] | 2.033 [-10.55]*** | 3.233 [-5.38]*** | 2.259 [-5.47]*** | 4.796 |
| Notes: Welch two-sample t-test vs. Non-Borrower; t-statistics in brackets. *** p<0.01, ** p<0.05, * p<0.10. Non-Borrower = no BTFP, no DW, no abnormal FHLB borrowing (FHLB-only banks excluded). Both = used BTFP and DW in the same period. Total Assets in $B. TA = total assets. MTM = mark-to-market. Uninsured Share = uninsured / total deposits. Wholesale = fed funds + repos + short-term borrowings as % of total liabilities. Adjusted equity = book equity minus MTM losses as % of TA. t-tests for all groups use the Acute Non-Borrower as reference (2022Q4 baseline). |
# Table 2
kable(
strip_tex(tab2),
format = "html",
escape = FALSE,
caption = "Table 2: Mean Bank Characteristics by User Type — Crisis vs. Arbitrage",
col.names = c("Variable",
"BTFP Only", "DW Only", "Both", "Non-Borrower",
"BTFP Only", "DW Only†", "Both", "Non-Borrower"),
align = c("l", rep("r", 9))
) %>%
kable_styling(
bootstrap_options = c("striped", "condensed", "hover"),
full_width = TRUE, font_size = 10
) %>%
add_header_above(c(
" " = 1,
"Crisis — Acute ∪ Post-Acute (Mar. 8–May 4, 2023)" = 4,
"Arbitrage (Nov. 15, 2023–Jan. 24, 2024)" = 4
)) %>%
row_spec(0, bold = TRUE) %>%
row_spec(1:2, italic = TRUE, background = "#f0f0f0") %>%
footnote(
general = paste(
shared_fn,
"Each period's groups are tested vs. their own period's Non-Borrower.",
"Crisis baseline: 2022Q4; Arbitrage baseline: 2023Q3.",
"† Arbitrage DW reflects partial coverage (Nov. 15–Dec. 31, 2023 only);",
"DW data unavailable after December 31, 2023."
),
general_title = "Notes: ", footnote_as_chunk = TRUE
)| Variable | BTFP Only | DW Only | Both | Non-Borrower | BTFP Only | DW Only† | Both | Non-Borrower |
|---|---|---|---|---|---|---|---|---|
| N | 395 | 327 | 106 | 3,226 | 639 | 252 | 110 | 3,062 |
| N adj. equity < 0 | 120 | 61 | 24 | 587 | 174 | 36 | 34 | 538 |
| Total Assets ($B) | 4.935 [1.81]* | 3.951 [2.61]*** | 15.061 [2.34]** | 1.848 | 2.179 [-0.38] | 7.110 [2.99]*** | 9.461 [1.36] | 2.362 |
| Cash / TA (%) | 4.686 [-15.45]*** | 6.151 [-7.44]*** | 4.617 [-8.61]*** | 9.138 | 4.882 [-16.50]*** | 6.481 [-5.02]*** | 4.494 [-12.21]*** | 8.807 |
| Securities / TA (%) | 28.443 [3.40]*** | 23.635 [-2.71]*** | 27.877 [1.34] | 25.885 | 25.398 [2.69]*** | 20.549 [-3.73]*** | 24.364 [0.48] | 23.839 |
| Loans / TA (%) | 61.181 [3.20]*** | 64.260 [6.19]*** | 61.752 [2.02]** | 58.681 | 63.932 [5.05]*** | 66.947 [6.47]*** | 65.048 [3.72]*** | 60.846 |
| Total MTM Loss / TA (%) | 6.175 [7.98]*** | 5.718 [3.31]*** | 5.832 [2.70]*** | 5.326 | 6.030 [8.98]*** | 5.180 [-0.37] | 5.950 [3.34]*** | 5.236 |
| OMO MTM Loss / TA (%) | 0.875 [4.16]*** | 0.728 [1.49] | 0.924 [2.87]*** | 0.657 | 0.851 [5.50]*** | 0.689 [1.01] | 0.745 [1.39] | 0.642 |
| Non-OMO MTM Loss / TA (%) | 5.047 [5.75]*** | 4.935 [4.16]*** | 4.829 [2.04]** | 4.473 | 4.933 [6.44]*** | 4.419 [0.11] | 4.977 [2.88]*** | 4.403 |
| Book Equity / TA (%) | 8.188 [-10.49]*** | 9.097 [-6.34]*** | 8.138 [-7.91]*** | 10.674 | 8.478 [-11.10]*** | 9.342 [-6.20]*** | 8.119 [-8.96]*** | 11.027 |
| Insured Dep. / TA (%) | 59.928 [-3.92]*** | 58.986 [-4.72]*** | 53.137 [-6.63]*** | 62.521 | 61.314 [-3.68]*** | 61.273 [-2.37]** | 60.196 [-2.84]*** | 63.199 |
| Uninsured Dep. / TA (%) | 26.154 [5.56]*** | 26.774 [5.92]*** | 32.010 [6.87]*** | 22.726 | 22.502 [3.84]*** | 22.825 [2.74]*** | 23.555 [2.82]*** | 20.773 |
| Uninsured / Total Dep. (%) | 30.496 [5.53]*** | 31.491 [6.11]*** | 37.683 [6.96]*** | 26.532 | 26.936 [4.22]*** | 27.210 [2.87]*** | 28.038 [2.90]*** | 24.683 |
| Wholesale Funding (%) | 1.497 [3.53]*** | 1.501 [2.86]*** | 1.740 [3.07]*** | 0.876 | 3.591 [13.32]*** | 1.774 [2.75]*** | 3.086 [5.62]*** | 1.168 |
| FHLB Advances / TA (%) | 3.831 [6.15]*** | 3.241 [3.57]*** | 4.034 [2.96]*** | 2.344 | 3.716 [3.85]*** | 3.723 [2.58]** | 3.719 [1.84]* | 2.919 |
| ROA (%) | 1.059 [-2.28]** | 1.133 [-0.95] | 1.090 [-1.40] | 1.193 | 0.896 [-7.44]*** | 1.108 [-2.67]*** | 0.897 [-5.04]*** | 1.319 |
| Adjusted Equity / TA (%) | 2.012 [-11.55]*** | 3.379 [-6.25]*** | 2.306 [-6.80]*** | 5.241 | 2.447 [-12.15]*** | 4.162 [-4.17]*** | 2.169 [-7.55]*** | 5.572 |
| Notes: Welch two-sample t-test vs. Non-Borrower; t-statistics in brackets. *** p<0.01, ** p<0.05, * p<0.10. Non-Borrower = no BTFP, no DW, no abnormal FHLB borrowing (FHLB-only banks excluded). Both = used BTFP and DW in the same period. Total Assets in $B. TA = total assets. MTM = mark-to-market. Uninsured Share = uninsured / total deposits. Wholesale = fed funds + repos + short-term borrowings as % of total liabilities. Adjusted equity = book equity minus MTM losses as % of TA. Each period’s groups are tested vs. their own period’s Non-Borrower. Crisis baseline: 2022Q4; Arbitrage baseline: 2023Q3. † Arbitrage DW reflects partial coverage (Nov. 15–Dec. 31, 2023 only); DW data unavailable after December 31, 2023. |
# ==============================================================================
# 8. LATEX SAVE
# ==============================================================================
save_wide_latex <- function(tbl, filename, caption_text,
header_row1, header_row2,
cmidrule_str, notes_text) {
n_data <- ncol(tbl) - 1
col_spec <- paste(c("l", rep("r", n_data)), collapse = " ")
row_strings <- apply(tbl, 1, function(r) {
# Protect $ in math cells
paste0(" ", paste(r, collapse = " & "), " \\\\\n")
})
row_strings[3] <- paste0(" \\addlinespace[3pt]\n", row_strings[3])
latex_out <- paste0(
"\\begin{table}[htbp]\n",
"\\centering\n",
"\\caption{", caption_text, "}\n",
"\\label{tab:", gsub("[^a-zA-Z0-9]", "_", tolower(filename)), "}\n",
"\\vspace{0.2em}\n",
"\\begin{threeparttable}\n",
"\\scriptsize\n",
"\\setlength{\\tabcolsep}{4pt}\n",
"\\renewcommand{\\arraystretch}{0.95}\n",
"\\begin{tabular}{@{} ", col_spec, " @{}}\n",
"\\toprule\n",
header_row1, "\n",
cmidrule_str, "\n",
header_row2, "\n",
"\\midrule\n",
paste(row_strings, collapse = ""),
"\\bottomrule\n",
"\\end{tabular}\n",
"\\begin{tablenotes}[flushleft]\n",
"\\footnotesize\n",
"\\item \\textit{Notes:} ", notes_text, "\n",
"\\end{tablenotes}\n",
"\\end{threeparttable}\n",
"\\end{table}\n"
)
safe_writeLines(latex_out,
file.path(TABLE_PATH, paste0(filename, ".tex")))
message("Saved: ", filename, ".tex")
invisible(latex_out)
}
# ---- Table 1 LaTeX ----
save_wide_latex(
tbl = tab1,
filename = "Table_Means_Crisis_Period",
caption_text = "Mean Bank Characteristics by User Type --- Crisis Period (Acute vs.\\ Post-Acute)",
header_row1 = paste0(
" & \\multicolumn{3}{c}{Acute (Mar.\\ 8--15, 2023)}",
" & \\multicolumn{3}{c}{Post-Acute (Mar.\\ 16--May\\ 4, 2023)}",
" & \\\\"
),
cmidrule_str = "\\cmidrule(lr){2-4}\\cmidrule(lr){5-7}",
header_row2 = paste0(
" & BTFP Only & DW Only & Both",
" & BTFP Only & DW Only & Both",
" & Non-Borrower \\\\"
),
notes_text = paste0(
"Welch two-sample $t$-test vs.\\ Non-Borrower (shared reference, Acute period); ",
"$t$-statistics in brackets; *** $p<0.01$, ** $p<0.05$, * $p<0.10$. ",
"Non-Borrower $=$ banks that used neither BTFP nor DW and had no abnormal ",
"FHLB borrowing; FHLB-only banks excluded. ",
"Both $=$ used BTFP and DW during the Acute window. ",
"All characteristics measured at 2022Q4 (last pre-crisis quarter). ",
"Total Assets in billions of USD. ",
"TA $=$ total assets. MTM $=$ mark-to-market. OMO $=$ open-market-operations eligible. ",
"Uninsured Share $=$ uninsured deposits as a share of total deposits. ",
"Wholesale $=$ fed funds purchased $+$ repos $+$ other short-term borrowings, as \\% of total liabilities. ",
"Adjusted equity $=$ book equity minus total MTM losses, as \\% of total assets."
)
)
# ---- Table 2 LaTeX ----
save_wide_latex(
tbl = tab2,
filename = "Table_Means_Crisis_vs_Arbitrage",
caption_text = "Mean Bank Characteristics by User Type --- Crisis (Acute) vs.\\ Arbitrage Period",
header_row1 = paste0(
" & \\multicolumn{4}{c}{Crisis --- Acute $\\cup$ Post-Acute (Mar.\\ 8--May\\ 4, 2023)}",
" & \\multicolumn{4}{c}{Arbitrage (Nov.\\ 15, 2023--Jan.\\ 24, 2024)} \\\\"
),
cmidrule_str = "\\cmidrule(lr){2-5}\\cmidrule(lr){6-9}",
header_row2 = paste0(
" & BTFP Only & DW Only & Both & Non-Borrower",
" & BTFP Only & DW Only\\textsuperscript{$\\dagger$} & Both & Non-Borrower \\\\"
),
notes_text = paste0(
"Welch two-sample $t$-test vs.\\ period-specific Non-Borrower; ",
"$t$-statistics in brackets; *** $p<0.01$, ** $p<0.05$, * $p<0.10$. ",
"Non-Borrower $=$ banks that used neither BTFP nor DW and had no abnormal ",
"FHLB borrowing; FHLB-only banks excluded. ",
"Both $=$ used BTFP and DW in the same period. ",
"Crisis columns use the 2022Q4 baseline; Arbitrage columns use the 2023Q3 baseline. ",
"Total Assets in billions of USD. ",
"TA $=$ total assets. MTM $=$ mark-to-market. OMO $=$ open-market-operations eligible. ",
"Uninsured Share $=$ uninsured deposits as a share of total deposits. ",
"Wholesale $=$ fed funds purchased $+$ repos $+$ other short-term borrowings, as \\% of total liabilities. ",
"Adjusted equity $=$ book equity minus total MTM losses, as \\% of total assets. ",
"\\textsuperscript{$\\dagger$}Arbitrage DW reflects partial coverage ",
"(Nov.\\ 15--Dec.\\ 31, 2023 only); DW loan-level data unavailable after December 31, 2023."
)
)
# ==============================================================================
# 9. VERIFICATION
# ==============================================================================
cat("\n=== VERIFICATION: GROUP COUNTS ===\n")##
## === VERIFICATION: GROUP COUNTS ===cat("Table 1 — Acute:\n")## Table 1 — Acute:df_acute_t %>%
group_by(user_type) %>%
summarise(N = n(), N_insol = sum(mtm_insolvent == 1, na.rm = TRUE)) %>%
print()## # A tibble: 4 × 3
## user_type N N_insol
## <chr> <int> <int>
## 1 BTFP Only 23 6
## 2 Both 3 1
## 3 DW Only 151 31
## 4 Non-Borrower 3829 744cat("Table 1 — Post-Acute:\n")## Table 1 — Post-Acute:df_post_t %>%
group_by(user_type) %>%
summarise(N = n(), N_insol = sum(mtm_insolvent == 1, na.rm = TRUE)) %>%
print()## # A tibble: 4 × 3
## user_type N N_insol
## <chr> <int> <int>
## 1 BTFP Only 408 124
## 2 Both 82 19
## 3 DW Only 270 50
## 4 Non-Borrower 3289 599cat("Table 2 — Crisis (Acute UNION Post-Acute):\n")## Table 2 — Crisis (Acute UNION Post-Acute):df_crisis_t %>%
group_by(user_type) %>%
summarise(N = n(), N_insol = sum(mtm_insolvent == 1, na.rm = TRUE)) %>%
print()## # A tibble: 4 × 3
## user_type N N_insol
## <chr> <int> <int>
## 1 BTFP Only 395 120
## 2 Both 106 24
## 3 DW Only 327 61
## 4 Non-Borrower 3226 587cat("Table 2 — Arbitrage:\n")## Table 2 — Arbitrage:df_arb_t %>%
group_by(user_type) %>%
summarise(N = n(), N_insol = sum(mtm_insolvent == 1, na.rm = TRUE)) %>%
print()## # A tibble: 4 × 3
## user_type N N_insol
## <chr> <int> <int>
## 1 BTFP Only 639 174
## 2 Both 110 34
## 3 DW Only 252 36
## 4 Non-Borrower 3062 538cat("\nNote: Crisis N > Acute N because banks that first borrowed in Post-Acute",
"are now correctly included in the Crisis group.\n")##
## Note: Crisis N > Acute N because banks that first borrowed in Post-Acute are now correctly included in the Crisis group.11 Regression Analysis
11.1 Extensive Margin
11.1.1 Extensive Margin: Acute Period (BTFP and DW)
# ==============================================================================
# TABLE: EXTENSIVE MARGIN — ACUTE PERIOD (Mar 8–15, 2023)
# 6 Models: Base / OMO / DepBeta × BTFP / DW
# Baseline: 2022Q4 | Sample: Facility borrowers vs. pure non-borrowers
# ==============================================================================
res_acute_btfp <- run_three_models(df_btfp_s, "btfp_acute")
res_acute_dw <- run_three_models(df_dw_s, "dw_acute")
# DV=1 counts for extra lines
n_btfp_acute <- sum(df_btfp_s$btfp_acute == 1, na.rm = TRUE)
n_dw_acute <- sum(df_dw_s$dw_acute == 1, na.rm = TRUE)
# --- HTML display ---
etable(
c(res_acute_btfp, res_acute_dw),
fitstat = ~ n + r2,
order = COEF_ORDER,
se.below = TRUE,
headers = list(
"^:_:" = list("BTFP" = 3, "DW" = 3)
),
extralines = list(
"_^Period" = rep("Acute", 6),
"_^Baseline" = rep("2022Q4", 6),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_btfp_acute, 3), rep(n_dw_acute, 3))
)
)## base omo depbeta
## BTFP BTFP BTFP
## Dependent Var.: btfp_acute btfp_acute btfp_acute
##
## Constant 0.0051*** 0.0051*** 0.0059***
## (0.0013) (0.0013) (0.0016)
## MTM Loss OMO (z) 0.0004
## (0.0020)
## MTM Loss (z) 0.0018 0.0024
## (0.0014) (0.0017)
## Uninsured Leverage (z) 0.0010 0.0010 0.0009
## (0.0017) (0.0019) (0.0020)
## Deposit Beta (z) 0.0009
## (0.0013)
## MTM $\times$ Uninsured $\times$ Dep. Beta -0.0012
## (0.0017)
## MTM OMO $\times$ Uninsured 0.0022
## (0.0024)
## MTM $\times$ Uninsured 0.0004 -0.0006
## (0.0010) (0.0013)
## MTM $\times$ Dep. Beta 0.0023
## (0.0016)
## Uninsured $\times$ Dep. Beta -0.0016
## (0.0018)
## Log(Assets) 0.0029 0.0030 0.0030
## (0.0018) (0.0020) (0.0018)
## Cash Ratio -0.0014 -0.0020* -0.0015
## (0.0008) (0.0008) (0.0009)
## Loan-to-Deposit 0.0019 0.0015 0.0019
## (0.0013) (0.0017) (0.0013)
## Book Equity Ratio -0.0018* -0.0019* -0.0015
## (0.0009) (0.0008) (0.0010)
## Wholesale Funding -0.0002 -0.0002 -0.0002
## (0.0010) (0.0011) (0.0010)
## ROA -0.0003 -0.0005 -0.0006
## (0.0012) (0.0011) (0.0012)
## ________________________________________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob.
## Period Acute Acute Acute
## Baseline 2022Q4 2022Q4 2022Q4
## Controls Yes Yes Yes
## Borrowers 26 26 26
## Observations 2,907 2,911 2,815
## R2 0.00576 0.00612 0.00708
##
## base.1 omo.1 depbeta.1
## DW DW DW
## Dependent Var.: dw_acute dw_acute dw_acute
##
## Constant 0.0335*** 0.0338*** 0.0325***
## (0.0033) (0.0033) (0.0036)
## MTM Loss OMO (z) 0.0018
## (0.0040)
## MTM Loss (z) -0.0008 -0.0013
## (0.0042) (0.0041)
## Uninsured Leverage (z) 0.0002 0.0005 0.0003
## (0.0041) (0.0039) (0.0045)
## Deposit Beta (z) 0.0027
## (0.0041)
## MTM $\times$ Uninsured $\times$ Dep. Beta 0.0024
## (0.0059)
## MTM OMO $\times$ Uninsured -0.0045
## (0.0033)
## MTM $\times$ Uninsured 0.0018 0.0037
## (0.0041) (0.0043)
## MTM $\times$ Dep. Beta -0.0069
## (0.0042)
## Uninsured $\times$ Dep. Beta 0.0036
## (0.0043)
## Log(Assets) 0.0323*** 0.0338*** 0.0326***
## (0.0056) (0.0056) (0.0056)
## Cash Ratio -0.0021 -0.0018 -0.0014
## (0.0036) (0.0035) (0.0035)
## Loan-to-Deposit -0.0028 -0.0023 -0.0032
## (0.0046) (0.0047) (0.0050)
## Book Equity Ratio -0.0010 -0.0019 -0.0015
## (0.0038) (0.0036) (0.0040)
## Wholesale Funding 0.0086* 0.0106* 0.0091*
## (0.0042) (0.0045) (0.0043)
## ROA -0.0009 0.0005 -0.0013
## (0.0033) (0.0032) (0.0034)
## ________________________________________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob.
## Period Acute Acute Acute
## Baseline 2022Q4 2022Q4 2022Q4
## Controls Yes Yes Yes
## Borrowers 154 154 154
## Observations 2,991 2,997 2,897
## R2 0.03418 0.03991 0.03820
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- LaTeX save ---
save_etable(
c(res_acute_btfp, res_acute_dw),
filename = "Table_Extensive_Acute",
title_text = "Extensive Margin: Emergency Borrowing During the Acute Crisis (Mar 8--15, 2023)",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Dependent variable equals one if the bank used the facility during the Acute window.",
"Models (1)--(3): BTFP; Models (4)--(6): Discount Window.",
"Sample: facility borrowers vs.\\ pure non-borrowers (no BTFP, no DW, no abnormal FHLB).",
"All explanatory variables are z-standardized from the 2022Q4 cross-section.",
"Controls: Log(Assets), Cash Ratio, Loan-to-Deposit, Book Equity Ratio, Wholesale Funding, ROA.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Period" = rep("Acute", 6),
"_^Baseline" = rep("2022Q4", 6),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_btfp_acute, 3), rep(n_dw_acute, 3))
)
)11.1.2 Extensive Margin: Post-Acute Period (BTFP and DW)
# ==============================================================================
# TABLE: EXTENSIVE MARGIN — POST-ACUTE PERIOD (Mar 16–May 4, 2023)
# 6 Models: Base / OMO / DepBeta × BTFP / DW
# Baseline: 2022Q4 | Sample: Facility borrowers vs. pure non-borrowers
# ==============================================================================
res_post_btfp <- run_three_models(df_btfp_post_s, "btfp_post")
res_post_dw <- run_three_models(df_dw_post_s, "dw_post")
n_btfp_post <- sum(df_btfp_post_s$btfp_post == 1, na.rm = TRUE)
n_dw_post <- sum(df_dw_post_s$dw_post == 1, na.rm = TRUE)
# --- HTML display ---
etable(
c(res_post_btfp, res_post_dw),
fitstat = ~ n + r2,
order = COEF_ORDER,
se.below = TRUE,
headers = list(
"^:_:" = list("BTFP" = 3, "DW" = 3)
),
extralines = list(
"_^Period" = rep("Post-Acute", 6),
"_^Baseline" = rep("2022Q4", 6),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_btfp_post, 3), rep(n_dw_post, 3))
)
)## base omo depbeta
## BTFP BTFP BTFP
## Dependent Var.: btfp_post btfp_post btfp_post
##
## Constant 0.1262*** 0.1254*** 0.1316***
## (0.0061) (0.0061) (0.0068)
## MTM Loss OMO (z) 0.0195**
## (0.0073)
## MTM Loss (z) 0.0125 0.0189**
## (0.0067) (0.0072)
## Uninsured Leverage (z) 0.0143 0.0106 0.0113
## (0.0073) (0.0071) (0.0079)
## Deposit Beta (z) 0.0095
## (0.0084)
## MTM $\times$ Uninsured $\times$ Dep. Beta -0.0073
## (0.0068)
## MTM OMO $\times$ Uninsured 0.0041
## (0.0067)
## MTM $\times$ Uninsured 0.0123* 0.0105
## (0.0062) (0.0067)
## MTM $\times$ Dep. Beta 0.0058
## (0.0073)
## Uninsured $\times$ Dep. Beta -0.0170*
## (0.0066)
## Log(Assets) 0.0581*** 0.0588*** 0.0579***
## (0.0084) (0.0083) (0.0086)
## Cash Ratio -0.0337*** -0.0359*** -0.0299***
## (0.0053) (0.0050) (0.0054)
## Loan-to-Deposit -0.0069 -0.0055 -0.0047
## (0.0071) (0.0075) (0.0072)
## Book Equity Ratio -0.0170** -0.0160* -0.0163*
## (0.0063) (0.0063) (0.0066)
## Wholesale Funding 0.0210** 0.0194** 0.0219**
## (0.0072) (0.0073) (0.0072)
## ROA -0.0076 -0.0069 -0.0088
## (0.0061) (0.0060) (0.0064)
## ________________________________________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob.
## Period Post-Acute Post-Acute Post-Acute
## Baseline 2022Q4 2022Q4 2022Q4
## Controls Yes Yes Yes
## Borrowers 490 490 490
## Observations 2,832 2,839 2,743
## R2 0.06929 0.07087 0.07344
##
## base.1 omo.1 depbeta.1
## DW DW DW
## Dependent Var.: dw_post dw_post dw_post
##
## Constant 0.1012*** 0.0985*** 0.1049***
## (0.0058) (0.0056) (0.0064)
## MTM Loss OMO (z) 0.0071
## (0.0065)
## MTM Loss (z) 0.0126* 0.0160*
## (0.0064) (0.0071)
## Uninsured Leverage (z) -0.0008 -0.0032 -0.0017
## (0.0066) (0.0064) (0.0073)
## Deposit Beta (z) 0.0063
## (0.0077)
## MTM $\times$ Uninsured $\times$ Dep. Beta -0.0059
## (0.0061)
## MTM OMO $\times$ Uninsured 2.49e-5
## (0.0058)
## MTM $\times$ Uninsured 0.0158** 0.0108
## (0.0053) (0.0060)
## MTM $\times$ Dep. Beta 0.0157*
## (0.0071)
## Uninsured $\times$ Dep. Beta -0.0093
## (0.0061)
## Log(Assets) 0.0767*** 0.0765*** 0.0770***
## (0.0083) (0.0083) (0.0086)
## Cash Ratio -0.0028 -0.0072 -0.0031
## (0.0059) (0.0055) (0.0060)
## Loan-to-Deposit -0.0017 -0.0035 -0.0023
## (0.0070) (0.0070) (0.0072)
## Book Equity Ratio 0.0019 -0.0020 0.0051
## (0.0056) (0.0054) (0.0060)
## Wholesale Funding 0.0134* 0.0129* 0.0136*
## (0.0064) (0.0065) (0.0065)
## ROA -0.0089 -0.0068 -0.0097
## (0.0057) (0.0056) (0.0060)
## ________________________________________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob.
## Period Post-Acute Post-Acute Post-Acute
## Baseline 2022Q4 2022Q4 2022Q4
## Controls Yes Yes Yes
## Borrowers 352 352 352
## Observations 2,741 2,746 2,653
## R2 0.06950 0.06719 0.07372
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- LaTeX save ---
save_etable(
c(res_post_btfp, res_post_dw),
filename = "Table_Extensive_PostAcute",
title_text = "Extensive Margin: Emergency Borrowing During the Post-Acute Period (Mar 16--May 4, 2023)",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Dependent variable equals one if the bank used the facility during the Post-Acute window.",
"Models (1)--(3): BTFP; Models (4)--(6): Discount Window.",
"Sample: facility borrowers vs.\\ pure non-borrowers.",
"All explanatory variables are z-standardized from the 2022Q4 cross-section.",
"Controls: Log(Assets), Cash Ratio, Loan-to-Deposit, Book Equity Ratio, Wholesale Funding, ROA.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Period" = rep("Post-Acute", 6),
"_^Baseline" = rep("2022Q4", 6),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_btfp_post, 3), rep(n_dw_post, 3))
)
)11.2 Threshold Gradient
# ==============================================================================
# THRESHOLD GRADIENT: SPLIT BY MTM LOSS TERCILE
#
# Theory: At low MTM losses, banks with higher uninsured leverage borrow
# more to preempt run risk. β^H > β^M > β^L
#
# Specification per tercile k ∈ {Low, Med, High}:
# Borrower_i = α^(k) + β^(k) × UninsuredLev_i + γ X_i + ε_i
#
# Estimated across: Acute × Post-Acute × BTFP / DW / Both / Any Facility
# ==============================================================================
# --- Helper: extract UninsuredLev coefficient from a single fixest model ---
extract_unins_coef <- function(m) {
cv <- coef(m)["uninsured_lev"]
sev <- sqrt(vcov(m)["uninsured_lev", "uninsured_lev"])
pv <- 2 * pnorm(-abs(cv / sev))
list(coef = cv, se = sev, p = pv, n = nobs(m))
}
# --- Helper: run gradient for one DV + sample + period label ---
run_gradient <- function(data, dv, period_label, facility_label) {
# Add MTM terciles computed within the sample
data_split <- data %>%
filter(!is.na(mtm_total_w)) %>%
mutate(
mtm_tercile = factor(
ntile(mtm_total_w, 3),
levels = 1:3,
labels = c("Low MTM", "Med MTM", "High MTM")
)
)
fml <- as.formula(paste(dv, "~ uninsured_lev +", CONTROLS))
# feols with split returns a list of fixest objects
models <- feols(fml, data = data_split, split = ~mtm_tercile, vcov = "hetero")
# Extract from each tercile model individually
tercile_labels <- c("Low MTM", "Med MTM", "High MTM")
# Count DV=1 per tercile
dv_counts <- data_split %>%
group_by(mtm_tercile) %>%
summarise(n_borrowers = sum(!!sym(dv) == 1, na.rm = TRUE), .groups = "drop")
results <- map2_dfr(models, tercile_labels, function(m, tlab) {
ex <- extract_unins_coef(m)
nb <- dv_counts %>% filter(mtm_tercile == tlab) %>% pull(n_borrowers)
tibble(
Period = period_label,
Facility = facility_label,
Tercile = tlab,
beta = ex$coef,
se = ex$se,
p = ex$p,
N = ex$n,
Borrowers = if (length(nb) > 0) nb else NA_integer_,
stars = format_pval(ex$p)
)
})
results
}
# --- Build "Any Facility" and "Both" indicators for each period ---
# Acute
df_any_acute_s <- df_acute %>% filter(any_fed == 1 | non_user == 1)
df_both_acute_s <- df_acute %>%
filter((btfp_acute == 1 & dw_acute == 1) | non_user == 1) %>%
mutate(both_acute = as.integer(btfp_acute == 1 & dw_acute == 1))
# Post-Acute
df_any_post_s <- df_post %>% filter(any_fed == 1 | non_user == 1)
df_both_post_s <- df_post %>%
filter((btfp_post == 1 & dw_post == 1) | non_user == 1) %>%
mutate(both_post = as.integer(btfp_post == 1 & dw_post == 1))
# --- Run all combinations ---
gradient_results <- bind_rows(
# Acute
run_gradient(df_btfp_s, "btfp_acute", "Acute", "BTFP"),
run_gradient(df_dw_s, "dw_acute", "Acute", "DW"),
run_gradient(df_both_acute_s, "both_acute", "Acute", "Both"),
run_gradient(df_any_acute_s, "any_fed", "Acute", "Any Facility"),
# Post-Acute
run_gradient(df_btfp_post_s, "btfp_post", "Post-Acute", "BTFP"),
run_gradient(df_dw_post_s, "dw_post", "Post-Acute", "DW"),
run_gradient(df_both_post_s, "both_post", "Post-Acute", "Both"),
run_gradient(df_any_post_s, "any_fed", "Post-Acute", "Any Facility")
)
# --- HTML display: summary table ---
gradient_display <- gradient_results %>%
mutate(
`β [SE]` = paste0(sprintf("%.4f", beta), stars, " (", sprintf("%.4f", se), ")")
) %>%
select(Period, Facility, Tercile, `β [SE]`, N, Borrowers)
kable(
gradient_display,
format = "html",
escape = FALSE,
caption = "Threshold Gradient: Uninsured Leverage Effect on Borrowing by MTM Loss Tercile"
) %>%
kable_styling(
bootstrap_options = c("striped", "condensed", "hover"),
full_width = FALSE, font_size = 11
) %>%
collapse_rows(columns = 1:2, valign = "top")| Period | Facility | Tercile | β [SE] | N | Borrowers |
|---|---|---|---|---|---|
| Acute | BTFP | Low MTM | 0.0008 (0.0006) | 930 | 7 |
| Med MTM | 0.0039 (0.0039) | 1017 | 6 | ||
| High MTM | -0.0012 (0.0030) | 960 | 13 | ||
| DW | Low MTM | -0.0036 (0.0058) | 963 | 44 | |
| Med MTM | -0.0052 (0.0064) | 1037 | 48 | ||
| High MTM | 0.0133 (0.0092) | 991 | 57 | ||
| Both | Low MTM | 0.0000 (NaN) | 925 | 2 | |
| Med MTM | 0.0000 (NaN) | 1012 | 0 | ||
| High MTM | 0.0000 (NaN) | 955 | 1 | ||
| Any Facility | Low MTM | -0.0028 (0.0059) | 967 | 49 | |
| Med MTM | -0.0012 (0.0074) | 1044 | 54 | ||
| High MTM | 0.0120 (0.0094) | 995 | 69 | ||
| Post-Acute | BTFP | Low MTM | 0.0148 (0.0101) | 911 | 93 |
| Med MTM | 0.0010 (0.0132) | 984 | 185 | ||
| High MTM | 0.0310** (0.0142) | 937 | 191 | ||
| DW | Low MTM | -0.0146 (0.0098) | 873 | 81 | |
| Med MTM | -0.0068 (0.0116) | 950 | 128 | ||
| High MTM | 0.0238* (0.0130) | 918 | 132 | ||
| Both | Low MTM | 0.0053 (0.0050) | 803 | 16 | |
| Med MTM | -0.0041 (0.0051) | 883 | 36 | ||
| High MTM | 0.0134* (0.0075) | 847 | 26 | ||
| Any Facility | Low MTM | -0.0016 (0.0119) | 979 | 161 | |
| Med MTM | -0.0021 (0.0150) | 1052 | 277 | ||
| High MTM | 0.0366** (0.0156) | 1009 | 294 |
# --- fixest etable for main BTFP/DW × Acute/Post ---
run_split_etable <- function(data, dv) {
data_s <- data %>%
filter(!is.na(mtm_total_w)) %>%
mutate(mtm_tercile = factor(ntile(mtm_total_w, 3),
levels = 1:3,
labels = c("Low MTM", "Med MTM", "High MTM")))
fml <- as.formula(paste(dv, "~ uninsured_lev +", CONTROLS))
feols(fml, data = data_s, split = ~mtm_tercile, vcov = "hetero")
}
# Count borrowers per tercile for extra lines
count_dv_by_tercile <- function(data, dv) {
data %>%
filter(!is.na(mtm_total_w)) %>%
mutate(mtm_tercile = factor(ntile(mtm_total_w, 3),
levels = 1:3,
labels = c("Low MTM", "Med MTM", "High MTM"))) %>%
group_by(mtm_tercile) %>%
summarise(n = sum(!!sym(dv) == 1, na.rm = TRUE), .groups = "drop") %>%
pull(n)
}
grad_btfp_acute <- run_split_etable(df_btfp_s, "btfp_acute")
grad_dw_acute <- run_split_etable(df_dw_s, "dw_acute")
grad_btfp_post <- run_split_etable(df_btfp_post_s, "btfp_post")
grad_dw_post <- run_split_etable(df_dw_post_s, "dw_post")
n_grad_borrowers <- c(
count_dv_by_tercile(df_btfp_s, "btfp_acute"),
count_dv_by_tercile(df_dw_s, "dw_acute"),
count_dv_by_tercile(df_btfp_post_s, "btfp_post"),
count_dv_by_tercile(df_dw_post_s, "dw_post")
)
save_etable(
c(grad_btfp_acute, grad_dw_acute, grad_btfp_post, grad_dw_post),
filename = "Table_Threshold_Gradient",
title_text = "Threshold Gradient: Borrowing Propensity by MTM Loss Tercile",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Sample split into terciles based on total MTM losses (within each sample).",
"Each column estimates: Borrower_i = α + β × UninsuredLev_i + γ X_i + ε_i.",
"Prediction: β(High) > β(Med) > β(Low) — steeper gradient at higher fragility.",
"Models (1)--(3): BTFP Acute; (4)--(6): DW Acute;",
"(7)--(9): BTFP Post-Acute; (10)--(12): DW Post-Acute.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Facility" = c(rep("BTFP", 3), rep("DW", 3), rep("BTFP", 3), rep("DW", 3)),
"_^Period" = c(rep("Acute", 6), rep("Post-Acute", 6)),
"_^Controls" = rep("Yes", 12),
"_^Borrowers" = n_grad_borrowers
)
)11.3 Intensive Margin
# ==============================================================================
# INTENSIVE MARGIN — SINGLE TABLE, 4 MODELS
#
# Among borrowers only (1 model spec × 2 periods × BTFP/DW = 4 columns):
# (1) BTFP Acute (2) DW Acute (3) BTFP Post-Acute (4) DW Post-Acute
#
# Specification (Base interaction model):
# Borrow_Amt_i = α + β₁ MTM_i + β₂ UninsuredLev_i
# + β₃ (MTM_i × UninsuredLev_i) + γ X_i + ε_i
#
# DV: borrowing amount as % of total assets
# ==============================================================================
# --- Build intensive margin samples ---
# Acute: BTFP borrowers
df_btfp_int_acute <- df_acute %>%
filter(btfp_acute == 1, !is.na(btfp_pct))
# Acute: DW borrowers
df_dw_int_acute <- df_acute %>%
filter(dw_acute == 1, !is.na(dw_pct))
# Post-Acute: BTFP borrowers
df_btfp_int_post <- df_post %>%
filter(btfp_post == 1, !is.na(btfp_post_amt), btfp_post_amt > 0) %>%
mutate(btfp_post_pct = 100 * btfp_post_amt / (total_asset * 1000))
# Post-Acute: DW borrowers
df_dw_int_post <- df_post %>%
filter(dw_post == 1, !is.na(dw_post_amt), dw_post_amt > 0) %>%
mutate(dw_post_pct = 100 * dw_post_amt / (total_asset * 1000))
cat("=== INTENSIVE MARGIN SAMPLE SIZES ===\n")## === INTENSIVE MARGIN SAMPLE SIZES ===cat("Acute BTFP: ", nrow(df_btfp_int_acute), "\n")## Acute BTFP: 26cat("Acute DW: ", nrow(df_dw_int_acute), "\n")## Acute DW: 154cat("Post-Acute BTFP: ", nrow(df_btfp_int_post), "\n")## Post-Acute BTFP: 490cat("Post-Acute DW: ", nrow(df_dw_int_post), "\n")## Post-Acute DW: 352# --- Run all 4 models ---
int_acute_btfp <- run_one(df_btfp_int_acute, "btfp_pct", EXPL_BASE)
int_acute_dw <- run_one(df_dw_int_acute, "dw_pct", EXPL_BASE)
int_post_btfp <- run_one(df_btfp_int_post, "btfp_post_pct", EXPL_BASE)
int_post_dw <- run_one(df_dw_int_post, "dw_post_pct", EXPL_BASE)
int_models <- list(
`BTFP (Acute)` = int_acute_btfp,
`DW (Acute)` = int_acute_dw,
`BTFP (Post-Acute)` = int_post_btfp,
`DW (Post-Acute)` = int_post_dw
)
# --- HTML display ---
etable(
int_models,
fitstat = ~ n + r2,
order = COEF_ORDER,
se.below = TRUE,
headers = list(
"^:_:" = list("Acute" = 2, "Post-Acute" = 2)
),
extralines = list(
"_^Facility" = c("BTFP", "DW", "BTFP", "DW"),
"_^Controls" = rep("Yes", 4),
"_^Borrowers" = c(nrow(df_btfp_int_acute), nrow(df_dw_int_acute),
nrow(df_btfp_int_post), nrow(df_dw_int_post))
)
)## BTFP (.. DW (Ac.. BTFP (Post-.. DW (Post-..
## Acute Acute Post-Acute Post-Acute
## Dependent Var.: btfp_pct dw_pct btfp_post_pct dw_post_pct
##
## Constant 4.151* 1.792** 5.614*** 4.426***
## (1.373) (0.5555) (0.4582) (1.248)
## MTM Loss (z) 0.3490 -0.7726 -0.1759 -1.481
## (0.9969) (0.5136) (0.4018) (1.328)
## Uninsured Leverage (z) 1.851 0.8425 0.4050 2.278
## (1.273) (0.6415) (0.3774) (1.687)
## MTM $\times$ Uninsured 1.920 0.9832* 0.2221 1.521
## (2.184) (0.4731) (0.3222) (1.721)
## Log(Assets) 0.5233 -0.1352 -0.4068 -0.9541
## (1.465) (0.5178) (0.4489) (0.8623)
## Cash Ratio 0.7971 -0.7347 -0.7852 -2.737*
## (3.507) (0.4764) (0.6996) (1.205)
## Loan-to-Deposit -0.8089 0.0840 -0.5559 -0.6222
## (1.173) (0.5290) (0.5431) (1.346)
## Book Equity Ratio 4.140 0.0018 0.2051 0.3381
## (2.468) (0.3598) (0.4453) (0.9998)
## Wholesale Funding -2.089 0.7090 0.2224 1.026
## (1.168) (0.4475) (0.3089) (0.7665)
## ROA 0.1320 -0.8046 -0.4739 -0.7603
## (0.8244) (0.4167) (0.3051) (0.9754)
## ______________________ ________ ________ _____________ ___________
## S.E. type Het.-rob. Het.-rob. Heteros.-rob. Heter.-rob.
## Facility BTFP DW BTFP DW
## Controls Yes Yes Yes Yes
## Borrowers 26 154 490 352
## Observations 15 99 351 260
## R2 0.84509 0.13945 0.02063 0.03610
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- LaTeX save ---
save_etable(
int_models,
filename = "Table_Intensive_Margin",
title_text = "Intensive Margin: Borrowing Amount Conditional on Facility Usage",
notes_text = paste(
"OLS with heteroskedasticity-robust standard errors.",
"Sample restricted to banks that accessed the facility during the specified window.",
"Dependent variable: borrowing amount as \\% of total assets.",
"Models (1)--(2): Acute period (BTFP, DW);",
"Models (3)--(4): Post-Acute period (BTFP, DW).",
"All explanatory variables are z-standardized from the 2022Q4 cross-section.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Period" = c(rep("Acute", 2), rep("Post-Acute", 2)),
"_^Facility" = c("BTFP", "DW", "BTFP", "DW"),
"_^Controls" = rep("Yes", 4),
"_^Borrowers" = c(nrow(df_btfp_int_acute), nrow(df_dw_int_acute),
nrow(df_btfp_int_post), nrow(df_dw_int_post))
)
)11.4 Robustness: Temporal — Crisis vs. Arbitrage (BTFP Only)
# ==============================================================================
# ROBUSTNESS: TEMPORAL — CRISIS (Acute ∪ Post-Acute) vs. ARBITRAGE
# Repeat Extensive Margin for BTFP: 3 models × 2 periods
#
# Crisis = Mar 8 – May 4, 2023 (baseline: 2022Q4)
# Arbitrage = Nov 15, 2023 – Jan 24, 2024 (baseline: 2023Q3)
# ==============================================================================
# --- Crisis sample: BTFP crisis borrowers vs pure non-borrowers ---
df_btfp_crisis_s <- df_crisis_t %>%
filter(btfp_crisis == 1 | user_type == "Non-Borrower")
res_crisis_btfp <- run_three_models(df_btfp_crisis_s, "btfp_crisis")
res_arb_btfp <- run_three_models(df_btfp_arb_s, "btfp_arb")
n_btfp_crisis <- sum(df_btfp_crisis_s$btfp_crisis == 1, na.rm = TRUE)
n_btfp_arb <- sum(df_btfp_arb_s$btfp_arb == 1, na.rm = TRUE)
# --- HTML display ---
etable(
c(res_crisis_btfp, res_arb_btfp),
fitstat = ~ n + r2,
order = COEF_ORDER,
se.below = TRUE,
headers = list(
"^:_:" = list("Crisis (Mar 8 – May 4)" = 3, "Arbitrage (Nov 15 – Jan 24)" = 3)
),
extralines = list(
"_^Baseline" = c(rep("2022Q4", 3), rep("2023Q3", 3)),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_btfp_crisis, 3), rep(n_btfp_arb, 3))
)
)## base
## Crisis (Mar 8 – May 4)
## Dependent Var.: btfp_crisis
##
## Constant 0.1303***
## (0.0063)
## MTM Loss OMO (z)
##
## MTM Loss (z) 0.0132
## (0.0068)
## Uninsured Leverage (z) 0.0148*
## (0.0074)
## Deposit Beta (z)
##
## MTM $\times$ Uninsured $\times$ Dep. Beta
##
## MTM OMO $\times$ Uninsured
##
## MTM $\times$ Uninsured 0.0126*
## (0.0063)
## MTM $\times$ Dep. Beta
##
## Uninsured $\times$ Dep. Beta
##
## Log(Assets) 0.0609***
## (0.0086)
## Cash Ratio -0.0343***
## (0.0054)
## Loan-to-Deposit -0.0065
## (0.0072)
## Book Equity Ratio -0.0179**
## (0.0064)
## Wholesale Funding 0.0207**
## (0.0072)
## ROA -0.0068
## (0.0062)
## ________________________________________ ___________
## S.E. type Heter.-rob.
## Baseline 2022Q4
## Controls Yes
## Borrowers 501
## Observations 2,795
## R2 0.07264
##
## omo
## Crisis (Mar 8 – May 4)
## Dependent Var.: btfp_crisis
##
## Constant 0.1296***
## (0.0062)
## MTM Loss OMO (z) 0.0182*
## (0.0075)
## MTM Loss (z)
##
## Uninsured Leverage (z) 0.0109
## (0.0072)
## Deposit Beta (z)
##
## MTM $\times$ Uninsured $\times$ Dep. Beta
##
## MTM OMO $\times$ Uninsured 0.0043
## (0.0067)
## MTM $\times$ Uninsured
##
## MTM $\times$ Dep. Beta
##
## Uninsured $\times$ Dep. Beta
##
## Log(Assets) 0.0621***
## (0.0085)
## Cash Ratio -0.0368***
## (0.0051)
## Loan-to-Deposit -0.0058
## (0.0076)
## Book Equity Ratio -0.0170**
## (0.0063)
## Wholesale Funding 0.0192**
## (0.0073)
## ROA -0.0063
## (0.0060)
## ________________________________________ ___________
## S.E. type Heter.-rob.
## Baseline 2022Q4
## Controls Yes
## Borrowers 501
## Observations 2,802
## R2 0.07380
##
## depbeta
## Crisis (Mar 8 – May 4)
## Dependent Var.: btfp_crisis
##
## Constant 0.1359***
## (0.0069)
## MTM Loss OMO (z)
##
## MTM Loss (z) 0.0198**
## (0.0074)
## Uninsured Leverage (z) 0.0117
## (0.0081)
## Deposit Beta (z) 0.0101
## (0.0085)
## MTM $\times$ Uninsured $\times$ Dep. Beta -0.0077
## (0.0070)
## MTM OMO $\times$ Uninsured
##
## MTM $\times$ Uninsured 0.0105
## (0.0069)
## MTM $\times$ Dep. Beta 0.0060
## (0.0074)
## Uninsured $\times$ Dep. Beta -0.0170*
## (0.0068)
## Log(Assets) 0.0607***
## (0.0088)
## Cash Ratio -0.0304***
## (0.0055)
## Loan-to-Deposit -0.0043
## (0.0074)
## Book Equity Ratio -0.0171*
## (0.0067)
## Wholesale Funding 0.0217**
## (0.0073)
## ROA -0.0082
## (0.0065)
## ________________________________________ ___________
## S.E. type Heter.-rob.
## Baseline 2022Q4
## Controls Yes
## Borrowers 501
## Observations 2,708
## R2 0.07694
##
## base.1
## Arbitrage (Nov 15 – Jan 24)
## Dependent Var.: btfp_arb
##
## Constant 0.1850***
## (0.0065)
## MTM Loss OMO (z)
##
## MTM Loss (z) 0.0202**
## (0.0077)
## Uninsured Leverage (z) 0.0058
## (0.0077)
## Deposit Beta (z)
##
## MTM $\times$ Uninsured $\times$ Dep. Beta
##
## MTM OMO $\times$ Uninsured
##
## MTM $\times$ Uninsured -0.0016
## (0.0070)
## MTM $\times$ Dep. Beta
##
## Uninsured $\times$ Dep. Beta
##
## Log(Assets) 0.0572***
## (0.0081)
## Cash Ratio -0.0318***
## (0.0068)
## Loan-to-Deposit -0.0040
## (0.0078)
## Book Equity Ratio -0.0094
## (0.0075)
## Wholesale Funding 0.1104***
## (0.0086)
## ROA -0.0246***
## (0.0072)
## ________________________________________ __________
## S.E. type Hete.-rob.
## Baseline 2023Q3
## Controls Yes
## Borrowers 749
## Observations 3,050
## R2 0.15116
##
## omo.1
## Arbitrage (Nov 15 – Jan 24)
## Dependent Var.: btfp_arb
##
## Constant 0.1864***
## (0.0065)
## MTM Loss OMO (z) 0.0106
## (0.0079)
## MTM Loss (z)
##
## Uninsured Leverage (z) 0.0068
## (0.0075)
## Deposit Beta (z)
##
## MTM $\times$ Uninsured $\times$ Dep. Beta
##
## MTM OMO $\times$ Uninsured -0.0103
## (0.0071)
## MTM $\times$ Uninsured
##
## MTM $\times$ Dep. Beta
##
## Uninsured $\times$ Dep. Beta
##
## Log(Assets) 0.0552***
## (0.0081)
## Cash Ratio -0.0372***
## (0.0066)
## Loan-to-Deposit -0.0057
## (0.0084)
## Book Equity Ratio -0.0110
## (0.0073)
## Wholesale Funding 0.1127***
## (0.0088)
## ROA -0.0265***
## (0.0069)
## ________________________________________ __________
## S.E. type Hete.-rob.
## Baseline 2023Q3
## Controls Yes
## Borrowers 749
## Observations 3,056
## R2 0.15121
##
## depbeta.1
## Arbitrage (Nov 15 – Jan 24)
## Dependent Var.: btfp_arb
##
## Constant 0.1859***
## (0.0067)
## MTM Loss OMO (z)
##
## MTM Loss (z) 0.0189*
## (0.0080)
## Uninsured Leverage (z) 0.0091
## (0.0082)
## Deposit Beta (z) -0.0011
## (0.0073)
## MTM $\times$ Uninsured $\times$ Dep. Beta 0.0024
## (0.0072)
## MTM OMO $\times$ Uninsured
##
## MTM $\times$ Uninsured -0.0034
## (0.0075)
## MTM $\times$ Dep. Beta 0.0090
## (0.0071)
## Uninsured $\times$ Dep. Beta 0.0015
## (0.0074)
## Log(Assets) 0.0562***
## (0.0084)
## Cash Ratio -0.0333***
## (0.0071)
## Loan-to-Deposit -0.0043
## (0.0081)
## Book Equity Ratio -0.0077
## (0.0078)
## Wholesale Funding 0.1087***
## (0.0087)
## ROA -0.0248**
## (0.0076)
## ________________________________________ __________
## S.E. type Hete.-rob.
## Baseline 2023Q3
## Controls Yes
## Borrowers 749
## Observations 2,932
## R2 0.14881
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- LaTeX save ---
save_etable(
c(res_crisis_btfp, res_arb_btfp),
filename = "Table_Robustness_Crisis_Vs_Arbitrage",
title_text = "Robustness: BTFP Borrowing During Crisis vs.\\ Arbitrage Period",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Dependent variable equals one if the bank used the BTFP during the specified window.",
"Models (1)--(3): Crisis period (Acute $\\cup$ Post-Acute, Mar 8--May 4, 2023; 2022Q4 baseline).",
"Models (4)--(6): Arbitrage period (Nov 15, 2023--Jan 24, 2024; 2023Q3 baseline).",
"If the selection mechanism is run-risk related, coefficients should be",
"significant during Crisis but attenuated/insignificant during Arbitrage.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Period" = c(rep("Crisis", 3), rep("Arbitrage", 3)),
"_^Baseline" = c(rep("2022Q4", 3), rep("2023Q3", 3)),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_btfp_crisis, 3), rep(n_btfp_arb, 3))
)
)11.5 Falsification Test: FHLB Abnormal Borrowing
# ==============================================================================
# FALSIFICATION: ABNORMAL FHLB BORROWING
# Repeat Extensive Margin for FHLB: 3 models × 2 periods
#
# Prediction: Results should be insignificant or weak — FHLB borrowing
# is not driven by the same run-risk channel as BTFP/DW.
# ==============================================================================
res_fhlb_acute <- run_three_models(df_fhlb_s, "fhlb_user")
res_fhlb_post <- run_three_models(df_fhlb_post_s, "fhlb_user")
n_fhlb_acute <- sum(df_fhlb_s$fhlb_user == 1, na.rm = TRUE)
n_fhlb_post <- sum(df_fhlb_post_s$fhlb_user == 1, na.rm = TRUE)
# --- HTML display ---
etable(
c(res_fhlb_acute, res_fhlb_post),
fitstat = ~ n + r2,
order = COEF_ORDER,
se.below = TRUE,
headers = list(
"^:_:" = list("Acute" = 3, "Post-Acute" = 3)
),
extralines = list(
"_^Period" = c(rep("Acute", 3), rep("Post-Acute", 3)),
"_^Baseline" = rep("2022Q4", 6),
"_^Controls" = rep("Yes", 6),
"_^Abn. FHLB" = c(rep(n_fhlb_acute, 3), rep(n_fhlb_post, 3))
)
)## base omo depbeta
## Acute Acute Acute
## Dependent Var.: fhlb_user fhlb_user fhlb_user
##
## Constant 0.0768*** 0.0787*** 0.0799***
## (0.0047) (0.0047) (0.0053)
## MTM Loss OMO (z) -0.0090
## (0.0050)
## MTM Loss (z) 0.0010 0.0025
## (0.0058) (0.0062)
## Uninsured Leverage (z) 0.0117* 0.0094 0.0089
## (0.0055) (0.0054) (0.0059)
## Deposit Beta (z) 0.0111
## (0.0064)
## MTM $\times$ Uninsured $\times$ Dep. Beta -0.0071
## (0.0060)
## MTM OMO $\times$ Uninsured 0.0016
## (0.0046)
## MTM $\times$ Uninsured -0.0037 -0.0031
## (0.0050) (0.0055)
## MTM $\times$ Dep. Beta -0.0085
## (0.0063)
## Uninsured $\times$ Dep. Beta -0.0116*
## (0.0050)
## Log(Assets) 0.0058 0.0080 0.0028
## (0.0065) (0.0065) (0.0068)
## Cash Ratio -0.0201*** -0.0223*** -0.0184***
## (0.0044) (0.0040) (0.0045)
## Loan-to-Deposit 0.0298*** 0.0260*** 0.0273***
## (0.0063) (0.0065) (0.0065)
## Book Equity Ratio 0.0121* 0.0115* 0.0145**
## (0.0053) (0.0054) (0.0056)
## Wholesale Funding 0.0041 0.0044 0.0051
## (0.0051) (0.0052) (0.0051)
## ROA -0.0120* -0.0133** -0.0115*
## (0.0052) (0.0051) (0.0053)
## ________________________________________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob.
## Period Acute Acute Acute
## Baseline 2022Q4 2022Q4 2022Q4
## Controls Yes Yes Yes
## Abn. FHLB 302 302 302
## Observations 3,136 3,147 3,035
## R2 0.02860 0.02868 0.03142
##
## base.1 omo.1 depbeta.1
## Post-Acute Post-Acute Post-Acute
## Dependent Var.: fhlb_user fhlb_user fhlb_user
##
## Constant 0.0917*** 0.0933*** 0.0961***
## (0.0056) (0.0056) (0.0063)
## MTM Loss OMO (z) -0.0082
## (0.0058)
## MTM Loss (z) 0.0034 0.0059
## (0.0065) (0.0071)
## Uninsured Leverage (z) 0.0133* 0.0101 0.0099
## (0.0062) (0.0061) (0.0067)
## Deposit Beta (z) 0.0135
## (0.0075)
## MTM $\times$ Uninsured $\times$ Dep. Beta -0.0079
## (0.0065)
## MTM OMO $\times$ Uninsured 0.0019
## (0.0053)
## MTM $\times$ Uninsured -0.0012 -0.0013
## (0.0056) (0.0062)
## MTM $\times$ Dep. Beta -0.0072
## (0.0072)
## Uninsured $\times$ Dep. Beta -0.0154**
## (0.0057)
## Log(Assets) 0.0155* 0.0179* 0.0118
## (0.0077) (0.0076) (0.0080)
## Cash Ratio -0.0239*** -0.0270*** -0.0217***
## (0.0048) (0.0043) (0.0049)
## Loan-to-Deposit 0.0324*** 0.0278*** 0.0302***
## (0.0070) (0.0072) (0.0071)
## Book Equity Ratio 0.0130* 0.0120* 0.0160*
## (0.0059) (0.0060) (0.0062)
## Wholesale Funding 0.0070 0.0069 0.0080
## (0.0061) (0.0062) (0.0061)
## ROA -0.0147* -0.0159** -0.0144*
## (0.0058) (0.0057) (0.0060)
## ________________________________________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob.
## Period Post-Acute Post-Acute Post-Acute
## Baseline 2022Q4 2022Q4 2022Q4
## Controls Yes Yes Yes
## Abn. FHLB 302 302 302
## Observations 2,725 2,739 2,638
## R2 0.03825 0.03790 0.04128
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- LaTeX save ---
save_etable(
c(res_fhlb_acute, res_fhlb_post),
filename = "Table_Falsification_FHLB",
title_text = "Falsification Test: Abnormal FHLB Borrowing",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Dependent variable equals one if the bank exhibited abnormal FHLB borrowing",
"(top 10\\% quarter-over-quarter increase, z-score $> 1.28$).",
"Models (1)--(3): Acute period; Models (4)--(6): Post-Acute period.",
"Sample: abnormal FHLB borrowers vs.\\ pure non-borrowers (2022Q4 baseline).",
"Prediction: coefficients should be insignificant or weak compared to BTFP/DW tables.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Period" = c(rep("Acute", 3), rep("Post-Acute", 3)),
"_^Baseline" = rep("2022Q4", 6),
"_^Controls" = rep("Yes", 6),
"_^Abn. FHLB" = c(rep(n_fhlb_acute, 3), rep(n_fhlb_post, 3))
)
)11.6 Additional Robustness
11.6.1 Insured Deposit Specifications
# ==============================================================================
# INSURED DEPOSIT ROBUSTNESS (3 specifications × 2 periods)
#
# 1. Horse-race: Add insured leverage to baseline (with uninsured + MTM×uninsured)
# 2. Swap: Replace uninsured with insured leverage (+ MTM×insured interaction)
# 3. No interaction: Just MTM + insured, no interaction term
# ==============================================================================
m_horse_acute <- run_one(df_btfp_s, "btfp_acute", EXPL_INSURED_HORSE)
m_swap_acute <- run_one(df_btfp_s, "btfp_acute", EXPL_INSURED_SWAP)
m_noint_acute <- run_one(df_btfp_s, "btfp_acute", EXPL_INSURED_NOINT)
m_horse_post <- run_one(df_btfp_post_s, "btfp_post", EXPL_INSURED_HORSE)
m_swap_post <- run_one(df_btfp_post_s, "btfp_post", EXPL_INSURED_SWAP)
m_noint_post <- run_one(df_btfp_post_s, "btfp_post", EXPL_INSURED_NOINT)
n_insured_acute <- sum(df_btfp_s$btfp_acute == 1, na.rm = TRUE)
n_insured_post <- sum(df_btfp_post_s$btfp_post == 1, na.rm = TRUE)
# --- HTML display ---
etable(
list(
`Horse-Race (Acute)` = m_horse_acute,
`Swap (Acute)` = m_swap_acute,
`No Int. (Acute)` = m_noint_acute,
`Horse-Race (Post)` = m_horse_post,
`Swap (Post)` = m_swap_post,
`No Int. (Post)` = m_noint_post
),
fitstat = ~ n + r2,
order = COEF_ORDER,
se.below = TRUE,
extralines = list(
"_^Period" = c(rep("Acute", 3), rep("Post-Acute", 3)),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_insured_acute, 3), rep(n_insured_post, 3))
)
)## Horse-Ra.. Swap (Ac.. No Int. .. Horse-Ra...1 Swap (Po..
## Dependent Var.: btfp_acute btfp_acute btfp_acute btfp_post btfp_post
##
## Constant 0.0071*** 0.0054*** 0.0052*** 0.1363*** 0.1327***
## (0.0020) (0.0014) (0.0014) (0.0072) (0.0064)
## MTM Loss (z) 0.0017 0.0023 0.0021 0.0120 0.0184**
## (0.0014) (0.0014) (0.0013) (0.0067) (0.0069)
## Uninsured Leverage (z) -0.0120* -0.0508*
## (0.0058) (0.0215)
## Insured Leverage (z) -0.0152* -0.0028 -0.0026 -0.0753** -0.0328***
## (0.0073) (0.0021) (0.0020) (0.0237) (0.0086)
## MTM $\times$ Uninsured 0.0006 0.0123
## (0.0011) (0.0065)
## MTM $\times$ Insured -0.0012 -0.0158*
## (0.0013) (0.0072)
## Log(Assets) 0.0022 0.0019 0.0019 0.0549*** 0.0507***
## (0.0018) (0.0017) (0.0017) (0.0086) (0.0086)
## Cash Ratio -0.0010 -0.0016 -0.0017 -0.0316*** -0.0310***
## (0.0008) (0.0009) (0.0009) (0.0055) (0.0059)
## Loan-to-Deposit -0.0005 0.0017 0.0016 -0.0188* -0.0095
## (0.0016) (0.0013) (0.0013) (0.0077) (0.0071)
## Book Equity Ratio -0.0054* -0.0021* -0.0021* -0.0353*** -0.0234***
## (0.0022) (0.0009) (0.0009) (0.0089) (0.0061)
## Wholesale Funding -0.0018 -0.0004 -0.0003 0.0131 0.0184*
## (0.0014) (0.0011) (0.0011) (0.0077) (0.0072)
## ROA 0.0003 -0.0004 -0.0003 -0.0043 -0.0054
## (0.0011) (0.0011) (0.0011) (0.0064) (0.0062)
## ______________________ __________ __________ __________ __________ __________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob. Hete.-rob. Hete.-rob.
## Period Acute Acute Acute Post-Acute Post-Acute
## Controls Yes Yes Yes Yes Yes
## Borrowers 26 26 26 490 490
## Observations 2,852 2,912 2,912 2,777 2,837
## R2 0.00961 0.00654 0.00632 0.07305 0.07162
##
## No Int. ...1
## Dependent Var.: btfp_post
##
## Constant 0.1300***
## (0.0062)
## MTM Loss (z) 0.0157*
## (0.0065)
## Uninsured Leverage (z)
##
## Insured Leverage (z) -0.0294***
## (0.0082)
## MTM $\times$ Uninsured
##
## MTM $\times$ Insured
##
## Log(Assets) 0.0504***
## (0.0086)
## Cash Ratio -0.0319***
## (0.0059)
## Loan-to-Deposit -0.0104
## (0.0071)
## Book Equity Ratio -0.0238***
## (0.0061)
## Wholesale Funding 0.0190**
## (0.0072)
## ROA -0.0044
## (0.0062)
## ______________________ __________
## S.E. type Hete.-rob.
## Period Post-Acute
## Controls Yes
## Borrowers 490
## Observations 2,837
## R2 0.06984
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- LaTeX save ---
save_etable(
list(
`Both (Acute)` = m_horse_acute,
`Insured (Acute)` = m_swap_acute,
`No Int. (Acute)` = m_noint_acute,
`Both (Post)` = m_horse_post,
`Insured (Post)` = m_swap_post,
`No Int. (Post)` = m_noint_post
),
filename = "Table_Robustness_Insured_Deposits",
title_text = "Robustness: The Role of Insured vs.\\ Uninsured Deposits",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Dependent variable: BTFP usage indicator.",
"Both: adds Insured Leverage to baseline spec with Uninsured + MTM$\\times$Uninsured.",
"Insured: replaces Uninsured Leverage with Insured Leverage (+ MTM$\\times$Insured).",
"No Interaction: MTM + Insured Leverage only, no interaction term.",
"Models (1)--(3): Acute; Models (4)--(6): Post-Acute.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Period" = c(rep("Acute", 3), rep("Post-Acute", 3)),
"_^Spec." = rep(c("Both", "Insured", "No Int."), 2),
"_^Controls" = rep("Yes", 6),
"_^Borrowers" = c(rep(n_insured_acute, 3), rep(n_insured_post, 3))
)
)11.6.2 Repeat Borrower Analysis
# ==============================================================================
# 2. REPEAT BORROWER REGRESSION TABLES (LPM)
#
# Definition: Facility-specific repeat borrowers.
# - A BTFP repeat borrower used BTFP in Crisis AND BTFP in Arbitrage.
# - A DW repeat borrower used DW in Crisis AND DW in Arbitrage.
# ==============================================================================
# Identify banks that appear in BOTH 2022Q4 and 2023Q3 baselines
common_ids <- intersect(df_2022q4$idrssd, df_2023q3$idrssd)
cat("Banks present in both baselines:", length(common_ids), "\n")## Banks present in both baselines: 4165# Facility-specific tracking
df_repeat_status <- tibble(idrssd = common_ids) %>%
left_join(df_crisis_t %>% select(idrssd, btfp_crisis, dw_crisis), by = "idrssd") %>%
left_join(df_arb_t %>% select(idrssd, btfp_arb, dw_arb_partial), by = "idrssd") %>%
mutate(
btfp_crisis = replace_na(btfp_crisis, 0L),
dw_crisis = replace_na(dw_crisis, 0L),
btfp_arb = replace_na(btfp_arb, 0L),
dw_arb_partial = replace_na(dw_arb_partial, 0L),
# Facility-specific exact repeat indicators
is_btfp_repeat = as.integer(btfp_crisis == 1 & btfp_arb == 1),
is_dw_repeat = as.integer(dw_crisis == 1 & dw_arb_partial == 1),
# BTFP Status
btfp_status = case_when(
is_btfp_repeat == 1 ~ "Repeat BTFP",
btfp_crisis == 1 & btfp_arb == 0 ~ "Crisis BTFP Only",
btfp_crisis == 0 & btfp_arb == 1 ~ "Arb BTFP Only",
TRUE ~ "Never BTFP"
),
# DW Status
dw_status = case_when(
is_dw_repeat == 1 ~ "Repeat DW",
dw_crisis == 1 & dw_arb_partial == 0 ~ "Crisis DW Only",
dw_crisis == 0 & dw_arb_partial == 1 ~ "Arb DW Only",
TRUE ~ "Never DW"
)
)
# ==============================================================================
# HELPER FUNCTION: BUILD PANEL & RUN REGRESSIONS FOR A SPECIFIC FACILITY
# ==============================================================================
run_repeat_analysis <- function(facility_name, status_col, crisis_dv_col, arb_dv_col) {
# 1. Extract IDs for each group
repeat_ids <- df_repeat_status %>% filter(!!sym(status_col) == paste("Repeat", facility_name)) %>% pull(idrssd)
crisis_only_ids <- df_repeat_status %>% filter(!!sym(status_col) == paste("Crisis", facility_name, "Only")) %>% pull(idrssd)
arb_only_ids <- df_repeat_status %>% filter(!!sym(status_col) == paste("Arb", facility_name, "Only")) %>% pull(idrssd)
never_ids <- df_repeat_status %>% filter(!!sym(status_col) == paste("Never", facility_name)) %>% pull(idrssd)
# 2. Control subsample (3x repeat borrowers)
set.seed(42)
n_controls <- min(length(never_ids), 3 * length(repeat_ids))
control_ids <- sample(never_ids, n_controls)
panel_ids <- unique(c(repeat_ids, crisis_only_ids, arb_only_ids, control_ids))
cat(sprintf("\n=== %s PANEL SETUP ===\n", facility_name))
cat("Panel banks:", length(panel_ids),
"| Repeat:", length(repeat_ids),
"| Crisis-only:", length(crisis_only_ids),
"| Arb-only:", length(arb_only_ids),
"| Control:", length(control_ids), "\n")
# 3. Build Stacked Panel
panel_crisis <- df_2022q4 %>%
filter(idrssd %in% panel_ids) %>%
left_join(df_repeat_status %>% select(idrssd, borrower = !!sym(crisis_dv_col)), by = "idrssd") %>%
mutate(period_id = "Crisis", period_dum = 0L)
panel_arb <- df_2023q3 %>%
filter(idrssd %in% panel_ids) %>%
left_join(df_repeat_status %>% select(idrssd, borrower = !!sym(arb_dv_col)), by = "idrssd") %>%
mutate(period_id = "Arbitrage", period_dum = 1L)
common_cols <- intersect(names(panel_crisis), names(panel_arb))
panel_stacked <- bind_rows(
panel_crisis %>% select(all_of(common_cols)),
panel_arb %>% select(all_of(common_cols))
) %>%
mutate(period_id = factor(period_id, levels = c("Crisis", "Arbitrage")))
# 4. Run Regressions
fml_base <- as.formula(paste("borrower ~ mtm_total + uninsured_lev + mtm_x_uninsured +", CONTROLS))
fml_pooled <- as.formula(paste("borrower ~ period_dum * (mtm_total + uninsured_lev + mtm_x_uninsured) +", CONTROLS))
fml_fe <- as.formula(paste("borrower ~ period_dum * (mtm_total + uninsured_lev + mtm_x_uninsured) +", CONTROLS, "| idrssd"))
m_crisis <- feols(fml_base, data = panel_stacked %>% filter(period_dum == 0), vcov = "hetero")
m_arb <- feols(fml_base, data = panel_stacked %>% filter(period_dum == 1), vcov = "hetero")
m_pooled <- feols(fml_pooled, data = panel_stacked, vcov = "hetero")
m_fe <- feols(fml_fe, data = panel_stacked, vcov = "hetero")
models <- list(`Crisis Only` = m_crisis, `Arbitrage Only` = m_arb, `Pooled + Period` = m_pooled, `Bank FE + Period` = m_fe)
# Counts for table footers
n_bor_crisis <- sum(panel_stacked$borrower[panel_stacked$period_dum == 0] == 1, na.rm = TRUE)
n_bor_arb <- sum(panel_stacked$borrower[panel_stacked$period_dum == 1] == 1, na.rm = TRUE)
n_bor_pooled <- sum(panel_stacked$borrower == 1, na.rm = TRUE)
# 5. Paired t-tests for context
df_chars_crisis <- df_2022q4 %>% filter(idrssd %in% repeat_ids) %>% select(idrssd, mtm_total_raw, uninsured_lev_raw, adjusted_equity_raw, cash_ratio_raw, book_equity_ratio_raw)
df_chars_arb <- df_2023q3 %>% filter(idrssd %in% repeat_ids) %>% select(idrssd, mtm_total_raw, uninsured_lev_raw, adjusted_equity_raw, cash_ratio_raw, book_equity_ratio_raw)
paired_vars <- c("mtm_total_raw", "uninsured_lev_raw", "adjusted_equity_raw", "cash_ratio_raw", "book_equity_ratio_raw")
paired_labels <- c("MTM Loss (% TA)", "Uninsured Leverage (% TA)", "Adjusted Equity (% TA)", "Cash Ratio (% TA)", "Book Equity Ratio (% TA)")
paired_results <- map2_dfr(paired_vars, paired_labels, function(v, lbl) {
merged <- inner_join(
df_chars_crisis %>% select(idrssd, crisis_val = !!sym(v)),
df_chars_arb %>% select(idrssd, arb_val = !!sym(v)),
by = "idrssd"
) %>% filter(!is.na(crisis_val), !is.na(arb_val))
if (nrow(merged) < 3) return(tibble(Variable = lbl, N = nrow(merged), `Crisis Mean` = NA, `Arb Mean` = NA, Diff = NA, `t-stat` = NA, p = NA))
tt <- t.test(merged$crisis_val, merged$arb_val, paired = TRUE)
tibble(Variable = lbl, N = nrow(merged), `Crisis Mean` = round(mean(merged$crisis_val, na.rm = TRUE), 3), `Arb Mean` = round(mean(merged$arb_val, na.rm = TRUE), 3), Diff = round(tt$estimate, 3), `t-stat` = round(tt$statistic, 2), p = round(tt$p.value, 4))
})
return(list(
models = models,
paired_results = paired_results,
n_bor_crisis = n_bor_crisis,
n_bor_arb = n_bor_arb,
n_bor_pooled = n_bor_pooled
))
}
# --- Update fixest dict for period interaction terms ---
setFixest_dict(c(
getFixest_dict(),
period_dum = "Arbitrage Period",
"period_dum::1:mtm_total" = "Arb. $\\times$ MTM Loss",
"period_dum::1:uninsured_lev" = "Arb. $\\times$ Uninsured Lev.",
"period_dum::1:mtm_x_uninsured" = "Arb. $\\times$ MTM $\\times$ Uninsured"
))
# ==============================================================================
# EXECUTE FOR BTFP
# ==============================================================================
btfp_res <- run_repeat_analysis("BTFP", "btfp_status", "btfp_crisis", "btfp_arb")##
## === BTFP PANEL SETUP ===
## Panel banks: 1720 | Repeat: 242 | Crisis-only: 254 | Arb-only: 498 | Control: 726save_etable(
btfp_res$models,
filename = "Table_Robustness_Repeat_Borrowers_BTFP",
title_text = "Repeat BTFP Borrowers: Within-Bank Determinants Across Periods",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Panel includes strict BTFP repeat borrowers (used BTFP in both Crisis and Arbitrage),",
"switchers (Crisis BTFP-only or Arb BTFP-only), and a matched subsample of",
"pure non-borrowers (3$\\times$ the number of repeat borrowers, randomly drawn).",
"Each bank appears twice: once with 2022Q4 characteristics (Crisis row)",
"and once with 2023Q3 characteristics (Arbitrage row).",
"Arb.\\ $\\times$ interaction terms test whether the same variables predict",
"borrowing differently in Crisis vs.\\ Arbitrage.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Sample" = c("Panel (Crisis)", "Panel (Arb)", "Stacked Panel", "Stacked Panel"),
"_^Bank FE" = c("No", "No", "No", "Yes"),
"_^Controls" = rep("Yes", 4),
"_^Borrowers" = c(btfp_res$n_bor_crisis, btfp_res$n_bor_arb, btfp_res$n_bor_pooled, btfp_res$n_bor_pooled)
)
)
kable(btfp_res$paired_results, format = "html", escape = FALSE, caption = "Paired t-test: How Repeat BTFP Borrowers' Fundamentals Changed (Crisis → Arbitrage)") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, font_size = 11)| Variable | N | Crisis Mean | Arb Mean | Diff | t-stat | p |
|---|---|---|---|---|---|---|
| MTM Loss (% TA) | 242 | 6.258 | 6.058 | 0.199 | 9.14 | 0.0000 |
| Uninsured Leverage (% TA) | 242 | 28.208 | 24.032 | 4.176 | 11.93 | 0.0000 |
| Adjusted Equity (% TA) | 242 | 2.015 | 2.031 | -0.016 | -0.38 | 0.7016 |
| Cash Ratio (% TA) | 242 | 4.034 | 4.918 | -0.884 | -4.16 | 0.0000 |
| Book Equity Ratio (% TA) | 242 | 8.273 | 8.090 | 0.183 | 4.14 | 0.0000 |
# ==============================================================================
# EXECUTE FOR DISCOUNT WINDOW (DW)
# ==============================================================================
dw_res <- run_repeat_analysis("DW", "dw_status", "dw_crisis", "dw_arb_partial")##
## === DW PANEL SETUP ===
## Panel banks: 1023 | Repeat: 118 | Crisis-only: 308 | Arb-only: 243 | Control: 354save_etable(
dw_res$models,
filename = "Table_Robustness_Repeat_Borrowers_DW",
title_text = "Repeat DW Borrowers: Within-Bank Determinants Across Periods",
notes_text = paste(
"LPM with heteroskedasticity-robust standard errors.",
"Panel includes strict DW repeat borrowers (used DW in both Crisis and Arbitrage),",
"switchers (Crisis DW-only or Arb DW-only), and a matched subsample of",
"pure non-borrowers (3$\\times$ the number of repeat borrowers, randomly drawn).",
"Each bank appears twice: once with 2022Q4 characteristics (Crisis row)",
"and once with 2023Q3 characteristics (Arbitrage row).",
"Arb.\\ $\\times$ interaction terms test whether the same variables predict",
"borrowing differently in Crisis vs.\\ Arbitrage.",
"*** p$<$0.01, ** p$<$0.05, * p$<$0.10."
),
extra_lines = list(
"_^Sample" = c("Panel (Crisis)", "Panel (Arb)", "Stacked Panel", "Stacked Panel"),
"_^Bank FE" = c("No", "No", "No", "Yes"),
"_^Controls" = rep("Yes", 4),
"_^Borrowers" = c(dw_res$n_bor_crisis, dw_res$n_bor_arb, dw_res$n_bor_pooled, dw_res$n_bor_pooled)
)
)
kable(dw_res$paired_results, format = "html", escape = FALSE, caption = "Paired t-test: How Repeat DW Borrowers' Fundamentals Changed (Crisis → Arbitrage)") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, font_size = 11)| Variable | N | Crisis Mean | Arb Mean | Diff | t-stat | p |
|---|---|---|---|---|---|---|
| MTM Loss (% TA) | 118 | 5.532 | 5.366 | 0.166 | 5.79 | 0.0000 |
| Uninsured Leverage (% TA) | 118 | 28.353 | 24.445 | 3.908 | 5.54 | 0.0000 |
| Adjusted Equity (% TA) | 118 | 3.176 | 3.290 | -0.114 | -1.24 | 0.2179 |
| Cash Ratio (% TA) | 118 | 5.261 | 5.401 | -0.140 | -0.43 | 0.6659 |
| Book Equity Ratio (% TA) | 118 | 8.708 | 8.656 | 0.052 | 0.56 | 0.5749 |
12 Visualization for paper and presentation
12.1 Timeline with key Events
# ==============================================================================
# 1. SURGICAL TIME-WARP (CUMULATIVE WEIGHT APPROACH)
# ==============================================================================
# Define exact start and end dates for the timeline
START_DATE <- as.Date("2023-03-01")
END_DATE <- as.Date("2024-04-01")
# Create a sequence of all days in our timeline
dates_seq <- seq(START_DATE, END_DATE, by = "day")
# Assign an artificial "width" (weight) to every single day
date_weights <- tibble(date = dates_seq, w = 0.4) %>% # 0.4 = compress quiet months
mutate(
w = case_when(
date >= as.Date("2023-03-07") & date <= as.Date("2023-03-16") ~ 22.0, # Massive March Expansion
date >= as.Date("2023-04-28") & date <= as.Date("2023-05-04") ~ 5.0, # First Republic Expansion
date >= as.Date("2023-11-04") & date <= as.Date("2023-11-18") ~ 6.0, # November Expansion
date >= as.Date("2024-01-22") & date <= as.Date("2024-01-27") ~ 22.0, # January Expansion
date >= as.Date("2024-03-09") & date <= as.Date("2024-03-13") ~ 5.0, # March 2024 Expansion
TRUE ~ w
)
) %>%
# The warped coordinate is just the cumulative sum of these widths
mutate(x_warped = cumsum(w))
# Warping function to map any date to its new x-coordinate
warp_date <- function(dates_in) {
tibble(date = as.Date(dates_in)) %>%
left_join(date_weights, by = "date") %>%
pull(x_warped)
}
# ==============================================================================
# 2. PREPARE WARPED DATA
# ==============================================================================
# A) Highlight Segments
# Notice we manually place the label_date in quiet gaps to prevent line crossing
periods_df <- tribble(
~Period, ~start, ~end, ~color, ~label_date,
"Crisis Window", CRISIS_START, CRISIS_END, "#d62728", as.Date("2023-05-04"),
"Arbitrage Window", ARB_START_MAIN, ARB_END, "#ff7f0e", as.Date("2023-12-15")
) %>%
mutate(
x_start = warp_date(start),
x_end = warp_date(end),
x_label = warp_date(label_date)
)
# B) Events with extreme zig-zag vertical spacing to guarantee NO overlap
events_df <- tribble(
~date, ~label, ~yend, ~vjust, ~color,
DATE_MAR08, "Mar 8\nSVB sale/raise", 1.1, 0, "black",
DATE_MAR09, "Mar 9\nRun day (>$40B)", -1.1, 1, "black",
DATE_MAR10, "Mar 10\nSVB fails", 2.5, 0, "#d62728",
DATE_MAR12, "Mar 12\nSignature fails\nBTFP ann.", -2.5, 1, "#d62728",
DATE_MAR13, "Mar 13\nBTFP opens\nDW no-haircut", 1.3, 0, "black",
DATE_MAY01, "May 1\nFirst Republic fails", -1.2, 1, "black",
DATE_OCT31, "Oct 31\nDW no-haircut ends", 2.2, 0, "black",
DATE_NOV06, "Nov 6\nBTFP < IORB", -1.1, 1, "black",
DATE_NOV15, "Nov 15\nSustained sub-IORB", 1.2, 0, "#ff7f0e",
DATE_JAN24, "Jan 24\nPricing floor ann.", 2.2, 0, "#ff7f0e",
DATE_JAN25, "Jan 25\nFloor effective", -2.2, 1, "black",
DATE_MAR11_2024, "Mar 11\nBTFP ends", 1.2, 0, "black"
) %>% mutate(
x_warped = warp_date(date),
y_text = ifelse(yend > 0, yend + 0.15, yend - 0.15)
)
# C) Axis Anchor Ticks (Starts strictly on Mar 1)
anchors_df <- tribble(
~date, ~label,
START_DATE, "Mar 1\n2023",
as.Date("2023-04-01"), "Apr 1",
as.Date("2023-05-04"), "May 4",
as.Date("2023-08-01"), "Jul 1",
as.Date("2023-10-30"), "Oct 1",
as.Date("2024-01-01"), "Jan 1\n2024",
END_DATE, "Apr 1\n2024"
) %>% mutate(x_warped = warp_date(date))
axis_start <- warp_date(START_DATE)
axis_end <- warp_date(END_DATE) + 15
# ==============================================================================
# 3. BUILD THE PLOT
# ==============================================================================
p_warped_clean <- ggplot() +
# A) Main Timeline Axis
geom_segment(
aes(x = axis_start, xend = axis_end, y = 0, yend = 0),
arrow = arrow(length = unit(0.12, "inches"), type = "closed"),
linewidth = 0.6, color = "black"
) +
# B) Colored Highlight Segments
geom_segment(
data = periods_df,
aes(x = x_start, xend = x_end, y = 0, yend = 0, color = color),
linewidth = 3.0 # Thicker to stand out
) +
# C) Period Labels (Placed snugly on the axis in the quiet gaps)
geom_text(
data = periods_df,
aes(x = x_label, y = 0.25, label = Period, color = color),
fontface = "bold", size = 4.2, vjust = 0, family = "serif"
) +
# D) Event Tick Lines
geom_segment(
data = events_df,
aes(x = x_warped, xend = x_warped, y = 0, yend = yend, color = color),
linewidth = 0.5, linetype = "solid"
) +
# E) Event Text Labels (Smaller font for zero overlap)
geom_text(
data = events_df,
aes(x = x_warped, y = y_text, label = label, color = color, vjust = vjust),
size = 3.2, fontface = "bold", lineheight = 0.9, family = "serif"
) +
# F) Axis Anchor Ticks
geom_segment(
data = anchors_df,
aes(x = x_warped, xend = x_warped, y = -0.08, yend = 0.08),
linewidth = 0.6, color = "black"
) +
# G) Axis Anchor Labels
geom_text(
data = anchors_df,
aes(x = x_warped, y = -0.25, label = label),
size = 3.5, vjust = 1, color = "grey30", family = "serif", lineheight = 0.9
) +
scale_color_identity() +
scale_y_continuous(limits = c(-3.5, 3.5)) + # Plenty of vertical room for extreme zig-zags
labs(
title = "Timeline of Crisis Windows and Key Events (2023–2024)",
subtitle = "Note: Horizontal space is heavily weighted around event clusters (e.g., March '23, Jan '24) to ensure clarity."
) +
theme_void() +
theme(
plot.title = element_text(face = "bold", size = 15, margin = margin(b = 5), family = "serif", hjust = 0.5),
plot.subtitle = element_text(size = 11, color = "grey30", margin = margin(b = 25), family = "serif", hjust = 0.5, face = "italic"),
plot.margin = margin(30, 20, 20, 20),
plot.background = element_rect(fill = "white", color = NA)
)
# ==============================================================================
# 4. SAVE
# ==============================================================================
p_warped_clean
save_figure(p_warped_clean, "fig_timeline_new", width = 14, height = 6)12.2 Daily Federal Reserve Emergency Lending During the 2023 Banking Crisis
# ==============================================================================
# 1. AGGREGATE DAILY LENDING
# ==============================================================================
daily_dw <- dw_loans %>%
group_by(date = dw_loan_date) %>%
summarise(Amount = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(Facility = "Discount Window")
daily_btfp <- btfp_loans %>%
group_by(date = btfp_loan_date) %>%
summarise(Amount = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(Facility = "BTFP")
daily_lending <- bind_rows(daily_dw, daily_btfp)
# Color palette for lines
pal_fac <- c("Discount Window" = "#D62828", "BTFP" = "#003049")
# ==============================================================================
# 2. PANEL A: CRISIS PERIOD (Mar 1 - May 15, 2023)
# ==============================================================================
p_panel_a <- daily_lending %>%
filter(date >= as.Date("2023-03-01") & date <= as.Date("2023-05-15")) %>%
ggplot(aes(x = date, y = Amount, color = Facility)) +
geom_line(linewidth = 0.7) +
geom_vline(xintercept = DATE_MAR10, linetype = "dashed", color = "grey50") +
geom_vline(xintercept = DATE_MAR12, linetype = "dashed", color = "grey50") +
geom_vline(xintercept = DATE_MAR13, linetype = "dashed", color = "grey50") +
geom_vline(xintercept = DATE_MAY01, linetype = "dashed", color = "grey50") +
# Using y = Inf and hjust = 1.1 anchors the text perfectly to the top without clipping
annotate("text", x = DATE_MAR10 - 1.5, y = Inf,
label = "SVB Fails", angle = 90, size = 3.5, color = "grey30", hjust = 1.1) +
annotate("text", x = DATE_MAR12 - 0.5, y = Inf,
label = "Signature Fails", angle = 90, size = 3.5, color = "grey30", hjust = 1.1) +
annotate("text", x = DATE_MAR13 + 1.5, y = Inf,
label = "BTFP Opens", angle = 90, size = 3.5, color = "grey30", hjust = 1.1) +
annotate("text", x = DATE_MAY01 - 1.5, y = Inf,
label = "First Republic Fails", angle = 90, size = 3.5, color = "grey30", hjust = 1.1) +
scale_color_manual(values = pal_fac) +
scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
scale_x_date(date_breaks = "1 week", date_labels = "%b %d") +
labs(title = "Panel A: Acute Crisis Period (Mar 1 – May 15, 2023)",
x = NULL, y = "Daily Originations ($B)") +
theme_paper
# ==============================================================================
# 3. PANEL B: ARBITRAGE PERIOD (Nov 1, 2023 - Jan 31, 2024)
# ==============================================================================
p_panel_b <- daily_lending %>%
filter(date >= as.Date("2023-11-01") & date <= as.Date("2024-01-31")) %>%
ggplot(aes(x = date, y = Amount, color = Facility)) +
geom_line(linewidth = 0.7) +
geom_vline(xintercept = DATE_NOV15, linetype = "dashed", color = "grey50") +
geom_vline(xintercept = DATE_JAN24, linetype = "dashed", color = "grey50") +
# Fix for Panel B: Anchoring text to the top so it doesn't get squished by the Y-axis scale
annotate("text", x = DATE_NOV15 - 1.5, y = Inf,
label = "Sustained Arbitrage Starts", angle = 90, size = 3.5, color = "grey30", hjust = 1.1) +
annotate("text", x = DATE_JAN24 - 1.5, y = Inf,
label = "Pricing Floor Announced", angle = 90, size = 3.5, color = "grey30", hjust = 1.1) +
scale_color_manual(values = pal_fac) +
scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
scale_x_date(date_breaks = "2 weeks", date_labels = "%b %d") +
labs(title = "Panel B: Arbitrage Period (Nov 1, 2023 – Jan 31, 2024)",
subtitle = "Note: DW loan-level data is unavailable after Dec 31, 2023.",
x = NULL, y = "Daily Originations ($B)") +
theme_paper
# ==============================================================================
# 4. PANEL C: ENTIRE BTFP PROGRAM (Feb 15, 2023 - Mar 11, 2024)
# ==============================================================================
p_panel_c <- daily_lending %>%
filter(date >= as.Date("2023-02-15") & date <= as.Date("2024-03-11")) %>%
ggplot(aes(x = date, y = Amount, color = Facility)) +
geom_line(linewidth = 0.6) +
scale_color_manual(values = pal_fac) +
scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
labs(title = "Panel C: Entire Program Timeline (Feb 15, 2023 – Mar 11, 2024)",
x = NULL, y = "Daily Originations ($B)") +
theme_paper
# ==============================================================================
# 5. COMBINE AND SAVE (Using patchwork)
# ==============================================================================
# Ensure the legend is prominent and collected nicely at the bottom
p_combined_lending <- p_panel_a / p_panel_b / p_panel_c +
plot_layout(guides = "collect") &
theme(
legend.position = "bottom",
legend.title = element_text(face = "bold", size = 13),
legend.text = element_text(size = 12),
legend.key.width = unit(2, "cm") # Makes the legend lines wider/easier to see
)
p_combined_lending
save_figure(p_combined_lending, "Fig_Daily_Emergency_Lending", width = 12, height = 12)12.3 Adjusted Equity Distribution during Crisis period by borrower group (DW, BTFP, no borrower). Kernel density of adjusted equity (book equity minus MTM losses, % of assets)
# Prepare data (Filter out "Both" to match prompt request)
df_kde <- df_crisis_t %>%
filter(user_type %in% c("BTFP Only", "DW Only", "Non-Borrower")) %>%
mutate(
Group = case_when(
user_type == "BTFP Only" ~ "BTFP",
user_type == "DW Only" ~ "DW",
TRUE ~ "Non-Borrower"
),
Group = factor(Group, levels = c("Non-Borrower", "DW", "BTFP"))
)
pal_kde <- c("Non-Borrower" = "grey70", "DW" = "#D62828", "BTFP" = "#003049")
p_adj_eq <- ggplot(df_kde, aes(x = adjusted_equity_w, fill = Group, color = Group)) +
geom_density(alpha = 0.5, linewidth = 0.8) +
scale_fill_manual(values = pal_kde) +
scale_color_manual(values = pal_kde) +
geom_vline(xintercept = 0, linetype = "dotted", color = "black", linewidth = 1) +
labs(
title = "Distribution of Adjusted Equity by Borrower Group (Crisis Period)",
x = "Adjusted Equity = (Book Equity - MTM Loss)",
y = "Density"
) +
theme_paper
p_adj_eq
save_figure(p_adj_eq, "Fig_KDE_Adjusted_Equity", width = 8, height = 5)12.4 Kernel density of MTM losses (% of assets) by borrower group (DW, BTFP, no borrower), crisis period. Dashed line: sample median.%
# Calculate median for the dashed line
med_mtm <- median(df_kde$mtm_total_w, na.rm = TRUE)
p_mtm <- ggplot(df_kde, aes(x = mtm_total_w, fill = Group, color = Group)) +
geom_density(alpha = 0.5, linewidth = 0.8) +
scale_fill_manual(values = pal_kde) +
scale_color_manual(values = pal_kde) +
geom_vline(xintercept = med_mtm, linetype = "dashed", color = "black", linewidth = 0.8) +
annotate("text", x = med_mtm + 0.5, y = 0.1, label = "Sample Median", angle = 90, size = 3.5) +
labs(
title = "Distribution of Total MTM Losses by Borrower Group (Crisis Period)",
x = "Total MTM Loss (% of Total Assets)",
y = "Density"
) +
theme_paper
p_mtm
save_figure(p_mtm, "Fig_KDE_MTM_Loss", width = 8, height = 5)12.5 Kernel density of uninsured deposits (% of assets) by borrower group (DW, BTFP, no borrower), crisis period. Dashed line: sample median.%
# Calculate median for the dashed line
med_unins <- median(df_kde$uninsured_lev_w, na.rm = TRUE)
p_unins <- ggplot(df_kde, aes(x = uninsured_lev_w, fill = Group, color = Group)) +
geom_density(alpha = 0.5, linewidth = 0.8) +
scale_fill_manual(values = pal_kde) +
scale_color_manual(values = pal_kde) +
geom_vline(xintercept = med_unins, linetype = "dashed", color = "black", linewidth = 0.8) +
annotate("text", x = med_unins + 2, y = 0.02, label = "Sample Median", angle = 90, size = 3.5) +
labs(
title = "Distribution of Uninsured Leverage by Borrower Group (Crisis Period)",
x = "Uninsured Deposits (% of Total Assets)",
y = "Density"
) +
theme_paper
p_unins
save_figure(p_unins, "Fig_KDE_Uninsured_Leverage", width = 8, height = 5)12.6 Variable Distributions (2022Q4 Cross-Section)
# ==============================================================================
# VARIABLE DISTRIBUTION DISTRIBUTIONS (2022Q4 BASELINE)
# Recreates Figure A4 using trimmed variables (_w)
# ==============================================================================
# 1. Select the relevant trimmed variables and apply readable names
df_dist <- df_2022q4 %>%
select(
`MTM Loss (% of Assets)` = mtm_total_w,
`Uninsured Leverage (% of Assets)` = uninsured_lev_w,
`Adjusted Equity (% of Assets)` = adjusted_equity_w,
`Log(Total Assets)` = ln_assets_w,
`Cash Ratio (% of Assets)` = cash_ratio_w,
`Loan-to-Deposit Ratio (%)` = loan_to_deposit_w,
`Book Equity Ratio (%)` = book_equity_ratio_w,
`Wholesale Funding (%)` = wholesale_w,
`Return on Assets (%)` = roa_w
) %>%
# Pivot to long format for easy faceting and drop the trimmed NA values
pivot_longer(cols = everything(), names_to = "Variable", values_to = "Value") %>%
drop_na(Value)
# 2. Define the exact order for the 3x3 grid (matching your PDF)
var_order <- c(
"MTM Loss (% of Assets)",
"Uninsured Leverage (% of Assets)",
"Adjusted Equity (% of Assets)",
"Log(Total Assets)",
"Cash Ratio (% of Assets)",
"Loan-to-Deposit Ratio (%)",
"Book Equity Ratio (%)",
"Wholesale Funding (%)",
"Return on Assets (%)"
)
df_dist$Variable <- factor(df_dist$Variable, levels = var_order)
# 3. Calculate sample means to plot the red dashed lines
df_means <- df_dist %>%
group_by(Variable) %>%
summarise(Mean = mean(Value, na.rm = TRUE), .groups = "drop")
# 4. Build the plot using ggplot2 and facet_wrap
p_dist <- ggplot(df_dist, aes(x = Value)) +
geom_histogram(bins = 50, fill = "#2B5C70", color = "white", linewidth = 0.2) +
geom_vline(data = df_means, aes(xintercept = Mean),
color = "#D62828", linetype = "dashed", linewidth = 0.8) +
facet_wrap(~ Variable, scales = "free", ncol = 3) +
labs(
x = NULL,
y = "Count",
title = "Distribution of Key Variables (2022Q4 Cross-Section)",
subtitle = "Red dashed line = sample mean | Outliers trimmed at 2.5th/97.5th percentiles"
) +
theme_minimal(base_size = 12) +
theme(
strip.text = element_text(face = "bold", size = 11),
plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(color = "grey40", size = 11, margin = margin(b = 15)),
panel.grid.minor = element_blank(),
panel.spacing = unit(1.5, "lines"), # Add breathing room between panels
axis.title.y = element_text(margin = margin(r = 10))
)
# Display the plot in the HTML output
p_dist
# Save the figure to the output directory
save_figure(p_dist, "FigA4_Control_Distributions", width = 12, height = 10)