Emergency Lending and Depositor Coordination: An Adjusted Equity Framework Reverse
BTFP, Discount Window, and FHLB Borrowing During the March 2023 Banking Crisis
Mohua Ferdousi
February 12, 2026
1 SETUP AND DATA PREPARATION
1.1 Packages
rm(list = ls())
# Core
library(data.table)
library(dplyr)
library(tidyr)
library(stringr)
library(lubridate)
library(purrr)
library(tibble)
# 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
# ==============================================================================
winsorize <- 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)
pmax(pmin(x, q[2]), q[1])
}
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 HELPERS
# ==============================================================================
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)
}
}
mean_by_group <- function(df, columns_to_include, group_var, win_probs = c(0, 1)) {
dt <- as.data.table(copy(df))
setnames(dt, group_var, "group_var")
count_tbl <- dt[, .(N = .N), by = group_var]
result_tbl <- dt[, lapply(.SD, function(x) {
round(mean(Winsorize(x, quantile(x, probs = win_probs, na.rm = TRUE)), na.rm = TRUE), 3)
}), by = group_var, .SDcols = columns_to_include]
merged <- merge(count_tbl, result_tbl, by = "group_var")
setorder(merged, group_var)
transposed <- t(merged)
colnames(transposed) <- unlist(transposed[1, ])
transposed <- transposed[-1, , drop = FALSE]
out <- data.table(Variable = c("N", columns_to_include), transposed)
return(out)
}
# ==============================================================================
# FILE I/O (OneDrive resilient)
# ==============================================================================
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_reg_table <- function(models, filename, title_text = "", notes_text = "",
coef_map_use = NULL, gof_map_use = NULL,
add_rows_use = NULL, ...) {
tryCatch({
modelsummary(models, stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = coef_map_use, gof_map = gof_map_use,
add_rows = add_rows_use,
title = title_text, notes = notes_text,
output = file.path(TABLE_PATH, paste0(filename, ".tex")), ...)
message("Saved: ", filename, ".tex")
}, error = function(e) message("Warning: Could not save ", filename, ": ", e$message))
}
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 and Key Dates
# ==============================================================================
# PATHS
# ==============================================================================
BASE_PATH <- "C:/Users/mferdo2/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/adjusted_equity")
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)
}
# ==============================================================================
# KEY DATES AND PERIODS
# ==============================================================================
BASELINE_MAIN <- "2022Q4"
BASELINE_ARB <- "2023Q3"
BASELINE_WIND <- "2023Q4"
DATE_MAR01 <- as.Date("2023-03-01")
DATE_MAR09 <- as.Date("2023-03-09")
DATE_MAR10 <- as.Date("2023-03-10")
DATE_MAR12 <- as.Date("2023-03-12")
DATE_MAR13 <- as.Date("2023-03-13")
DATE_MAR14 <- as.Date("2023-03-14")
ACUTE_START <- as.Date("2023-03-13")
ACUTE_END <- as.Date("2023-05-01")
POST_ACUTE_END <- as.Date("2023-10-31")
ARB_START <- as.Date("2023-11-01")
ARB_END <- as.Date("2024-01-24")
WIND_START <- as.Date("2024-01-25")
WIND_END <- as.Date("2024-03-11")
DW_DATA_END <- as.Date("2023-12-31")
OVERALL_START <- as.Date("2023-03-01")
OVERALL_END <- as.Date("2024-03-11")1.4 Load Data
call_q <- read_csv(file.path(DATA_PROC, "final_call_gsib.csv"), show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd))
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))
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("BTFP Loans:", nrow(btfp_loans_raw), "| DW Loans:", nrow(dw_loans_raw), "\n")## BTFP Loans: 6734 | DW Loans: 100081.5 Exclude Failed Banks and G-SIBs
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): 41btfp_loans <- btfp_loans_raw %>% filter(!rssd_id %in% excluded_banks)
dw_loans <- dw_loans_raw %>% filter(!rssd_id %in% excluded_banks)1.6 Create Borrower Indicators by Period
# ==============================================================================
# BORROWER INDICATOR FACTORY
# ==============================================================================
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 ---
btfp_mar10 <- create_borrower_indicator(btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount", DATE_MAR10, DATE_MAR10, "btfp_mar10")
btfp_mar10_13 <- create_borrower_indicator(btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount", DATE_MAR10, DATE_MAR13, "btfp_mar10_13")
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", ACUTE_END + 1, 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, "btfp_overall")
# --- DW ---
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", ACUTE_END + 1, 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("\n=== BORROWER COUNTS ===\n")##
## === BORROWER COUNTS ===cat("BTFP: Mar10=", nrow(btfp_mar10), " Acute=", nrow(btfp_acute),
" Post=", nrow(btfp_post), " Arb=", nrow(btfp_arb), " Wind=", nrow(btfp_wind), "\n")## BTFP: Mar10= 0 Acute= 485 Post= 811 Arb= 797 Wind= 237cat("DW: Pre=", nrow(dw_prebtfp), " Acute=", nrow(dw_acute), " Post=", nrow(dw_post), "\n")## DW: Pre= 106 Acute= 417 Post= 9541.7 Construct Analysis Variables
# ==============================================================================
# VARIABLE CONSTRUCTION
# ==============================================================================
construct_analysis_vars <- function(baseline_data) {
baseline_data %>%
mutate(
# === RAW VARIABLES ===
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,
uninsured_share_raw = uninsured_to_deposit,
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
uninsured_outflow_raw = change_uninsured_fwd_q,
insured_outflow_raw = change_insured_deposit_fwd_q,
total_outflow_raw = change_total_deposit_fwd_q,
# === ADJUSTED EQUITY (MTM Losses - Book Equity) ===
# REVERSED: higher AE = larger loss gap = worse solvency
adjusted_equity_raw = mtm_loss_to_total_asset - book_equity_to_total_asset,
# === JIANG ET AL. INSOLVENCY MEASURES ===
mv_adjustment_raw = if_else(mm_asset == 0 | is.na(mm_asset), NA_real_, (total_asset / mm_asset) - 1),
idcr_1_raw = safe_div(mm_asset - 0.5 * uninsured_deposit - insured_deposit, insured_deposit),
idcr_2_raw = safe_div(mm_asset - 1.0 * uninsured_deposit - insured_deposit, insured_deposit),
insolvency_1_raw = safe_div((total_asset - total_liability) - 0.5 * uninsured_deposit * mv_adjustment_raw, total_asset),
insolvency_2_raw = safe_div((total_asset - total_liability) - 1.0 * uninsured_deposit * mv_adjustment_raw, total_asset),
# === WINSORIZED ===
mtm_total_w = winsorize(mtm_total_raw),
mtm_btfp_w = winsorize(mtm_btfp_raw),
mtm_other_w = winsorize(mtm_other_raw),
uninsured_lev_w = winsorize(uninsured_lev_raw),
uninsured_share_w = winsorize(uninsured_share_raw),
ln_assets_w = winsorize(ln_assets_raw),
cash_ratio_w = winsorize(cash_ratio_raw),
securities_ratio_w = winsorize(securities_ratio_raw),
loan_ratio_w = winsorize(loan_ratio_raw),
book_equity_ratio_w = winsorize(book_equity_ratio_raw),
tier1_ratio_w = winsorize(tier1_ratio_raw),
roa_w = winsorize(roa_raw),
fhlb_ratio_w = winsorize(fhlb_ratio_raw),
loan_to_deposit_w = winsorize(loan_to_deposit_raw),
wholesale_w = winsorize(wholesale_raw),
adjusted_equity_w = winsorize(adjusted_equity_raw),
mv_adjustment = winsorize(mv_adjustment_raw),
idcr_1 = winsorize(idcr_1_raw),
idcr_2 = winsorize(idcr_2_raw),
insolvency_1 = winsorize(insolvency_1_raw),
insolvency_2 = winsorize(insolvency_2_raw),
# === Z-STANDARDIZED (for regressions) ===
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),
uninsured_share = standardize_z(uninsured_share_w),
adjusted_equity = standardize_z(adjusted_equity_w),
# Interaction (z * z)
ae_x_uninsured = standardize_z(adjusted_equity_w) * standardize_z(uninsured_lev_w),
mtm_x_uninsured = standardize_z(mtm_total_w) * standardize_z(uninsured_lev_w),
# === OMO-BASED VARIABLES ===
# Adjusted Equity using OMO losses only (Outline OMO-4)
adjusted_equity_omo_raw = mtm_loss_omo_eligible_to_total_asset - book_equity_to_total_asset,
adjusted_equity_omo_w = winsorize(adjusted_equity_omo_raw),
adjusted_equity_omo = standardize_z(adjusted_equity_omo_w),
# Par Benefit = OMO MTM Loss / OMO Holdings (Outline OMO-6)
# Both numerator and denominator are _to_total_asset ratios, so TA cancels
par_benefit_raw = safe_div(mtm_loss_omo_eligible_to_total_asset,
safe_div(omo_eligible, total_asset), 0),
par_benefit_w = winsorize(par_benefit_raw),
par_benefit = standardize_z(par_benefit_w),
# OMO-specific interactions (z × z, matching ae_x_uninsured pattern)
mtm_omo_x_uninsured = mtm_btfp * uninsured_lev,
mtm_nonomo_x_uninsured = mtm_other * uninsured_lev,
ae_omo_x_uninsured = adjusted_equity_omo * uninsured_lev,
par_x_uninsured = par_benefit * uninsured_lev,
# OMO-based solvency indicators (Outline OMO-5)
# REVERSED: AE = MTM - BookEquity, so AE > 0 means insolvent
omo_insolvent = as.integer(adjusted_equity_omo_w > 0),
omo_solvent = as.integer(adjusted_equity_omo_w <= 0),
# Controls (z)
ln_assets = standardize_z(ln_assets_w),
cash_ratio = standardize_z(cash_ratio_w),
securities_ratio = standardize_z(securities_ratio_w),
loan_ratio = standardize_z(loan_ratio_w),
book_equity_ratio = standardize_z(book_equity_ratio_w),
tier1_ratio = standardize_z(tier1_ratio_w),
roa = standardize_z(roa_w),
fhlb_ratio = standardize_z(fhlb_ratio_w),
loan_to_deposit = standardize_z(loan_to_deposit_w),
wholesale = standardize_z(wholesale_w),
# Deposit outflows (z)
uninsured_outflow = standardize_z(winsorize(uninsured_outflow_raw)),
insured_outflow = standardize_z(winsorize(insured_outflow_raw)),
total_outflow = standardize_z(winsorize(total_outflow_raw)),
# === THREE INSOLVENCY DEFINITIONS ===
# (1) MTM Insolvent: MTM Loss - Book Equity > 0 (reversed AE)
mtm_insolvent = as.integer(adjusted_equity_w > 0),
# (2) IDCR 50% scenario: idcr_1 < 0
insolvent_idcr_s50 = as.integer(idcr_1 < 0),
# (3) IDCR 100% scenario: idcr_2 < 0
insolvent_idcr_s100 = as.integer(idcr_2 < 0),
# Complementary solvency indicators
mtm_solvent = as.integer(adjusted_equity_w <= 0),
solvent_idcr_s50 = as.integer(idcr_1 >= 0),
solvent_idcr_s100 = as.integer(idcr_2 >= 0),
# === MEDIAN-SPLIT INDICATORS ===
high_uninsured = as.integer(uninsured_lev > median(uninsured_lev, na.rm = TRUE)),
high_mtm_loss = as.integer(mtm_total > median(mtm_total, na.rm = TRUE)),
# === SIZE ===
size_cat = factor(create_size_category_3(total_asset), levels = size_levels_3),
# Clustering
state = if ("state" %in% names(.)) state else NA_character_,
fed_district = if ("fed_district" %in% names(.)) fed_district else NA_character_
)
}
# ==============================================================================
# ADD QUARTILE DUMMIES AND RISK DUMMIES
# ==============================================================================
add_run_risk_dummies <- function(data) {
medians <- data %>%
summarise(median_mtm = median(mtm_total_w, na.rm = TRUE),
median_uninsured = median(uninsured_lev_w, na.rm = TRUE))
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)
)
data %>%
mutate(
# --- Median-split Risk Dummies (reference = Risk 1) ---
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 Quartile Dummies (ref = Q1 = safest, lowest loss gap) ---
# REVERSED AE: Q1 = lowest (safest), Q4 = highest (riskiest)
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),
adj_equity_q4 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q3), 0L),
# --- Uninsured Leverage Quartile Dummies (ref = Q1 = lowest) ---
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 Spec 5 threshold gradient)
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 Quartile Dummies (ref = 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),
# --- 16-cell AE x Uninsured (ref = aeq1_ulq1 = safest AE x lowest uninsured) ---
aeq1_ulq1 = replace_na(as.integer(adjusted_equity_w <= quartiles$adj_eq_q1 & uninsured_lev_w <= quartiles$unins_lev_q1), 0L),
aeq1_ulq2 = replace_na(as.integer(adjusted_equity_w <= quartiles$adj_eq_q1 & uninsured_lev_w > quartiles$unins_lev_q1 & uninsured_lev_w <= quartiles$unins_lev_q2), 0L),
aeq1_ulq3 = replace_na(as.integer(adjusted_equity_w <= quartiles$adj_eq_q1 & uninsured_lev_w > quartiles$unins_lev_q2 & uninsured_lev_w <= quartiles$unins_lev_q3), 0L),
aeq1_ulq4 = replace_na(as.integer(adjusted_equity_w <= quartiles$adj_eq_q1 & uninsured_lev_w > quartiles$unins_lev_q3), 0L),
aeq2_ulq1 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q1 & adjusted_equity_w <= quartiles$adj_eq_q2 & uninsured_lev_w <= quartiles$unins_lev_q1), 0L),
aeq2_ulq2 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q1 & adjusted_equity_w <= quartiles$adj_eq_q2 & uninsured_lev_w > quartiles$unins_lev_q1 & uninsured_lev_w <= quartiles$unins_lev_q2), 0L),
aeq2_ulq3 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q1 & adjusted_equity_w <= quartiles$adj_eq_q2 & uninsured_lev_w > quartiles$unins_lev_q2 & uninsured_lev_w <= quartiles$unins_lev_q3), 0L),
aeq2_ulq4 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q1 & adjusted_equity_w <= quartiles$adj_eq_q2 & uninsured_lev_w > quartiles$unins_lev_q3), 0L),
aeq3_ulq1 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q2 & adjusted_equity_w <= quartiles$adj_eq_q3 & uninsured_lev_w <= quartiles$unins_lev_q1), 0L),
aeq3_ulq2 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q2 & adjusted_equity_w <= quartiles$adj_eq_q3 & uninsured_lev_w > quartiles$unins_lev_q1 & uninsured_lev_w <= quartiles$unins_lev_q2), 0L),
aeq3_ulq3 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q2 & adjusted_equity_w <= quartiles$adj_eq_q3 & uninsured_lev_w > quartiles$unins_lev_q2 & uninsured_lev_w <= quartiles$unins_lev_q3), 0L),
aeq3_ulq4 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q2 & adjusted_equity_w <= quartiles$adj_eq_q3 & uninsured_lev_w > quartiles$unins_lev_q3), 0L),
aeq4_ulq1 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q3 & uninsured_lev_w <= quartiles$unins_lev_q1), 0L),
aeq4_ulq2 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q3 & uninsured_lev_w > quartiles$unins_lev_q1 & uninsured_lev_w <= quartiles$unins_lev_q2), 0L),
aeq4_ulq3 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q3 & uninsured_lev_w > quartiles$unins_lev_q2 & uninsured_lev_w <= quartiles$unins_lev_q3), 0L),
aeq4_ulq4 = replace_na(as.integer(adjusted_equity_w > quartiles$adj_eq_q3 & uninsured_lev_w > quartiles$unins_lev_q3), 0L),
# Store cutoffs
adj_eq_q1_used = quartiles$adj_eq_q1,
adj_eq_q2_used = quartiles$adj_eq_q2,
adj_eq_q3_used = quartiles$adj_eq_q3,
unins_lev_q1_used = quartiles$unins_lev_q1,
unins_lev_q2_used = quartiles$unins_lev_q2,
unins_lev_q3_used = quartiles$unins_lev_q3,
mtm_q1_used = quartiles$mtm_q1,
mtm_q2_used = quartiles$mtm_q2,
mtm_q3_used = quartiles$mtm_q3,
median_mtm_used = medians$median_mtm,
median_uninsured_used = medians$median_uninsured
)
}1.8 Create Baseline Datasets
df_2022q4 <- call_q %>%
filter(period == BASELINE_MAIN, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
construct_analysis_vars() %>% add_run_risk_dummies()
df_2023q3 <- call_q %>%
filter(period == BASELINE_ARB, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
construct_analysis_vars() %>% add_run_risk_dummies()
df_2023q4 <- call_q %>%
filter(period == BASELINE_WIND, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
construct_analysis_vars() %>% add_run_risk_dummies()
cat("=== BASELINE DATASETS ===\n")## === BASELINE DATASETS ===cat("2022Q4:", nrow(df_2022q4), "| 2023Q3:", nrow(df_2023q3), "| 2023Q4:", nrow(df_2023q4), "\n")## 2022Q4: 4292 | 2023Q3: 4214 | 2023Q4: 4197cat("\n=== INSOLVENCY COUNTS (2022Q4) ===\n")##
## === INSOLVENCY COUNTS (2022Q4) ===cat("MTM Insolvent:", sum(df_2022q4$mtm_insolvent, na.rm=TRUE), "\n")## MTM Insolvent: 825cat("IDCR 50% Insolvent:", sum(df_2022q4$insolvent_idcr_s50, na.rm=TRUE), "\n")## IDCR 50% Insolvent: 179cat("IDCR 100% Insolvent:", sum(df_2022q4$insolvent_idcr_s100, na.rm=TRUE), "\n")## IDCR 100% Insolvent: 12101.9 Join Borrower Indicators
# ==============================================================================
# CLEAN SAMPLE CONSTRUCTION
# 0 = PURE NON-BORROWERS (no BTFP, no DW, no 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 = case_when(
!!sym(btfp_var) == 1 & !!sym(dw_var) == 1 ~ "Both",
!!sym(btfp_var) == 1 & !!sym(dw_var) == 0 ~ "BTFP_Only",
!!sym(btfp_var) == 0 & !!sym(dw_var) == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
user_group = factor(user_group, levels = c("Neither", "BTFP_Only", "DW_Only", "Both")),
any_fed = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1),
both_fed = as.integer(!!sym(btfp_var) == 1 & !!sym(dw_var) == 1),
all_user = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1 | fhlb_user == 1),
non_user = as.integer(!!sym(btfp_var) == 0 & !!sym(dw_var) == 0 & fhlb_user == 0),
# 5-group user type for descriptive tables
user_type_5 = case_when(
!!sym(dw_var) == 1 ~ "DW",
!!sym(btfp_var) == 1 ~ "BTFP",
fhlb_user == 1 ~ "FHLB",
TRUE ~ "Pure Non-Borrower"
),
user_type_5 = factor(user_type_5, levels = c("DW", "BTFP", "FHLB", "Pure Non-Borrower"))
)
}
# --- Period datasets ---
df_acute <- join_all_borrowers(df_2022q4, btfp_acute, dw_acute, "btfp_acute", "dw_acute") %>%
mutate(
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_)
)
df_mar10 <- join_all_borrowers(df_2022q4, btfp_mar10, dw_mar10, "btfp_mar10", "dw_mar10")
df_mar10_13 <- join_all_borrowers(df_2022q4, btfp_mar10_13, dw_mar10_13, "btfp_mar10_13", "dw_mar10_13")
btfp_prebtfp <- create_borrower_indicator(btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount", DATE_MAR01, DATE_MAR12, "btfp_prebtfp")
df_prebtfp <- join_all_borrowers(df_2022q4, btfp_prebtfp, dw_prebtfp, "btfp_prebtfp", "dw_prebtfp")
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")))
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")))
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")))
df_overall <- join_all_borrowers(df_2022q4, btfp_overall, dw_overall, "btfp_overall", "dw_overall")
cat("\n=== ACUTE PERIOD USER GROUPS ===\n")##
## === ACUTE PERIOD USER GROUPS ===print(table(df_acute$user_group))##
## Neither BTFP_Only DW_Only Both
## 3531 368 299 94cat("Pure Non-Users:", sum(df_acute$non_user), "\n")## Pure Non-Users: 32851.10 Model Setup
# ==============================================================================
# CONTROLS (book_equity_ratio dropped from CONTROLS_AE to avoid collinearity)
# ==============================================================================
CONTROLS_FULL <- "ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa"
CONTROLS_AE <- "ln_assets + cash_ratio + loan_to_deposit + wholesale + roa"
# ==============================================================================
# FORMULA BUILDERS
# ==============================================================================
build_formula <- function(dv, explanatory, controls = CONTROLS_FULL) {
as.formula(paste(dv, "~", explanatory, "+", controls))
}
build_formula_ae <- function(dv, explanatory, controls = CONTROLS_AE) {
as.formula(paste(dv, "~", explanatory, "+", controls))
}
# ==============================================================================
# VARIABLE LABELS (fixest dictionary)
# ==============================================================================
setFixest_dict(c(
adjusted_equity = "Adjusted Equity (z)",
uninsured_lev = "Uninsured Leverage (z)",
ae_x_uninsured = "Adj. Equity $\\times$ Uninsured",
mtm_total = "MTM Loss (z)",
mtm_btfp = "MTM Loss OMO (z)",
mtm_other = "MTM Loss Non-OMO (z)",
mtm_x_uninsured = "MTM $\\times$ Uninsured",
mtm_omo_x_uninsured = "MTM OMO $\\times$ Uninsured",
mtm_nonomo_x_uninsured = "MTM Non-OMO $\\times$ Uninsured",
adjusted_equity_omo = "Adj. Equity OMO (z)",
ae_omo_x_uninsured = "Adj. Equity OMO $\\times$ Uninsured",
par_benefit = "Par Benefit (z)",
par_x_uninsured = "Par Benefit $\\times$ Uninsured",
run_risk_2 = "Risk 2: Low MTM, High Unins.",
run_risk_3 = "Risk 3: High MTM, Low Unins.",
run_risk_4 = "Risk 4: High MTM, High Unins.",
adj_equity_q2 = "Adj. Equity Q2", adj_equity_q3 = "Adj. Equity Q3", adj_equity_q4 = "Adj. Equity Q4 (Highest)",
unins_lev_q2 = "Unins. Lev. Q2", unins_lev_q3 = "Unins. Lev. Q3", unins_lev_q4 = "Unins. Lev. Q4 (Highest)",
mtm_q2 = "MTM Q2", mtm_q3 = "MTM Q3", mtm_q4 = "MTM Q4 (Highest Loss)",
aeq1_ulq1 = "AE-Q1 $\\times$ UL-Q1", aeq1_ulq2 = "AE-Q1 $\\times$ UL-Q2",
aeq1_ulq3 = "AE-Q1 $\\times$ UL-Q3", aeq1_ulq4 = "AE-Q1 $\\times$ UL-Q4",
aeq2_ulq1 = "AE-Q2 $\\times$ UL-Q1", aeq2_ulq2 = "AE-Q2 $\\times$ UL-Q2",
aeq2_ulq3 = "AE-Q2 $\\times$ UL-Q3", aeq2_ulq4 = "AE-Q2 $\\times$ UL-Q4",
aeq3_ulq1 = "AE-Q3 $\\times$ UL-Q1", aeq3_ulq2 = "AE-Q3 $\\times$ UL-Q2",
aeq3_ulq3 = "AE-Q3 $\\times$ UL-Q3", aeq3_ulq4 = "AE-Q3 $\\times$ UL-Q4",
aeq4_ulq1 = "AE-Q4 $\\times$ UL-Q1", aeq4_ulq2 = "AE-Q4 $\\times$ UL-Q2", aeq4_ulq3 = "AE-Q4 $\\times$ UL-Q3",
aeq4_ulq4 = "AE-Q4 $\\times$ UL-Q4",
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"
))
# ==============================================================================
# EXPLANATORY VARIABLE STRINGS
# ==============================================================================
EXPL_AE_BASE <- "adjusted_equity + uninsured_lev + ae_x_uninsured"
EXPL_AE_Q <- "adj_equity_q2 + adj_equity_q3 + adj_equity_q4"
EXPL_UNINS_Q <- "unins_lev_q2 + unins_lev_q3 + unins_lev_q4"
EXPL_AE_UL_Q16 <- paste(
"aeq1_ulq2 + aeq1_ulq3 + aeq1_ulq4",
"aeq2_ulq1 + aeq2_ulq2 + aeq2_ulq3 + aeq2_ulq4",
"aeq3_ulq1 + aeq3_ulq2 + aeq3_ulq3 + aeq3_ulq4",
"aeq4_ulq1 + aeq4_ulq2 + aeq4_ulq3 + aeq4_ulq4", sep = " + ")
EXPL_MTM_DECOMP <- "mtm_btfp + mtm_other + uninsured_lev"
EXPL_RISK <- "run_risk_2 + run_risk_3 + run_risk_4"
EXPL_OMO_DECOMP <- "mtm_btfp + mtm_other + uninsured_lev"
EXPL_OMO_INTER <- "mtm_btfp + uninsured_lev + mtm_omo_x_uninsured"
EXPL_OMO_HORSE <- "mtm_btfp + mtm_other + uninsured_lev + mtm_omo_x_uninsured + mtm_nonomo_x_uninsured"
EXPL_AE_OMO_BASE <- "adjusted_equity_omo + uninsured_lev + ae_omo_x_uninsured"
EXPL_PAR_BENEFIT <- "par_benefit + uninsured_lev + par_x_uninsured"
# ==============================================================================
# GENERIC MODEL RUNNER
# ==============================================================================
run_one <- function(data, dv, explanatory, family_type = "lpm", controls = CONTROLS_AE) {
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")
}
}
count_info <- function(data, dv) {
paste0("N(", dv, "=1)=", sum(data[[dv]] == 1, na.rm = TRUE), ", N=", nrow(data))
}
# ==============================================================================
# ETABLE SAVER
# ==============================================================================
save_etable <- function(models, filename, title_text, notes_text,
fitstat_use = ~ n + r2, drop_controls = TRUE,
extra_lines = NULL) {
drop_pattern <- if (drop_controls) "Log\\(Assets\\)|Cash Ratio|Loan-to-Deposit|Book Equity|Wholesale|ROA" else NULL
etable(models, title = title_text, notes = notes_text, fitstat = fitstat_use,
drop = drop_pattern, extralines = extra_lines,
tex = TRUE, file = file.path(TABLE_PATH, paste0(filename, ".tex")),
replace = TRUE, style.tex = style.tex("aer"))
message("Saved: ", filename, ".tex")
}
# ==============================================================================
# VISUALIZATION THEME (consistent across all figures)
# ==============================================================================
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)
)
# Color palette: borrower types
pal_user <- c("DW" = "#D62828", "BTFP" = "#003049", "FHLB" = "#F77F00",
"Pure Non-Borrower" = "grey70", "Both" = "#7209B7")
pal_solv <- c("Solvent" = "#2A9D8F", "Insolvent" = "#E76F51")2 DESCRIPTIVE STATISTICS
2.1 Table 1: Full Sample Summary Statistics
# ==============================================================================
# TABLE 1: STANDARD SUMMARY STATISTICS — FULL SAMPLE
# ==============================================================================
sumstat_vars <- c(
"adjusted_equity_raw", "mtm_total_raw", "mtm_btfp_raw", "mtm_other_raw",
"uninsured_lev_raw", "uninsured_share_raw",
"book_equity_ratio_raw", "ln_assets_raw", "cash_ratio_raw",
"securities_ratio_raw", "loan_ratio_raw", "roa_raw",
"fhlb_ratio_raw", "loan_to_deposit_raw", "wholesale_raw",
"idcr_1_raw", "idcr_2_raw"
)
sumstat_labels <- c(
"Adjusted Equity / TA (%)", "Total MTM Loss / TA (%)", "OMO MTM Loss / TA (%)", "Non-OMO MTM Loss / TA (%)",
"Uninsured Deposits / TA (%)", "Uninsured / Total Deposits (%)",
"Book Equity / TA (%)", "Log(Total Assets)", "Cash / TA (%)",
"Securities / TA (%)", "Loans / TA (%)", "ROA (%)",
"FHLB / TA (%)", "Loan-to-Deposit (%)", "Wholesale Funding (%)",
"IDCR 50% Scenario", "IDCR 100% Scenario"
)
tab_sumstats <- summary_stats_function(df_2022q4, sumstat_vars)
tab_sumstats$Variable <- sumstat_labels[match(tab_sumstats$Variable, sumstat_vars)]
kable(tab_sumstats, caption = "Table 1: Summary Statistics (2022Q4, OMO-Eligible Banks)",
digits = 3, align = c("l", rep("r", 8))) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE, font_size = 11)| Variable | N | Mean | SD | P10 | P25 | P50 | P75 | P90 |
|---|---|---|---|---|---|---|---|---|
| Adjusted Equity / TA (%) | 4282 | -4.672 | 9.403 | -9.721 | -6.435 | -3.621 | -0.853 | 1.791 |
| Total MTM Loss / TA (%) | 4282 | 5.467 | 2.223 | 2.791 | 3.863 | 5.320 | 6.975 | 8.455 |
| OMO MTM Loss / TA (%) | 4282 | 0.681 | 0.848 | 0.016 | 0.136 | 0.405 | 0.932 | 1.706 |
| Non-OMO MTM Loss / TA (%) | 4282 | 4.599 | 2.062 | 2.161 | 3.110 | 4.395 | 5.972 | 7.384 |
| Uninsured Deposits / TA (%) | 4292 | 23.611 | 12.158 | 9.604 | 15.285 | 22.247 | 30.353 | 39.278 |
| Uninsured / Total Deposits (%) | 4292 | 27.595 | 14.258 | 11.388 | 17.867 | 25.801 | 35.108 | 46.042 |
| Book Equity / TA (%) | 4292 | 10.220 | 8.817 | 5.452 | 7.143 | 8.842 | 10.888 | 14.114 |
| Log(Total Assets) | 4292 | 12.882 | 1.483 | 11.210 | 11.903 | 12.721 | 13.650 | 14.709 |
| Cash / TA (%) | 4292 | 8.148 | 9.191 | 1.712 | 2.667 | 5.030 | 10.051 | 18.015 |
| Securities / TA (%) | 4292 | 25.681 | 15.784 | 7.079 | 13.704 | 23.323 | 35.090 | 46.765 |
| Loans / TA (%) | 4292 | 59.990 | 17.654 | 36.254 | 49.604 | 62.303 | 73.421 | 80.308 |
| ROA (%) | 4292 | 1.163 | 2.569 | 0.401 | 0.704 | 1.014 | 1.319 | 1.680 |
| FHLB / TA (%) | 4292 | 2.647 | 4.215 | 0.000 | 0.000 | 0.346 | 4.073 | 7.987 |
| Loan-to-Deposit (%) | 4292 | 70.866 | 27.432 | 40.909 | 56.561 | 71.818 | 86.500 | 97.535 |
| Wholesale Funding (%) | 4292 | 1.000 | 3.166 | 0.000 | 0.000 | 0.000 | 0.533 | 3.058 |
| IDCR 50% Scenario | 4251 | 1.716 | 37.337 | 0.065 | 0.148 | 0.247 | 0.388 | 0.605 |
| IDCR 100% Scenario | 4251 | 1.329 | 36.320 | -0.110 | -0.013 | 0.068 | 0.160 | 0.296 |
2.2 Table 2: Insolvency Prevalence (Three Definitions)
# ==============================================================================
# TABLE 2: INSOLVENCY PREVALENCE ACROSS DEFINITIONS
# ==============================================================================
insolvency_summary <- function(df, label) {
n <- nrow(df)
tibble(
Period = label,
N = n,
`MTM Insolvent (N)` = sum(df$mtm_insolvent, na.rm = TRUE),
`MTM Insolvent (%)` = round(100 * sum(df$mtm_insolvent, na.rm = TRUE) / n, 1),
`IDCR-50 Insolvent (N)` = sum(df$insolvent_idcr_s50, na.rm = TRUE),
`IDCR-50 Insolvent (%)` = round(100 * sum(df$insolvent_idcr_s50, na.rm = TRUE) / n, 1),
`IDCR-100 Insolvent (N)` = sum(df$insolvent_idcr_s100, na.rm = TRUE),
`IDCR-100 Insolvent (%)` = round(100 * sum(df$insolvent_idcr_s100, na.rm = TRUE) / n, 1)
)
}
tab_insolvency <- bind_rows(
insolvency_summary(df_2022q4, "2022Q4"),
insolvency_summary(df_2023q3, "2023Q3"),
insolvency_summary(df_2023q4, "2023Q4")
)
kable(tab_insolvency, caption = "Table 2: Insolvency Prevalence by Definition and Period",
align = c("l", rep("r", 7))) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Period | N | MTM Insolvent (N) | MTM Insolvent (%) | IDCR-50 Insolvent (N) | IDCR-50 Insolvent (%) | IDCR-100 Insolvent (N) | IDCR-100 Insolvent (%) |
|---|---|---|---|---|---|---|---|
| 2022Q4 | 4292 | 825 | 19.2 | 179 | 4.2 | 1210 | 28.2 |
| 2023Q3 | 4214 | 801 | 19.0 | 404 | 9.6 | 1359 | 32.2 |
| 2023Q4 | 4197 | 574 | 13.7 | 489 | 11.7 | 1510 | 36.0 |
2.3 Table 3: Solvent vs. Insolvent Borrower Statistics by Period
# ==============================================================================
# TABLE 3: SOLVENT vs INSOLVENT BORROWERS — BY USER TYPE AND PERIOD
# Three insolvency specifications x {DW, BTFP, FHLB, Pure Non-Borrower}
# ==============================================================================
compute_solvency_by_user <- function(df, insolvency_var, user_type_col = "user_type_5", label) {
df %>%
filter(!is.na(!!sym(insolvency_var)), !is.na(!!sym(user_type_col))) %>%
group_by(!!sym(user_type_col)) %>%
summarise(
N_total = n(),
N_insolvent = sum(!!sym(insolvency_var) == 1, na.rm = TRUE),
N_solvent = sum(!!sym(insolvency_var) == 0, na.rm = TRUE),
Pct_insolvent = round(100 * N_insolvent / N_total, 1),
Pct_solvent = round(100 * N_solvent / N_total, 1),
# Mean characteristics for solvent vs insolvent
AE_mean_solvent = round(mean(adjusted_equity_raw[!!sym(insolvency_var) == 0], na.rm = TRUE), 3),
AE_mean_insolvent = round(mean(adjusted_equity_raw[!!sym(insolvency_var) == 1], na.rm = TRUE), 3),
MTM_mean_solvent = round(mean(mtm_total_raw[!!sym(insolvency_var) == 0], na.rm = TRUE), 3),
MTM_mean_insolvent = round(mean(mtm_total_raw[!!sym(insolvency_var) == 1], na.rm = TRUE), 3),
UL_mean_solvent = round(mean(uninsured_lev_raw[!!sym(insolvency_var) == 0], na.rm = TRUE), 3),
UL_mean_insolvent = round(mean(uninsured_lev_raw[!!sym(insolvency_var) == 1], na.rm = TRUE), 3),
.groups = "drop"
) %>%
mutate(Specification = label)
}
# --- Acute Period ---
sol_acute_mtm <- compute_solvency_by_user(df_acute, "mtm_insolvent", label = "MTM Insolvent")
sol_acute_id50 <- compute_solvency_by_user(df_acute, "insolvent_idcr_s50", label = "IDCR 50%")
sol_acute_id100 <- compute_solvency_by_user(df_acute, "insolvent_idcr_s100", label = "IDCR 100%")
tab_sol_acute <- bind_rows(sol_acute_mtm, sol_acute_id50, sol_acute_id100) %>%
select(Specification, everything()) %>%
rename(User_Type = user_type_5)
cat("\n=== TABLE 3A: SOLVENCY BY USER TYPE — ACUTE PERIOD ===\n")##
## === TABLE 3A: SOLVENCY BY USER TYPE — ACUTE PERIOD ===kable(tab_sol_acute,
caption = "Table 3A: Solvent vs. Insolvent Borrowers by User Type — Acute Period (Mar 13 – May 1, 2023)",
digits = 2, align = c("l", "l", rep("r", 11))) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE, font_size = 10) %>%
pack_rows("MTM Insolvent (AdjEquity < 0)", 1, 4) %>%
pack_rows("IDCR 50% Scenario", 5, 8) %>%
pack_rows("IDCR 100% Scenario", 9, 12)| Specification | User_Type | N_total | N_insolvent | N_solvent | Pct_insolvent | Pct_solvent | AE_mean_solvent | AE_mean_insolvent | MTM_mean_solvent | MTM_mean_insolvent | UL_mean_solvent | UL_mean_insolvent |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| MTM Insolvent (AdjEquity < 0) | ||||||||||||
| MTM Insolvent | DW | 393 | 77 | 316 | 19.6 | 80.4 | -4.46 | 2.67 | 5.26 | 7.91 | 28.44 | 27.37 |
| MTM Insolvent | BTFP | 368 | 112 | 256 | 30.4 | 69.6 | -4.05 | 2.69 | 5.43 | 7.88 | 26.47 | 25.60 |
| MTM Insolvent | FHLB | 246 | 34 | 212 | 13.8 | 86.2 | -5.33 | 2.51 | 5.19 | 8.72 | 23.64 | 22.99 |
| MTM Insolvent | Pure Non-Borrower | 3275 | 602 | 2673 | 18.4 | 81.6 | -6.87 | 2.24 | 4.79 | 7.75 | 22.53 | 23.75 |
| IDCR 50% Scenario | ||||||||||||
| IDCR 50% | DW | 393 | 24 | 369 | 6.1 | 93.9 | -2.96 | -4.70 | 5.87 | 4.35 | 28.56 | 23.17 |
| IDCR 50% | BTFP | 368 | 13 | 355 | 3.5 | 96.5 | -1.95 | -3.39 | 6.22 | 5.13 | 26.53 | 17.35 |
| IDCR 50% | FHLB | 246 | 10 | 236 | 4.1 | 95.9 | -4.29 | -3.26 | 5.71 | 4.91 | 23.51 | 24.44 |
| IDCR 50% | Pure Non-Borrower | 3244 | 132 | 3112 | 4.1 | 95.9 | -4.43 | -4.99 | 5.42 | 4.28 | 23.00 | 22.47 |
| IDCR 100% Scenario | ||||||||||||
| IDCR 100% | DW | 393 | 122 | 271 | 31.0 | 69.0 | -3.35 | -2.43 | 5.86 | 5.59 | 27.25 | 30.40 |
| IDCR 100% | BTFP | 368 | 107 | 261 | 29.1 | 70.9 | -2.22 | -1.45 | 6.22 | 6.10 | 25.56 | 27.79 |
| IDCR 100% | FHLB | 246 | 61 | 185 | 24.8 | 75.2 | -4.62 | -3.12 | 5.72 | 5.56 | 22.14 | 27.84 |
| IDCR 100% | Pure Non-Borrower | 3244 | 920 | 2324 | 28.4 | 71.6 | -5.23 | -2.51 | 5.34 | 5.44 | 21.42 | 26.89 |
# --- Post-Acute ---
df_post_typed <- df_post %>%
mutate(user_type_5 = case_when(
dw_post == 1 ~ "DW", btfp_post == 1 ~ "BTFP",
fhlb_user == 1 ~ "FHLB", TRUE ~ "Pure Non-Borrower"),
user_type_5 = factor(user_type_5, levels = c("DW", "BTFP", "FHLB", "Pure Non-Borrower")))
sol_post <- bind_rows(
compute_solvency_by_user(df_post_typed, "mtm_insolvent", label = "MTM Insolvent"),
compute_solvency_by_user(df_post_typed, "insolvent_idcr_s50", label = "IDCR 50%"),
compute_solvency_by_user(df_post_typed, "insolvent_idcr_s100", label = "IDCR 100%")
) %>% select(Specification, everything()) %>% rename(User_Type = user_type_5)
cat("\n=== TABLE 3B: SOLVENCY BY USER TYPE — POST-ACUTE PERIOD ===\n")##
## === TABLE 3B: SOLVENCY BY USER TYPE — POST-ACUTE PERIOD ===kable(sol_post, caption = "Table 3B: Solvent vs. Insolvent Borrowers — Post-Acute (May 2 – Oct 31, 2023)",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE, font_size = 10)| Specification | User_Type | N_total | N_insolvent | N_solvent | Pct_insolvent | Pct_solvent | AE_mean_solvent | AE_mean_insolvent | MTM_mean_solvent | MTM_mean_insolvent | UL_mean_solvent | UL_mean_insolvent |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| MTM Insolvent | DW | 887 | 159 | 728 | 17.9 | 82.1 | -5.07 | 2.29 | 5.03 | 7.95 | 27.14 | 25.50 |
| MTM Insolvent | BTFP | 545 | 161 | 384 | 29.5 | 70.5 | -4.24 | 2.80 | 5.41 | 7.77 | 24.14 | 24.78 |
| MTM Insolvent | FHLB | 188 | 24 | 164 | 12.8 | 87.2 | -5.40 | 2.82 | 5.12 | 8.93 | 23.74 | 23.80 |
| MTM Insolvent | Pure Non-Borrower | 2662 | 481 | 2181 | 18.1 | 81.9 | -7.22 | 2.20 | 4.76 | 7.74 | 22.05 | 23.78 |
| IDCR 50% | DW | 887 | 39 | 848 | 4.4 | 95.6 | -3.71 | -4.71 | 5.60 | 4.51 | 27.06 | 22.29 |
| IDCR 50% | BTFP | 545 | 19 | 526 | 3.5 | 96.5 | -2.12 | -3.18 | 6.16 | 4.74 | 24.36 | 23.59 |
| IDCR 50% | FHLB | 188 | 7 | 181 | 3.7 | 96.3 | -4.38 | -3.85 | 5.65 | 4.56 | 23.61 | 27.09 |
| IDCR 50% | Pure Non-Borrower | 2631 | 114 | 2517 | 4.3 | 95.7 | -4.58 | -5.06 | 5.39 | 4.28 | 22.66 | 21.80 |
| IDCR 100% | DW | 887 | 269 | 618 | 30.3 | 69.7 | -4.34 | -2.41 | 5.53 | 5.60 | 25.88 | 29.06 |
| IDCR 100% | BTFP | 545 | 163 | 382 | 29.9 | 70.1 | -2.54 | -1.26 | 6.18 | 5.94 | 23.11 | 27.21 |
| IDCR 100% | FHLB | 188 | 48 | 140 | 25.5 | 74.5 | -4.75 | -3.20 | 5.66 | 5.44 | 22.37 | 27.76 |
| IDCR 100% | Pure Non-Borrower | 2631 | 730 | 1901 | 27.7 | 72.3 | -5.35 | -2.66 | 5.32 | 5.40 | 21.03 | 26.76 |
# --- Arbitrage ---
df_arb_typed <- df_arb %>%
mutate(user_type_5 = case_when(
btfp_arb == 1 ~ "BTFP", fhlb_user == 1 ~ "FHLB", TRUE ~ "Pure Non-Borrower"),
user_type_5 = factor(user_type_5, levels = c("DW", "BTFP", "FHLB", "Pure Non-Borrower")))
sol_arb <- bind_rows(
compute_solvency_by_user(df_arb_typed, "mtm_insolvent", label = "MTM Insolvent"),
compute_solvency_by_user(df_arb_typed, "insolvent_idcr_s50", label = "IDCR 50%"),
compute_solvency_by_user(df_arb_typed, "insolvent_idcr_s100", label = "IDCR 100%")
) %>% select(Specification, everything()) %>% rename(User_Type = user_type_5)
cat("\n=== TABLE 3C: SOLVENCY BY USER TYPE — ARBITRAGE PERIOD ===\n")##
## === TABLE 3C: SOLVENCY BY USER TYPE — ARBITRAGE PERIOD ===kable(sol_arb, caption = "Table 3C: Solvent vs. Insolvent Borrowers — Arbitrage (Nov 1, 2023 – Jan 24, 2024)",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE, font_size = 10)| Specification | User_Type | N_total | N_insolvent | N_solvent | Pct_insolvent | Pct_solvent | AE_mean_solvent | AE_mean_insolvent | MTM_mean_solvent | MTM_mean_insolvent | UL_mean_solvent | UL_mean_insolvent |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| MTM Insolvent | BTFP | 766 | 210 | 556 | 27.4 | 72.6 | -4.33 | 2.62 | 5.27 | 7.93 | 23.29 | 21.46 |
| MTM Insolvent | FHLB | 159 | 19 | 140 | 11.9 | 88.1 | -4.70 | 2.16 | 5.27 | 8.03 | 20.57 | 18.87 |
| MTM Insolvent | Pure Non-Borrower | 3272 | 572 | 2700 | 17.5 | 82.5 | -7.18 | 2.52 | 4.69 | 7.81 | 20.70 | 21.84 |
| IDCR 50% | BTFP | 766 | 71 | 695 | 9.3 | 90.7 | -2.29 | -3.79 | 6.12 | 4.82 | 23.06 | 20.11 |
| IDCR 50% | FHLB | 159 | 23 | 136 | 14.5 | 85.5 | -3.93 | -3.60 | 5.74 | 4.77 | 21.00 | 16.59 |
| IDCR 50% | Pure Non-Borrower | 3243 | 310 | 2933 | 9.6 | 90.4 | -4.77 | -4.86 | 5.37 | 4.32 | 21.20 | 19.92 |
| IDCR 100% | BTFP | 766 | 263 | 503 | 34.3 | 65.7 | -2.49 | -2.30 | 6.19 | 5.64 | 21.98 | 24.32 |
| IDCR 100% | FHLB | 159 | 57 | 102 | 35.8 | 64.2 | -4.05 | -3.57 | 5.94 | 5.00 | 19.81 | 21.35 |
| IDCR 100% | Pure Non-Borrower | 3243 | 1039 | 2204 | 32.0 | 68.0 | -5.41 | -3.44 | 5.38 | 5.04 | 19.64 | 24.14 |
2.4 Table 4: Mean Characteristics by User Type (Acute)
# ==============================================================================
# TABLE 4: MEANS BY USER TYPE (DW, BTFP, FHLB, Pure Non-Borrower)
# ==============================================================================
mean_vars <- c(
"adjusted_equity_raw", "mtm_total_raw", "mtm_btfp_raw", "mtm_other_raw",
"uninsured_lev_raw", "book_equity_ratio_raw", "ln_assets_raw",
"cash_ratio_raw", "roa_raw", "loan_to_deposit_raw", "wholesale_raw",
"fhlb_ratio_raw"
)
mean_labels <- c(
"Adjusted Equity / TA (%)", "Total MTM Loss / TA (%)", "OMO MTM Loss / TA (%)",
"Non-OMO MTM Loss / TA (%)", "Uninsured Dep / TA (%)", "Book Equity / TA (%)",
"Log(Total Assets)", "Cash / TA (%)", "ROA (%)",
"Loan-to-Deposit (%)", "Wholesale Funding (%)", "FHLB / TA (%)"
)
# Reference group
ref_group <- "Pure Non-Borrower"
compare_groups <- c("DW", "BTFP", "FHLB")
# Build the table row by row
build_mean_ttest_table <- function(df, vars, labels, group_col, ref, comparisons) {
df_ref <- df %>% filter(!!sym(group_col) == ref)
# --- N row ---
n_vec <- c(Variable = "N")
for (g in c(comparisons, ref)) {
n_g <- sum(df[[group_col]] == g, na.rm = TRUE)
n_vec[g] <- as.character(n_g)
}
# --- Variable rows: mean [t-stat]*** ---
rows_list <- list()
for (i in seq_along(vars)) {
v <- vars[i]
row <- c(Variable = labels[i])
x_ref <- df_ref[[v]]
x_ref <- x_ref[!is.na(x_ref)]
ref_mean <- round(mean(x_ref, na.rm = TRUE), 3)
for (g in comparisons) {
x_g <- df %>% filter(!!sym(group_col) == g) %>% pull(!!sym(v))
x_g <- x_g[!is.na(x_g)]
g_mean <- round(mean(x_g, na.rm = TRUE), 3)
# Welch t-test vs reference
if (length(x_g) >= 2 & length(x_ref) >= 2) {
tt <- tryCatch(t.test(x_g, x_ref), error = function(e) NULL)
if (!is.null(tt)) {
tval <- round(tt$statistic, 2)
pval <- tt$p.value
stars <- ifelse(pval < 0.01, "***", ifelse(pval < 0.05, "**", ifelse(pval < 0.10, "*", "")))
row[g] <- paste0(g_mean, " [", tval, "]", stars)
} else {
row[g] <- as.character(g_mean)
}
} else {
row[g] <- as.character(g_mean)
}
}
# Reference group — just the mean (no t-test against itself)
row[ref] <- as.character(ref_mean)
rows_list[[i]] <- row
}
# Combine
out <- bind_rows(
tibble(!!!as.list(n_vec)),
map_dfr(rows_list, ~ tibble(!!!as.list(.x)))
)
return(out)
}
tab_means <- build_mean_ttest_table(df_acute, mean_vars, mean_labels,
"user_type_5", ref_group, compare_groups)
kable(tab_means,
caption = "Table 4: Mean Bank Characteristics by User Type — Acute Period (t-test vs. Pure Non-Borrower)",
align = c("l", rep("r", ncol(tab_means) - 1)),
escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE, font_size = 11) %>%
footnote(general = "Welch two-sample t-test of each group mean vs. Pure Non-Borrower. t-statistics in brackets. *** p<0.01, ** p<0.05, * p<0.10.",
general_title = "Notes: ", footnote_as_chunk = TRUE)| Variable | DW | BTFP | FHLB | Pure Non-Borrower |
|---|---|---|---|---|
| N | 393 | 368 | 246 | 3285 |
| Adjusted Equity / TA (%) | -3.066 [7.67]*** | -1.996 [11.27]*** | -4.245 [2.87]*** | -5.197 |
| Total MTM Loss / TA (%) | 5.776 [4.13]*** | 6.18 [7.6]*** | 5.68 [2.33]** | 5.334 |
| OMO MTM Loss / TA (%) | 0.783 [2.74]*** | 0.884 [4.15]*** | 0.533 [-2.83]*** | 0.657 |
| Non-OMO MTM Loss / TA (%) | 4.932 [4.44]*** | 5.022 [5.23]*** | 4.976 [3.62]*** | 4.484 |
| Uninsured Dep / TA (%) | 28.231 [8.26]*** | 26.205 [5.39]*** | 23.549 [1.06] | 22.773 |
| Book Equity / TA (%) | 8.842 [-7.69]*** | 8.177 [-10.42]*** | 9.925 [-2.59]*** | 10.636 |
| Log(Total Assets) | 14.017 [16.61]*** | 13.537 [11.23]*** | 13.185 [5.7]*** | 12.651 |
| Cash / TA (%) | 5.817 [-8.93]*** | 4.695 [-14.78]*** | 4.788 [-15.6]*** | 9.065 |
| ROA (%) | 1.13 [-1] | 1.064 [-2.17]** | 1.011 [-2.83]*** | 1.19 |
| Loan-to-Deposit (%) | 75.378 [5.16]*** | 72.462 [2.78]*** | 81.55 [10]*** | 69.347 |
| Wholesale Funding (%) | 1.624 [3.79]*** | 1.518 [3.47]*** | 0.873 [-0.03] | 0.877 |
| FHLB / TA (%) | 3.466 [4.37]*** | 3.953 [6.35]*** | 3.332 [3.62]*** | 2.351 |
| Notes: Welch two-sample t-test of each group mean vs. Pure Non-Borrower. t-statistics in brackets. *** p<0.01, ** p<0.05, * p<0.10. |
3 SPEC 1: BASELINE — WHO BORROWED?
Model: \(\text{BTFP}_i = \alpha + \beta_1 \cdot \text{AdjEquity}_i + \beta_2 \cdot \text{UninsuredLev}_i + \gamma X_i + \varepsilon_i\)
Storyline: Adjusted Equity = MTM Losses − Book Equity (reversed). Higher AE = worse solvency. Banks with higher AE (more insolvent) borrowed, and banks with higher uninsured leverage (fragile) borrowed.
# ==============================================================================
# SPEC 1: BASELINE — WHO BORROWED?
# ==============================================================================
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)
# (1) AE + Uninsured (no interaction)
# (2) AE + Uninsured + Interaction
# (3) MTM decomposed into OMO + Non-OMO + Uninsured
m_spec1_btfp <- list(
"(1) AE" = run_one(df_btfp_s, "btfp_acute", "adjusted_equity + uninsured_lev"),
"(2) AE+Inter" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE),
"(3) MTM Decomp" = run_one(df_btfp_s, "btfp_acute", EXPL_MTM_DECOMP)
)
m_spec1_dw <- list(
"(1) AE" = run_one(df_dw_s, "dw_acute", "adjusted_equity + uninsured_lev"),
"(2) AE+Inter" = run_one(df_dw_s, "dw_acute", EXPL_AE_BASE),
"(3) MTM Decomp" = run_one(df_dw_s, "dw_acute", EXPL_MTM_DECOMP)
)
m_spec1_fhlb <- list(
"(1) AE" = run_one(df_fhlb_s, "fhlb_user", "adjusted_equity + uninsured_lev"),
"(2) AE+Inter" = run_one(df_fhlb_s, "fhlb_user", EXPL_AE_BASE),
"(3) MTM Decomp" = run_one(df_fhlb_s, "fhlb_user", EXPL_MTM_DECOMP)
)
etable(m_spec1_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 1: Baseline — BTFP (LPM)")## (1) AE (2) AE+Inter
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1293*** (0.0054) 0.1277*** (0.0053)
## Adjusted Equity (z) 0.0241*** (0.0049) 0.0294*** (0.0054)
## Uninsured Leverage (z) 0.0128* (0.0061) 0.0164* (0.0065)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045)
## MTM Loss OMO (z)
## MTM Loss Non-OMO (z)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08668 0.08934
##
## (3) MTM Decomp
## Dependent Var.: btfp_acute
##
## Constant 0.1294*** (0.0054)
## Adjusted Equity (z)
## Uninsured Leverage (z) 0.0176** (0.0062)
## Adj. Equity $\times$ Uninsured
## MTM Loss OMO (z) 0.0176** (0.0062)
## MTM Loss Non-OMO (z) 0.0091. (0.0053)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 3,737
## R2 0.08515
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_spec1_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 1: Baseline — DW (LPM)")## (1) AE (2) AE+Inter
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1130*** (0.0051) 0.1121*** (0.0051)
## Adjusted Equity (z) 0.0084. (0.0046) 0.0115* (0.0052)
## Uninsured Leverage (z) 0.0067 (0.0057) 0.0090 (0.0061)
## Adj. Equity $\times$ Uninsured 0.0095* (0.0043)
## MTM Loss OMO (z)
## MTM Loss Non-OMO (z)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09213 0.09320
##
## (3) MTM Decomp
## Dependent Var.: dw_acute
##
## Constant 0.1130*** (0.0051)
## Adjusted Equity (z)
## Uninsured Leverage (z) 0.0094 (0.0058)
## Adj. Equity $\times$ Uninsured
## MTM Loss OMO (z) 0.0090 (0.0057)
## MTM Loss Non-OMO (z) 0.0101. (0.0053)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 3,668
## R2 0.09293
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_spec1_fhlb, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 1: Baseline — FHLB (LPM)")## (1) AE (2) AE+Inter
## Dependent Var.: fhlb_user fhlb_user
##
## Constant 0.0892*** (0.0048) 0.0894*** (0.0048)
## Adjusted Equity (z) -0.0062 (0.0046) -0.0072 (0.0050)
## Uninsured Leverage (z) 0.0049 (0.0047) 0.0040 (0.0049)
## Adj. Equity $\times$ Uninsured -0.0029 (0.0036)
## MTM Loss OMO (z)
## MTM Loss Non-OMO (z)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,577 3,577
## R2 0.03826 0.03838
##
## (3) MTM Decomp
## Dependent Var.: fhlb_user
##
## Constant 0.0892*** (0.0048)
## Adjusted Equity (z)
## Uninsured Leverage (z) 0.0045 (0.0046)
## Adj. Equity $\times$ Uninsured
## MTM Loss OMO (z) -0.0074 (0.0047)
## MTM Loss Non-OMO (z) 0.0048 (0.0050)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 3,577
## R2 0.03873
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec1_btfp, "Spec1_BTFP_Baseline_LPM",
title_text = "Spec 1: Who Borrowed from BTFP? (LPM)",
notes_text = "LPM. DV = BTFP access. AdjEquity = MTM Loss - Book Equity (reversed). Controls: CONTROLS_AE. Robust SEs.")
save_etable(m_spec1_dw, "Spec1_DW_Baseline_LPM",
title_text = "Spec 1: Who Borrowed from DW? (LPM)",
notes_text = "LPM. DV = DW access. Controls: CONTROLS_AE. Robust SEs.")
save_etable(m_spec1_fhlb, "Spec1__FHLBBaseline_LPM",
title_text = "Spec 1: Who Borrowed from FHLB? (LPM)",
notes_text = "LPM. DV = FHLB abnormal borrower 10pct. Controls: CONTROLS_AE. Robust SEs.")4 SPEC 2: STRATEGIC COMPLEMENTARITIES
Model: \(\text{BTFP}_i = \alpha + \beta_1 \cdot \text{AdjEquity}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 \cdot (\text{AdjEquity}_i \times \text{UninsuredLev}_i) + \gamma X_i + \varepsilon_i\)
Key: \(\beta_3 > 0\) → fragility amplifies the fundamental-borrowing relationship (threshold varies with fragility).
# ==============================================================================
# SPEC 2: STRATEGIC COMPLEMENTARITIES (AE x Uninsured Interaction)
# Already estimated in Spec1 col (2). Here we add Logit + AE quartile interactions.
# ==============================================================================
m_spec2_btfp <- list(
"(1) LPM" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE, "lpm"),
"(2) Logit" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE, "logit"),
"(3) Q16" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_UL_Q16, "lpm")
)
m_spec2_dw <- list(
"(1) LPM" = run_one(df_dw_s, "dw_acute", EXPL_AE_BASE, "lpm"),
"(2) Logit" = run_one(df_dw_s, "dw_acute", EXPL_AE_BASE, "logit"),
"(3) Q16" = run_one(df_dw_s, "dw_acute", EXPL_AE_UL_Q16, "lpm")
)
etable(m_spec2_btfp, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 2: Strategic Complementarities — BTFP")## (1) LPM (2) Logit
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1277*** (0.0053) -2.327*** (0.0699)
## Adjusted Equity (z) 0.0294*** (0.0054) 0.4367*** (0.0741)
## Uninsured Leverage (z) 0.0164* (0.0065) 0.2017** (0.0630)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045) 0.0265 (0.0621)
## AE-Q1 $\times$ UL-Q2
## AE-Q1 $\times$ UL-Q3
## AE-Q1 $\times$ UL-Q4
## AE-Q2 $\times$ UL-Q1
## AE-Q2 $\times$ UL-Q2
## AE-Q2 $\times$ UL-Q3
## AE-Q2 $\times$ UL-Q4
## AE-Q3 $\times$ UL-Q1
## AE-Q3 $\times$ UL-Q2
## AE-Q3 $\times$ UL-Q3
## AE-Q3 $\times$ UL-Q4
## AE-Q4 $\times$ UL-Q1
## AE-Q4 $\times$ UL-Q2
## AE-Q4 $\times$ UL-Q3
## AE-Q4 $\times$ UL-Q4
## ______________________________ __________________ __________________
## Family OLS Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08934 --
## Log-Likelihood -975.09 -1,214.6
##
## (3) Q16
## Dependent Var.: btfp_acute
##
## Constant 0.0981*** (0.0106)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## AE-Q1 $\times$ UL-Q2 0.0122 (0.0206)
## AE-Q1 $\times$ UL-Q3 -0.0502** (0.0184)
## AE-Q1 $\times$ UL-Q4 0.0131 (0.0233)
## AE-Q2 $\times$ UL-Q1 0.0008 (0.0185)
## AE-Q2 $\times$ UL-Q2 0.0160 (0.0200)
## AE-Q2 $\times$ UL-Q3 -0.0403* (0.0186)
## AE-Q2 $\times$ UL-Q4 0.0421 (0.0267)
## AE-Q3 $\times$ UL-Q1 0.0198 (0.0218)
## AE-Q3 $\times$ UL-Q2 0.0192 (0.0218)
## AE-Q3 $\times$ UL-Q3 0.1378*** (0.0287)
## AE-Q3 $\times$ UL-Q4 0.0475. (0.0278)
## AE-Q4 $\times$ UL-Q1 0.0182 (0.0225)
## AE-Q4 $\times$ UL-Q2 0.0449. (0.0234)
## AE-Q4 $\times$ UL-Q3 0.0870** (0.0267)
## AE-Q4 $\times$ UL-Q4 0.1057*** (0.0294)
## ______________________________ __________________
## Family OLS
## S.E. type Heteroskedas.-rob.
## Observations 3,747
## R2 0.09867
## Log-Likelihood -954.09
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_spec2_dw, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 2: Strategic Complementarities — DW")## (1) LPM (2) Logit
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1121*** (0.0051) -2.440*** (0.0676)
## Adjusted Equity (z) 0.0115* (0.0052) 0.2891*** (0.0757)
## Uninsured Leverage (z) 0.0090 (0.0061) 0.1383* (0.0592)
## Adj. Equity $\times$ Uninsured 0.0095* (0.0043) 0.0206 (0.0570)
## AE-Q1 $\times$ UL-Q2
## AE-Q1 $\times$ UL-Q3
## AE-Q1 $\times$ UL-Q4
## AE-Q2 $\times$ UL-Q1
## AE-Q2 $\times$ UL-Q2
## AE-Q2 $\times$ UL-Q3
## AE-Q2 $\times$ UL-Q4
## AE-Q3 $\times$ UL-Q1
## AE-Q3 $\times$ UL-Q2
## AE-Q3 $\times$ UL-Q3
## AE-Q3 $\times$ UL-Q4
## AE-Q4 $\times$ UL-Q1
## AE-Q4 $\times$ UL-Q2
## AE-Q4 $\times$ UL-Q3
## AE-Q4 $\times$ UL-Q4
## ______________________________ __________________ __________________
## Family OLS Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09320 --
## Log-Likelihood -720.98 -1,082.9
##
## (3) Q16
## Dependent Var.: dw_acute
##
## Constant 0.1065*** (0.0117)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## AE-Q1 $\times$ UL-Q2 -0.0011 (0.0209)
## AE-Q1 $\times$ UL-Q3 -0.0032 (0.0244)
## AE-Q1 $\times$ UL-Q4 -0.0073 (0.0237)
## AE-Q2 $\times$ UL-Q1 -0.0014 (0.0188)
## AE-Q2 $\times$ UL-Q2 -0.0174 (0.0187)
## AE-Q2 $\times$ UL-Q3 -0.0359. (0.0205)
## AE-Q2 $\times$ UL-Q4 -0.0033 (0.0249)
## AE-Q3 $\times$ UL-Q1 -0.0059 (0.0199)
## AE-Q3 $\times$ UL-Q2 0.0085 (0.0225)
## AE-Q3 $\times$ UL-Q3 0.0850** (0.0280)
## AE-Q3 $\times$ UL-Q4 0.0446 (0.0285)
## AE-Q4 $\times$ UL-Q1 -0.0201 (0.0191)
## AE-Q4 $\times$ UL-Q2 0.0103 (0.0225)
## AE-Q4 $\times$ UL-Q3 0.0072 (0.0245)
## AE-Q4 $\times$ UL-Q4 0.0370 (0.0272)
## ______________________________ __________________
## Family OLS
## S.E. type Heteroskedas.-rob.
## Observations 3,678
## R2 0.09874
## Log-Likelihood -707.28
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec2_btfp, "Spec2_BTFP_Complementarities",
title_text = "Spec 2: Strategic Complementarities — BTFP",
notes_text = "DV = BTFP. Col1: LPM continuous. Col2: Logit. Col3: 16-cell AExUL quartile dummies (ref=Q4-Q1). Robust SEs.",
fitstat_use = ~ n + r2 + ll)
save_etable(m_spec2_dw, "Spec2_DW_Complementarities",
title_text = "Spec 2: Strategic Complementarities — DW",
notes_text = "DV = DW. Specifications as in BTFP table. Robust SEs.",
fitstat_use = ~ n + r2 + ll)5 SPEC 3: SPLIT BY SOLVENCY — IDENTIFY RUN TYPES
3a. Solvent (AdjEquity ≥ 0): \(\text{BTFP}_i = \alpha + \delta^S \cdot \text{UninsuredLev}_i + \gamma X_i + \varepsilon_i\)
3b. Insolvent (AdjEquity < 0): \(\text{BTFP}_i = \alpha + \delta^I \cdot \text{UninsuredLev}_i + \gamma X_i + \varepsilon_i\)
# ==============================================================================
# SPEC 3: SPLIT-SAMPLE BY SOLVENCY (three definitions)
# δ_S > 0 and δ_I ≈ 0 → Panic runs among solvent, fundamental among insolvent
# ==============================================================================
run_solvency_split <- function(df, dv, solvent_var, insolvent_var, label) {
df_s <- df %>% filter(!!sym(solvent_var) == 1)
df_i <- df %>% filter(!!sym(insolvent_var) == 1)
list(
Solvent = run_one(df_s, dv, "uninsured_lev"),
Insolvent = tryCatch(
run_one(df_i, dv, "uninsured_lev"),
error = function(e) { message(" [", label, "] Insolvent subsample too small: ", e$message); NULL }
)
)
}
# --- BTFP ---
split_btfp_mtm <- run_solvency_split(df_btfp_s, "btfp_acute", "mtm_solvent", "mtm_insolvent", "MTM")
split_btfp_id50 <- run_solvency_split(df_btfp_s, "btfp_acute", "solvent_idcr_s50", "insolvent_idcr_s50", "IDCR50")
split_btfp_id100 <- run_solvency_split(df_btfp_s, "btfp_acute", "solvent_idcr_s100", "insolvent_idcr_s100", "IDCR100")
models_spec3_btfp <- compact(list(
"MTM: Solvent" = split_btfp_mtm$Solvent,
"MTM: Insolvent" = split_btfp_mtm$Insolvent,
"IDCR50: Solvent" = split_btfp_id50$Solvent,
"IDCR50: Insolvent" = split_btfp_id50$Insolvent,
"IDCR100: Solvent" = split_btfp_id100$Solvent,
"IDCR100: Insolvent"= split_btfp_id100$Insolvent
))
etable(models_spec3_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 3: Solvency Split — BTFP")## MTM: Solvent MTM: Insolvent IDCR50: Solvent
## Dependent Var.: btfp_acute btfp_acute btfp_acute
##
## Constant 0.1204*** (0.0060) 0.1486*** (0.0178) 0.1299*** (0.0055)
## Uninsured Leverage (z) 0.0151* (0.0065) 0.0252 (0.0175) 0.0185** (0.0064)
## ______________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,003 734 3,558
## R2 0.08385 0.07607 0.08076
##
## IDCR50: Insolvent IDCR100: Solvent IDCR100: Insolvent
## Dependent Var.: btfp_acute btfp_acute btfp_acute
##
## Constant 0.1168*** (0.0268) 0.1326*** (0.0065) 0.1298*** (0.0116)
## Uninsured Leverage (z) -0.0233 (0.0232) 0.0254** (0.0078) -0.0010 (0.0116)
## ______________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 148 2,656 1,050
## R2 0.16537 0.09202 0.06162
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# --- DW ---
split_dw_mtm <- run_solvency_split(df_dw_s, "dw_acute", "mtm_solvent", "mtm_insolvent", "MTM")
split_dw_id50 <- run_solvency_split(df_dw_s, "dw_acute", "solvent_idcr_s50", "insolvent_idcr_s50", "IDCR50")
split_dw_id100 <- run_solvency_split(df_dw_s, "dw_acute", "solvent_idcr_s100", "insolvent_idcr_s100", "IDCR100")
models_spec3_dw <- compact(list(
"MTM: Solvent" = split_dw_mtm$Solvent,
"MTM: Insolvent" = split_dw_mtm$Insolvent,
"IDCR50: Solvent" = split_dw_id50$Solvent,
"IDCR50: Insolvent" = split_dw_id50$Insolvent,
"IDCR100: Solvent" = split_dw_id100$Solvent,
"IDCR100: Insolvent"= split_dw_id100$Insolvent
))
etable(models_spec3_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 3: Solvency Split — DW")## MTM: Solvent MTM: Insolvent IDCR50: Solvent
## Dependent Var.: dw_acute dw_acute dw_acute
##
## Constant 0.1123*** (0.0057) 0.1021*** (0.0160) 0.1110*** (0.0052)
## Uninsured Leverage (z) 0.0054 (0.0062) 0.0249 (0.0161) 0.0106. (0.0060)
## ______________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 2,989 679 3,481
## R2 0.09475 0.08611 0.08849
##
## IDCR50: Insolvent IDCR100: Solvent IDCR100: Insolvent
## Dependent Var.: dw_acute dw_acute dw_acute
##
## Constant 0.1499*** (0.0298) 0.1113*** (0.0061) 0.1224*** (0.0114)
## Uninsured Leverage (z) -0.0124 (0.0305) 0.0114 (0.0071) 0.0002 (0.0115)
## ______________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 156 2,595 1,042
## R2 0.15547 0.09175 0.09362
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(models_spec3_btfp, "Spec3_BTFP_SolvencySplit",
title_text = "Spec 3: Solvency-Split Regressions — BTFP",
notes_text = "Split by solvency. MTM: AdjEquity>=0. IDCR50: idcr_1>=0. IDCR100: idcr_2>=0. DV = BTFP. Robust SEs.")
save_etable(models_spec3_dw, "Spec3_DW_SolvencySplit",
title_text = "Spec 3: Solvency-Split Regressions — DW",
notes_text = "Same splits as BTFP table. DV = DW. Robust SEs.")6 SPEC 4: THRESHOLD VARIATION WITHIN SOLVENT BANKS
Model (Solvent only): \(\text{BTFP}_i = \beta_1 \cdot \text{AdjEquity}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 \cdot (\text{AdjEquity}_i \times \text{UninsuredLev}_i) + \gamma X_i + \varepsilon_i\)
Key: \(\beta_3 > 0\) → fragile solvent banks borrow at higher adjusted equity (lower solvency threshold).
# ==============================================================================
# SPEC 4: THRESHOLD VARIATION WITHIN SOLVENT BANKS
# ==============================================================================
df_btfp_solvent <- df_btfp_s %>% filter(mtm_solvent == 1)
df_dw_solvent <- df_dw_s %>% filter(mtm_solvent == 1)
m_spec4_btfp <- list(
"(1) AE+UL" = run_one(df_btfp_solvent, "btfp_acute", "adjusted_equity + uninsured_lev"),
"(2) AE+UL+Inter" = run_one(df_btfp_solvent, "btfp_acute", EXPL_AE_BASE),
"(3) Q16" = run_one(df_btfp_solvent, "btfp_acute", EXPL_AE_UL_Q16)
)
m_spec4_dw <- list(
"(1) AE+UL" = run_one(df_dw_solvent, "dw_acute", "adjusted_equity + uninsured_lev"),
"(2) AE+UL+Inter" = run_one(df_dw_solvent, "dw_acute", EXPL_AE_BASE),
"(3) Q16" = run_one(df_dw_solvent, "dw_acute", EXPL_AE_UL_Q16)
)
etable(m_spec4_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 4: Within-Solvent Threshold Variation — BTFP")## (1) AE+UL (2) AE+UL+Inter
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1254*** (0.0064) 0.1252*** (0.0063)
## Adjusted Equity (z) 0.0194*** (0.0054) 0.0264*** (0.0063)
## Uninsured Leverage (z) 0.0132* (0.0065) 0.0221** (0.0078)
## Adj. Equity $\times$ Uninsured 0.0175*** (0.0052)
## AE-Q1 $\times$ UL-Q2
## AE-Q1 $\times$ UL-Q3
## AE-Q1 $\times$ UL-Q4
## AE-Q2 $\times$ UL-Q1
## AE-Q2 $\times$ UL-Q2
## AE-Q2 $\times$ UL-Q3
## AE-Q2 $\times$ UL-Q4
## AE-Q3 $\times$ UL-Q1
## AE-Q3 $\times$ UL-Q2
## AE-Q3 $\times$ UL-Q3
## AE-Q3 $\times$ UL-Q4
## AE-Q4 $\times$ UL-Q1
## AE-Q4 $\times$ UL-Q2
## AE-Q4 $\times$ UL-Q3
## AE-Q4 $\times$ UL-Q4
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,003 3,003
## R2 0.08626 0.08896
##
## (3) Q16
## Dependent Var.: btfp_acute
##
## Constant 0.0907*** (0.0111)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## AE-Q1 $\times$ UL-Q2 0.0150 (0.0206)
## AE-Q1 $\times$ UL-Q3 -0.0447* (0.0185)
## AE-Q1 $\times$ UL-Q4 0.0205 (0.0235)
## AE-Q2 $\times$ UL-Q1 0.0053 (0.0186)
## AE-Q2 $\times$ UL-Q2 0.0216 (0.0201)
## AE-Q2 $\times$ UL-Q3 -0.0334. (0.0188)
## AE-Q2 $\times$ UL-Q4 0.0517. (0.0270)
## AE-Q3 $\times$ UL-Q1 0.0264 (0.0219)
## AE-Q3 $\times$ UL-Q2 0.0273 (0.0219)
## AE-Q3 $\times$ UL-Q3 0.1466*** (0.0289)
## AE-Q3 $\times$ UL-Q4 0.0579* (0.0281)
## AE-Q4 $\times$ UL-Q1 -0.0195 (0.0283)
## AE-Q4 $\times$ UL-Q2 0.0294 (0.0421)
## AE-Q4 $\times$ UL-Q3 0.0777 (0.0517)
## AE-Q4 $\times$ UL-Q4 0.1263. (0.0665)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 3,003
## R2 0.10324
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_spec4_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 4: Within-Solvent Threshold Variation — DW")## (1) AE+UL (2) AE+UL+Inter
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1155*** (0.0061) 0.1154*** (0.0061)
## Adjusted Equity (z) 0.0119* (0.0055) 0.0153* (0.0066)
## Uninsured Leverage (z) 0.0043 (0.0063) 0.0088 (0.0075)
## Adj. Equity $\times$ Uninsured 0.0087 (0.0053)
## AE-Q1 $\times$ UL-Q2
## AE-Q1 $\times$ UL-Q3
## AE-Q1 $\times$ UL-Q4
## AE-Q2 $\times$ UL-Q1
## AE-Q2 $\times$ UL-Q2
## AE-Q2 $\times$ UL-Q3
## AE-Q2 $\times$ UL-Q4
## AE-Q3 $\times$ UL-Q1
## AE-Q3 $\times$ UL-Q2
## AE-Q3 $\times$ UL-Q3
## AE-Q3 $\times$ UL-Q4
## AE-Q4 $\times$ UL-Q1
## AE-Q4 $\times$ UL-Q2
## AE-Q4 $\times$ UL-Q3
## AE-Q4 $\times$ UL-Q4
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 2,989 2,989
## R2 0.09570 0.09639
##
## (3) Q16
## Dependent Var.: dw_acute
##
## Constant 0.1038*** (0.0122)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## AE-Q1 $\times$ UL-Q2 -0.0006 (0.0210)
## AE-Q1 $\times$ UL-Q3 -0.0022 (0.0245)
## AE-Q1 $\times$ UL-Q4 -0.0062 (0.0240)
## AE-Q2 $\times$ UL-Q1 0.0009 (0.0190)
## AE-Q2 $\times$ UL-Q2 -0.0154 (0.0189)
## AE-Q2 $\times$ UL-Q3 -0.0339 (0.0208)
## AE-Q2 $\times$ UL-Q4 -0.0009 (0.0251)
## AE-Q3 $\times$ UL-Q1 -0.0026 (0.0200)
## AE-Q3 $\times$ UL-Q2 0.0118 (0.0228)
## AE-Q3 $\times$ UL-Q3 0.0882** (0.0282)
## AE-Q3 $\times$ UL-Q4 0.0475. (0.0288)
## AE-Q4 $\times$ UL-Q1 -0.0270 (0.0268)
## AE-Q4 $\times$ UL-Q2 0.0305 (0.0442)
## AE-Q4 $\times$ UL-Q3 0.0156 (0.0482)
## AE-Q4 $\times$ UL-Q4 0.0126 (0.0595)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 2,989
## R2 0.10348
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec4_btfp, "Spec4_BTFP_WithinSolvent",
title_text = "Spec 4: Threshold Variation Within Solvent Banks — BTFP",
notes_text = "Sample: MTM-solvent banks (AdjEquity >= 0) only. DV = BTFP. Robust SEs.")
save_etable(m_spec4_dw, "Spec4_DW_WithinSolvent",
title_text = "Spec 4: Threshold Variation Within Solvent Banks — DW",
notes_text = "Sample: MTM-solvent banks only. DV = DW. Robust SEs.")7 SPEC 4b: THRESHOLD VARIATION WITHIN INSOLVENT BANKS
Model (Insolvent only): \(\text{BTFP}_i = \beta_1 \cdot \text{AdjEquity}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 \cdot (\text{AdjEquity}_i \times \text{UninsuredLev}_i) + \gamma X_i + \varepsilon_i\)
Key: Among MTM-insolvent banks (AdjEquity < 0), examine whether fragility (uninsured leverage) still modulates borrowing behavior.
# ==============================================================================
# SPEC 4b: THRESHOLD VARIATION WITHIN INSOLVENT BANKS
# ==============================================================================
df_btfp_insolvent <- df_btfp_s %>% filter(mtm_solvent == 0)
df_dw_insolvent <- df_dw_s %>% filter(mtm_solvent == 0)
cat("Insolvent sample sizes — BTFP:", nrow(df_btfp_insolvent),
"| DW:", nrow(df_dw_insolvent), "\n")## Insolvent sample sizes — BTFP: 734 | DW: 679m_spec4b_btfp <- list(
"(1) AE+UL" = run_one(df_btfp_insolvent, "btfp_acute", "adjusted_equity + uninsured_lev"),
"(2) AE+UL+Inter" = run_one(df_btfp_insolvent, "btfp_acute", EXPL_AE_BASE),
"(3) Q16" = run_one(df_btfp_insolvent, "btfp_acute", EXPL_AE_UL_Q16)
)
m_spec4b_dw <- list(
"(1) AE+UL" = run_one(df_dw_insolvent, "dw_acute", "adjusted_equity + uninsured_lev"),
"(2) AE+UL+Inter" = run_one(df_dw_insolvent, "dw_acute", EXPL_AE_BASE),
"(3) Q16" = run_one(df_dw_insolvent, "dw_acute", EXPL_AE_UL_Q16)
)
etable(m_spec4b_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 4b: Within-Insolvent Threshold Variation — BTFP")## (1) AE+UL (2) AE+UL+Inter
## Dependent Var.: btfp_acute btfp_acute
##
## Constant -0.0012 (0.0557) 0.0028 (0.0554)
## Adjusted Equity (z) 0.1273** (0.0445) 0.1245** (0.0443)
## Uninsured Leverage (z) 0.0275 (0.0174) -0.0504 (0.0613)
## Adj. Equity $\times$ Uninsured 0.0595 (0.0471)
## AE-Q4 $\times$ UL-Q1
## AE-Q4 $\times$ UL-Q2
## AE-Q4 $\times$ UL-Q3
## ______________________________ _________________ _________________
## S.E. type Heteroskeda.-rob. Heteroskeda.-rob.
## Observations 734 734
## R2 0.08578 0.08783
##
## (3) Q16
## Dependent Var.: btfp_acute
##
## Constant 0.1817*** (0.0325)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## AE-Q4 $\times$ UL-Q1 -0.0636 (0.0443)
## AE-Q4 $\times$ UL-Q2 -0.0574 (0.0403)
## AE-Q4 $\times$ UL-Q3 -0.0102 (0.0409)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 734
## R2 0.07777
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_spec4b_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 4b: Within-Insolvent Threshold Variation — DW")## (1) AE+UL (2) AE+UL+Inter
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.0266 (0.0480) 0.0305 (0.0474)
## Adjusted Equity (z) 0.0641. (0.0387) 0.0611 (0.0383)
## Uninsured Leverage (z) 0.0260 (0.0160) -0.0472 (0.0510)
## Adj. Equity $\times$ Uninsured 0.0555 (0.0405)
## AE-Q4 $\times$ UL-Q1
## AE-Q4 $\times$ UL-Q2
## AE-Q4 $\times$ UL-Q3
## ______________________________ ________________ ________________
## S.E. type Heterosked.-rob. Heterosked.-rob.
## Observations 679 679
## R2 0.08974 0.09240
##
## (3) Q16
## Dependent Var.: dw_acute
##
## Constant 0.1387*** (0.0297)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## AE-Q4 $\times$ UL-Q1 -0.0636 (0.0388)
## AE-Q4 $\times$ UL-Q2 -0.0453 (0.0359)
## AE-Q4 $\times$ UL-Q3 -0.0391 (0.0353)
## ______________________________ __________________
## S.E. type Heteroskedas.-rob.
## Observations 679
## R2 0.08639
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec4b_btfp, "Spec4b_BTFP_WithinInsolvent",
title_text = "Spec 4b: Threshold Variation Within Insolvent Banks — BTFP",
notes_text = "Sample: MTM-insolvent banks (AdjEquity < 0) only. DV = BTFP. Robust SEs.")
save_etable(m_spec4b_dw, "Spec4b_DW_WithinInsolvent",
title_text = "Spec 4b: Threshold Variation Within Insolvent Banks — DW",
notes_text = "Sample: MTM-insolvent banks only. DV = DW. Robust SEs.")8 SPEC 5: TERCILE ANALYSIS — THRESHOLD GRADIENT
Model: Split by Uninsured Leverage terciles (Low/Med/High), estimate: \(\text{BTFP}_i = \alpha^{(k)} + \beta^{(k)} \cdot \text{AdjEquity}_i + \gamma X_i + \varepsilon_i\) for \(k \in \{L, M, H\}\)
Prediction: \(\beta^H > \beta^M > \beta^L\) (steeper gradient in high-fragility = lower threshold).
# ==============================================================================
# SPEC 5: TERCILE ANALYSIS — BTFP
# ==============================================================================
run_tercile_models <- function(df, dv) {
list(
"Low UL" = run_one(df %>% filter(unins_lev_tercile == "Low"), dv, "adjusted_equity"),
"Med UL" = run_one(df %>% filter(unins_lev_tercile == "Med"), dv, "adjusted_equity"),
"High UL" = run_one(df %>% filter(unins_lev_tercile == "High"), dv, "adjusted_equity")
)
}
m_spec5_btfp <- run_tercile_models(df_btfp_s, "btfp_acute")
m_spec5_dw <- run_tercile_models(df_dw_s, "dw_acute")
etable(m_spec5_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 5: Tercile Gradient — BTFP")## Low UL Med UL High UL
## Dependent Var.: btfp_acute btfp_acute btfp_acute
##
## Constant 0.1102*** (0.0113) 0.1258*** (0.0090) 0.1373*** (0.0108)
## Adjusted Equity (z) 0.0157** (0.0059) 0.0244* (0.0118) 0.0444*** (0.0113)
## ___________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 1,294 1,236 1,207
## R2 0.06921 0.08294 0.09096
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_spec5_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 5: Tercile Gradient — DW")## Low UL Med UL High UL
## Dependent Var.: dw_acute dw_acute dw_acute
##
## Constant 0.0920*** (0.0108) 0.1094*** (0.0089) 0.1044*** (0.0094)
## Adjusted Equity (z) 0.0083 (0.0056) 0.0188. (0.0103) 0.0163 (0.0115)
## ___________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 1,275 1,203 1,190
## R2 0.05137 0.05702 0.12295
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec5_btfp, "Spec5_BTFP_TercileGradient",
title_text = "Spec 5: AE Effect by Uninsured Leverage Tercile — BTFP",
notes_text = "Split by UL tercile. DV = BTFP. Expect AE coefficient to increase with fragility. Robust SEs.")
save_etable(m_spec5_dw, "Spec5_DW_TercileGradient",
title_text = "Spec 5: AE Effect by Uninsured Leverage Tercile — DW",
notes_text = "Same tercile split. DV = DW. Robust SEs.")9 SPEC 6: FACILITY CHOICE — DW vs. BTFP
6a. Compare coefficients across facilities 6b. Multinomial logit: Neither / BTFP only / DW only / Both
Prediction: \(\beta_3^{DW} > \beta_3^{BTFP}\) (DW signals more severe run pressure).
# ==============================================================================
# SPEC 6: FACILITY CHOICE
# ==============================================================================
# 6a: Side-by-side comparison (already estimated — collect)
m_spec6_compare <- list(
"BTFP: LPM" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE, "lpm"),
"DW: LPM" = run_one(df_dw_s, "dw_acute", EXPL_AE_BASE, "lpm"),
"BTFP: Logit" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE, "logit"),
"DW: Logit" = run_one(df_dw_s, "dw_acute", EXPL_AE_BASE, "logit")
)
etable(m_spec6_compare, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 6a: BTFP vs DW Coefficient Comparison")## BTFP: LPM DW: LPM
## Dependent Var.: btfp_acute dw_acute
##
## Constant 0.1277*** (0.0053) 0.1121*** (0.0051)
## Adjusted Equity (z) 0.0294*** (0.0054) 0.0115* (0.0052)
## Uninsured Leverage (z) 0.0164* (0.0065) 0.0090 (0.0061)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045) 0.0095* (0.0043)
## ______________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,668
## R2 0.08934 0.09320
## Log-Likelihood -975.09 -720.98
##
## BTFP: Logit DW: Logit
## Dependent Var.: btfp_acute dw_acute
##
## Constant -2.327*** (0.0699) -2.440*** (0.0676)
## Adjusted Equity (z) 0.4367*** (0.0741) 0.2891*** (0.0757)
## Uninsured Leverage (z) 0.2017** (0.0630) 0.1383* (0.0592)
## Adj. Equity $\times$ Uninsured 0.0265 (0.0621) 0.0206 (0.0570)
## ______________________________ __________________ __________________
## Family Logit Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,668
## R2 -- --
## Log-Likelihood -1,214.6 -1,082.9
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec6_compare, "Spec6a_FacilityChoice_Compare",
title_text = "Spec 6a: BTFP vs. DW Coefficient Comparison",
notes_text = "DV: facility-specific. Compare AE x Uninsured interaction across facilities. Robust SEs.",
fitstat_use = ~ n + r2 + ll)
# 6b: Multinomial Logit
cat("\n=== SPEC 6b: MULTINOMIAL LOGIT ===\n")##
## === SPEC 6b: MULTINOMIAL LOGIT ===df_mlogit <- df_acute %>%
filter(!is.na(adjusted_equity) & !is.na(uninsured_lev)) %>%
mutate(facility_choice = factor(user_group, levels = c("Neither", "BTFP_Only", "DW_Only", "Both")))
mlogit_fit <- nnet::multinom(
facility_choice ~ adjusted_equity_w + uninsured_lev_w +
I(adjusted_equity_w * uninsured_lev_w) +
ln_assets_w + cash_ratio_w + loan_to_deposit_w + wholesale_w + roa_w,
data = df_mlogit, trace = FALSE
)
cat("\nMultinomial Logit Summary (ref = Neither):\n")##
## Multinomial Logit Summary (ref = Neither):print(summary(mlogit_fit))## Call:
## nnet::multinom(formula = facility_choice ~ adjusted_equity_w +
## uninsured_lev_w + I(adjusted_equity_w * uninsured_lev_w) +
## ln_assets_w + cash_ratio_w + loan_to_deposit_w + wholesale_w +
## roa_w, data = df_mlogit, trace = FALSE)
##
## Coefficients:
## (Intercept) adjusted_equity_w uninsured_lev_w
## BTFP_Only -6.379 0.10181 0.011033
## DW_Only -9.814 0.06545 0.003305
## Both -13.907 0.03210 0.043360
## I(adjusted_equity_w * uninsured_lev_w) ln_assets_w cash_ratio_w
## BTFP_Only -0.00009666 0.3410 -0.068067
## DW_Only -0.00026029 0.5251 -0.004375
## Both 0.00212109 0.7298 -0.048412
## loan_to_deposit_w wholesale_w roa_w
## BTFP_Only -0.0004111 0.08525 0.04528
## DW_Only 0.0044808 0.07489 0.15913
## Both -0.0021836 0.15348 -0.19291
##
## Std. Errors:
## (Intercept) adjusted_equity_w uninsured_lev_w
## BTFP_Only 0.6461 0.03508 0.006859
## DW_Only 0.6908 0.03491 0.007881
## Both 1.2587 0.07427 0.012222
## I(adjusted_equity_w * uninsured_lev_w) ln_assets_w cash_ratio_w
## BTFP_Only 0.001270 0.05016 0.01431
## DW_Only 0.001246 0.05091 0.01176
## Both 0.002259 0.08851 0.02584
## loan_to_deposit_w wholesale_w roa_w
## BTFP_Only 0.003587 0.02683 0.1309
## DW_Only 0.003940 0.03044 0.1365
## Both 0.007077 0.04559 0.2654
##
## Residual Deviance: 4949
## AIC: 500310 SPEC 7: INTENSIVE MARGIN — BORROWING AMOUNT
Among borrowers only: \(\text{BTFP\_Amt}_i = \alpha + \beta_1 \cdot \text{AdjEquity}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 \cdot (\text{AdjEquity}_i \times \text{UninsuredLev}_i) + \gamma X_i + \varepsilon_i\)
# ==============================================================================
# SPEC 7: INTENSIVE MARGIN (CONDITIONAL ON BORROWING)
# ==============================================================================
df_btfp_intensive <- df_acute %>% filter(btfp_acute == 1, !is.na(btfp_pct))
df_dw_intensive <- df_acute %>% filter(dw_acute == 1, !is.na(dw_pct))
m_spec7_btfp <- list(
"(1) AE" = run_one(df_btfp_intensive, "btfp_pct", "adjusted_equity + uninsured_lev"),
"(2) AE+Inter" = run_one(df_btfp_intensive, "btfp_pct", EXPL_AE_BASE),
"(3) Log Amt" = run_one(df_btfp_intensive, "log_btfp_amt", EXPL_AE_BASE)
)
if (nrow(df_dw_intensive) >= 30) {
m_spec7_dw <- list(
"(1) AE" = run_one(df_dw_intensive, "dw_pct", "adjusted_equity + uninsured_lev"),
"(2) AE+Inter" = run_one(df_dw_intensive, "dw_pct", EXPL_AE_BASE),
"(3) Log Amt" = run_one(df_dw_intensive, "log_dw_amt", EXPL_AE_BASE)
)
} else {
cat("DW intensive sample too small (N =", nrow(df_dw_intensive), "). Skipping.\n")
m_spec7_dw <- NULL
}
etable(m_spec7_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 7: Intensive Margin — BTFP")## (1) AE (2) AE+Inter
## Dependent Var.: btfp_pct btfp_pct
##
## Constant 7.018*** (0.9800) 7.143*** (1.041)
## Adjusted Equity (z) -1.826 (1.431) -1.994 (1.485)
## Uninsured Leverage (z) -1.767 (1.427) -2.127 (1.589)
## Adj. Equity $\times$ Uninsured 1.654 (1.104)
## ______________________________ _________________ ________________
## S.E. type Heteroskeda.-rob. Heterosked.-rob.
## Observations 462 462
## R2 0.12699 0.14598
##
## (3) Log Amt
## Dependent Var.: log_btfp_amt
##
## Constant 15.72*** (0.2071)
## Adjusted Equity (z) 0.2474 (0.2080)
## Uninsured Leverage (z) -0.2453 (0.2205)
## Adj. Equity $\times$ Uninsured 0.2780 (0.2382)
## ______________________________ _________________
## S.E. type Heteroskeda.-rob.
## Observations 462
## R2 0.13873
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_spec7_btfp, "Spec7_BTFP_IntensiveMargin",
title_text = "Spec 7: Intensive Margin — BTFP Borrowing Amount",
notes_text = "OLS, borrowers only. DV: Cols 1-2 = BTFP amt / TA (%). Col 3 = log(BTFP amount). Robust SEs.")
if (!is.null(m_spec7_dw)) {
etable(m_spec7_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 7: Intensive Margin — DW")
save_etable(m_spec7_dw, "Spec7_DW_IntensiveMargin",
title_text = "Spec 7: Intensive Margin — DW Borrowing Amount",
notes_text = "OLS, borrowers only. DV: DW amt. Robust SEs.")
}11 TEMPORAL ANALYSIS — BTFP ACROSS PERIODS
# ==============================================================================
# BTFP ACROSS PERIODS: AE-based specifications
# ==============================================================================
df_btfp_acute_s <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
df_btfp_post_s <- df_post %>% filter(btfp_post == 1 | non_user == 1)
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
models_btfp_temporal <- list(
"Acute: AE" = run_one(df_btfp_acute_s, "btfp_acute", EXPL_AE_BASE),
"Post: AE" = run_one(df_btfp_post_s, "btfp_post", EXPL_AE_BASE),
"Arb: AE" = run_one(df_btfp_arb_s, "btfp_arb", EXPL_AE_BASE),
"Wind: AE" = run_one(df_btfp_wind_s, "btfp_wind", EXPL_AE_BASE),
"Acute: AE-Q" = run_one(df_btfp_acute_s, "btfp_acute", EXPL_AE_Q),
"Post: AE-Q" = run_one(df_btfp_post_s, "btfp_post", EXPL_AE_Q),
"Arb: AE-Q" = run_one(df_btfp_arb_s, "btfp_arb", EXPL_AE_Q),
"Wind: AE-Q" = run_one(df_btfp_wind_s, "btfp_wind", EXPL_AE_Q)
)
temp_extra <- list(
"__N(BTFP=1)" = c(
sum(df_btfp_acute_s$btfp_acute), sum(df_btfp_post_s$btfp_post),
sum(df_btfp_arb_s$btfp_arb), sum(df_btfp_wind_s$btfp_wind),
sum(df_btfp_acute_s$btfp_acute), sum(df_btfp_post_s$btfp_post),
sum(df_btfp_arb_s$btfp_arb), sum(df_btfp_wind_s$btfp_wind)
),
"__Baseline" = c("2022Q4","2022Q4","2023Q3","2023Q4","2022Q4","2022Q4","2023Q3","2023Q4")
)
etable(models_btfp_temporal, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
extralines = temp_extra,
title = "BTFP Temporal: AE Specifications (LPM)")## Acute: AE Post: AE
## Dependent Var.: btfp_acute btfp_post
##
## Constant 0.1277*** (0.0053) 0.2333*** (0.0071)
## Adjusted Equity (z) 0.0294*** (0.0054) 0.0368*** (0.0074)
## Uninsured Leverage (z) 0.0164* (0.0065) 0.0152. (0.0082)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045) 0.0098. (0.0056)
## Adj. Equity Q2
## Adj. Equity Q3
## Adj. Equity Q4 (Highest)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,437
## R2 0.08934 0.08373
## N(BTFP=1) 462 775
## Baseline 2022Q4 2022Q4
##
## Arb: AE Wind: AE
## Dependent Var.: btfp_arb btfp_wind
##
## Constant 0.1894*** (0.0057) 0.0572*** (0.0036)
## Adjusted Equity (z) 0.0226*** (0.0064) 0.0065 (0.0042)
## Uninsured Leverage (z) 0.0102 (0.0065) 0.0072. (0.0042)
## Adj. Equity $\times$ Uninsured 0.0050 (0.0045) -0.0026 (0.0029)
## Adj. Equity Q2
## Adj. Equity Q3
## Adj. Equity Q4 (Highest)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 4,038 4,043
## R2 0.14168 0.06292
## N(BTFP=1) 766 229
## Baseline 2023Q3 2023Q4
##
## Acute: AE-Q Post: AE-Q
## Dependent Var.: btfp_acute btfp_post
##
## Constant 0.0953*** (0.0088) 0.1823*** (0.0128)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## Adj. Equity Q2 0.0086 (0.0123) 0.0443* (0.0179)
## Adj. Equity Q3 0.0605*** (0.0144) 0.0793*** (0.0195)
## Adj. Equity Q4 (Highest) 0.0671*** (0.0151) 0.0843*** (0.0208)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,747 3,447
## R2 0.08760 0.08273
## N(BTFP=1) 462 775
## Baseline 2022Q4 2022Q4
##
## Arb: AE-Q Wind: AE-Q
## Dependent Var.: btfp_arb btfp_wind
##
## Constant 0.1510*** (0.0105) 0.0462*** (0.0063)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## Adj. Equity Q2 0.0388** (0.0150) 0.0070 (0.0084)
## Adj. Equity Q3 0.0397* (0.0157) 0.0158 (0.0098)
## Adj. Equity Q4 (Highest) 0.0766*** (0.0182) 0.0199. (0.0112)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 4,055 4,061
## R2 0.14250 0.06184
## N(BTFP=1) 766 229
## Baseline 2023Q3 2023Q4
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(models_btfp_temporal, "Temporal_BTFP_AE_LPM",
title_text = "BTFP Participation: AE Specifications Across Periods (LPM)",
notes_text = "Cols 1-4: Continuous AE + UL + interaction. Cols 5-8: AE quartile dummies. Robust SEs.",
extra_lines = temp_extra)12 TEMPORAL ANALYSIS — DW ACROSS PERIODS
df_dw_pre_s <- df_prebtfp %>% filter(dw_prebtfp == 1 | non_user == 1)
df_dw_acute_s <- df_acute %>% filter(dw_acute == 1 | non_user == 1)
df_dw_post_s <- df_post %>% filter(dw_post == 1 | non_user == 1)
models_dw_temporal <- list(
"Pre: AE" = run_one(df_dw_pre_s, "dw_prebtfp", EXPL_AE_BASE),
"Acute: AE" = run_one(df_dw_acute_s, "dw_acute", EXPL_AE_BASE),
"Post: AE" = run_one(df_dw_post_s, "dw_post", EXPL_AE_BASE),
"Pre: AE-Q" = run_one(df_dw_pre_s, "dw_prebtfp", EXPL_AE_Q),
"Acute: AE-Q"= run_one(df_dw_acute_s, "dw_acute", EXPL_AE_Q),
"Post: AE-Q" = run_one(df_dw_post_s, "dw_post", EXPL_AE_Q)
)
dw_temp_extra <- list(
"__N(DW=1)" = c(
sum(df_dw_pre_s$dw_prebtfp), sum(df_dw_acute_s$dw_acute), sum(df_dw_post_s$dw_post),
sum(df_dw_pre_s$dw_prebtfp), sum(df_dw_acute_s$dw_acute), sum(df_dw_post_s$dw_post)
),
"__Baseline" = rep("2022Q4", 6)
)
etable(models_dw_temporal, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
extralines = dw_temp_extra,
title = "DW Temporal: AE Specifications (LPM)")## Pre: AE Acute: AE
## Dependent Var.: dw_prebtfp dw_acute
##
## Constant 0.0257*** (0.0025) 0.1121*** (0.0051)
## Adjusted Equity (z) -0.0006 (0.0030) 0.0115* (0.0052)
## Uninsured Leverage (z) -0.0001 (0.0029) 0.0090 (0.0061)
## Adj. Equity $\times$ Uninsured -0.0009 (0.0023) 0.0095* (0.0043)
## Adj. Equity Q2
## Adj. Equity Q3
## Adj. Equity Q4 (Highest)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,988 3,668
## R2 0.03541 0.09320
## N(DW=1) 100 393
## Baseline 2022Q4 2022Q4
##
## Post: AE Pre: AE-Q
## Dependent Var.: dw_post dw_prebtfp
##
## Constant 0.2532*** (0.0069) 0.0268*** (0.0049)
## Adjusted Equity (z) 0.0089 (0.0076)
## Uninsured Leverage (z) 0.0164* (0.0083)
## Adj. Equity $\times$ Uninsured 0.0115. (0.0059)
## Adj. Equity Q2 -0.0096 (0.0061)
## Adj. Equity Q3 0.0062 (0.0075)
## Adj. Equity Q4 (Highest) -0.0016 (0.0077)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,549 3,998
## R2 0.12725 0.03659
## N(DW=1) 887 100
## Baseline 2022Q4 2022Q4
##
## Acute: AE-Q Post: AE-Q
## Dependent Var.: dw_acute dw_post
##
## Constant 0.1047*** (0.0093) 0.2335*** (0.0133)
## Adjusted Equity (z)
## Uninsured Leverage (z)
## Adj. Equity $\times$ Uninsured
## Adj. Equity Q2 -0.0131 (0.0125) 0.0120 (0.0185)
## Adj. Equity Q3 0.0356* (0.0147) 0.0451* (0.0201)
## Adj. Equity Q4 (Highest) 0.0104 (0.0144) 0.0253 (0.0209)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,678 3,559
## R2 0.09430 0.12736
## N(DW=1) 393 887
## Baseline 2022Q4 2022Q4
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(models_dw_temporal, "Temporal_DW_AE_LPM",
title_text = "DW Usage: AE Specifications Across Periods (LPM)",
notes_text = "Cols 1-3: Continuous. Cols 4-6: AE quartile. Robust SEs.",
extra_lines = dw_temp_extra)13 SPEC 8: ROBUSTNESS
# ==============================================================================
# SPEC 8: ROBUSTNESS CHECKS
# ==============================================================================
df_rob <- df_btfp_s
# (a) Alternative fragility: Uninsured / Deposits (instead of / Assets)
df_rob_alt <- df_rob %>% mutate(uninsured_dep = standardize_z(winsorize(uninsured_share_raw)),
ae_x_uninsdep = adjusted_equity * uninsured_dep)
m_rob_alt_frag <- feols(btfp_acute ~ adjusted_equity + uninsured_dep + ae_x_uninsdep +
ln_assets + cash_ratio + loan_to_deposit + wholesale + roa,
data = df_rob_alt, vcov = "hetero")
# (b) Alternative fundamentals: Tier1 - MTM
df_rob_t1 <- df_rob %>% mutate(tier1_adj = standardize_z(winsorize(tier1_ratio_raw - mtm_total_raw)))
m_rob_tier1 <- feols(btfp_acute ~ tier1_adj + uninsured_lev +
ln_assets + cash_ratio + loan_to_deposit + wholesale + roa,
data = df_rob_t1, vcov = "hetero")
# (c) Acute only (Mar 13 – May 2023)
m_rob_baseline <- run_one(df_rob, "btfp_acute", EXPL_AE_BASE, "lpm")
# (d) Alternative winsorization (1/99%)
df_rob_w1 <- df_rob %>%
mutate(ae_1 = standardize_z(winsorize(adjusted_equity_raw, c(0.01, 0.99))),
ul_1 = standardize_z(winsorize(uninsured_lev_raw, c(0.01, 0.99))),
ae_ul_1 = ae_1 * ul_1)
m_rob_win1 <- feols(btfp_acute ~ ae_1 + ul_1 + ae_ul_1 +
ln_assets + cash_ratio + loan_to_deposit + wholesale + roa,
data = df_rob_w1, vcov = "hetero")
# (e) Exclude large banks
m_rob_small <- run_one(df_rob %>% filter(size_cat != "Large (>$100B)"), "btfp_acute", EXPL_AE_BASE, "lpm")
# (f) Size interaction
df_rob_size <- df_rob %>% mutate(ae_x_size = adjusted_equity * ln_assets)
m_rob_size <- feols(btfp_acute ~ adjusted_equity + uninsured_lev + ae_x_uninsured + ae_x_size +
ln_assets + cash_ratio + loan_to_deposit + wholesale + roa,
data = df_rob_size, vcov = "hetero")
models_rob <- list(
"(1) Baseline" = m_rob_baseline,
"(2) Alt Fragility" = m_rob_alt_frag,
"(3) Tier1-MTM" = m_rob_tier1,
"(4) Win 1/99" = m_rob_win1,
"(5) Excl Large" = m_rob_small,
"(6) Size Inter" = m_rob_size
)
etable(models_rob, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "Spec 8: Robustness Checks — BTFP Acute")## (1) Baseline (2) Alt Fragility
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1277*** (0.0053) 0.1289*** (0.0053)
## Adjusted Equity (z) 0.0294*** (0.0054) 0.0280*** (0.0050)
## Uninsured Leverage (z) 0.0164* (0.0065)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045)
## uninsured_dep 0.0221** (0.0068)
## ae_x_uninsdep 0.0142*** (0.0040)
## tier1_adj
## ae_1
## ul_1
## ae_ul_1
## ae_x_size
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08934 0.08986
##
## (3) Tier1-MTM (4) Win 1/99
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1290*** (0.0053) 0.1236*** (0.0053)
## Adjusted Equity (z)
## Uninsured Leverage (z) 0.0132* (0.0061)
## Adj. Equity $\times$ Uninsured
## uninsured_dep
## ae_x_uninsdep
## tier1_adj -0.0199*** (0.0046)
## ae_1 0.0448*** (0.0085)
## ul_1 0.0163* (0.0065)
## ae_ul_1 0.0265*** (0.0049)
## ae_x_size
## ______________________________ ___________________ __________________
## S.E. type Heteroskedast.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08552 0.08903
##
## (5) Excl Large (6) Size Inter
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1275*** (0.0054) 0.1259*** (0.0053)
## Adjusted Equity (z) 0.0297*** (0.0054) 0.0372*** (0.0063)
## Uninsured Leverage (z) 0.0157* (0.0065) 0.0164* (0.0065)
## Adj. Equity $\times$ Uninsured 0.0161*** (0.0045) 0.0074 (0.0048)
## uninsured_dep
## ae_x_uninsdep
## tier1_adj
## ae_1
## ul_1
## ae_ul_1
## ae_x_size 0.0271*** (0.0065)
## ______________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,722 3,737
## R2 0.08885 0.09490
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(models_rob, "Spec8_Robustness_BTFP",
title_text = "Spec 8: Robustness Checks — BTFP Participation",
notes_text = paste(
"All LPM. DV = BTFP acute.",
"(1) Baseline AE spec.",
"(2) Uninsured/Deposits instead of Uninsured/Assets.",
"(3) Tier1-MTM as fundamental proxy.",
"(4) 1/99% winsorization.",
"(5) Excluding banks > $100B.",
"(6) AE x Size interaction. Robust SEs."))14 OMO-Based Tests (to address Jiang et al “solvency runs”)
# ==============================================================================
# OMO SPEC 1: BASELINE — DECOMPOSE MTM LOSSES
#
# BTFP_i = α + β1·MTM_OMO + β2·MTM_NonOMO + β3·UninsuredLev + γX + ε
#
# Purpose: Separate liquid (OMO) vs. illiquid (non-OMO) asset losses.
# Expected: β1 > 0, β2 > 0, β3 > 0.
# Uses CONTROLS_FULL (includes book_equity_ratio — no AE collinearity issue)
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 1: BASELINE — DECOMPOSE MTM LOSSES\n")## OMO SPEC 1: BASELINE — DECOMPOSE MTM LOSSEScat("===================================================================\n")## ===================================================================m_omo1_btfp <- list(
"(1) MTM Total" = run_one(df_btfp_s, "btfp_acute", "mtm_total + uninsured_lev",
controls = CONTROLS_FULL),
"(2) MTM Decomp" = run_one(df_btfp_s, "btfp_acute", "mtm_btfp + mtm_other + uninsured_lev",
controls = CONTROLS_FULL),
"(3) Logit" = run_one(df_btfp_s, "btfp_acute", "mtm_btfp + mtm_other + uninsured_lev",
"logit", controls = CONTROLS_FULL)
)
m_omo1_dw <- list(
"(1) MTM Total" = run_one(df_dw_s, "dw_acute", "mtm_total + uninsured_lev",
controls = CONTROLS_FULL),
"(2) MTM Decomp" = run_one(df_dw_s, "dw_acute", "mtm_btfp + mtm_other + uninsured_lev",
controls = CONTROLS_FULL),
"(3) Logit" = run_one(df_dw_s, "dw_acute", "mtm_btfp + mtm_other + uninsured_lev",
"logit", controls = CONTROLS_FULL)
)
etable(m_omo1_btfp, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 1: MTM Decomposition — BTFP")## (1) MTM Total (2) MTM Decomp (3) Logit
## Dependent Var.: btfp_acute btfp_acute btfp_acute
##
## Constant 0.1293*** (0.0054) 0.1292*** (0.0054) -2.319*** (0.0703)
## MTM Loss (z) 0.0198*** (0.0055)
## Uninsured Leverage (z) 0.0154* (0.0063) 0.0143* (0.0064) 0.1916** (0.0626)
## MTM Loss OMO (z) 0.0165** (0.0062) 0.0948. (0.0554)
## MTM Loss Non-OMO (z) 0.0072 (0.0054) 0.0613 (0.0594)
## ______________________ __________________ __________________ __________________
## Family OLS OLS Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737 3,737
## R2 0.08704 0.08651 --
## Log-Likelihood -979.80 -980.88 -1,218.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_omo1_dw, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 1: MTM Decomposition — DW")## (1) MTM Total (2) MTM Decomp (3) Logit
## Dependent Var.: dw_acute dw_acute dw_acute
##
## Constant 0.1130*** (0.0051) 0.1130*** (0.0051) -2.435*** (0.0676)
## MTM Loss (z) 0.0122* (0.0054)
## Uninsured Leverage (z) 0.0089 (0.0060) 0.0091 (0.0060) 0.1488* (0.0616)
## MTM Loss OMO (z) 0.0089 (0.0057) 0.0411 (0.0642)
## MTM Loss Non-OMO (z) 0.0099. (0.0053) 0.1523* (0.0647)
## ______________________ __________________ __________________ __________________
## Family OLS OLS Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668 3,668
## R2 0.09279 0.09295 --
## Log-Likelihood -721.81 -721.50 -1,083.5
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_omo1_btfp, "OMO_Spec1_BTFP_Decomp",
title_text = "OMO Spec 1: MTM Loss Decomposition — BTFP",
notes_text = "DV = BTFP. Col1: total MTM. Col2-3: OMO + Non-OMO decomposed. Controls include book equity. Robust SEs.",
fitstat_use = ~ n + r2 + ll)
save_etable(m_omo1_dw, "OMO_Spec1_DW_Decomp",
title_text = "OMO Spec 1: MTM Loss Decomposition — DW",
notes_text = "DV = DW. Same specifications. Robust SEs.",
fitstat_use = ~ n + r2 + ll)# ==============================================================================
# OMO SPEC 2: STRATEGIC COMPLEMENTARITIES — OMO LOSSES ONLY
#
# BTFP_i = α + β1·MTM_OMO + β2·UninsuredLev + β3·(MTM_OMO × Uninsured) + γX + ε
#
# Key coefficient: β3 > 0 → fragility amplifies response to liquid losses.
# Interpretation: Rules out illiquidity spiral — must be pure panic on
# publicly observable, easily liquidated assets.
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 2: STRATEGIC COMPLEMENTARITIES — OMO LOSSES ONLY\n")## OMO SPEC 2: STRATEGIC COMPLEMENTARITIES — OMO LOSSES ONLYcat("===================================================================\n")## ===================================================================m_omo2_btfp <- list(
"(1) OMO only" = run_one(df_btfp_s, "btfp_acute", "mtm_btfp + uninsured_lev",
controls = CONTROLS_FULL),
"(2) OMO × Unins" = run_one(df_btfp_s, "btfp_acute", EXPL_OMO_INTER,
controls = CONTROLS_FULL),
"(3) Logit" = run_one(df_btfp_s, "btfp_acute", EXPL_OMO_INTER,
"logit", controls = CONTROLS_FULL)
)
m_omo2_dw <- list(
"(1) OMO only" = run_one(df_dw_s, "dw_acute", "mtm_btfp + uninsured_lev",
controls = CONTROLS_FULL),
"(2) OMO × Unins" = run_one(df_dw_s, "dw_acute", EXPL_OMO_INTER,
controls = CONTROLS_FULL),
"(3) Logit" = run_one(df_dw_s, "dw_acute", EXPL_OMO_INTER,
"logit", controls = CONTROLS_FULL)
)
etable(m_omo2_btfp, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 2: OMO Strategic Complementarities — BTFP")## (1) OMO only (2) OMO × Unins
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1291*** (0.0054) 0.1290*** (0.0053)
## MTM Loss OMO (z) 0.0155* (0.0062) 0.0157* (0.0062)
## Uninsured Leverage (z) 0.0131* (0.0063) 0.0138* (0.0063)
## MTM OMO $\times$ Uninsured 0.0106* (0.0053)
## __________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08613 0.08727
## Log-Likelihood -981.65 -979.33
##
## (3) Logit
## Dependent Var.: btfp_acute
##
## Constant -2.321*** (0.0706)
## MTM Loss OMO (z) 0.0848 (0.0562)
## Uninsured Leverage (z) 0.1803** (0.0620)
## MTM OMO $\times$ Uninsured 0.0019 (0.0444)
## __________________________ __________________
## Family Logit
## S.E. type Heteroskedas.-rob.
## Observations 3,737
## R2 --
## Log-Likelihood -1,219.3
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_omo2_dw, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 2: OMO Strategic Complementarities — DW")## (1) OMO only (2) OMO × Unins
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1129*** (0.0051) 0.1128*** (0.0051)
## MTM Loss OMO (z) 0.0076 (0.0057) 0.0079 (0.0057)
## Uninsured Leverage (z) 0.0074 (0.0059) 0.0080 (0.0059)
## MTM OMO $\times$ Uninsured 0.0086. (0.0050)
## __________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09212 0.09297
## Log-Likelihood -723.18 -721.46
##
## (3) Logit
## Dependent Var.: dw_acute
##
## Constant -2.426*** (0.0669)
## MTM Loss OMO (z) 0.0157 (0.0678)
## Uninsured Leverage (z) 0.1238* (0.0602)
## MTM OMO $\times$ Uninsured 0.0201 (0.0475)
## __________________________ __________________
## Family Logit
## S.E. type Heteroskedas.-rob.
## Observations 3,668
## R2 --
## Log-Likelihood -1,086.2
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_omo2_btfp, "OMO_Spec2_BTFP_Complementarities",
title_text = "OMO Spec 2: OMO-Loss Strategic Complementarities — BTFP",
notes_text = "DV = BTFP. Key: MTM_OMO x Uninsured > 0 → panic on liquid-asset losses. Robust SEs.",
fitstat_use = ~ n + r2 + ll)
save_etable(m_omo2_dw, "OMO_Spec2_DW_Complementarities",
title_text = "OMO Spec 2: OMO-Loss Strategic Complementarities — DW",
notes_text = "DV = DW. Same specifications. Robust SEs.",
fitstat_use = ~ n + r2 + ll)# ==============================================================================
# OMO SPEC 3: HORSE RACE — OMO vs NON-OMO INTERACTIONS
#
# BTFP_i = α + β1·MTM_OMO + β2·MTM_NonOMO + β3·Uninsured
# + β4·(MTM_OMO × Uninsured) + β5·(MTM_NonOMO × Uninsured) + γX + ε
#
# Purpose: Which losses drive the panic channel?
# β4 > 0, β5 ≈ 0 → Panic on public signals (OMO)
# β4 ≈ β5 > 0 → General coordination failure
# β5 > β4 → Illiquidity concerns dominate
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 3: HORSE RACE — OMO vs NON-OMO INTERACTIONS\n")## OMO SPEC 3: HORSE RACE — OMO vs NON-OMO INTERACTIONScat("===================================================================\n")## ===================================================================m_omo3_btfp <- list(
"(1) Horse Race LPM" = run_one(df_btfp_s, "btfp_acute", EXPL_OMO_HORSE,
controls = CONTROLS_FULL),
"(2) Horse Race Logit" = run_one(df_btfp_s, "btfp_acute", EXPL_OMO_HORSE,
"logit", controls = CONTROLS_FULL)
)
m_omo3_dw <- list(
"(1) Horse Race LPM" = run_one(df_dw_s, "dw_acute", EXPL_OMO_HORSE,
controls = CONTROLS_FULL),
"(2) Horse Race Logit" = run_one(df_dw_s, "dw_acute", EXPL_OMO_HORSE,
"logit", controls = CONTROLS_FULL)
)
etable(m_omo3_btfp, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 3: Horse Race — BTFP")## (1) Horse Race LPM (2) Horse Race L..
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1306*** (0.0054) -2.312*** (0.0706)
## MTM Loss OMO (z) 0.0171** (0.0062) 0.0957. (0.0567)
## MTM Loss Non-OMO (z) 0.0100. (0.0058) 0.0572 (0.0601)
## Uninsured Leverage (z) 0.0181** (0.0068) 0.1903** (0.0633)
## MTM OMO $\times$ Uninsured 0.0101. (0.0052) -0.0003 (0.0447)
## MTM Non-OMO $\times$ Uninsured 0.0133** (0.0051) 0.0393 (0.0566)
## ______________________________ __________________ __________________
## Family OLS Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08931 --
## Log-Likelihood -975.15 -1,218.5
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_omo3_dw, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 3: Horse Race — DW")## (1) Horse Race LPM (2) Horse Race L..
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1148*** (0.0052) -2.419*** (0.0670)
## MTM Loss OMO (z) 0.0095. (0.0057) 0.0389 (0.0683)
## MTM Loss Non-OMO (z) 0.0133* (0.0058) 0.1367* (0.0655)
## Uninsured Leverage (z) 0.0137* (0.0064) 0.1503* (0.0618)
## MTM OMO $\times$ Uninsured 0.0078 (0.0050) 0.0083 (0.0496)
## MTM Non-OMO $\times$ Uninsured 0.0173*** (0.0049) 0.1070. (0.0549)
## ______________________________ __________________ __________________
## Family OLS Logit
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09705 --
## Log-Likelihood -713.19 -1,081.7
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Wald test: β4 = β5
cat("\n--- Wald Test: OMO interaction = Non-OMO interaction (BTFP LPM) ---\n")##
## --- Wald Test: OMO interaction = Non-OMO interaction (BTFP LPM) ---tryCatch({
wald_btfp <- wald(m_omo3_btfp[["(1) Horse Race LPM"]],
"mtm_omo_x_uninsured = mtm_nonomo_x_uninsured")
print(wald_btfp)
}, error = function(e) cat("Wald test error:", e$message, "\n"))## [1] NAcat("\n--- Wald Test: OMO interaction = Non-OMO interaction (DW LPM) ---\n")##
## --- Wald Test: OMO interaction = Non-OMO interaction (DW LPM) ---tryCatch({
wald_dw <- wald(m_omo3_dw[["(1) Horse Race LPM"]],
"mtm_omo_x_uninsured = mtm_nonomo_x_uninsured")
print(wald_dw)
}, error = function(e) cat("Wald test error:", e$message, "\n"))## [1] NAsave_etable(m_omo3_btfp, "OMO_Spec3_BTFP_HorseRace",
title_text = "OMO Spec 3: OMO vs. Non-OMO Horse Race — BTFP",
notes_text = "DV = BTFP. Both OMO and Non-OMO interactions included. β4 > β5 → panic on public signals. Robust SEs.",
fitstat_use = ~ n + r2 + ll)
save_etable(m_omo3_dw, "OMO_Spec3_DW_HorseRace",
title_text = "OMO Spec 3: OMO vs. Non-OMO Horse Race — DW",
notes_text = "DV = DW. Same specifications. Robust SEs.",
fitstat_use = ~ n + r2 + ll)# ==============================================================================
# OMO SPEC 4: ADJUSTED EQUITY WITH OMO LOSSES
#
# AdjEquity_OMO = BookEquity − MTM_OMO
#
# BTFP_i = α + β1·AdjEquity_OMO + β2·Uninsured + β3·(AdjEquity_OMO × Uninsured) + γX + ε
#
# Purpose: Threshold based on liquid-asset fundamentals only.
# Key coefficient: β3 > 0 → threshold varies with fragility (Goldstein prediction).
# Uses CONTROLS_AE (no book_equity_ratio to avoid collinearity with AdjEquity_OMO)
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 4: ADJUSTED EQUITY WITH OMO LOSSES\n")## OMO SPEC 4: ADJUSTED EQUITY WITH OMO LOSSEScat("===================================================================\n")## ===================================================================m_omo4_btfp <- list(
"(1) AE-OMO" = run_one(df_btfp_s, "btfp_acute",
"adjusted_equity_omo + uninsured_lev"),
"(2) AE-OMO + Inter" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_OMO_BASE),
"(3) Logit" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_OMO_BASE, "logit"),
"(4) vs Full AE" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE)
)
m_omo4_dw <- list(
"(1) AE-OMO" = run_one(df_dw_s, "dw_acute",
"adjusted_equity_omo + uninsured_lev"),
"(2) AE-OMO + Inter" = run_one(df_dw_s, "dw_acute", EXPL_AE_OMO_BASE),
"(3) Logit" = run_one(df_dw_s, "dw_acute", EXPL_AE_OMO_BASE, "logit"),
"(4) vs Full AE" = run_one(df_dw_s, "dw_acute", EXPL_AE_BASE)
)
etable(m_omo4_btfp, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "OMO Spec 4: AdjEquity-OMO — BTFP")## (1) AE-OMO (2) AE-OMO + Inter
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1293*** (0.0054) 0.1265*** (0.0053)
## Adj. Equity OMO (z) 0.0187*** (0.0046) 0.0251*** (0.0054)
## Uninsured Leverage (z) 0.0117. (0.0062) 0.0137* (0.0064)
## Adj. Equity OMO $\times$ Uninsured 0.0140*** (0.0041)
## Adjusted Equity (z)
## Adj. Equity $\times$ Uninsured
## __________________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08515 0.08726
## Log-Likelihood -983.67 -979.34
##
## (3) Logit (4) vs Full AE
## Dependent Var.: btfp_acute btfp_acute
##
## Constant -2.323*** (0.0702) 0.1277*** (0.0053)
## Adj. Equity OMO (z) 0.4068*** (0.0825)
## Uninsured Leverage (z) 0.1711** (0.0644) 0.0164* (0.0065)
## Adj. Equity OMO $\times$ Uninsured 0.0309 (0.0648)
## Adjusted Equity (z) 0.0294*** (0.0054)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045)
## __________________________________ __________________ __________________
## Family Logit OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 -- 0.08934
## Log-Likelihood -1,218.8 -975.09
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_omo4_dw, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "OMO Spec 4: AdjEquity-OMO — DW")## (1) AE-OMO (2) AE-OMO + Inter
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1129*** (0.0051) 0.1118*** (0.0051)
## Adj. Equity OMO (z) 0.0046 (0.0042) 0.0072 (0.0051)
## Uninsured Leverage (z) 0.0067 (0.0058) 0.0075 (0.0060)
## Adj. Equity OMO $\times$ Uninsured 0.0056 (0.0040)
## Adjusted Equity (z)
## Adj. Equity $\times$ Uninsured
## __________________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09174 0.09213
## Log-Likelihood -723.93 -723.14
##
## (3) Logit (4) vs Full AE
## Dependent Var.: dw_acute dw_acute
##
## Constant -2.423*** (0.0669) 0.1121*** (0.0051)
## Adj. Equity OMO (z) 0.2183** (0.0788)
## Uninsured Leverage (z) 0.1273* (0.0598) 0.0090 (0.0061)
## Adj. Equity OMO $\times$ Uninsured -0.0127 (0.0583)
## Adjusted Equity (z) 0.0115* (0.0052)
## Adj. Equity $\times$ Uninsured 0.0095* (0.0043)
## __________________________________ __________________ __________________
## Family Logit OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 -- 0.09320
## Log-Likelihood -1,086.2 -720.98
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_omo4_btfp, "OMO_Spec4_BTFP_AE_OMO",
title_text = "OMO Spec 4: Adjusted Equity (OMO Only) — BTFP",
notes_text = "AdjEquity_OMO = BookEquity - MTM_OMO. Col4: full AE for comparison. Robust SEs.",
fitstat_use = ~ n + r2 + ll)
save_etable(m_omo4_dw, "OMO_Spec4_DW_AE_OMO",
title_text = "OMO Spec 4: Adjusted Equity (OMO Only) — DW",
notes_text = "Same specifications. Robust SEs.",
fitstat_use = ~ n + r2 + ll)# ==============================================================================
# OMO SPEC 5: SPLIT BY SOLVENCY (OMO-BASED)
#
# 5a. Solvent (AdjEquity_OMO ≥ 0): BTFP = α + δ^S · Uninsured + γX + ε
# 5b. Insolvent (AdjEquity_OMO < 0): BTFP = α + δ^I · Uninsured + γX + ε
#
# Note: OMO losses are smaller than total, so nearly all banks will be
# OMO-solvent. The insolvent subsample may be very small / empty.
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 5: SPLIT BY SOLVENCY (OMO-BASED)\n")## OMO SPEC 5: SPLIT BY SOLVENCY (OMO-BASED)cat("===================================================================\n")## ===================================================================cat("OMO Solvency Distribution (full sample):\n")## OMO Solvency Distribution (full sample):cat(" OMO-Solvent:", sum(df_2022q4$omo_solvent, na.rm = TRUE),
"| OMO-Insolvent:", sum(df_2022q4$omo_insolvent, na.rm = TRUE), "\n\n")## OMO-Solvent: 4282 | OMO-Insolvent: 0# --- BTFP ---
df_btfp_omo_solvent <- df_btfp_s %>% filter(omo_solvent == 1)
df_btfp_omo_insolvent <- df_btfp_s %>% filter(omo_insolvent == 1)
cat("BTFP clean sample — OMO-Solvent:", nrow(df_btfp_omo_solvent),
"| OMO-Insolvent:", nrow(df_btfp_omo_insolvent), "\n")## BTFP clean sample — OMO-Solvent: 3737 | OMO-Insolvent: 0m_omo5_btfp_solvent <- run_one(df_btfp_omo_solvent, "btfp_acute", "uninsured_lev")
m_omo5_btfp_insolvent <- tryCatch(
run_one(df_btfp_omo_insolvent, "btfp_acute", "uninsured_lev"),
error = function(e) {
cat(" OMO-Insolvent BTFP subsample too small (N =", nrow(df_btfp_omo_insolvent), "). Skipping.\n")
NULL
}
)## OMO-Insolvent BTFP subsample too small (N = 0 ). Skipping.# Also run full interaction within OMO-solvent
m_omo5_btfp_solvent_inter <- run_one(df_btfp_omo_solvent, "btfp_acute", EXPL_AE_OMO_BASE)
# --- DW ---
df_dw_omo_solvent <- df_dw_s %>% filter(omo_solvent == 1)
df_dw_omo_insolvent <- df_dw_s %>% filter(omo_insolvent == 1)
cat("DW clean sample — OMO-Solvent:", nrow(df_dw_omo_solvent),
"| OMO-Insolvent:", nrow(df_dw_omo_insolvent), "\n")## DW clean sample — OMO-Solvent: 3668 | OMO-Insolvent: 0m_omo5_dw_solvent <- run_one(df_dw_omo_solvent, "dw_acute", "uninsured_lev")
m_omo5_dw_insolvent <- tryCatch(
run_one(df_dw_omo_insolvent, "dw_acute", "uninsured_lev"),
error = function(e) {
cat(" OMO-Insolvent DW subsample too small (N =", nrow(df_dw_omo_insolvent), "). Skipping.\n")
NULL
}
)## OMO-Insolvent DW subsample too small (N = 0 ). Skipping.m_omo5_dw_solvent_inter <- run_one(df_dw_omo_solvent, "dw_acute", EXPL_AE_OMO_BASE)
# Collect models
models_omo5_btfp <- compact(list(
"OMO-Solvent: UL" = m_omo5_btfp_solvent,
"OMO-Insolvent: UL" = m_omo5_btfp_insolvent,
"OMO-Solvent: AE-OMO+Inter" = m_omo5_btfp_solvent_inter
))
models_omo5_dw <- compact(list(
"OMO-Solvent: UL" = m_omo5_dw_solvent,
"OMO-Insolvent: UL" = m_omo5_dw_insolvent,
"OMO-Solvent: AE-OMO+Inter" = m_omo5_dw_solvent_inter
))
etable(models_omo5_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "OMO Spec 5: OMO Solvency Split — BTFP")## OMO-Solvent: UL OMO-Solvent: AE-..
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1294*** (0.0054) 0.1265*** (0.0053)
## Uninsured Leverage (z) 0.0153* (0.0061) 0.0137* (0.0064)
## Adj. Equity OMO (z) 0.0251*** (0.0054)
## Adj. Equity OMO $\times$ Uninsured 0.0140*** (0.0041)
## __________________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08257 0.08726
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(models_omo5_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "OMO Spec 5: OMO Solvency Split — DW")## OMO-Solvent: UL OMO-Solvent: AE-..
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1128*** (0.0051) 0.1118*** (0.0051)
## Uninsured Leverage (z) 0.0075 (0.0057) 0.0075 (0.0060)
## Adj. Equity OMO (z) 0.0072 (0.0051)
## Adj. Equity OMO $\times$ Uninsured 0.0056 (0.0040)
## __________________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09156 0.09213
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(models_omo5_btfp, "OMO_Spec5_BTFP_SolvencySplit",
title_text = "OMO Spec 5: OMO-Solvency Split — BTFP",
notes_text = "Split by AdjEquity_OMO ≥ 0. δ^S > 0 with δ^I ≈ 0 → panic runs among OMO-solvent. Robust SEs.")
save_etable(models_omo5_dw, "OMO_Spec5_DW_SolvencySplit",
title_text = "OMO Spec 5: OMO-Solvency Split — DW",
notes_text = "Same split. DV = DW. Robust SEs.")# ==============================================================================
# OMO SPEC 6: PAR BENEFIT AS TREATMENT INTENSITY
#
# ParBenefit = MTM_OMO / OMO_Holdings (loss per dollar of eligible collateral)
#
# BTFP_i = α + β1·ParBenefit + β2·Uninsured + β3·(ParBenefit × Uninsured) + γX + ε
#
# β1 > 0 → Arbitrage motive (larger subsidy → more likely to borrow)
# β3 > 0 → Fragile banks with larger par benefit more likely to borrow
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 6: PAR BENEFIT AS TREATMENT INTENSITY\n")## OMO SPEC 6: PAR BENEFIT AS TREATMENT INTENSITYcat("===================================================================\n")## ===================================================================# Diagnostic: par benefit distribution
cat("Par Benefit distribution (raw, winsorized):\n")## Par Benefit distribution (raw, winsorized):print(summary(df_btfp_s$par_benefit_w))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.00 3.06 6.38 6.74 9.82 18.80 10cat("\n")m_omo6_btfp <- list(
"(1) Par + UL" = run_one(df_btfp_s, "btfp_acute", "par_benefit + uninsured_lev"),
"(2) Par + UL + Inter" = run_one(df_btfp_s, "btfp_acute", EXPL_PAR_BENEFIT),
"(3) Logit" = run_one(df_btfp_s, "btfp_acute", EXPL_PAR_BENEFIT, "logit"),
"(4) AE + Par" = run_one(df_btfp_s, "btfp_acute",
"adjusted_equity + par_benefit + uninsured_lev + par_x_uninsured")
)
m_omo6_dw <- list(
"(1) Par + UL" = run_one(df_dw_s, "dw_acute", "par_benefit + uninsured_lev"),
"(2) Par + UL + Inter" = run_one(df_dw_s, "dw_acute", EXPL_PAR_BENEFIT),
"(3) Logit" = run_one(df_dw_s, "dw_acute", EXPL_PAR_BENEFIT, "logit")
)
etable(m_omo6_btfp, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "OMO Spec 6: Par Benefit — BTFP")## (1) Par + UL (2) Par + UL + I..
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1294*** (0.0054) 0.1291*** (0.0054)
## Par Benefit (z) 0.0055 (0.0053) 0.0055 (0.0053)
## Uninsured Leverage (z) 0.0155* (0.0061) 0.0162** (0.0062)
## Par Benefit $\times$ Uninsured 0.0066 (0.0053)
## Adjusted Equity (z)
## ______________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08282 0.08324
## Log-Likelihood -988.41 -987.55
##
## (3) Logit (4) AE + Par
## Dependent Var.: btfp_acute btfp_acute
##
## Constant -2.264*** (0.0661) 0.1289*** (0.0054)
## Par Benefit (z) 0.0347 (0.0544) -0.0012 (0.0054)
## Uninsured Leverage (z) 0.2187*** (0.0586) 0.0136* (0.0062)
## Par Benefit $\times$ Uninsured -0.0416 (0.0502) 0.0077 (0.0052)
## Adjusted Equity (z) 0.0250*** (0.0051)
## ______________________________ __________________ __________________
## Family Logit OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 -- 0.08727
## Log-Likelihood -1,232.5 -979.32
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_omo6_dw, fitstat = ~ n + r2 + ll,
drop = "Log|Cash|Loan-to|Wholesale|ROA",
title = "OMO Spec 6: Par Benefit — DW")## (1) Par + UL (2) Par + UL + I..
## Dependent Var.: dw_acute dw_acute
##
## Constant 0.1129*** (0.0051) 0.1118*** (0.0051)
## Par Benefit (z) 0.0123* (0.0050) 0.0120* (0.0050)
## Uninsured Leverage (z) 0.0079 (0.0057) 0.0095 (0.0058)
## Par Benefit $\times$ Uninsured 0.0163** (0.0050)
## ______________________________ __________________ __________________
## Family OLS OLS
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,668 3,668
## R2 0.09299 0.09600
## Log-Likelihood -721.41 -715.32
##
## (3) Logit
## Dependent Var.: dw_acute
##
## Constant -2.404*** (0.0648)
## Par Benefit (z) 0.0990. (0.0583)
## Uninsured Leverage (z) 0.1365* (0.0590)
## Par Benefit $\times$ Uninsured 0.0507 (0.0481)
## ______________________________ __________________
## Family Logit
## S.E. type Heteroskedas.-rob.
## Observations 3,668
## R2 --
## Log-Likelihood -1,087.6
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(m_omo6_btfp, "OMO_Spec6_BTFP_ParBenefit",
title_text = "OMO Spec 6: Par Benefit as Treatment Intensity — BTFP",
notes_text = "ParBenefit = MTM_OMO / OMO_Holdings. β1>0: arbitrage. β3>0: fragile banks exploit more. Col4 adds AE. Robust SEs.",
fitstat_use = ~ n + r2 + ll)
save_etable(m_omo6_dw, "OMO_Spec6_DW_ParBenefit",
title_text = "OMO Spec 6: Par Benefit as Treatment Intensity — DW",
notes_text = "ParBenefit defined as for BTFP. DW has no par valuation, so effect should differ. Robust SEs.",
fitstat_use = ~ n + r2 + ll)# ==============================================================================
# OMO SPEC 7: TERCILE ANALYSIS ON OMO LOSSES
#
# Split by Uninsured Leverage terciles, run:
# BTFP_i = α^(k) + β^(k) · MTM_OMO + γX + ε for k ∈ {L, M, H}
#
# Prediction: β^H > β^M > β^L
# Higher sensitivity to OMO losses in fragile banks = lower threshold
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 7: TERCILE ANALYSIS ON OMO LOSSES\n")## OMO SPEC 7: TERCILE ANALYSIS ON OMO LOSSEScat("===================================================================\n")## ===================================================================run_omo_tercile_models <- function(df, dv) {
list(
"Low UL" = run_one(df %>% filter(unins_lev_tercile == "Low"), dv, "mtm_btfp",
controls = CONTROLS_FULL),
"Med UL" = run_one(df %>% filter(unins_lev_tercile == "Med"), dv, "mtm_btfp",
controls = CONTROLS_FULL),
"High UL" = run_one(df %>% filter(unins_lev_tercile == "High"), dv, "mtm_btfp",
controls = CONTROLS_FULL)
)
}
m_omo7_btfp <- run_omo_tercile_models(df_btfp_s, "btfp_acute")
m_omo7_dw <- run_omo_tercile_models(df_dw_s, "dw_acute")
etable(m_omo7_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 7: OMO Tercile Gradient — BTFP")## Low UL Med UL High UL
## Dependent Var.: btfp_acute btfp_acute btfp_acute
##
## Constant 0.1103*** (0.0114) 0.1253*** (0.0091) 0.1373*** (0.0107)
## MTM Loss OMO (z) 0.0065 (0.0084) 0.0091 (0.0112) 0.0256* (0.0127)
## ________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 1,294 1,236 1,207
## R2 0.06770 0.08289 0.09075
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etable(m_omo7_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 7: OMO Tercile Gradient — DW")## Low UL Med UL High UL
## Dependent Var.: dw_acute dw_acute dw_acute
##
## Constant 0.0923*** (0.0109) 0.1089*** (0.0090) 0.1056*** (0.0094)
## MTM Loss OMO (z) 0.0032 (0.0075) 0.0011 (0.0102) 0.0117 (0.0118)
## ________________ __________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 1,275 1,203 1,190
## R2 0.05115 0.05648 0.12257
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Coefficient comparison plot
extract_omo_coef <- function(model, label) {
ct <- coeftable(model)
idx <- which(rownames(ct) == "mtm_btfp")
if (length(idx) == 0) idx <- grep("mtm_btfp", rownames(ct))[1]
tibble(
Tercile = label,
Estimate = as.numeric(ct[idx, 1]),
SE = as.numeric(ct[idx, 2]),
CI_low = as.numeric(ct[idx, 1]) - 1.96 * as.numeric(ct[idx, 2]),
CI_high = as.numeric(ct[idx, 1]) + 1.96 * as.numeric(ct[idx, 2])
)
}
fig_omo7_data <- bind_rows(
extract_omo_coef(m_omo7_btfp[["Low UL"]], "Low UL"),
extract_omo_coef(m_omo7_btfp[["Med UL"]], "Med UL"),
extract_omo_coef(m_omo7_btfp[["High UL"]], "High UL")
) %>% mutate(Tercile = factor(Tercile, levels = c("Low UL", "Med UL", "High UL")))
fig_omo7 <- ggplot(fig_omo7_data, aes(x = Tercile, y = Estimate)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high, color = Tercile),
size = 1.2, linewidth = 1) +
scale_color_manual(values = c("Low UL" = "#2A9D8F", "Med UL" = "#E9C46A", "High UL" = "#E76F51")) +
labs(
title = "OMO MTM Loss Coefficient by Uninsured Leverage Tercile (BTFP)",
subtitle = expression(paste("Prediction: ", beta^H, " > ", beta^M, " > ", beta^L,
" — steeper = more panic-driven for fragile banks")),
x = "Uninsured Leverage Tercile",
y = "Coefficient on MTM Loss OMO (LPM)"
) +
theme_paper +
theme(legend.position = "none")
fig_omo7
save_figure(fig_omo7, "Fig_OMO7_Tercile_MTM_OMO_Gradient")
save_etable(m_omo7_btfp, "OMO_Spec7_BTFP_TercileGradient",
title_text = "OMO Spec 7: OMO MTM Effect by UL Tercile — BTFP",
notes_text = "Split by UL tercile. DV = BTFP. Key: β^H > β^M > β^L. Controls include book equity. Robust SEs.")
save_etable(m_omo7_dw, "OMO_Spec7_DW_TercileGradient",
title_text = "OMO Spec 7: OMO MTM Effect by UL Tercile — DW",
notes_text = "Same tercile split. DV = DW. Robust SEs.")# ==============================================================================
# OMO SPEC 8: INTENSIVE MARGIN — BORROWING AMOUNT (OMO VARIABLES)
#
# Among BTFP borrowers only:
# BTFP_Amt_i = α + β1·MTM_OMO + β2·Uninsured + β3·(MTM_OMO × Uninsured) + γX + ε
#
# Purpose: Conditional on borrowing, did fragile banks with OMO losses borrow more?
# Also test: Par Benefit as driver of amount (arbitrage motive for intensive margin)
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO SPEC 8: INTENSIVE MARGIN — OMO VARIABLES\n")## OMO SPEC 8: INTENSIVE MARGIN — OMO VARIABLEScat("===================================================================\n")## ===================================================================# df_btfp_intensive and df_dw_intensive already defined in Spec 7 AE-based
# but redefine here for safety
df_btfp_intensive_omo <- df_acute %>% filter(btfp_acute == 1, !is.na(btfp_pct))
df_dw_intensive_omo <- df_acute %>% filter(dw_acute == 1, !is.na(dw_pct))
cat("Intensive sample — BTFP:", nrow(df_btfp_intensive_omo),
"| DW:", nrow(df_dw_intensive_omo), "\n")## Intensive sample — BTFP: 462 | DW: 393m_omo8_btfp <- list(
"(1) OMO + UL" = run_one(df_btfp_intensive_omo, "btfp_pct",
"mtm_btfp + uninsured_lev",
controls = CONTROLS_FULL),
"(2) OMO × UL" = run_one(df_btfp_intensive_omo, "btfp_pct",
"mtm_btfp + uninsured_lev + mtm_omo_x_uninsured",
controls = CONTROLS_FULL),
"(3) Log Amt" = run_one(df_btfp_intensive_omo, "log_btfp_amt",
"mtm_btfp + uninsured_lev + mtm_omo_x_uninsured",
controls = CONTROLS_FULL),
"(4) Par Benefit" = run_one(df_btfp_intensive_omo, "btfp_pct",
EXPL_PAR_BENEFIT,
controls = CONTROLS_FULL),
"(5) AE-OMO Amt" = run_one(df_btfp_intensive_omo, "btfp_pct",
EXPL_AE_OMO_BASE)
)
etable(m_omo8_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 8: Intensive Margin (OMO) — BTFP")## (1) OMO + UL (2) OMO × UL
## Dependent Var.: btfp_pct btfp_pct
##
## Constant 6.836*** (0.8885) 6.939*** (0.9171)
## MTM Loss OMO (z) -0.6134 (0.7419) -0.9000 (0.8497)
## Uninsured Leverage (z) -1.697 (1.395) -1.772 (1.414)
## MTM OMO $\times$ Uninsured 0.6809 (0.5645)
## Par Benefit (z)
## Par Benefit $\times$ Uninsured
## Adj. Equity OMO (z)
## Adj. Equity OMO $\times$ Uninsured
## __________________________________ _________________ _________________
## S.E. type Heteroskeda.-rob. Heteroskeda.-rob.
## Observations 462 462
## R2 0.12242 0.12794
##
## (3) Log Amt (4) Par Benefit
## Dependent Var.: log_btfp_amt btfp_pct
##
## Constant 15.73*** (0.2044) 7.076*** (0.9392)
## MTM Loss OMO (z) -0.0906 (0.1262)
## Uninsured Leverage (z) -0.2147 (0.1930) -2.082 (1.512)
## MTM OMO $\times$ Uninsured 0.1333 (0.1214)
## Par Benefit (z) -1.438 (0.9042)
## Par Benefit $\times$ Uninsured 1.710* (0.8525)
## Adj. Equity OMO (z)
## Adj. Equity OMO $\times$ Uninsured
## __________________________________ _________________ _________________
## S.E. type Heteroskeda.-rob. Heteroskeda.-rob.
## Observations 462 462
## R2 0.13391 0.15186
##
## (5) AE-OMO Amt
## Dependent Var.: btfp_pct
##
## Constant 6.848*** (0.9176)
## MTM Loss OMO (z)
## Uninsured Leverage (z) -1.858 (1.461)
## MTM OMO $\times$ Uninsured
## Par Benefit (z)
## Par Benefit $\times$ Uninsured
## Adj. Equity OMO (z) -1.494 (1.213)
## Adj. Equity OMO $\times$ Uninsured 0.8363 (0.8024)
## __________________________________ _________________
## S.E. type Heteroskeda.-rob.
## Observations 462
## R2 0.12618
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# DW intensive (only if sample is large enough)
if (nrow(df_dw_intensive_omo) >= 30) {
m_omo8_dw <- list(
"(1) OMO + UL" = run_one(df_dw_intensive_omo, "dw_pct",
"mtm_btfp + uninsured_lev",
controls = CONTROLS_FULL),
"(2) OMO × UL" = run_one(df_dw_intensive_omo, "dw_pct",
"mtm_btfp + uninsured_lev + mtm_omo_x_uninsured",
controls = CONTROLS_FULL),
"(3) Log Amt" = run_one(df_dw_intensive_omo, "log_dw_amt",
"mtm_btfp + uninsured_lev + mtm_omo_x_uninsured",
controls = CONTROLS_FULL)
)
etable(m_omo8_dw, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Spec 8: Intensive Margin (OMO) — DW")
save_etable(m_omo8_dw, "OMO_Spec8_DW_IntensiveMargin",
title_text = "OMO Spec 8: Intensive Margin (OMO Variables) — DW",
notes_text = "OLS, DW borrowers only. DV: DW amt. Robust SEs.")
} else {
cat("DW intensive sample too small (N =", nrow(df_dw_intensive_omo), "). Skipping.\n")
}
save_etable(m_omo8_btfp, "OMO_Spec8_BTFP_IntensiveMargin",
title_text = "OMO Spec 8: Intensive Margin (OMO Variables) — BTFP",
notes_text = paste(
"OLS, BTFP borrowers only.",
"Col1-2: MTM_OMO + UL (with/without interaction). DV = BTFP amt/TA (%).",
"Col3: DV = log(BTFP amt). Col4: Par Benefit specification.",
"Col5: AdjEquity_OMO. Robust SEs."))# ==============================================================================
# COMBINED OMO SUMMARY TABLE (for quick comparison)
# ==============================================================================
cat("\n===================================================================\n")##
## ===================================================================cat(" OMO COMBINED: KEY SPECIFICATIONS SIDE BY SIDE\n")## OMO COMBINED: KEY SPECIFICATIONS SIDE BY SIDEcat("===================================================================\n")## ===================================================================# Collect the key interaction models across OMO specs for BTFP
models_omo_combined_btfp <- list(
"Decomp (S1)" = m_omo1_btfp[["(2) MTM Decomp"]],
"OMO Inter (S2)" = m_omo2_btfp[["(2) OMO × Unins"]],
"Horse Race (S3)" = m_omo3_btfp[["(1) Horse Race LPM"]],
"AE-OMO (S4)" = m_omo4_btfp[["(2) AE-OMO + Inter"]],
"Par Benefit (S6)" = m_omo6_btfp[["(2) Par + UL + Inter"]],
"Full AE (ref)" = run_one(df_btfp_s, "btfp_acute", EXPL_AE_BASE)
)
etable(models_omo_combined_btfp, fitstat = ~ n + r2,
drop = "Log|Cash|Loan-to|Book Equity|Wholesale|ROA",
title = "OMO Combined: Key BTFP Specifications Side by Side")## Decomp (S1) OMO Inter (S2)
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1292*** (0.0054) 0.1290*** (0.0053)
## MTM Loss OMO (z) 0.0165** (0.0062) 0.0157* (0.0062)
## MTM Loss Non-OMO (z) 0.0072 (0.0054)
## Uninsured Leverage (z) 0.0143* (0.0064) 0.0138* (0.0063)
## MTM OMO $\times$ Uninsured 0.0106* (0.0053)
## MTM Non-OMO $\times$ Uninsured
## Adj. Equity OMO (z)
## Adj. Equity OMO $\times$ Uninsured
## Par Benefit (z)
## Par Benefit $\times$ Uninsured
## Adjusted Equity (z)
## Adj. Equity $\times$ Uninsured
## __________________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08651 0.08727
##
## Horse Race (S3) AE-OMO (S4)
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1306*** (0.0054) 0.1265*** (0.0053)
## MTM Loss OMO (z) 0.0171** (0.0062)
## MTM Loss Non-OMO (z) 0.0100. (0.0058)
## Uninsured Leverage (z) 0.0181** (0.0068) 0.0137* (0.0064)
## MTM OMO $\times$ Uninsured 0.0101. (0.0052)
## MTM Non-OMO $\times$ Uninsured 0.0133** (0.0051)
## Adj. Equity OMO (z) 0.0251*** (0.0054)
## Adj. Equity OMO $\times$ Uninsured 0.0140*** (0.0041)
## Par Benefit (z)
## Par Benefit $\times$ Uninsured
## Adjusted Equity (z)
## Adj. Equity $\times$ Uninsured
## __________________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08931 0.08726
##
## Par Benefit (S6) Full AE (ref)
## Dependent Var.: btfp_acute btfp_acute
##
## Constant 0.1291*** (0.0054) 0.1277*** (0.0053)
## MTM Loss OMO (z)
## MTM Loss Non-OMO (z)
## Uninsured Leverage (z) 0.0162** (0.0062) 0.0164* (0.0065)
## MTM OMO $\times$ Uninsured
## MTM Non-OMO $\times$ Uninsured
## Adj. Equity OMO (z)
## Adj. Equity OMO $\times$ Uninsured
## Par Benefit (z) 0.0055 (0.0053)
## Par Benefit $\times$ Uninsured 0.0066 (0.0053)
## Adjusted Equity (z) 0.0294*** (0.0054)
## Adj. Equity $\times$ Uninsured 0.0160*** (0.0045)
## __________________________________ __________________ __________________
## S.E. type Heteroskedas.-rob. Heteroskedas.-rob.
## Observations 3,737 3,737
## R2 0.08324 0.08934
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1save_etable(models_omo_combined_btfp, "OMO_Combined_BTFP_KeySpecs",
title_text = "OMO Tests: Key Specifications — BTFP (Summary Table)",
notes_text = paste(
"S1: MTM decomposed. S2: OMO interaction only. S3: Horse race.",
"S4: AdjEquity_OMO. S6: Par Benefit. Ref: Full AE spec from main tests.",
"All LPM with robust SEs. Controls suppressed."))15 DIFFERENCE-IN-DIFFERENCES
# ==============================================================================
# DiD: BTFP EFFECT ON DEPOSIT STABILITY
# ==============================================================================
df_did_panel <- call_q %>%
filter(!idrssd %in% excluded_banks,
period %in% c("2022Q1","2022Q2","2022Q3","2022Q4","2023Q1","2023Q2","2023Q3")) %>%
select(idrssd, period, omo_eligible,
change_total_deposit_fwd_q, change_uninsured_fwd_q,
total_asset, uninsured_deposit, total_deposit, total_liability, total_equity,
cash_to_total_asset, total_loan, roa,
mtm_loss_to_total_asset, book_equity_to_total_asset,
fed_fund_purchase, repo, other_borrowed_less_than_1yr, loan_to_deposit) %>%
mutate(
has_omo = as.integer(!is.na(omo_eligible) & omo_eligible > 0),
post_btfp = as.integer(period >= "2023Q1"),
did_term = has_omo * post_btfp,
mtm_total_raw = mtm_loss_to_total_asset,
uninsured_lev_raw = safe_div(uninsured_deposit, total_asset),
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(replace_na(fed_fund_purchase, 0) + replace_na(repo, 0) +
replace_na(other_borrowed_less_than_1yr, 0), total_liability, 0) * 100,
roa_raw = roa,
outflow_total_dep = -1 * lag(change_total_deposit_fwd_q),
outflow_uninsured = -1 * lag(change_uninsured_fwd_q)
) %>%
ungroup() %>%
filter(!is.na(ln_assets_raw), is.finite(ln_assets_raw),
is.finite(outflow_total_dep), is.finite(outflow_uninsured)) %>%
mutate(
mtm_total = standardize_z(winsorize(mtm_total_raw)),
uninsured_lev = standardize_z(winsorize(uninsured_lev_raw)),
ln_assets = standardize_z(winsorize(ln_assets_raw)),
cash_ratio = standardize_z(winsorize(cash_ratio_raw)),
book_equity_ratio = standardize_z(winsorize(book_equity_ratio_raw)),
loan_to_deposit = standardize_z(winsorize(loan_to_deposit_raw)),
wholesale = standardize_z(winsorize(wholesale_raw)),
roa = standardize_z(winsorize(roa_raw))
)
# Fix MTM at 2022Q4
df_shock_ref <- df_did_panel %>% filter(period == "2022Q4") %>% select(idrssd, mtm_treatment = mtm_total)
df_did_fixed <- df_did_panel %>%
filter(has_omo == 1) %>%
left_join(df_shock_ref, by = "idrssd") %>%
filter(!is.na(mtm_treatment))
# Static DiD
m_did_static <- feols(
outflow_total_dep ~ mtm_treatment:post_btfp +
uninsured_lev + ln_assets + cash_ratio + book_equity_ratio + loan_to_deposit + wholesale + roa |
idrssd + period,
data = df_did_fixed, cluster = ~idrssd)
# Event Study
m_did_event <- feols(
outflow_total_dep ~ i(period, mtm_treatment, ref = "2022Q4") +
uninsured_lev + ln_assets + cash_ratio + book_equity_ratio + loan_to_deposit + wholesale + roa |
idrssd + period,
data = df_did_fixed, cluster = ~idrssd)
etable(m_did_static, m_did_event, fitstat = ~ n + r2,
title = "DiD: MTM Intensity on Deposit Stability")## m_did_static m_did_event
## Dependent Var.: outflow_total_dep outflow_total_dep
##
## Uninsured Leverage (z) -3.211*** (0.4140) -3.206*** (0.4152)
## Log(Assets) -41.36*** (4.519) -40.90*** (4.556)
## Cash Ratio -0.1146 (0.4658) -0.1479 (0.4646)
## Book Equity Ratio 0.1758 (0.3852) 0.2934 (0.4030)
## Loan-to-Deposit 4.111*** (1.064) 4.095*** (1.063)
## Wholesale Funding 0.2988* (0.1176) 0.3012* (0.1174)
## ROA 0.1355 (0.1816) 0.1392 (0.1822)
## mtm_treatment x post_btfp -0.5517*** (0.1357)
## mtm_treatment x period = 2022Q1 -0.4495* (0.2070)
## mtm_treatment x period = 2022Q2 -0.0632 (0.2045)
## mtm_treatment x period = 2022Q3 -0.1488 (0.2167)
## mtm_treatment x period = 2023Q1 -0.7268*** (0.1645)
## mtm_treatment x period = 2023Q2 -0.6422*** (0.1695)
## mtm_treatment x period = 2023Q3 -0.7216*** (0.1647)
## Fixed-Effects: ------------------- -------------------
## idrssd Yes Yes
## period Yes Yes
## _______________________________ ___________________ ___________________
## S.E.: Clustered by: idrssd by: idrssd
## Observations 29,211 29,211
## R2 0.37331 0.37359
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1iplot(m_did_event,
main = "Event Study: MTM Intensity on Deposit Outflow (OMO Banks)",
xlab = "Quarter", ylab = "Coefficient")
cat("\n=== DiD PANEL ===\n")##
## === DiD PANEL ===cat("Obs:", nrow(df_did_fixed), "| Banks:", n_distinct(df_did_fixed$idrssd), "\n")## Obs: 29211 | Banks: 431616 FIGURES
# ==============================================================================
# FIGURE 1: ADJUSTED EQUITY DISTRIBUTION — BORROWERS vs. NON-BORROWERS
# Purpose: Establish AE as the threshold. Borrowers cluster around the zero line.
# ==============================================================================
fig1_data <- df_acute %>%
filter(!is.na(adjusted_equity_raw)) %>%
mutate(borrower_status = case_when(
dw_acute == 1 ~ "DW",
btfp_acute == 1 ~ "BTFP",
fhlb_user == 1 ~ "FHLB",
TRUE ~ "Pure Non-Borrower"
),
borrower_status = factor(borrower_status, levels = c("DW", "BTFP", "FHLB", "Pure Non-Borrower")))
fig1 <- ggplot(fig1_data, aes(x = adjusted_equity_raw, fill = borrower_status)) +
geom_density(alpha = 0.4, color = NA) +
geom_vline(xintercept = 0, linetype = "dashed", color = "red", linewidth = 0.8) +
annotate("text", x = -0.5, y = Inf, label = "MTM Solvent\n(AE < 0)",
vjust = 1.5, hjust = 1, color = "#2A9D8F", size = 3.5, fontface = "italic") +
annotate("text", x = 0.5, y = Inf, label = "MTM Insolvent\n(AE > 0)",
vjust = 1.5, hjust = 0, color = "red", size = 3.5, fontface = "italic") +
scale_fill_manual(values = pal_user) +
labs(
title = "Figure: Distribution of Adjusted Equity by Borrower Type",
subtitle = "Adjusted Equity = MTM Losses − Book Equity (% of Total Assets, reversed). Dashed line = insolvency threshold.",
x = "Adjusted Equity / Total Assets (%)", y = "Density", fill = NULL
) +
coord_cartesian(xlim = quantile(fig1_data$adjusted_equity_raw, c(0.01, 0.99), na.rm = TRUE)) +
theme_paper
fig1
save_figure(fig1, "Fig1_AE_Distribution_ByBorrower")# ==============================================================================
# FIGURE 2: SOLVENCY COMPOSITION BY USER TYPE (Three Definitions)
# Purpose: Most borrowers were solvent → panic runs, not fundamental runs.
# ==============================================================================
fig2_data <- df_acute %>%
filter(!is.na(user_type_5)) %>%
select(user_type_5, mtm_insolvent, insolvent_idcr_s50, insolvent_idcr_s100) %>%
pivot_longer(cols = c(mtm_insolvent, insolvent_idcr_s50, insolvent_idcr_s100),
names_to = "definition", values_to = "insolvent") %>%
mutate(
definition = recode(definition,
"mtm_insolvent" = "MTM Insolvent (AE > 0)",
"insolvent_idcr_s50" = "IDCR 50% Scenario",
"insolvent_idcr_s100" = "IDCR 100% Scenario"),
solvency = ifelse(insolvent == 1, "Insolvent", "Solvent")
) %>%
filter(!is.na(insolvent)) %>%
count(user_type_5, definition, solvency) %>%
group_by(user_type_5, definition) %>%
mutate(pct = 100 * n / sum(n)) %>%
ungroup()
fig2 <- ggplot(fig2_data, aes(x = user_type_5, y = pct, fill = solvency)) +
geom_col(position = "stack", width = 0.7) +
geom_text(aes(label = ifelse(pct > 5, paste0(round(pct, 0), "%"), "")),
position = position_stack(vjust = 0.5), size = 3, color = "white", fontface = "bold") +
facet_wrap(~ definition, ncol = 3) +
scale_fill_manual(values = pal_solv) +
labs(
title = "Figure: Solvency Composition of Emergency Borrowers",
subtitle = "Three insolvency definitions. Majority of borrowers are solvent across all specifications.",
x = NULL, y = "Percent of Group (%)", fill = NULL
) +
theme_paper +
theme(axis.text.x = element_text(angle = 25, hjust = 1))
fig2
save_figure(fig2, "Fig2_Solvency_Composition_ByUser")# ==============================================================================
# FIGURE 3: HEATMAP — BTFP BORROWING RATE BY AE x UNINSURED QUARTILE
# Purpose: Visualize the 16-cell interaction. Shows threshold gradient.
# ==============================================================================
fig3_data <- df_acute %>%
filter(!is.na(adjusted_equity_w) & !is.na(uninsured_lev_w)) %>%
mutate(
ae_quartile = cut(adjusted_equity_w,
breaks = quantile(adjusted_equity_w, c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE),
labels = c("Q1\n(Lowest AE)", "Q2", "Q3", "Q4\n(Highest AE)"),
include.lowest = TRUE),
ul_quartile = cut(uninsured_lev_w,
breaks = quantile(uninsured_lev_w, c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE),
labels = c("Q1\n(Lowest UL)", "Q2", "Q3", "Q4\n(Highest UL)"),
include.lowest = TRUE)
) %>%
filter(!is.na(ae_quartile) & !is.na(ul_quartile)) %>%
group_by(ae_quartile, ul_quartile) %>%
summarise(
btfp_rate = 100 * mean(btfp_acute, na.rm = TRUE),
n = n(),
.groups = "drop"
)
fig3 <- ggplot(fig3_data, aes(x = ul_quartile, y = ae_quartile, fill = btfp_rate)) +
geom_tile(color = "white", linewidth = 1.5) +
geom_text(aes(label = paste0(round(btfp_rate, 1), "%\n(n=", n, ")")),
size = 3.5, fontface = "bold") +
scale_fill_gradient2(low = "#F0F0F0", mid = "#74B3CE", high = "#003049",
midpoint = median(fig3_data$btfp_rate),
name = "BTFP Rate (%)") +
labs(
title = "Figure: BTFP Borrowing Rate by Adjusted Equity × Uninsured Leverage Quartile",
subtitle = "Darker = higher borrowing rate. Strategic complementarity: low AE + high UL = highest rate.",
x = "Uninsured Leverage Quartile →", y = "Adjusted Equity Quartile →"
) +
theme_paper +
theme(panel.grid = element_blank(), legend.position = "right")
fig3
save_figure(fig3, "Fig3_Heatmap_BTFP_AExUL")# ==============================================================================
# FIGURE 3B: HEATMAP FOR DW
# ==============================================================================
fig3b_data <- df_acute %>%
filter(!is.na(adjusted_equity_w) & !is.na(uninsured_lev_w)) %>%
mutate(
ae_quartile = cut(adjusted_equity_w,
breaks = quantile(adjusted_equity_w, c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE),
labels = c("Q1\n(Lowest AE)", "Q2", "Q3", "Q4\n(Highest AE)"),
include.lowest = TRUE),
ul_quartile = cut(uninsured_lev_w,
breaks = quantile(uninsured_lev_w, c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE),
labels = c("Q1\n(Lowest UL)", "Q2", "Q3", "Q4\n(Highest UL)"),
include.lowest = TRUE)
) %>%
filter(!is.na(ae_quartile) & !is.na(ul_quartile)) %>%
group_by(ae_quartile, ul_quartile) %>%
summarise(dw_rate = 100 * mean(dw_acute, na.rm = TRUE), n = n(), .groups = "drop")
fig3b <- ggplot(fig3b_data, aes(x = ul_quartile, y = ae_quartile, fill = dw_rate)) +
geom_tile(color = "white", linewidth = 1.5) +
geom_text(aes(label = paste0(round(dw_rate, 1), "%\n(n=", n, ")")),
size = 3.5, fontface = "bold") +
scale_fill_gradient2(low = "#F0F0F0", mid = "#F4A261", high = "#D62828",
midpoint = median(fig3b_data$dw_rate),
name = "DW Rate (%)") +
labs(
title = "Figure: Discount Window Usage Rate by AE × Uninsured Leverage Quartile",
subtitle = "Compare pattern to BTFP: DW shows stronger concentration in high-fragility cells.",
x = "Uninsured Leverage Quartile →", y = "Adjusted Equity Quartile →"
) +
theme_paper +
theme(panel.grid = element_blank(), legend.position = "right")
fig3b
save_figure(fig3b, "Fig3B_Heatmap_DW_AExUL")# ==============================================================================
# FIGURE 4: TERCILE COEFFICIENT PLOT (Spec 5)
# Purpose: AE coefficient steeper in high-fragility group → lower threshold.
# ==============================================================================
extract_ae_coef <- function(model, label) {
ct <- coeftable(model)
idx <- which(rownames(ct) == "adjusted_equity")
if (length(idx) == 0) idx <- grep("adjusted_equity", rownames(ct))[1]
est <- as.numeric(ct[idx, 1]) # Estimate (column 1)
se <- as.numeric(ct[idx, 2]) # Std. Error (column 2)
tibble(
Tercile = label,
Estimate = est,
SE = se,
CI_low = est - 1.96 * se,
CI_high = est + 1.96 * se
)
}
df_btfp_s_fig <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
m_low <- run_one(df_btfp_s_fig %>% filter(unins_lev_tercile == "Low"), "btfp_acute", "adjusted_equity")
m_med <- run_one(df_btfp_s_fig %>% filter(unins_lev_tercile == "Med"), "btfp_acute", "adjusted_equity")
m_high <- run_one(df_btfp_s_fig %>% filter(unins_lev_tercile == "High"), "btfp_acute", "adjusted_equity")
fig4_data <- bind_rows(
extract_ae_coef(m_low, "Low UL"),
extract_ae_coef(m_med, "Med UL"),
extract_ae_coef(m_high, "High UL")
) %>%
mutate(Tercile = factor(Tercile, levels = c("Low UL", "Med UL", "High UL")))
fig4 <- ggplot(fig4_data, aes(x = Tercile, y = Estimate)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high, color = Tercile),
size = 1.2, linewidth = 1) +
scale_color_manual(values = c("Low UL" = "#2A9D8F", "Med UL" = "#E9C46A", "High UL" = "#E76F51")) +
labs(
title = "Figure 4: Adjusted Equity Coefficient by Uninsured Leverage Tercile (BTFP)",
# FIXED: Separated terms with commas to avoid chained inequality syntax errors
subtitle = expression(paste("Prediction: ", beta^H, " > ", beta^M, " > ", beta^L,
" — steeper gradient = lower run threshold for fragile banks")),
x = "Uninsured Leverage Tercile",
y = "Coefficient on Adjusted Equity (LPM)"
) +
theme_paper +
theme(legend.position = "none")
fig4
save_figure(fig4, "Fig4_Tercile_AE_Gradient")# ==============================================================================
# FIGURE 5: MTM DECOMPOSITION — OMO vs NON-OMO LOSSES
# Purpose: Show that OMO losses (eligible for par valuation) drive BTFP
# while Non-OMO losses capture residual solvency risk.
# ==============================================================================
fig5_data <- df_acute %>%
filter(!is.na(mtm_btfp_raw) & !is.na(mtm_other_raw)) %>%
mutate(borrower = case_when(
btfp_acute == 1 ~ "BTFP Borrower",
dw_acute == 1 ~ "DW Borrower",
TRUE ~ "Non-Borrower"
),
borrower = factor(borrower, levels = c("BTFP Borrower", "DW Borrower", "Non-Borrower")))
fig5 <- ggplot(fig5_data, aes(x = mtm_btfp_raw, y = mtm_other_raw, color = borrower)) +
geom_point(data = fig5_data %>% filter(borrower == "Non-Borrower"),
alpha = 0.15, size = 0.8) +
geom_point(data = fig5_data %>% filter(borrower != "Non-Borrower"),
alpha = 0.7, size = 1.5) +
scale_color_manual(values = c("BTFP Borrower" = "#003049", "DW Borrower" = "#D62828",
"Non-Borrower" = "grey75")) +
labs(
title = "Figure: MTM Loss Decomposition — OMO-Eligible vs. Non-OMO Securities",
x = "MTM Loss on OMO-Eligible Securities / Total Asset (%)",
y = "MTM Loss on Non-OMO Securities / Total Asset (%)",
color = NULL
) +
coord_cartesian(
xlim = quantile(fig5_data$mtm_btfp_raw, c(0.01, 0.99), na.rm = TRUE),
ylim = quantile(fig5_data$mtm_other_raw, c(0.01, 0.99), na.rm = TRUE)
) +
theme_paper
fig5
save_figure(fig5, "Fig5_MTM_Decomposition_OMO_NonOMO")# ==============================================================================
# FIGURE 6: TEMPORAL EVOLUTION OF KEY COEFFICIENTS (BTFP)
# Purpose: Panic-driven AE/UL effects fade Post-Acute, flip during Arbitrage.
# ==============================================================================
extract_coefs <- function(model, period_label) {
ct <- as.data.frame(coeftable(model))
ct$Variable <- rownames(ct)
ct %>%
filter(Variable %in% c("adjusted_equity", "uninsured_lev", "ae_x_uninsured")) %>%
transmute(
Period = period_label,
Variable = recode(Variable,
"adjusted_equity" = "Adjusted Equity",
"uninsured_lev" = "Uninsured Leverage",
"ae_x_uninsured" = "AE × Uninsured"),
Estimate = Estimate,
SE = `Std. Error`,
CI_low = Estimate - 1.96 * SE,
CI_high = Estimate + 1.96 * SE
)
}
df_btfp_acute_s <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
df_btfp_post_s <- df_post %>% filter(btfp_post == 1 | non_user == 1)
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
fig6_data <- bind_rows(
extract_coefs(run_one(df_btfp_acute_s, "btfp_acute", EXPL_AE_BASE), "Acute\n(Mar-May 23)"),
extract_coefs(run_one(df_btfp_post_s, "btfp_post", EXPL_AE_BASE), "Post-Acute\n(May-Oct 23)"),
extract_coefs(run_one(df_btfp_arb_s, "btfp_arb", EXPL_AE_BASE), "Arbitrage\n(Nov 23-Jan 24)"),
extract_coefs(run_one(df_btfp_wind_s, "btfp_wind", EXPL_AE_BASE), "Wind-Down\n(Jan-Mar 24)")
) %>%
mutate(Period = factor(Period, levels = c("Acute\n(Mar-May 23)", "Post-Acute\n(May-Oct 23)",
"Arbitrage\n(Nov 23-Jan 24)", "Wind-Down\n(Jan-Mar 24)")))
fig6 <- ggplot(fig6_data, aes(x = Period, y = Estimate, color = Variable, group = Variable)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high),
position = position_dodge(width = 0.4), size = 0.8, linewidth = 0.7) +
geom_line(position = position_dodge(width = 0.4), linewidth = 0.6, alpha = 0.5) +
scale_color_manual(values = c("Adjusted Equity" = "#003049", "Uninsured Leverage" = "#E76F51",
"AE × Uninsured" = "#7209B7")) +
labs(
title = "Figure: Evolution of Key Coefficients Across BTFP Program Periods",
subtitle = "Panic-driven selection (high UL, interaction) attenuates post-crisis. AE effect may reverse during arbitrage.",
x = NULL, y = "LPM Coefficient (95% CI)", color = NULL
) +
theme_paper
fig6
save_figure(fig6, "Fig6_Temporal_Coefficient_Evolution")# ==============================================================================
# FIGURE 7: BTFP vs DW COEFFICIENT COMPARISON (Spec 6)
# Purpose: DW shows stronger interaction → more severe run pressure.
# ==============================================================================
m_btfp_fig7 <- run_one(df_btfp_s_fig, "btfp_acute", EXPL_AE_BASE, "lpm")
m_dw_fig7 <- run_one(df_acute %>% filter(dw_acute == 1 | non_user == 1), "dw_acute", EXPL_AE_BASE, "lpm")
fig7_data <- bind_rows(
extract_coefs(m_btfp_fig7, "BTFP"),
extract_coefs(m_dw_fig7, "DW")
) %>%
mutate(Period = factor(Period, levels = c("BTFP", "DW")))
fig7 <- ggplot(fig7_data, aes(x = Variable, y = Estimate, color = Period)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high),
position = position_dodge(width = 0.5), size = 1, linewidth = 0.8) +
scale_color_manual(values = c("BTFP" = "#003049", "DW" = "#D62828")) +
labs(
title = "Figure: BTFP vs. Discount Window — Coefficient Comparison",
subtitle = expression("Prediction: " * beta[3]^DW > beta[3]^BTFP *
" — DW signals more severe run pressure"),
x = NULL, y = "LPM Coefficient (95% CI)", color = "Facility"
) +
theme_paper
fig7
save_figure(fig7, "Fig7_BTFP_vs_DW_Coefficients")