Depositor Runs = f(Fundamentals, Liquidity Fragility)
Public / common shock (helps coordination in panic) = Mark-to-Market (MTM) losses on securities
Larger MTM losses → worse perceived solvency / collateral value → higher run probability especially in an acute panic window
Liquidity fragility / mismatch (amplifies run incentives) = Uninsured deposit leverage
Higher uninsured deposits (relative to liquid resources/equity) → greater rollover risk and weaker ability to meet withdrawals → higher run probability
Key interaction (panic mechanism)
MTM × Uninsured leverage: Runs rise with (i) public bad news about solvency (MTM) and (ii) rollover fragility (uninsured leverage), and the effect of MTM is strongest when uninsured leverage is high.
Identification Strategy:
Extensive Margin (Crisis Period):
Controls: ln_assets,
cash_ratio, loan_to_deposit,
book_equity_ratio, wholesale, roa
We estimate this across crisis periods (1 model*4 borrower) for
Anyfed,BTFP, DW borrowers, fhlb abnormal.
Threshold Gradient At low levels of mark-to-market (MTM) losses, banks with higher uninsured leverage are expected to borrow more to preempt run risk. We test this threshold effect by splitting the sample into Uninsured terciles (Low, Medium, High) and estimating the extensive margin separately for each group \(k \in \{L, M, H\}\):
\[ \text{Borrower}_i = \alpha^{(k)} + \beta^{(k)} \cdot \text{mtm_loss}_i + \gamma \mathbf{X}_i + \varepsilon_i \]
Prediction: \(\beta^H > \beta^M > \beta^L\)
A steeper gradient in the high-fragility (High Uninsured) group indicates a lower threshold for emergency borrowing, implying these banks seek liquidity at weak fundamental levels to front-run potential deposit flight. We estimate this across the Acute and Post-Acute periods for BTFP, DW, Both, and Any Facility borrowers.
Intensive Margin
Among borrowers only:
\[\text{Borrow_Amt} = \alpha + \beta_1 \cdot \text{MTM\_total}_i + \beta_2 \cdot \text{UninsuredLev}_i + \beta_3 (\text{MTM\_total}_i \times \text{UninsuredLev}_i) + \gamma \mathbf{X}_i + \varepsilon_i\]
Purpose: Conditional on borrowing, did fragile banks borrow more at higher adjusted equity? Do this by Acute, post-acute (1 model*2 period) across BTFP, DW, both, all borrower
Robustness: Temporal Crisis Vs Arbitrage Repeat Extensive Margin for BTFP (1 model*2 period).
*** Falsefiction Test FHLB borrower(abnormal 10pct)** Repeat Extensive Margin for FHLB Prediction: results will be insignificant or week.
** Other clean test** Add the below for robustness: 1. Another powerful test would be to use insured deposits. run three regression. First, include insured deporit in the basline specification that has uninsured and the interaction with mtm. second replace the uninsured in the baseline regression with insured and see what happens to the main effects. Third run one with just MTM and insured with no interaction.
rm(list = ls())
# Core
library(data.table)
library(dplyr)
library(tidyr)
library(stringr)
library(lubridate)
library(purrr)
library(tibble)
library(ggrepel)
# Econometrics
library(fixest)
library(marginaleffects)
library(nnet)
library(broom)
# Tables
library(modelsummary)
library(knitr)
library(kableExtra)
# Statistics
library(DescTools)
# Visualization
library(ggplot2)
library(gridExtra)
library(scales)
library(patchwork)
# I/O
library(readr)
library(readxl)
cat("All packages loaded.\n")## All packages loaded.# ==============================================================================
# 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
# ==============================================================================
summary_stats_function <- function(df, column_list, group_by = NULL) {
summary_stat_df <- df %>% select(all_of(column_list)) %>% data.table()
calc_stats <- function(data) {
data %>%
summarise(across(everything(), list(
N = ~ sum(!is.na(.)),
Mean = ~ round(mean(., na.rm = TRUE), 3),
SD = ~ round(sd(., na.rm = TRUE), 3),
P10 = ~ round(quantile(., 0.10, na.rm = TRUE), 3),
P25 = ~ round(quantile(., 0.25, na.rm = TRUE), 3),
P50 = ~ round(quantile(., 0.50, na.rm = TRUE), 3),
P75 = ~ round(quantile(., 0.75, na.rm = TRUE), 3),
P90 = ~ round(quantile(., 0.90, na.rm = TRUE), 3)
), .names = "{col}__{fn}")) %>%
pivot_longer(cols = everything(),
names_to = c("Variable", ".value"),
names_sep = "__")
}
if (!is.null(group_by)) {
summary_stat_df %>%
group_by(across(all_of(group_by))) %>%
calc_stats()
} else {
calc_stats(summary_stat_df)
}
}
# ==============================================================================
# FILE I/O
# ==============================================================================
safe_writeLines <- function(text, con, max_retries = 5, wait_sec = 2) {
for (i in seq_len(max_retries)) {
result <- tryCatch(
{ writeLines(text, con); TRUE },
error = function(e) {
if (i < max_retries) Sys.sleep(wait_sec)
FALSE
}
)
if (isTRUE(result)) return(invisible(NULL))
}
warning("Failed to write ", con, " after ", max_retries, " attempts.")
}
save_table <- function(tbl, filename, caption_text = "") {
latex_file <- file.path(TABLE_PATH, paste0(filename, ".tex"))
latex_content <- knitr::kable(
tbl, format = "latex", caption = caption_text, booktabs = TRUE
)
safe_writeLines(as.character(latex_content), latex_file)
message("Saved: ", filename, ".tex")
}
save_figure <- function(plot_obj, filename, width = 12, height = 8) {
ggsave(
file.path(FIG_PATH, paste0(filename, ".pdf")),
plot = plot_obj, width = width, height = height, device = "pdf"
)
message("Saved: ", filename, ".pdf")
}# ==============================================================================
# PATHS — EDIT THIS BLOCK ONLY
# ==============================================================================
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/GExam_all_borrower")
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"
# --- Analysis windows (non-overlapping) ---
PRE_CRISIS_START <- as.Date("2023-01-01")
PRE_CRISIS_END <- as.Date("2023-03-07")
# 1. CRISIS PERIOD (SVB Announcement through First Republic)
CRISIS_START <- as.Date("2023-03-08")
CRISIS_END <- as.Date("2023-05-04")
# 2. ARBITRAGE PERIOD (Sustained sub-IORB to Pricing Floor)
ARB_START <- as.Date("2023-11-15")
ARB_END <- as.Date("2024-01-24")
# 3. WIND-DOWN PERIOD
WIND_START <- as.Date("2024-01-25")
WIND_END <- as.Date("2024-03-11")
# --- Dataset bounds ---
DW_DATA_END <- as.Date("2023-12-31")
cat("=== DATE CONSTANTS SET ===\n")## === DATE CONSTANTS SET ===cat("Crisis window: ", format(CRISIS_START), "to", format(CRISIS_END), "\n")## Crisis window: 2023-03-08 to 2023-05-04cat("Arbitrage window: ", format(ARB_START), "to", format(ARB_END), "\n")## Arbitrage window: 2023-11-15 to 2024-01-24cat("Wind-down window: ", format(WIND_START), "to", format(WIND_END), "\n")## Wind-down window: 2024-01-25 to 2024-03-11# ==============================================================================
# LOAD ALL RAW DATA FILES
# ==============================================================================
# --- Call Reports (quarterly bank financials) ---
call_q <- read_csv(
file.path(DATA_PROC, "final_call_gsib.csv"),
show_col_types = FALSE
) %>%
mutate(idrssd = as.character(idrssd))
# --- BTFP Loan-Level Data ---
btfp_loans_raw <- read_csv(
file.path(DATA_PROC, "btfp_loan_bank_only.csv"),
show_col_types = FALSE
) %>%
mutate(
rssd_id = as.character(rssd_id),
btfp_loan_date = mdy(btfp_loan_date)
)
# --- Discount Window Loan-Level Data ---
dw_loans_raw <- read_csv(
file.path(DATA_PROC, "dw_loan_bank_2023.csv"),
show_col_types = FALSE
) %>%
mutate(
rssd_id = as.character(rssd_id),
dw_loan_date = ymd(dw_loan_date)
)
cat("=== DATA LOADED ===\n")## === DATA LOADED ===cat("Call Report: ", nrow(call_q), "obs |",
n_distinct(call_q$idrssd), "banks\n")## Call Report: 75989 obs | 5074 bankscat("BTFP Loans: ", nrow(btfp_loans_raw), "loans\n")## BTFP Loans: 6734 loanscat("DW Loans: ", nrow(dw_loans_raw), "loans\n")## DW Loans: 10008 loans# ==============================================================================
# EXCLUSIONS: Failed banks and G-SIBs
# Identified at BASELINE_MAIN (2022Q4) to keep the exclusion list stable
# ==============================================================================
excluded_banks <- call_q %>%
filter(period == BASELINE_MAIN, failed_bank == 1 | gsib == 1) %>%
pull(idrssd)
cat("Excluded banks (failed + G-SIBs):", length(excluded_banks), "\n")## Excluded banks (failed + G-SIBs): 41# Apply exclusions to loan data
btfp_loans <- btfp_loans_raw %>% filter(!rssd_id %in% excluded_banks)
dw_loans <- dw_loans_raw %>% filter(!rssd_id %in% excluded_banks)
cat("BTFP loans after exclusions:", nrow(btfp_loans), "\n")## BTFP loans after exclusions: 6695cat("DW loans after exclusions: ", nrow(dw_loans), "\n")## DW loans after exclusions: 9935# ==============================================================================
# CREATE PERIOD-SPECIFIC BORROWER INDICATORS FROM LOAN-LEVEL DATA
#
# Returns a data frame with:
# idrssd — bank identifier
# {prefix} — binary indicator (1 = borrowed in window)
# {prefix}_amt — total amount borrowed in window
# {prefix}_first — date of first loan in window
# ==============================================================================
# ==============================================================================
# CREATE PERIOD-SPECIFIC BORROWER INDICATORS FROM LOAN-LEVEL DATA
# ==============================================================================
create_borrower_indicator <- function(loans_df, date_col, id_col, amount_col,
start_date, end_date, prefix) {
loans_df %>%
filter(
!!sym(date_col) >= start_date,
!!sym(date_col) <= end_date
) %>%
group_by(!!sym(id_col)) %>%
summarise(
"{prefix}" := 1L,
"{prefix}_amt" := sum(!!sym(amount_col), na.rm = TRUE),
"{prefix}_first" := min(!!sym(date_col)),
.groups = "drop"
) %>%
rename(idrssd = !!sym(id_col))
}
# --- BTFP BORROWER INDICATORS ---
btfp_crisis <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
CRISIS_START, CRISIS_END, "btfp_crisis"
)
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"
)
# --- DISCOUNT WINDOW BORROWER INDICATORS ---
dw_crisis <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
CRISIS_START, min(CRISIS_END, DW_DATA_END), "dw_crisis"
)
cat("=== BORROWER COUNTS ===\n")## === BORROWER COUNTS ===cat("BTFP: Crisis=", nrow(btfp_crisis),
" Arb=", nrow(btfp_arb),
" Wind=", nrow(btfp_wind), "\n")## BTFP: Crisis= 526 Arb= 780 Wind= 237cat("DW: Crisis=", nrow(dw_crisis), "\n")## DW: Crisis= 459# ==============================================================================
# Variable naming convention:
# *_raw — original scale (for descriptive tables)
# *_w — winsorized at [2.5%, 97.5%]
# * — z-standardized (mean 0, SD 1) — used in all regressions
# ==============================================================================
construct_analysis_vars <- function(baseline_data) {
baseline_data %>%
mutate(
# ======================================================================
# 1. RAW VARIABLES (original scale, for descriptive tables)
# ======================================================================
mtm_total_raw = mtm_loss_to_total_asset,
mtm_btfp_raw = mtm_loss_omo_eligible_to_total_asset,
mtm_other_raw = mtm_loss_non_omo_eligible_to_total_asset,
uninsured_lev_raw = uninsured_deposit_to_total_asset,
insured_lev_raw = r_insured_deposit,
uninsured_share_raw = uninsured_to_deposit,
# Controls
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
securities_ratio_raw = security_to_total_asset,
loan_ratio_raw = total_loan_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
tier1_ratio_raw = tier1cap_to_total_asset,
roa_raw = roa,
fhlb_ratio_raw = fhlb_to_total_asset,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(
fed_fund_purchase + repo +
replace_na(other_borrowed_less_than_1yr, 0),
total_liability, 0
) * 100,
# Deposit outflows (forward-looking)
uninsured_outflow_raw = change_uninsured_fwd_q,
insured_outflow_raw = change_insured_deposit_fwd_q,
total_outflow_raw = change_total_deposit_fwd_q,
# ======================================================================
# 2. SOLVENCY MEASURES
# ======================================================================
# Adjusted Equity: Book Equity minus MTM losses (% of assets)
# This is the theta in Goldstein-Pauzner — the bank's true economic position
adjusted_equity_raw = book_equity_to_total_asset - mtm_loss_to_total_asset,
# Market-value assets (for IDCR measures)
mv_assets = total_asset * (1 - mtm_loss_to_total_asset / 100),
# Jiang et al. (2023) insolvency measures
idcr_1 = safe_div(
mv_assets - 0.5 * uninsured_deposit - insured_deposit,
insured_deposit, NA_real_
),
idcr_2 = safe_div(
mv_assets - uninsured_deposit - insured_deposit,
insured_deposit, NA_real_
),
# Binary solvency indicators
mtm_insolvent = as.integer(adjusted_equity_raw < 0),
mtm_solvent = as.integer(adjusted_equity_raw >= 0),
insolvent_idcr_s50 = as.integer(idcr_1 < 0),
insolvent_idcr_s100 = as.integer(idcr_2 < 0),
# ======================================================================
# 3. TRIMMED VARIABLES [2.5%, 97.5%] (Replaces outliers with NA)
# ======================================================================
# Primary explanatory
mtm_total_w = 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),
insured_lev_w = winsorize(r_insured_deposit),
adjusted_equity_w = winsorize(adjusted_equity_raw),
# Controls
ln_assets_w = winsorize(ln_assets_raw),
cash_ratio_w = winsorize(cash_ratio_raw),
book_equity_ratio_w = winsorize(book_equity_ratio_raw),
roa_w = winsorize(roa_raw),
loan_to_deposit_w = winsorize(loan_to_deposit_raw),
wholesale_w = winsorize(wholesale_raw),
# Deposit outflows
uninsured_outflow_w = winsorize(uninsured_outflow_raw),
insured_outflow_w = winsorize(insured_outflow_raw),
total_outflow_w = winsorize(total_outflow_raw),
# ======================================================================
# 4. Z-STANDARDIZED VARIABLES (mean = 0, SD = 1)
# All regression variables use this scale — coefficients are
# interpreted as the effect of a 1-SD increase.
# ======================================================================
# Primary explanatory
mtm_total = standardize_z(mtm_total_w),
mtm_btfp = standardize_z(mtm_btfp_w),
mtm_other = standardize_z(mtm_other_w),
uninsured_lev = standardize_z(uninsured_lev_w),
insured_lev = standardize_z(insured_lev_w),
adjusted_equity = standardize_z(adjusted_equity_w),
# Controls
ln_assets = standardize_z(ln_assets_w),
cash_ratio = standardize_z(cash_ratio_w),
book_equity_ratio = standardize_z(book_equity_ratio_w),
roa = standardize_z(roa_w),
loan_to_deposit = standardize_z(loan_to_deposit_w),
wholesale = standardize_z(wholesale_w),
# Deposit outflows (standardized)
uninsured_outflow = standardize_z(uninsured_outflow_w),
insured_outflow = standardize_z(insured_outflow_w),
total_outflow = standardize_z(total_outflow_w),
# ======================================================================
# 5. INTERACTION TERMS
# Model 1 (Base): MTM_total × UninsuredLev
# All built from z-standardized components.
# ======================================================================
# Base model interaction
mtm_x_uninsured = mtm_total * uninsured_lev,
# insured model
mtm_x_insured = mtm_total * insured_lev,
# ======================================================================
# 6. PAR BENEFIT AND COLLATERAL CAPACITY
# ======================================================================
par_benefit_raw = safe_div(
mtm_btfp_raw,
mtm_btfp_raw + 100 * safe_div(omo_eligible, total_asset * 1000, 0),
NA_real_
),
collateral_capacity_raw = safe_div(
omo_eligible, total_asset * 1000, 0
) * 100,
# ======================================================================
# 7. CATEGORICAL / GROUPING VARIABLES
# ======================================================================
size_cat = factor(
create_size_category_3(total_asset),
levels = size_levels_3
),
state = if ("state" %in% names(.)) state else NA_character_,
fed_district = if ("fed_district" %in% names(.)) fed_district else NA_character_
) %>%
# Par benefit needs prior columns to exist — computed in second mutate pass
mutate(
par_benefit_w = winsorize(par_benefit_raw),
par_benefit = standardize_z(par_benefit_w),
par_x_uninsured = par_benefit * uninsured_lev
)
}# ==============================================================================
# BUILD BASELINE DATASETS
#
# Each baseline merges the appropriate deposit beta BEFORE calling
# construct_analysis_vars(), so beta_pooled is available inside that function.
#
# Baseline → Deposit Beta used:
# 2022Q4 → beta_pooled (full-period stable estimate, pre-crisis)
# 2023Q3 → beta_2023 (year-specific, known at arbitrage start)
# 2023Q4 → beta_2023 (year-specific, same year as wind-down)
# ==============================================================================
# Helper: prepare yearly beta for a specific year to reuse the same column name
# --- 2022Q4 Baseline (main crisis analysis) ---
df_2022q4 <- call_q %>%
filter(
period == BASELINE_MAIN,
!idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0
) %>%
construct_analysis_vars()
# --- 2023Q3 Baseline (arbitrage period) ---
df_2023q3 <- call_q %>%
filter(
period == BASELINE_ARB,
!idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0
) %>%
construct_analysis_vars()
# --- 2023Q4 Baseline (wind-down period) ---
df_2023q4 <- call_q %>%
filter(
period == BASELINE_WIND,
!idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0
) %>%
construct_analysis_vars()
cat("=== BASELINE DATASETS ===\n")## === BASELINE DATASETS ===cat("2022Q4:", nrow(df_2022q4), "banks |",
"Insolvent (AE<0):", sum(df_2022q4$mtm_insolvent, na.rm = TRUE), "\n")## 2022Q4: 4292 banks | Insolvent (AE<0): 825cat("2023Q3:", nrow(df_2023q3), "banks\n")## 2023Q3: 4214 bankscat("2023Q4:", nrow(df_2023q4), "banks\n")## 2023Q4: 4197 banks# ==============================================================================
# JOIN_ALL_BORROWERS() HELPER
# ==============================================================================
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),
# any_fed represents your "All" borrower category
any_fed = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1),
both_fed = as.integer(!!sym(btfp_var) == 1 & !!sym(dw_var) == 1),
user_group = factor(
case_when(
both_fed == 1 ~ "Both",
!!sym(btfp_var) == 1 ~ "BTFP_Only",
!!sym(dw_var) == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
),
non_user = as.integer(any_fed == 0 & fhlb_user == 0)
)
}
# ==============================================================================
# BUILD PERIOD DATASETS
# ==============================================================================
# --- CRISIS PERIOD (Mar 8 - May 4) ---
df_crisis <- join_all_borrowers(
df_2022q4, btfp_crisis, dw_crisis, "btfp_crisis", "dw_crisis"
) %>%
mutate(
# Intensive-margin variables (amount relative to bank size)
btfp_pct = ifelse(
btfp_crisis == 1 & btfp_crisis_amt > 0,
100 * btfp_crisis_amt / (total_asset * 1000), NA_real_
),
dw_pct = ifelse(
dw_crisis == 1 & dw_crisis_amt > 0,
100 * dw_crisis_amt / (total_asset * 1000), NA_real_
),
log_btfp_amt = ifelse(
btfp_crisis == 1 & btfp_crisis_amt > 0, log(btfp_crisis_amt), NA_real_
),
log_dw_amt = ifelse(
dw_crisis == 1 & dw_crisis_amt > 0, log(dw_crisis_amt), NA_real_
)
)
# --- ARBITRAGE PERIOD (Nov 15 - Jan 24) ---
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, # No DW data needed here per specifications
non_user = as.integer(btfp_arb == 0 & fhlb_user == 0),
user_group = factor(
ifelse(btfp_arb == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
)
)
# --- WIND-DOWN PERIOD (Jan 25 - Mar 11) ---
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)
)
cat("=== PERIOD DATASET COUNTS ===\n")## === PERIOD DATASET COUNTS ===cat("Crisis: ", nrow(df_crisis),
" | BTFP=1:", sum(df_crisis$btfp_crisis),
" | DW=1:", sum(df_crisis$dw_crisis),
" | AnyFed:", sum(df_crisis$any_fed), "\n")## Crisis: 4292 | BTFP=1: 501 | DW=1: 433 | AnyFed: 828# ==============================================================================
# ACUTE PERIOD (2022Q4 baseline)
# ==============================================================================
df_crisis <- join_all_borrowers(
df_2022q4, btfp_crisis, dw_crisis, "btfp_crisis", "dw_crisis"
) %>%
mutate(
# Intensive-margin variables (amount relative to bank size)
btfp_pct = ifelse(
btfp_crisis == 1 & btfp_crisis_amt > 0,
100 * btfp_crisis_amt / (total_asset * 1000), NA_real_
),
dw_pct = ifelse(
dw_crisis == 1 & dw_crisis_amt > 0,
100 * dw_crisis_amt / (total_asset * 1000), NA_real_
),
log_btfp_amt = ifelse(
btfp_crisis == 1 & btfp_crisis_amt > 0, log(btfp_crisis_amt), NA_real_
),
log_dw_amt = ifelse(
dw_crisis == 1 & dw_crisis_amt > 0, log(dw_crisis_amt), NA_real_
)
)
# ==============================================================================
# PRE-BTFP / NARROW WINDOWS (2022Q4 baseline)
# For falsification: before par-value subsidy existed
# ==============================================================================
# Mar 1 – Mar 12 (any DW before BTFP announcement)
btfp_prebtfp <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
as.Date("2023-03-01"), as.Date("2023-03-12"), "btfp_prebtfp"
)## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `btfp_prebtfp_first = min(btfp_loan_date)`.
## Caused by warning in `min.default()`:
## ! no non-missing arguments to min; returning Infdw_prebtfp <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
as.Date("2023-03-01"), as.Date("2023-03-12"), "dw_prebtfp"
)
df_prebtfp <- join_all_borrowers(
df_2022q4, btfp_prebtfp, dw_prebtfp, "btfp_prebtfp", "dw_prebtfp"
)
# SVB closure day only (Mar 10)
btfp_mar10 <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
as.Date("2023-03-10"), as.Date("2023-03-10"), "btfp_mar10"
)## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `btfp_mar10_first = min(btfp_loan_date)`.
## Caused by warning in `min.default()`:
## ! no non-missing arguments to min; returning Infdw_mar10 <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
as.Date("2023-03-10"), as.Date("2023-03-10"), "dw_mar10"
)
df_mar10 <- join_all_borrowers(
df_2022q4, btfp_mar10, dw_mar10, "btfp_mar10", "dw_mar10"
)
# Mar 10 – Mar 13 (SVB closure through BTFP launch)
btfp_mar10_13 <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
as.Date("2023-03-10"), as.Date("2023-03-13"), "btfp_mar10_13"
)
dw_mar10_13 <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
as.Date("2023-03-10"), as.Date("2023-03-13"), "dw_mar10_13"
)
df_mar10_13 <- join_all_borrowers(
df_2022q4, btfp_mar10_13, dw_mar10_13, "btfp_mar10_13", "dw_mar10_13"
)
# ==============================================================================
# ARBITRAGE PERIOD (2023Q3 baseline)
# No DW data in this window per design
# ==============================================================================
df_arb <- df_2023q3 %>%
left_join(btfp_arb %>% select(idrssd, btfp_arb, btfp_arb_amt), by = "idrssd") %>%
mutate(
btfp_arb = replace_na(btfp_arb, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = btfp_arb,
non_user = as.integer(btfp_arb == 0 & fhlb_user == 0),
user_group = factor(
ifelse(btfp_arb == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
)
)
# ==============================================================================
# WIND-DOWN PERIOD (2023Q4 baseline)
# No DW data in this window per design
# ==============================================================================
df_wind <- df_2023q4 %>%
left_join(btfp_wind %>% select(idrssd, btfp_wind, btfp_wind_amt), by = "idrssd") %>%
mutate(
btfp_wind = replace_na(btfp_wind, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = btfp_wind,
non_user = as.integer(btfp_wind == 0 & fhlb_user == 0),
user_group = factor(
ifelse(btfp_wind == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
)
)
cat("=== PERIOD DATASET COUNTS ===\n")## === PERIOD DATASET COUNTS ===cat("Crisis: ", nrow(df_crisis),
" | BTFP=1:", sum(df_crisis$btfp_crisis),
" | DW=1:", sum(df_crisis$dw_crisis),
" | AnyFed:", sum(df_crisis$any_fed),
" | Non-user:", sum(df_crisis$non_user), "\n")## Crisis: 4292 | BTFP=1: 501 | DW=1: 433 | AnyFed: 828 | Non-user: 3226cat("Arb: ", nrow(df_arb),
" | BTFP=1:", sum(df_arb$btfp_arb), "\n")## Arb: 4214 | BTFP=1: 749cat("Wind-down: ", nrow(df_wind),
" | BTFP=1:", sum(df_wind$btfp_wind), "\n")## Wind-down: 4197 | BTFP=1: 229# ==============================================================================
# PURE COMPARISON SAMPLES
# Each sample isolates a specific borrower type against pure non-borrowers
# ==============================================================================
# --- Extensive Margin: Crisis Period ---
df_btfp_s <- df_crisis %>% filter(btfp_crisis == 1 | non_user == 1)
df_dw_s <- df_crisis %>% filter(dw_crisis == 1 | non_user == 1)
df_anyfed_s <- df_crisis %>% filter(any_fed == 1 | non_user == 1) # Your "All" Group
df_fhlb_s <- df_crisis %>% filter(fhlb_user == 1 | non_user == 1) # Falsification
# --- Solvency Splits: Crisis Period ---
df_btfp_sol <- df_btfp_s %>% filter(mtm_solvent == 1)
df_btfp_ins <- df_btfp_s %>% filter(mtm_insolvent == 1)
df_dw_sol <- df_dw_s %>% filter(mtm_solvent == 1)
df_dw_ins <- df_dw_s %>% filter(mtm_insolvent == 1)
# --- Intensive Margin: Crisis Period (Borrowers Only) ---
df_btfp_int <- df_crisis %>% filter(btfp_crisis == 1, !is.na(btfp_pct))
df_btfp_int_sol <- df_btfp_int %>% filter(mtm_solvent == 1)
df_btfp_int_ins <- df_btfp_int %>% filter(mtm_insolvent == 1)
# --- Temporal Robustness: Arbitrage Period ---
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_fhlb_arb_s <- df_arb %>% filter(fhlb_user == 1 | non_user == 1)
# --- Temporal Robustness: Wind-down Period ---
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
cat("=== REGRESSION SAMPLES (Crisis) ===\n")## === REGRESSION SAMPLES (Crisis) ===cat("BTFP vs Non-user: ", nrow(df_btfp_s), " (BTFP=1:", sum(df_btfp_s$btfp_crisis), ")\n")## BTFP vs Non-user: 3727 (BTFP=1: 501 )cat("DW vs Non-user: ", nrow(df_dw_s), " (DW=1:", sum(df_dw_s$dw_crisis), ")\n")## DW vs Non-user: 3659 (DW=1: 433 )cat("AnyFed vs Non-user: ", nrow(df_anyfed_s), " (AnyFed=1:", sum(df_anyfed_s$any_fed), ")\n")## AnyFed vs Non-user: 4054 (AnyFed=1: 828 )cat("FHLB vs Non-user: ", nrow(df_fhlb_s), " (FHLB=1:", sum(df_fhlb_s$fhlb_user), ")\n")## FHLB vs Non-user: 3528 (FHLB=1: 302 )# MODEL INFRASTRUCTURE
# ==============================================================================
# CONTROLS STRING
# book_equity_ratio included here (not collinear in MTM framework)
# ==============================================================================
CONTROLS <- "ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa"
# ==============================================================================
# FORMULA STRINGS: IDENTIFICATION STRATEGY
# Mapped directly to the theoretical framework and robustness tests.
# ==============================================================================
# --- 1. Base Model (Extensive & Intensive Margin) ---
# Borrower_i = a + b1*MTM + b2*Uninsured + b3*(MTM x Uninsured) + Controls
EXPL_BASE <- "mtm_total + uninsured_lev + mtm_x_uninsured"
# --- 2. Threshold Gradient Test ---
# Run within Uninsured terciles (Low, Medium, High)
# Borrower_i = a + b*MTM + Controls
EXPL_GRADIENT <- "mtm_total"
# --- 3. Robustness: Insured Deposits (2 variations) ---
# Test 1: MTM and insured (no interaction
EXPL_INSURED_1 <- "mtm_total + insured_lev"
# Test 2: Replace uninsured with insured in baseline (main effects + interaction)
EXPL_INSURED_2 <- "mtm_total + insured_lev + mtm_x_insured"
# ==============================================================================
# FIXEST VARIABLE DICTIONARY (display labels for etable)
# ==============================================================================
setFixest_dict(c(
# Primary explanatory
mtm_total = "MTM Loss (z)",
uninsured_lev = "Uninsured Leverage (z)",
insured_lev = "Insured Leverage (z)",
# Interactions
mtm_x_uninsured = "MTM $\\times$ Uninsured",
mtm_x_insured = "MTM $\\times$ Insured",
# Controls
ln_assets = "Log(Assets)",
cash_ratio = "Cash Ratio",
loan_to_deposit = "Loan-to-Deposit",
book_equity_ratio = "Book Equity Ratio",
wholesale = "Wholesale Funding",
roa = "ROA"
))
# ==============================================================================
# COEFFICIENT DISPLAY ORDER (for etable order = argument)
# ==============================================================================
COEF_ORDER <- c(
"Constant",
"MTM Loss",
"Uninsured Leverage",
"Insured Leverage",
"MTM.*Uninsured",
"MTM.*Insured"
)
# ==============================================================================
# GENERIC MODEL RUNNER
# ==============================================================================
run_model <- function(data, dv, explanatory,
family_type = "lpm", controls = CONTROLS) {
ff <- as.formula(paste(dv, "~", explanatory, "+", controls))
if (family_type == "lpm") {
feols(ff, data = data, vcov = "hetero")
} else if (family_type == "logit") {
feglm(ff, data = data, family = binomial("logit"), vcov = "hetero")
} else {
stop("family_type must be either 'lpm' or 'logit'")
}
}
# ==============================================================================
# ETABLE SAVER
# ==============================================================================
save_etable <- function(models, filename, title_text, notes_text,
fitstat_use = ~ n + r2,
extra_lines = NULL) {
etable(
models,
title = title_text,
notes = notes_text,
fitstat = fitstat_use,
order = COEF_ORDER,
extralines = extra_lines,
se.below = TRUE,
tex = TRUE,
file = file.path(TABLE_PATH, paste0(filename, ".tex")),
replace = TRUE,
style.tex = style.tex("aer")
)
message("Saved: ", filename, ".tex")
}
# ==============================================================================
# VISUALIZATION THEME
# ==============================================================================
theme_paper <- theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 13, hjust = 0),
plot.subtitle = element_text(size = 10, color = "grey40", hjust = 0),
legend.position = "bottom",
panel.grid.minor = element_blank(),
strip.text = element_text(face = "bold", size = 11)
)
pal_user <- c(
"DW" = "#D62828",
"BTFP" = "#003049",
"FHLB" = "#F77F00",
"Pure Non-Borrower" = "grey70",
"Both" = "#7209B7",
"AnyFed" = "#2A9D8F"
)
cat("=== MODEL INFRASTRUCTURE READY ===\n")## === MODEL INFRASTRUCTURE READY ===cat("Formulas loaded for Base, Gradient, and Insured Robustness.\n")## Formulas loaded for Base, Gradient, and Insured Robustness.cat("Controls:", CONTROLS, "\n")## Controls: ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa# ==============================================================================
# EXTENSIVE MARGIN: CRISIS PERIOD
# Base Model: Borrower = MTM + Uninsured + (MTM x Uninsured) + Controls
# ==============================================================================
# 1. Estimate Models (Linear Probability Models)
mod_ext_anyfed <- run_model(df_anyfed_s, "any_fed", EXPL_BASE, family_type = "lpm")
mod_ext_btfp <- run_model(df_btfp_s, "btfp_crisis", EXPL_BASE, family_type = "lpm")
mod_ext_dw <- run_model(df_dw_s, "dw_crisis", EXPL_BASE, family_type = "lpm")
mod_ext_fhlb <- run_model(df_fhlb_s, "fhlb_user", EXPL_BASE, family_type = "lpm")
# Combine into a list for fixest::etable
models_extensive <- list(
"Any Fed" = mod_ext_anyfed,
"BTFP" = mod_ext_btfp,
"DW" = mod_ext_dw,
"FHLB" = mod_ext_fhlb
)
# 2. Calculate Dependent Variable Means and Count (N) for the Table Footer
mean_anyfed <- round(mean(df_anyfed_s$any_fed, na.rm = TRUE), 3)
mean_btfp <- round(mean(df_btfp_s$btfp_crisis, na.rm = TRUE), 3)
mean_dw <- round(mean(df_dw_s$dw_crisis, na.rm = TRUE), 3)
mean_fhlb <- round(mean(df_fhlb_s$fhlb_user, na.rm = TRUE), 3)
n_anyfed <- sum(df_anyfed_s$any_fed, na.rm = TRUE)
n_btfp <- sum(df_btfp_s$btfp_crisis, na.rm = TRUE)
n_dw <- sum(df_dw_s$dw_crisis, na.rm = TRUE)
n_fhlb <- sum(df_fhlb_s$fhlb_user, na.rm = TRUE)
# 3. Save the Table
save_etable(
models = models_extensive,
filename = "tab_extensive_margin_crisis",
title_text = "Extensive Margin: Bank Selection into Emergency Lending Facilities (Crisis Period)",
notes_text = "Linear probability models. The dependent variable is an indicator equal to 1 if the bank borrowed from the respective facility during the Crisis Period (March 8 -- May 4, 2023), and 0 if it used no emergency liquidity facilities. FHLB borrowing represents abnormal borrowing (top 10 percent). Standard errors are heteroskedasticity-robust. All continuous independent variables are z-standardized.",
extra_lines = list(
c("Borrowers (N)", n_anyfed, n_btfp, n_dw, n_fhlb),
c("Mean of DV", mean_anyfed, mean_btfp, mean_dw, mean_fhlb)
)
)
# Print a console summary to check results immediately
cat("=== EXTENSIVE MARGIN RESULTS (CRISIS) ===\n")## === EXTENSIVE MARGIN RESULTS (CRISIS) ===etable(models_extensive, fitstat = ~ n + r2, se.below = TRUE)## Any Fed BTFP DW FHLB
## Dependent Var.: any_fed btfp_crisis dw_crisis fhlb_user
##
## Constant 0.2081*** 0.1435*** 0.1272*** 0.0908***
## (0.0060) (0.0056) (0.0054) (0.0050)
## MTM Loss (z) 0.0300*** 0.0249*** 0.0158** 0.0039
## (0.0070) (0.0062) (0.0061) (0.0056)
## Uninsured Leverage (z) 0.0198** 0.0214** 0.0126 0.0064
## (0.0076) (0.0070) (0.0067) (0.0051)
## MTM $\times$ Uninsured 0.0199*** 0.0193*** 0.0170*** -0.0039
## (0.0057) (0.0052) (0.0051) (0.0043)
## Log(Assets) 0.1064*** 0.0713*** 0.0920*** 0.0266***
## (0.0082) (0.0077) (0.0077) (0.0065)
## Cash Ratio -0.0246*** -0.0285*** -0.0043 -0.0214***
## (0.0061) (0.0048) (0.0053) (0.0039)
## Loan-to-Deposit -0.0035 -0.0107 -0.0007 0.0244***
## (0.0067) (0.0057) (0.0057) (0.0050)
## Book Equity Ratio -0.0135* -0.0118* -0.0006 0.0101*
## (0.0055) (0.0047) (0.0044) (0.0041)
## Wholesale Funding 0.0297*** 0.0263*** 0.0204** 0.0019
## (0.0069) (0.0065) (0.0063) (0.0051)
## ROA -0.0019 -0.0059 -0.0029 -0.0091*
## (0.0057) (0.0049) (0.0048) (0.0043)
## ______________________ __________ ___________ __________ __________
## S.E. type Hete.-rob. Heter.-rob. Hete.-rob. Hete.-rob.
## Observations 4,044 3,717 3,649 3,518
## R2 0.12097 0.09615 0.10314 0.04090
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ==============================================================================
# THRESHOLD GRADIENT: CRISIS PERIOD
# Model: Borrower = MTM + Controls (Estimated across Uninsured Terciles)
# Prediction: Beta on MTM is steepest for the High Uninsured group.
# ==============================================================================
# 1. Define Uninsured Leverage Terciles using the population (df_crisis)
# This ensures the definition of "High" fragility is consistent across all models.
df_crisis <- df_crisis %>%
mutate(
unins_tercile = ntile(uninsured_lev, 3)
)
# Refresh the pure comparison samples to include the new tercile variable
df_anyfed_s <- df_crisis %>% filter(any_fed == 1 | non_user == 1)
df_btfp_s <- df_crisis %>% filter(btfp_crisis == 1 | non_user == 1)
df_dw_s <- df_crisis %>% filter(dw_crisis == 1 | non_user == 1)
# 2. Estimate Models by Tercile (Any Fed)
mod_any_L <- run_model(df_anyfed_s %>% filter(unins_tercile == 1), "any_fed", EXPL_GRADIENT, "lpm")
mod_any_M <- run_model(df_anyfed_s %>% filter(unins_tercile == 2), "any_fed", EXPL_GRADIENT, "lpm")
mod_any_H <- run_model(df_anyfed_s %>% filter(unins_tercile == 3), "any_fed", EXPL_GRADIENT, "lpm")
# 3. Estimate Models by Tercile (BTFP)
mod_btfp_L <- run_model(df_btfp_s %>% filter(unins_tercile == 1), "btfp_crisis", EXPL_GRADIENT, "lpm")
mod_btfp_M <- run_model(df_btfp_s %>% filter(unins_tercile == 2), "btfp_crisis", EXPL_GRADIENT, "lpm")
mod_btfp_H <- run_model(df_btfp_s %>% filter(unins_tercile == 3), "btfp_crisis", EXPL_GRADIENT, "lpm")
# 4. Estimate Models by Tercile (DW)
mod_dw_L <- run_model(df_dw_s %>% filter(unins_tercile == 1), "dw_crisis", EXPL_GRADIENT, "lpm")
mod_dw_M <- run_model(df_dw_s %>% filter(unins_tercile == 2), "dw_crisis", EXPL_GRADIENT, "lpm")
mod_dw_H <- run_model(df_dw_s %>% filter(unins_tercile == 3), "dw_crisis", EXPL_GRADIENT, "lpm")
# Combine into a list for fixest::etable
models_gradient <- list(
"Any Fed (Low)" = mod_any_L,
"Any Fed (Med)" = mod_any_M,
"Any Fed (High)" = mod_any_H,
"BTFP (Low)" = mod_btfp_L,
"BTFP (Med)" = mod_btfp_M,
"BTFP (High)" = mod_btfp_H,
"DW (Low)" = mod_dw_L,
"DW (Med)" = mod_dw_M,
"DW (High)" = mod_dw_H
)
# 5. Calculate Dependent Variable Means and Counts (N) for the Table Footer
calc_stats <- function(df, dv, terc) {
sub_df <- df %>% filter(unins_tercile == terc)
c(
n_borrowers = sum(sub_df[[dv]], na.rm = TRUE),
mean_dv = round(mean(sub_df[[dv]], na.rm = TRUE), 3)
)
}
stats_any_L <- calc_stats(df_anyfed_s, "any_fed", 1)
stats_any_M <- calc_stats(df_anyfed_s, "any_fed", 2)
stats_any_H <- calc_stats(df_anyfed_s, "any_fed", 3)
stats_btfp_L <- calc_stats(df_btfp_s, "btfp_crisis", 1)
stats_btfp_M <- calc_stats(df_btfp_s, "btfp_crisis", 2)
stats_btfp_H <- calc_stats(df_btfp_s, "btfp_crisis", 3)
stats_dw_L <- calc_stats(df_dw_s, "dw_crisis", 1)
stats_dw_M <- calc_stats(df_dw_s, "dw_crisis", 2)
stats_dw_H <- calc_stats(df_dw_s, "dw_crisis", 3)
# 6. Save the Table
save_etable(
models = models_gradient,
filename = "tab_threshold_gradient",
title_text = "Threshold Gradient: Borrowing Sensitivity to MTM Losses by Fragility Level",
notes_text = "Linear probability models estimated separately across terciles of Uninsured Leverage (Low, Medium, High). The dependent variable is an indicator equal to 1 if the bank borrowed from the respective facility during the Crisis Period, and 0 if it used no emergency liquidity facilities. Standard errors are heteroskedasticity-robust. All continuous independent variables are z-standardized.",
extra_lines = list(
c("Uninsured Lev.", "Low", "Medium", "High", "Low", "Medium", "High", "Low", "Medium", "High"),
c("Borrowers (N)",
stats_any_L["n_borrowers"], stats_any_M["n_borrowers"], stats_any_H["n_borrowers"],
stats_btfp_L["n_borrowers"], stats_btfp_M["n_borrowers"], stats_btfp_H["n_borrowers"],
stats_dw_L["n_borrowers"], stats_dw_M["n_borrowers"], stats_dw_H["n_borrowers"]),
c("Mean of DV",
stats_any_L["mean_dv"], stats_any_M["mean_dv"], stats_any_H["mean_dv"],
stats_btfp_L["mean_dv"], stats_btfp_M["mean_dv"], stats_btfp_H["mean_dv"],
stats_dw_L["mean_dv"], stats_dw_M["mean_dv"], stats_dw_H["mean_dv"])
)
)
# Print a console summary to check results immediately
cat("=== THRESHOLD GRADIENT RESULTS ===\n")## === THRESHOLD GRADIENT RESULTS ===cat("Prediction: Beta on MTM should increase from Low -> Medium -> High\n")## Prediction: Beta on MTM should increase from Low -> Medium -> Highetable(models_gradient, fitstat = ~ n + r2, se.below = TRUE)## Any Fed .. Any Fed ...1 Any Fed ...2 BTFP (Low) BTFP (Med)
## Dependent Var.: any_fed any_fed any_fed btfp_crisis btfp_crisis
##
## Constant 0.1826*** 0.2028*** 0.2163*** 0.1203*** 0.1344***
## (0.0132) (0.0105) (0.0126) (0.0119) (0.0094)
## MTM Loss (z) 0.0138 0.0169 0.0487*** 0.0099 0.0072
## (0.0088) (0.0128) (0.0145) (0.0072) (0.0105)
## Log(Assets) 0.1015*** 0.0849*** 0.1266*** 0.0718*** 0.0586***
## (0.0135) (0.0157) (0.0129) (0.0120) (0.0145)
## Cash Ratio -0.0107 -0.0225 -0.0388** -0.0117 -0.0355***
## (0.0084) (0.0120) (0.0119) (0.0062) (0.0096)
## Loan-to-Deposit -0.0046 0.0047 -0.0120 -0.0032 -0.0212
## (0.0087) (0.0152) (0.0139) (0.0072) (0.0131)
## Book Equity Ratio -0.0144* -0.0368* -0.0071 -0.0097 -0.0268*
## (0.0064) (0.0144) (0.0140) (0.0053) (0.0128)
## Wholesale Funding 0.0071 0.0589*** 0.0252 0.0028 0.0567***
## (0.0089) (0.0132) (0.0138) (0.0067) (0.0136)
## ROA -0.0101 0.0145 0.0015 -0.0121 0.0078
## (0.0080) (0.0115) (0.0112) (0.0066) (0.0099)
## _________________ __________ __________ __________ ___________ ___________
## S.E. type Hete.-rob. Hete.-rob. Hete.-rob. Heter.-rob. Heter.-rob.
## Observations 1,358 1,343 1,343 1,286 1,230
## R2 0.09509 0.08573 0.13268 0.07578 0.08066
##
## BTFP (High) DW (Low) DW (Med) DW (High)
## Dependent Var.: btfp_crisis dw_crisis dw_crisis dw_crisis
##
## Constant 0.1578*** 0.1070*** 0.1213*** 0.1207***
## (0.0117) (0.0117) (0.0093) (0.0105)
## MTM Loss (z) 0.0384** 0.0014 0.0114 0.0325*
## (0.0134) (0.0070) (0.0112) (0.0129)
## Log(Assets) 0.0853*** 0.0684*** 0.0701*** 0.1278***
## (0.0132) (0.0122) (0.0141) (0.0126)
## Cash Ratio -0.0411*** -0.0027 0.0105 -0.0154
## (0.0099) (0.0072) (0.0106) (0.0105)
## Loan-to-Deposit -0.0140 -0.0070 0.0246 -0.0185
## (0.0127) (0.0069) (0.0132) (0.0124)
## Book Equity Ratio -0.0179 -0.0072 -0.0194 0.0103
## (0.0122) (0.0049) (0.0109) (0.0126)
## Wholesale Funding 0.0240 0.0061 0.0342** 0.0236
## (0.0138) (0.0076) (0.0131) (0.0132)
## ROA -0.0026 -0.0041 0.0048 -0.0004
## (0.0097) (0.0067) (0.0098) (0.0099)
## _________________ ___________ __________ __________ __________
## S.E. type Heter.-rob. Hete.-rob. Hete.-rob. Hete.-rob.
## Observations 1,201 1,269 1,200 1,180
## R2 0.10041 0.06042 0.06120 0.13847
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ==============================================================================
# INTENSIVE MARGIN: CRISIS PERIOD
# Base Model: Borrow_Pct = MTM + Uninsured + (MTM x Uninsured) + Controls
# Estimated ONLY among banks that borrowed (Amount > 0)
# ==============================================================================
# 0. Ensure DW intensive margin datasets exist (filtering from df_crisis)
df_dw_int <- df_crisis %>% filter(dw_crisis == 1, !is.na(dw_pct))
df_dw_int_sol <- df_dw_int %>% filter(mtm_solvent == 1)
df_dw_int_ins <- df_dw_int %>% filter(mtm_insolvent == 1)
# 1. Estimate Models for BTFP
mod_int_btfp <- run_model(df_btfp_int, "btfp_pct", EXPL_BASE, family_type = "lpm")
mod_int_btfp_sol <- run_model(df_btfp_int_sol, "btfp_pct", EXPL_BASE, family_type = "lpm")
mod_int_btfp_ins <- run_model(df_btfp_int_ins, "btfp_pct", EXPL_BASE, family_type = "lpm")
# 2. Estimate Models for DW
mod_int_dw <- run_model(df_dw_int, "dw_pct", EXPL_BASE, family_type = "lpm")
mod_int_dw_sol <- run_model(df_dw_int_sol, "dw_pct", EXPL_BASE, family_type = "lpm")
mod_int_dw_ins <- run_model(df_dw_int_ins, "dw_pct", EXPL_BASE, family_type = "lpm")
# Combine into a list
models_intensive <- list(
"BTFP (All)" = mod_int_btfp,
"BTFP (Sol)" = mod_int_btfp_sol,
"BTFP (Ins)" = mod_int_btfp_ins,
"DW (All)" = mod_int_dw,
"DW (Sol)" = mod_int_dw_sol,
"DW (Ins)" = mod_int_dw_ins
)
# 3. Calculate Dependent Variable Means
mean_btfp_all <- round(mean(df_btfp_int$btfp_pct, na.rm = TRUE), 2)
mean_btfp_sol <- round(mean(df_btfp_int_sol$btfp_pct, na.rm = TRUE), 2)
mean_btfp_ins <- round(mean(df_btfp_int_ins$btfp_pct, na.rm = TRUE), 2)
mean_dw_all <- round(mean(df_dw_int$dw_pct, na.rm = TRUE), 2)
mean_dw_sol <- round(mean(df_dw_int_sol$dw_pct, na.rm = TRUE), 2)
mean_dw_ins <- round(mean(df_dw_int_ins$dw_pct, na.rm = TRUE), 2)
# 4. Save the Table
save_etable(
models = models_intensive,
filename = "tab_intensive_margin_crisis",
title_text = "Intensive Margin: Borrowing Amounts as a Percentage of Assets",
notes_text = "OLS regressions conditional on borrowing. The dependent variable is the total amount borrowed from the BTFP or DW during the Crisis Period scaled by total assets (in percent). The sample is restricted to banks that borrowed from the respective facility. Standard errors are heteroskedasticity-robust. All continuous independent variables are z-standardized.",
extra_lines = list(
c("Mean Borrowing (%)",
mean_btfp_all, mean_btfp_sol, mean_btfp_ins,
mean_dw_all, mean_dw_sol, mean_dw_ins)
)
)
# Print summary
cat("=== INTENSIVE MARGIN RESULTS (CRISIS) ===\n")## === INTENSIVE MARGIN RESULTS (CRISIS) ===etable(models_intensive, fitstat = ~ n + r2, se.below = TRUE)## BTFP (A.. BTFP (S.. BTFP (.. DW (All) DW (Sol)
## Dependent Var.: btfp_pct btfp_pct btfp_pct dw_pct dw_pct
##
## Constant 7.791*** 7.879*** -0.8703 3.943** 3.687*
## (1.113) (1.091) (2.460) (1.512) (1.690)
## MTM Loss (z) -1.199 -1.744 1.384 0.6626 2.017
## (1.026) (1.491) (0.9999) (1.993) (2.859)
## Uninsured Leverage (z) -1.622 -1.919 1.174 2.280 3.694
## (1.477) (1.495) (1.766) (2.036) (2.670)
## MTM $\times$ Uninsured 1.392 1.475 -0.4346 1.861 3.067
## (0.9568) (1.110) (1.528) (1.444) (2.103)
## Log(Assets) 1.742 1.907 0.6483 3.102 2.971
## (1.287) (1.408) (0.8416) (1.844) (2.090)
## Cash Ratio 2.072 2.394 -0.2366 -2.279 -1.745
## (1.626) (1.836) (1.487) (1.457) (1.552)
## Loan-to-Deposit -2.639 -3.074 -1.285 -0.6124 0.2873
## (1.565) (2.037) (1.053) (2.508) (2.692)
## Book Equity Ratio 0.8910 1.209 -3.887 -0.2767 -0.0739
## (0.8683) (1.212) (1.971) (2.008) (1.767)
## Wholesale Funding 0.6748 0.9329* 0.0674 2.524* 3.174*
## (0.3504) (0.4665) (0.4649) (1.265) (1.544)
## ROA -0.1763 0.3057 -2.936* -0.0455 -0.0678
## (0.8310) (0.9396) (1.407) (1.059) (1.086)
## ______________________ _________ _________ ________ ________ ________
## S.E. type Het.-rob. Het.-rob. Het.-rob. Het.-rob. Het.-rob.
## Observations 501 357 144 433 348
## R2 0.11747 0.15575 0.14633 0.03726 0.04980
##
## DW (Ins)
## Dependent Var.: dw_pct
##
## Constant 6.843
## (12.13)
## MTM Loss (z) -5.750
## (4.689)
## Uninsured Leverage (z) -8.548
## (5.959)
## MTM $\times$ Uninsured 7.179
## (4.387)
## Log(Assets) 2.736
## (2.273)
## Cash Ratio -2.260
## (4.605)
## Loan-to-Deposit 0.4213
## (5.610)
## Book Equity Ratio -6.181
## (8.297)
## Wholesale Funding 0.2798
## (2.252)
## ROA -0.9944
## (2.872)
## ______________________ ________
## S.E. type Het.-rob.
## Observations 85
## R2 0.04547
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ==============================================================================
# ROBUSTNESS: INSURED DEPOSITS
# Tests whether the panic mechanism is specifically driven by UNINSURED leverage
# Sample: BTFP vs Pure Non-Borrowers (Crisis Period)
# ==============================================================================
# Model 1: Include insured deposits in the baseline specification
mod_ins_1 <- run_model(df_btfp_s, "btfp_crisis", EXPL_INSURED_1, family_type = "lpm")
# Model 2: Replace uninsured with insured in baseline (main effects + interaction)
mod_ins_2 <- run_model(df_btfp_s, "btfp_crisis", EXPL_INSURED_2, family_type = "lpm")
models_insured <- list(
"Insured" = mod_ins_1,
"Interaction" = mod_ins_2
)
# Save the Table
save_etable(
models = models_insured,
filename = "tab_robustness_insured",
title_text = "Robustness: The Role of Insured vs. Uninsured Deposits",
notes_text = "Linear probability models predicting BTFP borrowing during the Crisis Period. Model 1 Insured Leverage to the baseline model. Model 2 with the interaction term. Standard errors are heteroskedasticity-robust."
)
cat("=== ROBUSTNESS: INSURED DEPOSITS ===\n")## === ROBUSTNESS: INSURED DEPOSITS ===etable(models_insured, fitstat = ~ n + r2, se.below = TRUE)## Insured Interaction
## Dependent Var.: btfp_crisis btfp_crisis
##
## Constant 0.1410*** 0.1439***
## (0.0055) (0.0057)
## MTM Loss (z) 0.0214*** 0.0233***
## (0.0057) (0.0059)
## Insured Leverage (z) -0.0291*** -0.0334***
## (0.0066) (0.0072)
## Log(Assets) 0.0659*** 0.0653***
## (0.0076) (0.0076)
## Cash Ratio -0.0304*** -0.0296***
## (0.0048) (0.0048)
## Loan-to-Deposit -0.0134* -0.0142*
## (0.0058) (0.0059)
## Book Equity Ratio -0.0252*** -0.0234***
## (0.0051) (0.0052)
## Wholesale Funding 0.0234*** 0.0229***
## (0.0065) (0.0065)
## ROA -0.0053 -0.0049
## (0.0049) (0.0049)
## MTM $\times$ Insured -0.0131**
## (0.0048)
## ____________________ ___________ ___________
## S.E. type Heter.-rob. Heter.-rob.
## Observations 3,717 3,717
## R2 0.09614 0.09770
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ==============================================================================
# TEMPORAL ROBUSTNESS: CRISIS VS. ARBITRAGE
# Model: Borrower = MTM + Uninsured + (MTM x Uninsured) + Controls
# Prediction: The GP run mechanism (MTM x Uninsured) should be strong in the
# Crisis period but weak/insignificant in the Arbitrage period.
# ==============================================================================
# 1. Estimate Models (Linear Probability Models)
# Crisis Period (BTFP vs pure non-borrowers)
mod_temp_crisis <- run_model(df_btfp_s, "btfp_crisis", EXPL_BASE, family_type = "lpm")
# Arbitrage Period (BTFP vs pure non-borrowers)
mod_temp_arb <- run_model(df_btfp_arb_s, "btfp_arb", EXPL_BASE, family_type = "lpm")
# Combine into a list for fixest::etable
models_temporal <- list(
"Crisis (Mar-May)" = mod_temp_crisis,
"Arbitrage (Nov-Jan)" = mod_temp_arb
)
# 2. Calculate Dependent Variable Means and Counts (N) for the Table Footer
mean_crisis <- round(mean(df_btfp_s$btfp_crisis, na.rm = TRUE), 3)
mean_arb <- round(mean(df_btfp_arb_s$btfp_arb, na.rm = TRUE), 3)
n_crisis <- sum(df_btfp_s$btfp_crisis, na.rm = TRUE)
n_arb <- sum(df_btfp_arb_s$btfp_arb, na.rm = TRUE)
# 3. Save the Table
save_etable(
models = models_temporal,
filename = "tab_temporal_robustness",
title_text = "Temporal Robustness: Crisis Panic vs. Arbitrage Borrowing",
notes_text = "Linear probability models comparing BTFP borrowing during the Crisis Period (March 8 -- May 4, 2023) versus the Arbitrage Period (Nov 15, 2023 -- Jan 24, 2024). The dependent variable is an indicator equal to 1 if the bank borrowed from the BTFP during the respective period, and 0 if it was a non-borrower. Standard errors are heteroskedasticity-robust. All continuous independent variables are z-standardized.",
extra_lines = list(
c("Borrowers (N)", n_crisis, n_arb),
c("Mean of DV", mean_crisis, mean_arb)
)
)
# Print a console summary to check results immediately
cat("=== TEMPORAL ROBUSTNESS (CRISIS VS ARBITRAGE) ===\n")## === TEMPORAL ROBUSTNESS (CRISIS VS ARBITRAGE) ===etable(models_temporal, fitstat = ~ n + r2, se.below = TRUE)## Crisis (M.. Arbitrag..
## Dependent Var.: btfp_crisis btfp_arb
##
## Constant 0.1435*** 0.1865***
## (0.0056) (0.0057)
## MTM Loss (z) 0.0249*** 0.0229***
## (0.0062) (0.0068)
## Uninsured Leverage (z) 0.0214** 0.0128
## (0.0070) (0.0066)
## MTM $\times$ Uninsured 0.0193*** 0.0082
## (0.0052) (0.0051)
## Log(Assets) 0.0713*** 0.0496***
## (0.0077) (0.0069)
## Cash Ratio -0.0285*** -0.0362***
## (0.0048) (0.0057)
## Loan-to-Deposit -0.0107 -0.0033
## (0.0057) (0.0062)
## Book Equity Ratio -0.0118* -0.0053
## (0.0047) (0.0056)
## Wholesale Funding 0.0263*** 0.1030***
## (0.0065) (0.0075)
## ROA -0.0059 -0.0236***
## (0.0049) (0.0057)
## ______________________ ___________ __________
## S.E. type Heter.-rob. Hete.-rob.
## Observations 3,717 4,038
## R2 0.09615 0.14406
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ==============================================================================
# REPEAT BORROWERS VS. SINGLE-PERIOD BORROWERS
# Question: Are repeat borrowers fundamentally different from banks that
# only borrowed during the Crisis or only borrowed during the Arbitrage window?
# ==============================================================================
# 1. Create DW Arbitrage indicator (Nov 15 to Dec 31, 2023)
dw_arb_temp <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
ARB_START, DW_DATA_END, "dw_arb"
)
# 2. Merge indicators onto the 2022Q4 baseline and classify bank types
df_repeat_analysis <- df_2022q4 %>%
left_join(btfp_crisis %>% select(idrssd, btfp_crisis), by = "idrssd") %>%
left_join(btfp_arb %>% select(idrssd, btfp_arb), by = "idrssd") %>%
left_join(dw_crisis %>% select(idrssd, dw_crisis), by = "idrssd") %>%
left_join(dw_arb_temp %>% select(idrssd, dw_arb), by = "idrssd") %>%
mutate(
across(c(btfp_crisis, btfp_arb, dw_crisis, dw_arb), ~replace_na(., 0L)),
# BTFP Classifications
btfp_status = case_when(
btfp_crisis == 1 & btfp_arb == 1 ~ "Repeat",
btfp_crisis == 1 & btfp_arb == 0 ~ "Crisis_Only",
btfp_crisis == 0 & btfp_arb == 1 ~ "Arb_Only",
TRUE ~ "Neither"
),
btfp_is_repeat = ifelse(btfp_status == "Repeat", 1, 0),
# DW Classifications
dw_status = case_when(
dw_crisis == 1 & dw_arb == 1 ~ "Repeat",
dw_crisis == 1 & dw_arb == 0 ~ "Crisis_Only",
dw_crisis == 0 & dw_arb == 1 ~ "Arb_Only",
TRUE ~ "Neither"
),
dw_is_repeat = ifelse(dw_status == "Repeat", 1, 0)
)
# Print Group Counts
cat("=== BANK CLASSIFICATIONS ===\n")## === BANK CLASSIFICATIONS ===cat("BTFP -> Repeat:", sum(df_repeat_analysis$btfp_status == "Repeat"),
" | Crisis-Only:", sum(df_repeat_analysis$btfp_status == "Crisis_Only"),
" | Arb-Only:", sum(df_repeat_analysis$btfp_status == "Arb_Only"), "\n")## BTFP -> Repeat: 245 | Crisis-Only: 256 | Arb-Only: 504cat("DW -> Repeat:", sum(df_repeat_analysis$dw_status == "Repeat"),
" | Crisis-Only:", sum(df_repeat_analysis$dw_status == "Crisis_Only"),
" | Arb-Only:", sum(df_repeat_analysis$dw_status == "Arb_Only"), "\n\n")## DW -> Repeat: 120 | Crisis-Only: 313 | Arb-Only: 248# 3. Build Comparison Samples
# A. BTFP: Repeat vs. Crisis-Only (Sample: All Crisis Borrowers)
df_btfp_rep_vs_cris <- df_repeat_analysis %>% filter(btfp_status %in% c("Repeat", "Crisis_Only"))
# B. BTFP: Repeat vs. Arb-Only (Sample: All Arbitrage Borrowers)
df_btfp_rep_vs_arb <- df_repeat_analysis %>% filter(btfp_status %in% c("Repeat", "Arb_Only"))
# C. DW: Repeat vs. Crisis-Only (Sample: All DW Crisis Borrowers)
df_dw_rep_vs_cris <- df_repeat_analysis %>% filter(dw_status %in% c("Repeat", "Crisis_Only"))
# D. DW: Repeat vs. Arb-Only (Sample: All DW Arbitrage Borrowers)
df_dw_rep_vs_arb <- df_repeat_analysis %>% filter(dw_status %in% c("Repeat", "Arb_Only"))
# 4. Estimate Models
mod_btfp_rc <- run_model(df_btfp_rep_vs_cris, "btfp_is_repeat", EXPL_BASE, family_type = "lpm")
mod_btfp_ra <- run_model(df_btfp_rep_vs_arb, "btfp_is_repeat", EXPL_BASE, family_type = "lpm")
mod_dw_rc <- run_model(df_dw_rep_vs_cris, "dw_is_repeat", EXPL_BASE, family_type = "lpm")
mod_dw_ra <- run_model(df_dw_rep_vs_arb, "dw_is_repeat", EXPL_BASE, family_type = "lpm")
# Combine into a list
models_repeat_chars <- list(
"BTFP: vs Crisis-Only" = mod_btfp_rc,
"BTFP: vs Arb-Only" = mod_btfp_ra,
"DW: vs Crisis-Only" = mod_dw_rc,
"DW: vs Arb-Only" = mod_dw_ra
)
# 5. Save the Table
save_etable(
models = models_repeat_chars,
filename = "tab_repeat_borrower_characteristics",
title_text = "Extensive Margin: What Drives a Bank to Become a Repeat Borrower?",
notes_text = "Linear probability models comparing the characteristics of repeat borrowers against single-period borrowers. The dependent variable is 1 if the bank borrowed in BOTH the Crisis and Arbitrage periods. In Columns 1 and 3, the sample is restricted to Crisis borrowers (baseline 0 = Crisis-Only). In Columns 2 and 4, the sample is restricted to Arbitrage borrowers (baseline 0 = Arbitrage-Only). Standard errors are heteroskedasticity-robust.",
extra_lines = list(
c("Repeaters (N)",
sum(df_btfp_rep_vs_cris$btfp_is_repeat), sum(df_btfp_rep_vs_arb$btfp_is_repeat),
sum(df_dw_rep_vs_cris$dw_is_repeat), sum(df_dw_rep_vs_arb$dw_is_repeat)),
c("Comparison Group (N)",
sum(df_btfp_rep_vs_cris$btfp_is_repeat == 0), sum(df_btfp_rep_vs_arb$btfp_is_repeat == 0),
sum(df_dw_rep_vs_cris$dw_is_repeat == 0), sum(df_dw_rep_vs_arb$dw_is_repeat == 0))
)
)
# Print summary
cat("=== REPEAT BORROWER CHARACTERISTICS ===\n")## === REPEAT BORROWER CHARACTERISTICS ===etable(models_repeat_chars, fitstat = ~ n + r2, se.below = TRUE)## BTFP: vs Cri.. BTFP: vs Arb.. DW: vs Cri.. DW: vs Arb..
## Dependent Var.: btfp_is_repeat btfp_is_repeat dw_is_repeat dw_is_repeat
##
## Constant 0.4233*** 0.2425*** 0.2521*** 0.2820***
## (0.0285) (0.0190) (0.0280) (0.0266)
## MTM Loss (z) 0.0275 0.0049 -0.0425 -0.0079
## (0.0291) (0.0208) (0.0266) (0.0253)
## Uninsured Leverage (z) 0.0537* 0.0695** 0.0093 0.0503
## (0.0236) (0.0219) (0.0243) (0.0259)
## MTM $\times$ Uninsured -0.0565* -0.0406 -0.0300 0.0077
## (0.0233) (0.0208) (0.0235) (0.0211)
## Log(Assets) 0.0074 0.0419 -0.0114 0.0048
## (0.0263) (0.0229) (0.0257) (0.0279)
## Cash Ratio -0.1465*** -0.1012*** -0.0404 -0.0299
## (0.0373) (0.0297) (0.0284) (0.0373)
## Loan-to-Deposit -0.0561 -0.0189 0.0179 0.0135
## (0.0334) (0.0248) (0.0283) (0.0360)
## Book Equity Ratio 0.0509 -0.0249 -0.0608 -0.0430
## (0.0333) (0.0230) (0.0352) (0.0366)
## Wholesale Funding -0.0244 0.0183 0.0457* 0.1014***
## (0.0177) (0.0165) (0.0201) (0.0232)
## ROA -0.0043 -0.0010 -0.0085 0.0060
## (0.0278) (0.0195) (0.0243) (0.0280)
## ______________________ ______________ ______________ ____________ ____________
## S.E. type Heterosk.-rob. Heterosk.-rob. Hetero.-rob. Hetero.-rob.
## Observations 501 749 433 368
## R2 0.04791 0.05193 0.03418 0.07329
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ==============================================================================
# TABLE: EMERGENCY LENDING FACILITY ACTIVITY BY PERIOD
# Panel A: All Fed | Panel B: Discount Window | Panel C: BTFP | Panel D: FHLB
#
# Run AFTER analysis_dataprep.Rmd so these objects exist:
# btfp_loans, dw_loans, call_q, excluded_banks
# All date constants, TABLE_PATH, safe_writeLines()
# ==============================================================================
# ==============================================================================
# 1. PERIOD DEFINITIONS
# ==============================================================================
# Loan-level windows (used for DW, BTFP, and All Fed)
periods <- list(
"Pre-BTFP" = list(start = as.Date("2023-03-01"), end = as.Date("2023-03-12")),
"Acute" = list(start = as.Date("2023-03-08"), end = as.Date("2023-03-15")),
"Post-Acute" = list(start = as.Date("2023-03-16"), end = as.Date("2023-05-04")),
"Arbitrage" = list(start = as.Date("2023-11-15"), end = as.Date("2024-01-24")),
"Entire BTFP" = list(start = as.Date("2023-03-13"), end = as.Date("2024-03-11"))
)
col_names <- names(periods)
# FHLB uses Call Report quarters — map each period to quarter(s) to include.
fhlb_period_quarters <- list(
"Pre-BTFP" = c("2022Q4"),
"Acute" = c("2022Q4"),
"Post-Acute" = c("2023Q1"),
"Arbitrage" = c("2023Q3"),
"Entire BTFP" = c("2023Q1", "2023Q2", "2023Q3", "2023Q4")
)
# ==============================================================================
# 2. FORMATTERS
# ==============================================================================
fmt_num <- function(x, digits = 2) {
ifelse(
is.na(x) | is.nan(x) | is.infinite(x), "---",
formatC(x, format = "f", digits = digits, big.mark = ",")
)
}
fmt_int <- function(x) {
ifelse(
is.na(x) | is.nan(x), "---",
formatC(as.integer(round(x)), format = "d", big.mark = ",")
)
}
# ==============================================================================
# 3. PANEL A: ALL FED BORROWING (BTFP + DW)
# ==============================================================================
build_all_fed_panel <- function() {
rows <- list()
for (col in col_names) {
s <- periods[[col]]$start
e <- periods[[col]]$end
# Cap DW end date based on availability
e_capped_dw <- min(e, DW_DATA_END)
# 1. Pull DW Loans
if (s <= DW_DATA_END) {
df_dw <- dw_loans %>%
filter(dw_loan_date >= s, dw_loan_date <= e_capped_dw) %>%
select(rssd_id, amount = dw_loan_amount)
} else {
df_dw <- tibble(rssd_id = character(), amount = numeric())
}
# 2. Pull BTFP Loans
if (col == "Pre-BTFP") {
df_btfp <- tibble(rssd_id = character(), amount = numeric())
} else {
df_btfp <- btfp_loans %>%
filter(btfp_loan_date >= s, btfp_loan_date <= e) %>%
select(rssd_id, amount = btfp_loan_amount)
}
# Combine
df_all <- bind_rows(df_dw, df_btfp)
if (nrow(df_all) == 0) {
rows[[col]] <- list(banks = 0, loans = 0, total_b = 0, mean_m = NA, median_m = NA)
next
}
rows[[col]] <- list(
banks = n_distinct(df_all$rssd_id),
loans = nrow(df_all),
total_b = sum(df_all$amount, na.rm = TRUE) / 1e9,
mean_m = mean(df_all$amount, na.rm = TRUE) / 1e6,
median_m = median(df_all$amount, na.rm = TRUE) / 1e6
)
}
metrics <- c("Banks (N)", "Loans (N)", "Total ($B)", "Mean ($M)", "Median ($M)")
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(
Metric = metrics,
Period = col,
Value = c(
fmt_int(r$banks), fmt_int(r$loans),
fmt_num(r$total_b), fmt_num(r$mean_m), fmt_num(r$median_m)
)
)
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
select(Metric, all_of(col_names))
}
# ==============================================================================
# 4. PANEL B: DISCOUNT WINDOW
# ==============================================================================
build_dw_panel <- function() {
rows <- list()
for (col in col_names) {
s <- periods[[col]]$start
e <- periods[[col]]$end
e_capped <- min(e, DW_DATA_END)
if (s > DW_DATA_END) {
rows[[col]] <- list(banks = NA, loans = NA, total_b = NA, mean_m = NA, median_m = NA, avg_rate = NA, avg_term = NA, avg_effmat = NA, loan_coll = NA)
next
}
df <- dw_loans %>% filter(dw_loan_date >= s, dw_loan_date <= e_capped)
if (nrow(df) == 0) {
rows[[col]] <- list(banks = 0, loans = 0, total_b = 0, mean_m = NA, median_m = NA, avg_rate = NA, avg_term = NA, avg_effmat = NA, loan_coll = NA)
next
}
rows[[col]] <- list(
banks = n_distinct(df$rssd_id),
loans = nrow(df),
total_b = sum(df$dw_loan_amount, na.rm = TRUE) / 1e9,
mean_m = mean(df$dw_loan_amount, na.rm = TRUE) / 1e6,
median_m = median(df$dw_loan_amount, na.rm = TRUE) / 1e6,
avg_rate = mean(df$dw_interest_rate, na.rm = TRUE),
avg_term = mean(df$dw_term, na.rm = TRUE),
avg_effmat = mean(df$dw_effective_maturity_days, na.rm = TRUE),
loan_coll = mean(safe_div(df$dw_loan_amount, df$dw_total_collateral) * 100, na.rm = TRUE)
)
}
metrics <- c("Banks (N)", "Loans (N)", "Total ($B)", "Mean ($M)", "Median ($M)", "Avg. Rate (%)", "Avg. Term (Days)", "Avg. Eff. Maturity (Days)", "Loan/Collateral (%)")
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(Metric = metrics, Period = col, Value = c(fmt_int(r$banks), fmt_int(r$loans), fmt_num(r$total_b), fmt_num(r$mean_m), fmt_num(r$median_m), fmt_num(r$avg_rate), fmt_num(r$avg_term), fmt_num(r$avg_effmat), fmt_num(r$loan_coll)))
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
select(Metric, all_of(col_names))
}
# ==============================================================================
# 5. PANEL C: BTFP
# ==============================================================================
build_btfp_panel <- function() {
rows <- list()
for (col in col_names) {
if (col == "Pre-BTFP") {
rows[[col]] <- list(banks = NA, loans = NA, total_b = NA, mean_m = NA, median_m = NA, avg_rate = NA, avg_term = NA, avg_effmat = NA, loan_coll = NA)
next
}
s <- periods[[col]]$start
e <- periods[[col]]$end
df <- btfp_loans %>% filter(btfp_loan_date >= s, btfp_loan_date <= e)
if (nrow(df) == 0) {
rows[[col]] <- list(banks = 0, loans = 0, total_b = 0, mean_m = NA, median_m = NA, avg_rate = NA, avg_term = NA, avg_effmat = NA, loan_coll = NA)
next
}
rows[[col]] <- list(
banks = n_distinct(df$rssd_id),
loans = nrow(df),
total_b = sum(df$btfp_loan_amount, na.rm = TRUE) / 1e9,
mean_m = mean(df$btfp_loan_amount, na.rm = TRUE) / 1e6,
median_m = median(df$btfp_loan_amount, na.rm = TRUE) / 1e6,
avg_rate = mean(df$btfp_interest_rate, na.rm = TRUE),
avg_term = mean(df$btfp_term, na.rm = TRUE),
avg_effmat = mean(df$btfp_effective_maturity_days, na.rm = TRUE),
loan_coll = mean(safe_div(df$btfp_loan_amount, df$btfp_total_collateral) * 100, na.rm = TRUE)
)
}
metrics <- c("Banks (N)", "Loans (N)", "Total ($B)", "Mean ($M)", "Median ($M)", "Avg. Rate (%)", "Avg. Term (Days)", "Avg. Eff. Maturity (Days)", "Loan/Collateral (%)")
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(Metric = metrics, Period = col, Value = c(fmt_int(r$banks), fmt_int(r$loans), fmt_num(r$total_b), fmt_num(r$mean_m), fmt_num(r$median_m), fmt_num(r$avg_rate), fmt_num(r$avg_term), fmt_num(r$avg_effmat), fmt_num(r$loan_coll)))
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
mutate(`Pre-BTFP` = "N/A") %>%
select(Metric, all_of(col_names))
}
# ==============================================================================
# 6. PANEL D: FHLB
# ==============================================================================
build_fhlb_panel <- function() {
rows <- list()
for (col in col_names) {
qtrs <- fhlb_period_quarters[[col]]
df_q <- call_q %>% filter(period %in% qtrs, !idrssd %in% excluded_banks, !is.na(fhlb_adv))
if (nrow(df_q) == 0) {
rows[[col]] <- list(banks_any = NA, banks_abn = NA, total_b = NA, mean_m = NA, median_m = NA, wa_term = NA)
next
}
df_bank <- df_q %>%
group_by(idrssd) %>%
summarise(
fhlb_adv = sum(fhlb_adv, na.rm = TRUE),
fhlb_less_than_1yr = sum(fhlb_less_than_1yr, na.rm = TRUE),
fhlb_1to3yr = sum(fhlb_1to3yr, na.rm = TRUE),
fhlb_3to5yr = sum(fhlb_3to5yr, na.rm = TRUE),
fhlb_more_than_5yr = sum(fhlb_more_than_5yr, na.rm = TRUE),
abnormal_fhlb = max(abnormal_fhlb_borrowing_10pct, na.rm = TRUE),
.groups = "drop"
)
df_bor <- df_bank %>% filter(fhlb_adv > 0)
total_adv <- sum(df_bor$fhlb_adv, na.rm = TRUE)
wa_term <- if (total_adv > 0) {
sum(replace_na(df_bor$fhlb_less_than_1yr, 0) * 0.5 + replace_na(df_bor$fhlb_1to3yr, 0) * 2.0 + replace_na(df_bor$fhlb_3to5yr, 0) * 4.0 + replace_na(df_bor$fhlb_more_than_5yr, 0) * 7.0, na.rm = TRUE) / total_adv
} else { NA_real_ }
rows[[col]] <- list(banks_any = nrow(df_bor), banks_abn = sum(df_bank$abnormal_fhlb == 1, na.rm = TRUE), total_b = total_adv / 1e6, mean_m = mean(df_bor$fhlb_adv, na.rm = TRUE) / 1e3, median_m = median(df_bor$fhlb_adv, na.rm = TRUE) / 1e3, wa_term = wa_term)
}
metrics <- c("Banks with Advances (N)", "Abnormal Borrowers (N)", "Total ($B)", "Mean ($M)", "Median ($M)", "Wtd. Avg. Term (Years)")
map_dfr(col_names, function(col) {
r <- rows[[col]]
tibble(Metric = metrics, Period = col, Value = c(fmt_int(r$banks_any), fmt_int(r$banks_abn), fmt_num(r$total_b), fmt_num(r$mean_m), fmt_num(r$median_m), fmt_num(r$wa_term)))
}) %>%
pivot_wider(names_from = Period, values_from = Value) %>%
select(Metric, all_of(col_names))
}
# ==============================================================================
# 7. BUILD ALL FOUR PANELS
# ==============================================================================
panel_all <- build_all_fed_panel()
panel_dw <- build_dw_panel()
panel_b <- build_btfp_panel()
panel_c <- build_fhlb_panel()
# ==============================================================================
# 8. HTML DISPLAY
# ==============================================================================
html_col_names <- c(
"Metric",
"Pre-BTFP<br><small>(Mar 1–12)</small>",
"Acute<br><small>(Mar 8–15)</small>",
"Post-Acute<br><small>(Mar 16–May 4)</small>",
"Arbitrage<br><small>(Nov 15–Jan 24)</small>",
"Entire BTFP<br><small>(Mar 13 '23 – Mar 11 '24)</small>"
)
display_panel <- function(df, panel_title) {
kable(
df, format = "html", escape = FALSE,
caption = panel_title,
col.names = html_col_names,
align = c("l", rep("r", 5))
) %>%
kable_styling(
bootstrap_options = c("striped", "condensed", "hover"),
full_width = FALSE, font_size = 12
) %>%
row_spec(0, bold = TRUE)
}
display_panel(panel_all, "Panel A: All Fed Borrowing (BTFP & DW)")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks (N) | 106 | 188 | 802 | 1,052 | 2,146 |
| Loans (N) | 296 | 369 | 2,776 | 4,135 | 14,764 |
| Total (\(B) </td> <td style="text-align:right;"> 19.56 </td> <td style="text-align:right;"> 144.57 </td> <td style="text-align:right;"> 525.12 </td> <td style="text-align:right;"> 234.34 </td> <td style="text-align:right;"> 1,079.38 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | 66.08 | 391.79 | 189.16 | 56.67 | 73.11 |
| Median ($M) | 10.00 | 10.50 | 10.00 | 10.80 | 9.00 |
display_panel(panel_dw, "Panel B: Discount Window Borrowing")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks (N) | 106 | 165 | 372 | 389 | 1,389 |
| Loans (N) | 296 | 336 | 1,506 | 1,037 | 8,069 |
| Total (\(B) </td> <td style="text-align:right;"> 19.56 </td> <td style="text-align:right;"> 138.32 </td> <td style="text-align:right;"> 399.88 </td> <td style="text-align:right;"> 14.90 </td> <td style="text-align:right;"> 669.02 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | 66.08 | 411.67 | 265.52 | 14.37 | 82.91 |
| Median ($M) | 10.00 | 10.00 | 9.00 | 3.50 | 5.50 |
| Avg. Rate (%) | 4.75 | 4.75 | 4.96 | 5.50 | 5.31 |
| Avg. Term (Days) | 4.72 | 5.72 | 4.11 | 5.47 | 5.23 |
| Avg. Eff. Maturity (Days) | 3.69 | 3.38 | 3.00 | 3.87 | 3.84 |
| Loan/Collateral (%) | 23.41 | 23.34 | 27.43 | 17.38 | 22.70 |
display_panel(panel_b, "Panel C: BTFP Borrowing")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks (N) | N/A | 27 | 515 | 780 | 1,316 |
| Loans (N) | N/A | 33 | 1,270 | 3,098 | 6,695 |
| Total (\(B) </td> <td style="text-align:right;"> N/A </td> <td style="text-align:right;"> 6.25 </td> <td style="text-align:right;"> 125.24 </td> <td style="text-align:right;"> 219.45 </td> <td style="text-align:right;"> 410.36 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | N/A | 189.35 | 98.61 | 70.84 | 61.29 |
| Median ($M) | N/A | 20.80 | 12.60 | 15.00 | 10.00 |
| Avg. Rate (%) | N/A | 4.55 | 4.71 | 4.95 | 5.02 |
| Avg. Term (Days) | N/A | 289.15 | 317.22 | 338.00 | 311.14 |
| Avg. Eff. Maturity (Days) | N/A | 144.70 | 157.89 | 88.10 | 104.47 |
| Loan/Collateral (%) | N/A | 65.16 | 51.06 | 50.45 | 45.13 |
display_panel(panel_c, "Panel D: FHLB Borrowing")| Metric |
Pre-BTFP (Mar 1–12) |
Acute (Mar 8–15) |
Post-Acute (Mar 16–May 4) |
Arbitrage (Nov 15–Jan 24) |
Entire BTFP (Mar 13 ’23 – Mar 11 ’24) |
|---|---|---|---|---|---|
| Banks with Advances (N) | 2,481 | 2,481 | 2,530 | 2,639 | 3,043 |
| Abnormal Borrowers (N) | 325 | 325 | 350 | 212 | 707 |
| Total (\(B) </td> <td style="text-align:right;"> 446.95 </td> <td style="text-align:right;"> 446.95 </td> <td style="text-align:right;"> 646.65 </td> <td style="text-align:right;"> 462.93 </td> <td style="text-align:right;"> 2,092.48 </td> </tr> <tr> <td style="text-align:left;"> Mean (\)M) | 180.15 | 180.15 | 255.59 | 175.42 | 687.64 |
| Median ($M) | 15.50 | 15.50 | 16.41 | 18.00 | 55.00 |
| Wtd. Avg. Term (Years) | 1.10 | 1.10 | 1.05 | 1.37 | 1.26 |
# ==============================================================================
# 9. LATEX SAVE
# ==============================================================================
build_latex_table <- function(p_all, p_dw, p_btfp, p_fhlb, filename) {
panel_to_rows <- function(df) {
apply(df, 1, function(r) {
paste0("\\quad ", r["Metric"], " & ", r["Pre-BTFP"], " & ", r["Acute"], " & ", r["Post-Acute"], " & ", r["Arbitrage"], " & ", r["Entire BTFP"], " \\\\\n")
})
}
rows_all <- panel_to_rows(p_all)
rows_dw <- panel_to_rows(p_dw)
rows_btfp <- panel_to_rows(p_btfp)
rows_fhlb <- panel_to_rows(p_fhlb)
latex_out <- paste0(
"% =================================================================\n",
"% Table: Emergency Lending Facility Activity by Crisis Period\n",
"% Preamble: \\usepackage{booktabs,threeparttable,multirow}\n",
"% =================================================================\n",
"\\begin{table}[htbp]\n",
"\\centering\n",
"\\caption{Emergency Lending Facility Activity by Crisis Period}\n",
"\\label{tab:borrowing_activity}\n",
"\\small\n",
"\\begin{threeparttable}\n",
"\\begin{tabular}{l rrrrr}\n",
"\\toprule\n",
" & Pre-BTFP & \\multicolumn{2}{c}{Crisis Period} & Arbitrage & Entire BTFP \\\\\n",
"\\cmidrule(lr){3-4}\n",
" & (Mar 1--12) & Acute & Post-Acute & (Nov 15--Jan 24) & (Mar 13, `23--Mar 11, `24) \\\\\n",
" & & (Mar 8--15) & (Mar 16--May 4) & & \\\\\n",
"\\midrule\n",
"\\multicolumn{6}{l}{\\textbf{Panel A: All Fed Borrowing (BTFP + DW)}} \\\\\n",
paste(rows_all, collapse = ""),
"\\midrule\n",
"\\multicolumn{6}{l}{\\textbf{Panel B: Discount Window}} \\\\\n",
paste(rows_dw, collapse = ""),
"\\midrule\n",
"\\multicolumn{6}{l}{\\textbf{Panel C: Bank Term Funding Program (BTFP)}} \\\\\n",
paste(rows_btfp, collapse = ""),
"\\midrule\n",
"\\multicolumn{6}{l}{\\textbf{Panel D: Federal Home Loan Bank (FHLB)}} \\\\\n",
paste(rows_fhlb, collapse = ""),
"\\bottomrule\n",
"\\end{tabular}\n",
"\\begin{tablenotes}[flushleft]\n",
"\\footnotesize\n",
"\\item \\textit{Notes:} Sample excludes failed banks and G-SIBs. All dollar amounts in billions (\\$B) or millions (\\$M). ",
"\\textbf{Panel A --- All Fed Borrowing:} Aggregates DW and BTFP originations. ",
"\\textbf{Panel B --- Discount Window:} Loan-level data available through December 31, 2023; Arbitrage and Entire BTFP columns show \\texttt{---} (data unavailable). ",
"\\textbf{Panel C --- BTFP:} BTFP launched March 13, 2023; Pre-BTFP column shows N/A. ",
"\\textbf{Panel D --- FHLB:} Computed from quarterly Call Report snapshots. Pre-BTFP and Acute use 2022Q4; Post-Acute uses 2023Q1; Arbitrage uses 2023Q3. ",
"Entire BTFP aggregates four quarters (2023Q1--2023Q4). Abnormal Borrowers = banks whose quarter-over-quarter change in FHLB advances exceeds a bank-specific Z-score of 1.28.",
"\\end{tablenotes}\n",
"\\end{threeparttable}\n",
"\\end{table}\n"
)
safe_writeLines(latex_out, file.path(TABLE_PATH, paste0(filename, ".tex")))
message("Saved: ", filename, ".tex")
invisible(latex_out)
}
build_latex_table(panel_all, panel_dw, panel_b, panel_c, "Table_Borrowing_Activity_ByPeriod")
# ==============================================================================
# 10. VERIFICATION
# ==============================================================================
cat("\n=== BORROWING ACTIVITY TABLE COMPLETE ===\n")##
## === BORROWING ACTIVITY TABLE COMPLETE ===cat("Panel A (All Fed):", nrow(panel_all), "metrics x", ncol(panel_all) - 1, "periods\n")## Panel A (All Fed): 5 metrics x 5 periodscat("Panel B (DW): ", nrow(panel_dw), "metrics x", ncol(panel_dw) - 1, "periods\n")## Panel B (DW): 9 metrics x 5 periodscat("Panel C (BTFP): ", nrow(panel_b), "metrics x", ncol(panel_b) - 1, "periods\n")## Panel C (BTFP): 9 metrics x 5 periodscat("Panel D (FHLB): ", nrow(panel_c), "metrics x", ncol(panel_c) - 1, "periods\n")## Panel D (FHLB): 6 metrics x 5 periods# ==============================================================================
# 1. VARIABLE LIST AND LABELS
# ==============================================================================
mean_vars <- c(
"total_asset_b", # Total Assets ($B) — computed inline below
"cash_ratio_raw",
"securities_ratio_raw",
"loan_ratio_raw",
"mtm_total_raw",
"mtm_btfp_raw",
"mtm_other_raw",
"book_equity_ratio_raw",
"insured_lev_raw", # r_insured_deposit
"uninsured_lev_raw",
"uninsured_share_raw",
"wholesale_raw",
"fhlb_ratio_raw",
"roa_raw",
"adjusted_equity_raw"
)
mean_labels_tex <- c(
"Total Assets (\\$B)",
"Cash Ratio",
"Securities Ratio",
"Loans Ratio",
"Total MTM Loss Ratio",
"OMO MTM Loss Ratio",
"Non-OMO MTM Loss Ratio",
"Book Equity Ratio",
"Insured Dep. Leverage",
"Uninsured Dep.Leverage",
"Uninsured / Total Dep.",
"Wholesale Funding Ratio",
"FHLB Advances Ratio",
"ROA ",
"Adjusted Equity "
)
# ==============================================================================
# 2. HELPERS
# ==============================================================================
fmt_mean <- function(x, digits = 3) {
if (is.na(x) | is.nan(x) | is.infinite(x)) return("---")
sprintf(paste0("%.", digits, "f"), x)
}
fmt_int_cell <- function(x) {
if (is.na(x)) return("---")
formatC(as.integer(x), format = "d", big.mark = ",")
}
# "mean [t-stat]***" cell — tests x_g vs x_ref (Welch)
mean_ttest_cell <- function(x_g, x_ref) {
x_g <- x_g[!is.na(x_g)]
x_ref <- x_ref[!is.na(x_ref)]
m_g <- mean(x_g, na.rm = TRUE)
if (length(x_g) < 2 | length(x_ref) < 2) return(fmt_mean(m_g))
tt <- tryCatch(t.test(x_g, x_ref), error = function(e) NULL)
if (is.null(tt)) return(fmt_mean(m_g))
stars <- case_when(
tt$p.value < 0.01 ~ "$^{***}$",
tt$p.value < 0.05 ~ "$^{**}$",
tt$p.value < 0.10 ~ "$^{*}$",
TRUE ~ ""
)
paste0(fmt_mean(m_g), " [", sprintf("%.2f", tt$statistic), "]", stars)
}
# Helper to format base display variables
add_display_vars <- function(df) {
df %>%
mutate(
total_asset_b = total_asset / 1e6,
insured_lev_raw = if ("insured_lev_raw" %in% names(.)) insured_lev_raw else r_insured_deposit
)
}
# ==============================================================================
# 3. REBUILD SUB-PERIODS & PREPARE DATASETS
# ==============================================================================
# Rebuild Acute (Mar 8 - Mar 15) and Post-Acute (Mar 16 - May 4) on the fly
btfp_acute <- create_borrower_indicator(btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount", as.Date("2023-03-08"), as.Date("2023-03-15"), "btfp_acute")
dw_acute <- create_borrower_indicator(dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount", as.Date("2023-03-08"), as.Date("2023-03-15"), "dw_acute")
df_acute <- join_all_borrowers(df_2022q4, btfp_acute, dw_acute, "btfp_acute", "dw_acute")
btfp_post <- create_borrower_indicator(btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount", as.Date("2023-03-16"), as.Date("2023-05-04"), "btfp_post")
dw_post <- create_borrower_indicator(dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount", as.Date("2023-03-16"), as.Date("2023-05-04"), "dw_post")
df_post <- join_all_borrowers(df_2022q4, btfp_post, dw_post, "btfp_post", "dw_post")
# Add display variables
df_crisis_d <- add_display_vars(df_crisis)
df_acute_d <- add_display_vars(df_acute)
df_post_d <- add_display_vars(df_post)
# Extract the 4 specific population groups for Table 1
df_all_crisis <- df_crisis_d %>% filter(any_fed == 1)
df_all_acute <- df_acute_d %>% filter(any_fed == 1)
df_all_post <- df_post_d %>% filter(any_fed == 1)
df_pure_non <- df_crisis_d %>% filter(non_user == 1) # The Reference Group
# ==============================================================================
# 4. TABLE 1: CRISIS PERIOD (All Borrowers vs Pure Non-Borrowers)
# 4 columns: Crisis All | Acute All | Post-Acute All | Pure Non-Borrower
# ==============================================================================
build_table1 <- function() {
# N row (Total Borrowers/Non-Borrowers)
n_row <- tibble(
Variable = "\\textit{N (Banks)}",
`Crisis` = fmt_int_cell(nrow(df_all_crisis)),
`Acute` = fmt_int_cell(nrow(df_all_acute)),
`Post` = fmt_int_cell(nrow(df_all_post)),
`NonB` = fmt_int_cell(nrow(df_pure_non))
)
# Breakdown Sub-rows for Borrower Types
n_btfp <- tibble(
Variable = "\\quad \\textit{BTFP Only}",
`Crisis` = fmt_int_cell(sum(df_all_crisis$user_group == "BTFP_Only", na.rm=T)),
`Acute` = fmt_int_cell(sum(df_all_acute$user_group == "BTFP_Only", na.rm=T)),
`Post` = fmt_int_cell(sum(df_all_post$user_group == "BTFP_Only", na.rm=T)),
`NonB` = "---"
)
n_dw <- tibble(
Variable = "\\quad \\textit{DW Only}",
`Crisis` = fmt_int_cell(sum(df_all_crisis$user_group == "DW_Only", na.rm=T)),
`Acute` = fmt_int_cell(sum(df_all_acute$user_group == "DW_Only", na.rm=T)),
`Post` = fmt_int_cell(sum(df_all_post$user_group == "DW_Only", na.rm=T)),
`NonB` = "---"
)
n_both <- tibble(
Variable = "\\quad \\textit{Both BTFP \\& DW}",
`Crisis` = fmt_int_cell(sum(df_all_crisis$user_group == "Both", na.rm=T)),
`Acute` = fmt_int_cell(sum(df_all_acute$user_group == "Both", na.rm=T)),
`Post` = fmt_int_cell(sum(df_all_post$user_group == "Both", na.rm=T)),
`NonB` = "---"
)
# N Insolvent Row
insol_row <- tibble(
Variable = "\\textit{N adj.\\ equity $<$ 0}",
`Crisis` = fmt_int_cell(sum(df_all_crisis$mtm_insolvent == 1, na.rm=T)),
`Acute` = fmt_int_cell(sum(df_all_acute$mtm_insolvent == 1, na.rm=T)),
`Post` = fmt_int_cell(sum(df_all_post$mtm_insolvent == 1, na.rm=T)),
`NonB` = fmt_int_cell(sum(df_pure_non$mtm_insolvent == 1, na.rm=T))
)
# Variable Rows (Means + t-tests against Pure Non-Borrower)
var_rows <- map2_dfr(mean_vars, mean_labels_tex, function(v, lbl) {
r_ref <- df_pure_non[[v]]
tibble(
Variable = lbl,
`Crisis` = mean_ttest_cell(df_all_crisis[[v]], r_ref),
`Acute` = mean_ttest_cell(df_all_acute[[v]], r_ref),
`Post` = mean_ttest_cell(df_all_post[[v]], r_ref),
`NonB` = fmt_mean(mean(r_ref, na.rm = TRUE))
)
})
bind_rows(n_row, n_btfp, n_dw, n_both, insol_row, var_rows)
}
tab1_output <- build_table1()
# ==============================================================================
# 5. PRINT FULL TABLE TO CONSOLE
# ==============================================================================
cat("=== TABLE 1: MEAN CHARACTERISTICS (CRISIS PERIOD) ===\n")## === TABLE 1: MEAN CHARACTERISTICS (CRISIS PERIOD) ===print(tab1_output, n = Inf)## # A tibble: 20 × 5
## Variable Crisis Acute Post NonB
## <chr> <chr> <chr> <chr> <chr>
## 1 "\\textit{N (Banks)}" 828 177 760 3,226
## 2 "\\quad \\textit{BTFP Only}" 395 23 408 ---
## 3 "\\quad \\textit{DW Only}" 327 151 270 ---
## 4 "\\quad \\textit{Both BTFP \\& DW}" 106 3 82 ---
## 5 "\\textit{N adj.\\ equity $<$ 0}" 205 38 193 587
## 6 "Total Assets (\\$B)" 5.843 [3.44]$^{***}$ 10.35… 4.83… 1.848
## 7 "Cash Ratio" 5.256 [-14.93]$^{***}$ 4.893… 5.08… 9.138
## 8 "Securities Ratio" 26.472 [1.03] 25.44… 26.8… 25.8…
## 9 "Loans Ratio" 62.470 [6.25]$^{***}$ 63.50… 62.3… 58.6…
## 10 "Total MTM Loss Ratio" 5.951 [7.85]$^{***}$ 5.701… 6.00… 5.326
## 11 "OMO MTM Loss Ratio" 0.824 [4.69]$^{***}$ 0.847… 0.83… 0.657
## 12 "Non-OMO MTM Loss Ratio" 4.975 [6.76]$^{***}$ 4.844… 5.01… 4.473
## 13 "Book Equity Ratio" 8.540 [-10.32]$^{***}$ 8.655… 8.49… 10.6…
## 14 "Insured Dep. Leverage" 58.687 [-7.44]$^{***}$ 54.60… 58.7… 62.5…
## 15 "Uninsured Dep.Leverage" 27.149 [9.42]$^{***}$ 30.61… 26.9… 22.7…
## 16 "Uninsured / Total Dep." 31.809 [9.55]$^{***}$ 36.42… 31.6… 26.5…
## 17 "Wholesale Funding Ratio" 1.530 [4.93]$^{***}$ 1.727… 1.61… 0.876
## 18 "FHLB Advances Ratio" 3.624 [7.20]$^{***}$ 4.015… 3.67… 2.344
## 19 "ROA " 1.092 [-1.80]$^{*}$ 1.119… 1.08… 1.193
## 20 "Adjusted Equity " 2.590 [-11.23]$^{***}$ 2.954… 2.48… 5.241# ==============================================================================
# 6. SAVE TO LATEX
# ==============================================================================
# We use escape = FALSE so the t-test stars and italics render correctly
latex_file <- file.path(TABLE_PATH, "Table_Mean_Characteristics_Crisis.tex")
latex_content <- kable(
tab1_output,
format = "latex",
escape = FALSE,
booktabs = TRUE,
col.names = c("Variable", "Crisis All", "Acute All", "Post-Acute All", "Pure Non-Borrower"),
caption = "Mean Characteristics of Borrowers vs. Non-Borrowers (Crisis Period)",
label = "tab:mean_chars_crisis",
align = c("l", "c", "c", "c", "c")
) %>%
row_spec(1:4, background = "gray!10") %>% # Optional: light shade for N counts
footnote(
general = "Characteristics measured at the 2022Q4 baseline. Continuous variables are winsorized at the 2.5 and 97.5 percentiles. Welch's t-tests compare the mean of each respective borrower group against the shared Pure Non-Borrower reference group. Brackets contain t-statistics. Statistical significance: * p < 0.10, ** p < 0.05, *** p < 0.01.",
threeparttable = TRUE,
escape = FALSE
)
safe_writeLines(as.character(latex_content), latex_file)