Bank Term Funding Program and Discount Window Borrowing
Par Valuation, Selection, and Partial Utilization During the 2023 Banking Crisis
Mohua Ferdousi
December 29, 2025
1 Summary
This analysis examines bank borrowing behavior across Federal Reserve emergency facilities (BTFP and Discount Window) during the March 2023 banking crisis. We exploit the institutional differences between facilities – particularly BTFP’s par valuation of eligible collateral – to test whether banks strategically selected facilities based on balance sheet vulnerabilities.
1.1 Research Questions
- Extensive Margin: Did BTFP’s par valuation generate systematic selection, with banks sorting into facilities based on MTM losses?
- Temporal Dynamics: Did borrowing determinants differ across crisis phases (acute crisis vs. post-acute vs. arbitrage)?
- Intensive Margin: Conditional on borrowing, did banks with larger MTM losses borrow more?
- Collateral Constraints: Did banks “max out” BTFP-eligible collateral and turn to DW for additional needs?
1.2 Empirical Strategy Overview
| Step | Analysis | Question Answered |
|---|---|---|
| 1 | Extensive margin (full period) | Did MTM losses drive BTFP selection? |
| 2 | Temporal analysis | Did determinants differ across phases? |
| 3 | Intensive margin | Did distressed banks borrow more? |
| 4 | “Both” banks | Did collateral constraints bind? |
2 Variable Definitions
3 Variable Definitions
3.1 Dependent Variables
| Variable | Definition | Formula |
|---|---|---|
| BTFP_i | Binary: Bank i borrowed from BTFP | 1[Bank i borrowed from BTFP] |
| DW_i | Binary: Bank i borrowed from DW | 1[Bank i borrowed from DW] |
| BTFPAmount_i | BTFP borrowing scaled by assets | BTFP Borrowing_i / Assets_i |
| BTFP_Acute_i | First BTFP borrow <= May 1, 2023 | 1[First BTFP date <= May 1] |
| BTFP_PostAcute_i | First BTFP borrow in (May 1, Oct 31] | 1[First BTFP date in (May 1, Oct 31]] |
| BTFP_Arb_i | First BTFP borrow in (Nov 1, Jan 24] | 1[First BTFP date in (Nov 1, Jan 24]] |
3.2 Key Explanatory Variables
| Variable | Definition | Formula |
|---|---|---|
| MTM_BTFP_i | MTM loss on BTFP-eligible securities / Assets | MTM Loss on OMO-Eligible_i / Total Assets_i |
| MTM_Other_i | MTM loss on non-eligible assets / Assets | MTM Loss on Non-OMO_i / Total Assets_i |
| UninsuredLev_i | Uninsured deposits / Assets | Uninsured Deposits_i / Total Assets_i |
| EligibleCollateral_i | BTFP-eligible securities / Assets | OMO-Eligible Securities_i / Total Assets_i |
| BorrowingSubsidy_i | MTM loss rate on eligible collateral | MTM Loss on OMO-Eligible_i / OMO-Eligible_i |
3.3 Run Risk Measures
| Variable | Definition | Formula |
|---|---|---|
| RunRisk1_i | Continuous: Uninsured x MTM | %Uninsured_i x %MTM Loss_i |
| RunRisk2_i | Continuous: Runable x MTM | %Runable_i x %MTM Loss_i |
| RunRisk1Dummy_i | Binary: Both above median | 1[%Uninsured > p50 AND %MTM > p50] |
| RunRisk2Dummy_i | Binary: Both above median | 1[%Runable > p50 AND %MTM > p50] |
3.4 Jiang et al. Insolvency Measures
3.4.1 Insured Deposit Coverage Ratio (IDCR)
IDCR_i(s) = (MV_Assets_i - s x UninsuredDeposits_i - InsuredDeposits_i) / InsuredDeposits_i
where s in {0.5, 1.0} represents the fraction of uninsured deposits that run.
| Variable | Run Scenario | Interpretation |
|---|---|---|
| IDCR_1 | s = 0.5 (50% run) | Coverage ratio under moderate run |
| IDCR_2 | s = 1.0 (100% run) | Coverage ratio under complete run |
Insolvency: Bank is insolvent if IDCR < 0
3.4.2 Capital Ratio Metric
Insolvency_i(s) = [(TotalAssets_i - TotalLiabilities_i) - s x UninsuredDeposits_i x MV_Adjustment_i] / TotalAssets_i
where: MV_Adjustment_i = (TotalAssets_i / MV_Assets_i) - 1
| Variable | Run Scenario | Interpretation |
|---|---|---|
| Insolvency_1 | s = 0.5 | Capital metric under 50% run |
| Insolvency_2 | s = 1.0 | Capital metric under 100% run |
3.4.3 Adjusted Equity (Jiang-Style)
AdjustedEquity_i = EquityRatio_i - MTMLoss_i
MTM_Insolvent_i = 1[AdjustedEquity_i < 0]
3.5 Control Variables
| Variable | Definition | Formula |
|---|---|---|
| ln_assets | Log of total assets | ln(Total Assets_i) |
| cash_ratio | Cash / Assets | Cash_i / Total Assets_i |
| securities_ratio | Securities / Assets | Securities_i / Total Assets_i |
| roa | Return on assets | Net Income_i / Avg Assets_i |
| loan_to_deposit | Loans / Deposits | Total Loans_i / Total Deposits_i |
| book_equity_ratio | Book equity / Assets | Total Equity_i / Total Assets_i |
| pct_wholesale_liability | Wholesale funding / Liabilities | (Fed Funds + Repo + Other Borr)_i / Total Liabilities_i |
| pct_runable_liability | Runable liabilities / Liabilities | (Uninsured + Wholesale)_i / Total Liabilities_i |
| pct_liquidity_available | Liquid assets / Assets | (Cash + Rerepo + FF Sold)_i / Total Assets_i |
| fhlb_ratio | FHLB advances / Assets | FHLB Advances_i / Total Assets_i |
3.6 Facility Choice Variables
| Variable | Definition |
|---|---|
| btfp | Binary: Used BTFP during full program |
| dw | Binary: Used DW during full program (post-BTFP) |
| dw_pre_btfp | Binary: Used DW in pre-BTFP period (Jan 1 - Mar 12, 2023) |
| both | Binary: Used both BTFP and DW |
| btfp_only | Binary: Used BTFP but not DW |
| dw_only | Binary: Used DW but not BTFP |
| any_fed | Binary: Used either facility |
| facility | Categorical: None / BTFP Only / DW Only / Both |
3.7 Period-Specific Variables
| Variable | Period | Date Range |
|---|---|---|
| dw_pre | Pre-BTFP (DW only) | Mar 1 - 10, 2023 |
| btfp_acute / dw_acute | Acute Crisis | Mar 13 - May 1, 2023 |
| btfp_post / dw_post | Post-Acute | May 2 - Oct 31, 2023 |
| btfp_arb / dw_arb | Arbitrage | Nov 1, 2023 - Jan 24, 2024 |
| Wind_down | BTFP closing period | Jan 25, 2024 - Mar 11, 2024 |
3.8 Intensive Margin Variables
| Variable | Definition | Formula |
|---|---|---|
| btfp_amount_pct | BTFP borrowing as % of assets | (BTFP Amount / Assets) x 100 |
| dw_amount_pct | DW borrowing as % of assets | (DW Amount / Assets) x 100 |
| total_borrowed_pct | Total Fed borrowing as % of assets | (BTFP + DW Amount) / Assets x 100 |
| btfp_share | BTFP share of total Fed borrowing | BTFP Amount / (BTFP + DW) x 100 |
| btfp_utilization | Collateral utilization rate | BTFP Amount / Collateral Capacity |
| maxed_out_btfp | Binary: Utilization > 90% | 1[btfp_utilization > 0.90] |
3.9 Step 1: Extensive Margin (Full Period)
\[BTFP_i = \alpha + \beta_1 \cdot MTM^{BTFP}_i + \beta_2 \cdot MTM^{Other}_i + \beta_3 \cdot UninsuredLev_i + \beta_4 \cdot (MTM^{BTFP}_i \times UninsuredLev_i) + \beta_5 \cdot EligibleCollateral_i + \gamma'Z_i + \varepsilon_i\]
Run separately for BTFP and DW as dependent variables.
3.10 Step 2: Temporal Analysis
For each period \(p \in \{Acute, PostAcute, Arbitrage\}\):
\[BTFP^p_i = \alpha + \beta^p_1 \cdot MTM^{BTFP}_i + \beta^p_2 \cdot MTM^{Other}_i + \beta^p_3 \cdot UninsuredLev_i + \gamma'Z_i + \varepsilon_i\]
3.11 Step 3: Intensive Margin
Among BTFP users:
\[\frac{BTFPAmount_i}{Assets_i} = \alpha + \beta_1 \cdot MTM^{BTFP}_i + \beta_2 \cdot MTM^{Other}_i + \beta_3 \cdot UninsuredLev_i + \gamma'Z_i + \varepsilon_i\]
3.12 Step 4: Both Banks and Collateral Constraints
\[DW_i = \alpha + \beta_1 \cdot MTM^{BTFP}_i + \beta_2 \cdot MTM^{Other}_i + \beta_3 \cdot EligibleCollateral_i + \gamma'Z_i + \varepsilon_i \quad | \quad BTFP_i = 1\]
# ============================================================================
# LOAD PACKAGES
# ============================================================================
library(tidyverse)
library(data.table)
library(lubridate)
library(fixest)
library(sandwich)
library(lmtest)
library(broom)
library(margins)
library(pROC)
library(sampleSelection)
library(modelsummary)
library(kableExtra)
library(patchwork)
library(scales)
library(viridis)
library(psych)
cat("All packages loaded successfully.\n")All packages loaded successfully.
# ============================================================================
# HELPER FUNCTIONS
# ============================================================================
# Winsorization function
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])
}
# Safe division
safe_div <- function(num, denom, default = NA_real_) {
ifelse(is.na(denom) | denom == 0, default, num / denom)
}
# Significance stars
add_stars <- function(pval) {
case_when(pval < 0.01 ~ "***", pval < 0.05 ~ "**", pval < 0.10 ~ "*", TRUE ~ "")
}
# Publication theme
theme_pub <- function(base_size = 12) {
theme_minimal(base_size = base_size) +
theme(
plot.title = element_text(face = "bold", size = base_size + 2),
plot.subtitle = element_text(color = "gray40"),
legend.position = "bottom",
panel.grid.minor = element_blank(),
axis.title = element_text(face = "bold")
)
}
# Color palettes
COLORS <- list(
btfp = "#2E86AB",
dw = "#A23B72",
both = "#F18F01",
neither = "gray70",
acute = "#FC9272",
post = "#A1D99B",
arb = "#9ECAE1",
winddown = "#DADAEB"
)
facility_colors <- c(
"BTFP" = "#2E86AB",
"DW" = "#A23B72",
"Discount Window" = "#A23B72",
"Both" = "#F18F01",
"Neither" = "gray70"
)# ============================================================================
# OUTPUT DIRECTORY SETUP
# ============================================================================
# Define output path
OUTPUT_PATH <- "C:/Users/mohua/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025/03_documentation/final_result"
# Create directory if it doesn't exist
if (!dir.exists(OUTPUT_PATH)) {
dir.create(OUTPUT_PATH, recursive = TRUE)
}
# Sub-directories for different output types
TABLE_PATH <- file.path(OUTPUT_PATH, "tables")
FIG_PATH <- file.path(OUTPUT_PATH, "figures")
if (!dir.exists(TABLE_PATH)) dir.create(TABLE_PATH)
if (!dir.exists(FIG_PATH)) dir.create(FIG_PATH)
cat("Output directories set up:\n")Output directories set up:
Tables: C:/Users/mohua/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025/03_documentation/final_result/tables
Figures: C:/Users/mohua/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025/03_documentation/final_result/figures
# ============================================================================
# CANONICAL PERIOD DEFINITIONS
# ============================================================================
# CRITICAL: These are the official period definitions used throughout
periods <- tribble(
~period_num, ~period_name, ~start_date, ~end_date, ~description,
0, "Pre-BTFP", "2023-03-01", "2023-03-10", "DW only available",
1, "Acute", "2023-03-13", "2023-05-01", "Peak crisis phase",
2, "Post-Acute", "2023-05-02", "2023-10-31", "Stabilization",
3, "Arbitrage", "2023-11-01", "2024-01-24", "BTFP rate < IORB",
4, "Wind-down", "2024-01-25", "2024-03-11", "BTFP closing announced"
) %>%
mutate(across(c(start_date, end_date), as.Date))
# Key dates for reference
BTFP_LAUNCH <- as.Date("2023-03-12")
BTFP_CLOSE <- as.Date("2024-03-11")
DW_DATA_END <- as.Date("2023-09-30")
ARB_WINDOW_OPEN <- as.Date("2023-11-01")
BASELINE_DATE <- "2022Q4"
# Key events
key_events <- tibble(
date = as.Date(c("2023-03-10", "2023-03-12", "2023-05-01", "2023-09-30",
"2023-11-01", "2024-01-24", "2024-03-11")),
event = c("SVB Fails", "BTFP Launch", "FRC Fails", "DW Data Ends",
"Arb Window Opens", "BTFP Rate Fixed", "BTFP Closes"),
event_short = c("SVB", "BTFP", "FRC", "DW End", "Arb", "Fixed", "Close")
)
# Display periods
periods %>%
kable(col.names = c("Period", "Name", "Start", "End", "Description"),
caption = "Table 0: Analysis Period Definitions") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Period | Name | Start | End | Description |
|---|---|---|---|---|
| 0 | Pre-BTFP | 2023-03-01 | 2023-03-10 | DW only available |
| 1 | Acute | 2023-03-13 | 2023-05-01 | Peak crisis phase |
| 2 | Post-Acute | 2023-05-02 | 2023-10-31 | Stabilization |
| 3 | Arbitrage | 2023-11-01 | 2024-01-24 | BTFP rate < IORB |
| 4 | Wind-down | 2024-01-25 | 2024-03-11 | BTFP closing announced |
# ============================================================================
# LOAD DATA
# ============================================================================
BASE_PATH <- "C:/Users/mohua/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025"
DATA_PROC <- file.path(BASE_PATH, "01_data/processed")
# Load datasets
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), "| BTFP Loans:", nrow(btfp_loans_raw), "| DW Loans:", nrow(dw_loans_raw), "\n")Call Report: 61002 | BTFP Loans: 6734 | DW Loans: 20219
# ============================================================================
# ASSIGN PERIODS TO LOANS - USING CANONICAL DEFINITIONS
# ============================================================================
assign_period <- function(date, periods_df) {
sapply(date, function(d) {
if (is.na(d)) return(NA_integer_)
match <- periods_df %>% filter(d >= start_date & d <= end_date) %>% pull(period_num)
if (length(match) == 0) NA_integer_ else match[1]
})
}
btfp_loans_raw <- btfp_loans_raw %>% mutate(period = assign_period(btfp_loan_date, periods))
dw_loans_raw <- dw_loans_raw %>% mutate(period = assign_period(dw_loan_date, periods))
# Period assignment verification
cat("\n=== PERIOD ASSIGNMENT VERIFICATION ===\n")=== PERIOD ASSIGNMENT VERIFICATION ===
BTFP loans by period:
1 2 3 4 1087 1972 3279 396
DW loans by period:
0 1 2 <NA> 299 1619 4237 14064
# ============================================================================
# DEFINE EXCLUDED BANKS (Failed + GSIBs)
# ============================================================================
# Identify failed banks and GSIBs at baseline
excluded_banks <- call_q %>%
filter(quarter == BASELINE_DATE, failed_bank == 1 | gsib == 1) %>%
pull(idrssd)
cat("=== EXCLUSIONS ===\n")=== EXCLUSIONS ===
Excluded banks (failed + G-SIBs): 41
# Create filtered loan datasets (excluding failed and GSIB)
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 exclusion:", nrow(btfp_loans), "\n")BTFP loans after exclusion: 6695
DW loans after exclusion: 20018
# ============================================================================
# AGGREGATE BORROWER-LEVEL DATA
# ============================================================================
# --- BTFP borrowers (post-announcement: period >= 1) ---
# For ALL banks
btfp_agg_all <- btfp_loans_raw %>%
filter(!is.na(period), period >= 1) %>%
group_by(rssd_id) %>%
summarise(
btfp = 1L,
btfp_amount = sum(btfp_loan_amount, na.rm = TRUE),
btfp_first_date = min(btfp_loan_date),
btfp_first_period = first(period[btfp_loan_date == min(btfp_loan_date)]),
btfp_n_loans = n(),
btfp_collateral = sum(btfp_total_collateral, na.rm = TRUE),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
# For EXCLUDED sample
btfp_agg <- btfp_loans %>%
filter(!is.na(period), period >= 1) %>%
group_by(rssd_id) %>%
summarise(
btfp = 1L,
btfp_amount = sum(btfp_loan_amount, na.rm = TRUE),
btfp_first_date = min(btfp_loan_date),
btfp_first_period = first(period[btfp_loan_date == min(btfp_loan_date)]),
btfp_n_loans = n(),
btfp_collateral = sum(btfp_total_collateral, na.rm = TRUE),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
# --- DW post-BTFP (period >= 1) ---
# For ALL banks
dw_post_agg_all <- dw_loans_raw %>%
filter(!is.na(period), period >= 1) %>%
group_by(rssd_id) %>%
summarise(
dw = 1L,
dw_amount = sum(dw_loan_amount, na.rm = TRUE),
dw_first_date = min(dw_loan_date),
dw_first_period = first(period[dw_loan_date == min(dw_loan_date)]),
dw_omo_coll = sum(dw_omo_eligible, na.rm = TRUE),
dw_non_omo_coll = sum(dw_non_omo_eligible, na.rm = TRUE),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
# For EXCLUDED sample
dw_post_agg <- dw_loans %>%
filter(!is.na(period), period >= 1) %>%
group_by(rssd_id) %>%
summarise(
dw = 1L,
dw_amount = sum(dw_loan_amount, na.rm = TRUE),
dw_first_date = min(dw_loan_date),
dw_first_period = first(period[dw_loan_date == min(dw_loan_date)]),
dw_omo_coll = sum(dw_omo_eligible, na.rm = TRUE),
dw_non_omo_coll = sum(dw_non_omo_eligible, na.rm = TRUE),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
# --- DW pre-BTFP (PLACEBO: period == 0) ---
# For ALL banks
dw_pre_agg_all <- dw_loans_raw %>%
filter(!is.na(period), period == 0) %>%
group_by(rssd_id) %>%
summarise(
dw_pre = 1L,
dw_pre_amount = sum(dw_loan_amount, na.rm = TRUE),
dw_pre_first_date = min(dw_loan_date),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
# For EXCLUDED sample
dw_pre_agg <- dw_loans %>%
filter(!is.na(period), period == 0) %>%
group_by(rssd_id) %>%
summarise(
dw_pre = 1L,
dw_pre_amount = sum(dw_loan_amount, na.rm = TRUE),
dw_pre_first_date = min(dw_loan_date),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
cat("\n=== AGGREGATED BORROWERS ===\n")=== AGGREGATED BORROWERS ===
cat("BTFP borrowers (excl):", nrow(btfp_agg), "| DW post (excl):", nrow(dw_post_agg),
"| DW pre-BTFP (excl):", nrow(dw_pre_agg), "\n")BTFP borrowers (excl): 1316 | DW post (excl): 1077 | DW pre-BTFP (excl): 106
cat("BTFP borrowers (all):", nrow(btfp_agg_all), "| DW post (all):", nrow(dw_post_agg_all),
"| DW pre-BTFP (all):", nrow(dw_pre_agg_all), "\n")BTFP borrowers (all): 1327 | DW post (all): 1092 | DW pre-BTFP (all): 109
# ============================================================================
# CONSTRUCT ANALYSIS DATASETS
# ============================================================================
# Helper function to create analysis dataframe
create_analysis_df <- function(baseline_data, btfp_agg, dw_post_agg, dw_pre_agg) {
df_raw <- baseline_data %>%
left_join(btfp_agg, by = "idrssd") %>%
left_join(dw_post_agg, by = "idrssd") %>%
left_join(dw_pre_agg, by = "idrssd") %>%
mutate(
# Fill NAs
btfp = replace_na(btfp, 0L),
dw = replace_na(dw, 0L),
dw_pre = replace_na(dw_pre, 0L),
# ================================================================
# DEPENDENT VARIABLES
# ================================================================
any_fed = as.integer(btfp == 1 | dw == 1),
both = as.integer(btfp == 1 & dw == 1),
btfp_only = as.integer(btfp == 1 & dw == 0),
dw_only = as.integer(btfp == 0 & dw == 1),
facility_choice = factor(
case_when(both == 1 ~ "Both", btfp_only == 1 ~ "BTFP_Only",
dw_only == 1 ~ "DW_Only", TRUE ~ "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
),
# Period-specific entry indicators
btfp_acute = as.integer(!is.na(btfp_first_period) & btfp_first_period == 1),
btfp_post = as.integer(!is.na(btfp_first_period) & btfp_first_period == 2),
btfp_arb = as.integer(!is.na(btfp_first_period) & btfp_first_period == 3),
btfp_winddown = as.integer(!is.na(btfp_first_period) & btfp_first_period == 4),
dw_acute = as.integer(!is.na(dw_first_period) & dw_first_period == 1),
dw_post = as.integer(!is.na(dw_first_period) & dw_first_period == 2),
dw_arb = as.integer(!is.na(dw_first_period) & dw_first_period == 3),
# ================================================================
# RAW KEY VARIABLES (before winsorization)
# ================================================================
mtm_btfp_raw = mtm_loss_omo_eligible_to_total_asset,
mtm_other_raw = mtm_loss_non_omo_eligible_to_total_asset,
mtm_total_raw = mtm_loss_to_total_asset,
borrowing_subsidy_raw = mtm_loss_omo_eligible_to_omo_eligible,
uninsured_lev_raw = uninsured_deposit_to_total_asset,
uninsured_share_raw = uninsured_to_deposit,
omo_ratio_raw = omo_eligible_to_total_asset,
non_omo_ratio_raw = non_omo_eligible_to_total_asset,
mv_asset = mm_asset,
# Jiang et al. insolvency measures
adjusted_equity_raw = book_equity_to_total_asset - mtm_loss_to_total_asset,
mv_adjustment_raw = if_else(mv_asset == 0 | is.na(mv_asset), NA_real_, (total_asset / mv_asset) - 1),
idcr_1_raw = safe_div(mv_asset - 0.5 * uninsured_deposit - insured_deposit, insured_deposit),
idcr_2_raw = safe_div(mv_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),
# 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,
loan_to_deposit_raw = loan_to_deposit,
fhlb_ratio_raw = fhlb_to_total_asset,
wholesale_raw = safe_div(
fed_fund_purchase + repo + replace_na(other_borrowed_less_than_1yr, 0),
total_liability, 0
) * 100,
# Intensive margin
btfp_pct_raw = ifelse(btfp == 1, 100 * btfp_amount / (total_asset * 1000), NA_real_),
dw_pct_raw = ifelse(dw == 1, 100 * dw_amount / (total_asset * 1000), NA_real_),
btfp_util_raw = ifelse(btfp == 1 & omo_eligible > 0,
btfp_amount / (omo_eligible * 1000), NA_real_),
# Clustering variables
size_cat = factor(size_bin, levels = c("small", "large")),
prior_dw = dw_pre,
# State for clustering
state = if("state" %in% names(.)) state else NA_character_,
fed_district = if("fed_district" %in% names(.)) fed_district else NA_character_
)
# ================================================================
# WINSORIZE ALL CONTINUOUS VARIABLES
# ================================================================
df <- df_raw %>%
mutate(
# Key explanatory
mtm_btfp = winsorize(mtm_btfp_raw),
mtm_other = winsorize(mtm_other_raw),
mtm_total = winsorize(mtm_total_raw),
borrowing_subsidy = winsorize(borrowing_subsidy_raw),
uninsured_lev = winsorize(uninsured_lev_raw),
uninsured_share = winsorize(uninsured_share_raw),
omo_ratio = winsorize(omo_ratio_raw),
non_omo_ratio = winsorize(non_omo_ratio_raw),
# Controls
ln_assets = winsorize(ln_assets_raw),
cash_ratio = winsorize(cash_ratio_raw),
securities_ratio = winsorize(securities_ratio_raw),
loan_ratio = winsorize(loan_ratio_raw),
book_equity_ratio = winsorize(book_equity_ratio_raw),
tier1_ratio = winsorize(tier1_ratio_raw),
roa = winsorize(roa_raw),
loan_to_deposit = winsorize(loan_to_deposit_raw),
fhlb_ratio = winsorize(fhlb_ratio_raw),
wholesale = winsorize(wholesale_raw),
# Jiang et al. measures
adjusted_equity = 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),
# Insolvency indicators
mtm_insolvent = as.integer(adjusted_equity < 0),
insolvent_idcr_s50 = as.integer(idcr_1 < 0),
insolvent_idcr_s100 = as.integer(idcr_2 < 0),
insolvent_cap_s50 = as.integer(insolvency_1 < 0),
insolvent_cap_s100 = as.integer(insolvency_2 < 0),
# Intensive margin
btfp_pct = winsorize(btfp_pct_raw),
dw_pct = winsorize(dw_pct_raw),
btfp_util = winsorize(btfp_util_raw),
# Derived variables
run_risk = uninsured_share * mtm_total,
high_uninsured = as.integer(uninsured_lev > median(uninsured_lev, na.rm = TRUE)),
high_mtm_btfp = as.integer(mtm_btfp > median(mtm_btfp, na.rm = TRUE)),
maxed_out = as.integer(!is.na(btfp_util) & btfp_util > 0.90),
# Log amount for intensive margin
log_btfp_amt = ifelse(btfp == 1 & btfp_amount > 0, log(btfp_amount), NA_real_),
# Total Fed borrowing percentage
total_fed_pct = ifelse(any_fed == 1,
100 * (replace_na(btfp_amount, 0) + replace_na(dw_amount, 0)) / (total_asset * 1000),
NA_real_)
)
# Calculate run risk dummy based on sample medians
df <- df %>%
mutate(
median_pct_uninsured = median(uninsured_share, na.rm = TRUE),
median_pct_mtm_loss = median(mtm_total, na.rm = TRUE),
run_risk_1_dummy = as.integer(uninsured_share > median_pct_uninsured & mtm_total > median_pct_mtm_loss)
)
# Remove raw variables
df <- df %>% select(-ends_with("_raw"))
return(df)
}
# --- Create baseline datasets ---
baseline_all <- call_q %>% filter(quarter == BASELINE_DATE)
baseline_excl <- call_q %>% filter(quarter == BASELINE_DATE, !idrssd %in% excluded_banks)
# --- Create analysis dataframes ---
# df_all = ALL banks (for some summary stats)
df_all <- create_analysis_df(baseline_all, btfp_agg_all, dw_post_agg_all, dw_pre_agg_all)
# df = EXCLUDING failed and GSIBs (for regression and main analysis)
df <- create_analysis_df(baseline_excl, btfp_agg, dw_post_agg, dw_pre_agg)
cat("\n=== ANALYSIS DATASETS CREATED ===\n")=== ANALYSIS DATASETS CREATED ===
df_all (all banks): 4737
df (excl. failed & GSIB): 4696
- BTFP users: 1305
- DW users: 1067
- Both: 425
- Pre-BTFP DW users: 105
# ============================================================================
# GLOBAL MODEL SETTINGS
# ============================================================================
# Standard controls
CONTROLS <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + wholesale + fhlb_ratio + roa"
# Cluster at bank level
CLUSTER_VAR <- "idrssd"
# Coefficient labels for modelsummary
COEF_MAP <- c(
"mtm_total" = "MTM Loss (Total)",
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"uninsured_lev" = "Uninsured Leverage",
"borrowing_subsidy" = "Borrowing Subsidy",
"run_risk" = "Run Risk (MTM × % Uninsured)",
"run_risk_1_dummy" = "Run Risk Dummy",
"I(mtm_btfp * uninsured_lev)" = "MTM(BTFP) × Uninsured",
"I(mtm_total * uninsured_lev)" = "MTM × Uninsured",
"adjusted_equity" = "Adjusted Equity",
"mtm_insolvent" = "MTM Insolvent",
"prior_dw" = "Prior DW User",
"omo_ratio" = "BTFP-Eligible Ratio",
"non_omo_ratio" = "DW-Only Eligible Ratio",
"maxed_out" = "Maxed Out (>90%)",
"high_uninsured" = "High Uninsured",
"high_mtm_btfp" = "High MTM-BTFP",
"I(mtm_btfp * prior_dw)" = "MTM(BTFP) × Prior DW",
"ln_assets" = "Log(Assets)",
"cash_ratio" = "Cash Ratio",
"securities_ratio" = "Securities Ratio",
"loan_to_deposit" = "Loan/Deposit",
"book_equity_ratio" = "Book Equity",
"wholesale" = "Wholesale Funding",
"fhlb_ratio" = "FHLB Ratio",
"roa" = "ROA"
)
cat("=== MODEL SETTINGS ===\n")=== MODEL SETTINGS ===
Clustering variable: idrssd
Controls: ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + wholesale + fhlb_ratio + roa
Regression sample size: 4696
4 1. Summary Statistics
4.1 1.1 Full Sample Summary Statistics
# ============================================================================
# TABLE 1: FULL SAMPLE SUMMARY STATISTICS
# ============================================================================
analysis_df <- df
summary_vars <- c(
"ln_assets",
"mtm_total", "mtm_btfp", "mtm_other", "borrowing_subsidy",
"uninsured_lev", "uninsured_share", "omo_ratio", "non_omo_ratio",
"cash_ratio", "securities_ratio", "loan_ratio", "book_equity_ratio",
"adjusted_equity", "loan_to_deposit", "wholesale", "fhlb_ratio", "roa",
"run_risk", "run_risk_1_dummy"
)
summary_labels <- c(
"Log(Total Assets)",
"MTM Loss / Assets (%)", "MTM Loss (BTFP-Eligible) / Assets (%)",
"MTM Loss (Non-BTFP) / Assets (%)", "Borrowing Subsidy (%)",
"Uninsured Deposits / Assets (%)", "Uninsured / Total Deposits (%)",
"BTFP-Eligible / Assets (%)", "Non-BTFP / Assets (%)",
"Cash / Assets (%)", "Securities / Assets (%)", "Loans / Assets (%)",
"Book Equity / Assets (%)", "Adjusted Equity (%)",
"Loans / Deposits", "Wholesale Funding / Liabilities (%)",
"FHLB / Assets (%)", "ROA (%)",
"Run Risk (Continuous)", "Run Risk Dummy"
)
# Function to compute summary stats
compute_summary <- function(data, vars) {
data %>%
select(any_of(vars)) %>%
pivot_longer(everything(), names_to = "variable", values_to = "value") %>%
group_by(variable) %>%
summarise(
N = sum(!is.na(value)),
Mean = mean(value, na.rm = TRUE),
SD = sd(value, na.rm = TRUE),
Min = min(value, na.rm = TRUE),
P25 = quantile(value, 0.25, na.rm = TRUE),
Median = median(value, na.rm = TRUE),
P75 = quantile(value, 0.75, na.rm = TRUE),
Max = max(value, na.rm = TRUE),
.groups = "drop"
)
}
# Summary for main sample (excluding failed/GSIB)
summary_excl <- compute_summary(df, summary_vars) %>%
mutate(variable = factor(variable, levels = summary_vars)) %>%
arrange(variable)
summary_excl$Label <- summary_labels
# Display table
table1 <- summary_excl %>%
select(Label, N, Mean, SD, Min, P25, Median, P75, Max) %>%
kable(
caption = "Table : Summary Statistics (Excluding Failed Banks & G-SIBs, 2022Q4 Baseline)",
digits = 3,
col.names = c("Variable", "N", "Mean", "SD", "Min", "P25", "Median", "P75", "Max")
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 11) %>%
pack_rows("Balance Sheet", 1, 1) %>%
pack_rows("MTM Loss Variables", 2, 5) %>%
pack_rows("Deposit Structure", 6, 7) %>%
pack_rows("Collateral Variables", 8, 9) %>%
pack_rows("Asset Composition", 10, 12) %>%
pack_rows("Capital & Funding", 13, 18) %>%
pack_rows("Run Risk Measures", 19, 20)
table1| Variable | N | Mean | SD | Min | P25 | Median | P75 | Max |
|---|---|---|---|---|---|---|---|---|
| Balance Sheet | ||||||||
| Log(Total Assets) | 4696 | 12.799 | 1.368 | 10.315 | 11.850 | 12.669 | 13.583 | 16.337 |
| MTM Loss Variables | ||||||||
| MTM Loss / Assets (%) | 4678 | 5.408 | 2.183 | 1.112 | 3.804 | 5.272 | 6.961 | 9.961 |
| MTM Loss (BTFP-Eligible) / Assets (%) | 4678 | 0.598 | 0.696 | 0.000 | 0.070 | 0.341 | 0.866 | 2.822 |
| MTM Loss (Non-BTFP) / Assets (%) | 4678 | 4.579 | 2.039 | 0.781 | 3.079 | 4.382 | 5.974 | 9.159 |
| Borrowing Subsidy (%) | 4282 | 6.876 | 4.724 | 0.000 | 3.205 | 6.537 | 9.849 | 18.801 |
| Deposit Structure | ||||||||
| Uninsured Deposits / Assets (%) | 4696 | 23.094 | 11.577 | 2.585 | 14.805 | 21.932 | 30.165 | 52.083 |
| Uninsured / Total Deposits (%) | 4696 | 27.234 | 13.632 | 4.445 | 17.478 | 25.607 | 34.981 | 62.834 |
| Collateral Variables | ||||||||
| BTFP-Eligible / Assets (%) | 4696 | 9.578 | 9.426 | 0.000 | 2.270 | 6.733 | 14.079 | 37.974 |
| Non-BTFP / Assets (%) | 4696 | 75.439 | 14.220 | 32.416 | 69.048 | 79.273 | 85.953 | 92.783 |
| Asset Composition | ||||||||
| Cash / Assets (%) | 4696 | 8.336 | 8.522 | 1.089 | 2.696 | 5.185 | 10.488 | 39.484 |
| Securities / Assets (%) | 4696 | 24.259 | 15.541 | 0.051 | 12.163 | 22.266 | 34.347 | 61.494 |
| Loans / Assets (%) | 4696 | 60.538 | 17.593 | 13.188 | 49.821 | 62.840 | 74.564 | 86.639 |
| Capital & Funding | ||||||||
| Book Equity / Assets (%) | 4696 | 9.933 | 4.683 | 3.392 | 7.236 | 9.003 | 11.182 | 28.060 |
| Adjusted Equity (%) | 4678 | 4.349 | 5.238 | -4.552 | 0.972 | 3.808 | 6.729 | 21.135 |
| Loans / Deposits | 4696 | 71.297 | 22.621 | 15.031 | 56.972 | 72.694 | 87.894 | 113.061 |
| Wholesale Funding / Liabilities (%) | 4696 | 0.785 | 1.790 | 0.000 | 0.000 | 0.000 | 0.437 | 7.927 |
| FHLB / Assets (%) | 4696 | 2.586 | 3.800 | 0.000 | 0.000 | 0.306 | 4.121 | 14.705 |
| ROA (%) | 4696 | 1.038 | 0.576 | -0.306 | 0.694 | 1.015 | 1.337 | 2.697 |
| Run Risk Measures | ||||||||
| Run Risk (Continuous) | 4678 | 142.299 | 84.437 | 4.945 | 79.133 | 129.233 | 189.949 | 625.865 |
| Run Risk Dummy | 4681 | 0.233 | 0.423 | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 |
4.2 1.2 Loan-Level Statistics by Period
# ============================================================================
# TABLE 3: BTFP BORROWING BY PERIOD
# ============================================================================
btfp_period_stats <- btfp_loans %>%
filter(!is.na(period), period >= 1) %>%
group_by(period) %>%
summarise(
N_Loans = n(),
N_Banks = n_distinct(rssd_id),
`Total ($B)` = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
`Mean ($M)` = mean(btfp_loan_amount, na.rm = TRUE) / 1e6,
`Median ($M)` = median(btfp_loan_amount, na.rm = TRUE) / 1e6,
`Avg Rate (%)` = mean(btfp_interest_rate, na.rm = TRUE),
`Avg Term (days)` = mean(btfp_term, na.rm = TRUE),
`Loan/Collateral` = mean(btfp_loan_amount / btfp_total_collateral, na.rm = TRUE),
.groups = "drop"
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
btfp_period_stats %>%
select(period_name, N_Loans, N_Banks, `Total ($B)`, `Mean ($M)`,
`Median ($M)`, `Avg Rate (%)`, `Avg Term (days)`, `Loan/Collateral`) %>%
kable(
caption = "**Table 3A: BTFP Borrowing Statistics by Period**",
digits = c(0, 0, 0, 2, 1, 1, 2, 0, 3),
col.names = c("Period", "Loans", "Banks", "Total ($B)", "Mean ($M)",
"Median ($M)", "Rate (%)", "Term (days)", "Loan/Coll.")
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Period | Loans | Banks | Total (\(B) </th> <th style="text-align:right;"> Mean (\)M) | Median ($M) | Rate (%) | Term (days) | Loan/Coll. | |
|---|---|---|---|---|---|---|---|---|
| Acute | 1071 | 485 | 121.13 | 113.1 | 14.0 | 4.69 | 313 | 0.526 |
| Post-Acute | 1961 | 811 | 51.30 | 26.2 | 5.0 | 5.20 | 274 | 0.348 |
| Arbitrage | 3272 | 797 | 224.81 | 68.7 | 15.0 | 4.97 | 335 | 0.496 |
| Wind-down | 391 | 237 | 13.11 | 33.5 | 7.5 | 5.40 | 295 | 0.392 |
# DW statistics by period
dw_period_stats <- dw_loans %>%
filter(!is.na(period)) %>%
group_by(period) %>%
summarise(
N_Loans = n(),
N_Banks = n_distinct(rssd_id),
`Total ($B)` = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
`Mean ($M)` = mean(dw_loan_amount, na.rm = TRUE) / 1e6,
`Median ($M)` = median(dw_loan_amount, na.rm = TRUE) / 1e6,
`Avg Rate (%)` = mean(dw_interest_rate, na.rm = TRUE),
`Avg Term (days)` = mean(dw_term, na.rm = TRUE),
`OMO Share (%)` = mean(dw_omo_eligible / dw_total_collateral, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
dw_period_stats %>%
select(period_name, N_Loans, N_Banks, `Total ($B)`, `Mean ($M)`,
`Median ($M)`, `Avg Rate (%)`, `Avg Term (days)`, `OMO Share (%)`) %>%
kable(
caption = "**Table 3B: Discount Window Borrowing Statistics by Period**",
digits = c(0, 0, 0, 2, 1, 1, 2, 0, 1),
col.names = c("Period", "Loans", "Banks", "Total ($B)", "Mean ($M)",
"Median ($M)", "Rate (%)", "Term (days)", "OMO (%)")
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Period | Loans | Banks | Total (\(B) </th> <th style="text-align:right;"> Mean (\)M) | Median ($M) | Rate (%) | Term (days) | OMO (%) | |
|---|---|---|---|---|---|---|---|---|
| Pre-BTFP | 296 | 106 | 19.56 | 66.1 | 10.0 | 4.75 | 5 | 32.6 |
| Acute | 1581 | 417 | 523.28 | 331.0 | 9.7 | 4.92 | 5 | 37.2 |
| Post-Acute | 4221 | 836 | 111.53 | 26.4 | 5.5 | 5.35 | 5 | 34.4 |
4.3 1.3 Bank Characteristics with T-Statistics
# ============================================================================
# TABLE 2: COMPARISON BY FACILITY CHOICE
# ============================================================================
comparison_vars <- c(
"ln_assets",
"mtm_total", "mtm_btfp", "mtm_other", "borrowing_subsidy",
"uninsured_lev", "uninsured_share", "omo_ratio", "non_omo_ratio",
"cash_ratio", "securities_ratio", "loan_ratio", "book_equity_ratio",
"adjusted_equity", "loan_to_deposit", "wholesale", "fhlb_ratio", "roa",
"run_risk", "run_risk_1_dummy"
)
comparison_labels <- c(
"Log(Total Assets)",
"MTM Loss / Assets (%)", "MTM Loss (BTFP-Eligible) / Assets (%)",
"MTM Loss (Non-BTFP) / Assets (%)", "Borrowing Subsidy (%)",
"Uninsured Deposits / Assets (%)", "Uninsured / Total Deposits (%)",
"BTFP-Eligible / Assets (%)", "Non-BTFP / Assets (%)",
"Cash / Assets (%)", "Securities / Assets (%)", "Loans / Assets (%)",
"Book Equity / Assets (%)", "Adjusted Equity (%)",
"Loans / Deposits", "Wholesale Funding / Liabilities (%)",
"FHLB / Assets (%)", "ROA (%)",
"Run Risk (Continuous)", "Run Risk Dummy"
)
# Compute means by group
# ============================================================================
# FIXED CODE
# ============================================================================
# 1. Define helper function for stars (Required for your code to work)
add_stars <- function(p) {
case_when(
p < 0.01 ~ "***",
p < 0.05 ~ "**",
p < 0.10 ~ "*",
TRUE ~ ""
)
}
# 2. Compute means by group
group_means <- analysis_df %>%
group_by(facility_choice) %>%
summarise(
N = n(),
across(all_of(comparison_vars), ~mean(., na.rm = TRUE)),
.groups = "drop"
)
# 3. Compute t-tests vs Neither
neither_data <- analysis_df %>% filter(facility_choice == "Neither")
ttest_results <- map_dfr(comparison_vars, function(v) {
results <- tibble(variable = v)
for (grp in c("BTFP_Only", "DW_Only", "Both")) {
# Extract data for the specific group
grp_data <- analysis_df %>% filter(facility_choice == grp) %>% pull(!!sym(v))
neither_vals <- neither_data %>% pull(!!sym(v))
# Check if enough observations exist for t-test
if (sum(!is.na(grp_data)) > 2 & sum(!is.na(neither_vals)) > 2) {
tt <- t.test(grp_data, neither_vals)
results[[paste0(grp, "_mean")]] <- mean(grp_data, na.rm = TRUE)
results[[paste0(grp, "_tstat")]] <- tt$statistic
results[[paste0(grp, "_pval")]] <- tt$p.value
} else {
results[[paste0(grp, "_mean")]] <- NA
results[[paste0(grp, "_tstat")]] <- NA
results[[paste0(grp, "_pval")]] <- 1
}
}
results
})
# 4. Format comparison table
comparison_table <- ttest_results %>%
mutate(
Variable = comparison_labels[match(variable, comparison_vars)],
# FIX: Use sprintf() here to force 'Neither' into Character format
Neither = sprintf("%.3f", group_means %>%
filter(facility_choice == "Neither") %>%
select(all_of(variable)) %>%
pull()),
BTFP_Only = sprintf("%.3f\n(%.2f%s)",
BTFP_Only_mean, BTFP_Only_tstat, add_stars(BTFP_Only_pval)),
DW_Only = sprintf("%.3f\n(%.2f%s)",
DW_Only_mean, DW_Only_tstat, add_stars(DW_Only_pval)),
Both = sprintf("%.3f\n(%.2f%s)",
Both_mean, Both_tstat, add_stars(Both_pval))
) %>%
select(Variable, Neither, BTFP_Only, DW_Only, Both)
# 5. Add N row (Ensure N is character to match table)
n_row <- tibble(
Variable = "Observations (N)",
Neither = as.character(group_means$N[group_means$facility_choice == "Neither"]),
BTFP_Only = as.character(group_means$N[group_means$facility_choice == "BTFP_Only"]),
DW_Only = as.character(group_means$N[group_means$facility_choice == "DW_Only"]),
Both = as.character(group_means$N[group_means$facility_choice == "Both"])
)
# 6. Bind Rows (Now both are Character types)
final_table <- bind_rows(n_row, comparison_table)
# 7. Generate Table
final_table %>%
kable(
caption = "**Table 2: Bank Characteristics by Facility Choice (2022Q4 Baseline)**",
col.names = c("Variable", "Neither", "BTFP Only", "DW Only", "Both"),
align = c("l", "c", "c", "c", "c"),
escape = FALSE
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
add_header_above(c(" " = 2, "Difference vs. Neither [Mean (T-stat)]" = 3)) %>%
footnote(
general = "T-statistics in parentheses test difference from Neither group. *** p<0.01, ** p<0.05, * p<0.10"
)| Variable | Neither | BTFP Only | DW Only | Both |
|---|---|---|---|---|
| Observations (N) | 2749 | 880 | 642 | 425 |
| Log(Total Assets) | 0.174 | 13.049 (14.37***) |
13.526
(19.60***
|
13.902
(21.84***
|
| MTM Loss / Assets (%) | 0.174 | 6.070 (11.88***) |
5.288
(1.62)
|
5.966
(8.03***)
|
| MTM Loss (BTFP-Eligible) / Assets (%) | 0.174 | 0.758 (8.13***) |
0.551
(0.92)
|
0.805
(7.08***)
|
| MTM Loss (Non-BTFP) / Assets (%) | 0.174 | 4.975 (8.09***) |
4.631
(2.86***)
|
4.963
(6.03***)
|
| Borrowing Subsidy (%) | 0.174 | 7.586 (7.32***) |
7.522
(5.91***)
|
8.294
(8.97***)
|
| Uninsured Deposits / Assets (%) | 0.174 | 24.366 (7.14***) |
25.343
(7.70***)
|
28.155
(11.72***
|
| Uninsured / Total Deposits (%) | 0.174 | 28.175 (5.64***) |
29.847
(7.26***)
|
33.102
(11.29***
|
| BTFP-Eligible / Assets (%) | 0.174 | 10.557 (2.81***) |
7.940
(-4.37***)
|
10.296
(1.61)
|
| Non-BTFP / Assets (%) | 0.174 | 77.959 (9.31***) |
78.371
(8.98***)
|
78.757
(8.77***
|
| Cash / Assets (%) | 0.174 | 5.696 (-16.47***) |
7.403
(-7.34***)
|
4.884
(-16.97***
|
| Securities / Assets (%) | 0.174 | 28.334 (8.38***) |
20.386
(-4.96***
|
25.858
(3.15***
|
| Loans / Assets (%) | 0.174 | 60.284 (2.13**) |
65.827
(9.53***)
|
63.173
(5.40***
|
| Book Equity / Assets (%) | 0.174 | 8.474 (-14.25***) |
9.783
(-4.82***)
|
8.620
(-11.65***
|
| Adjusted Equity (%) | 0.174 | 2.388 (-15.70***) |
4.463
(-3.54***)
|
2.660
(-11.74***
|
| Loans / Deposits | 0.174 | 70.245 (0.93) |
78.088
(9.05***)
|
74.795
(5.18***
|
| Wholesale Funding / Liabilities (%) | 0.174 | 0.975 (4.20***) |
0.734
(0.83)
|
1.207
(5.16***)
|
| FHLB / Assets (%) | 0.174 | 2.959 (4.94***) |
2.939
(4.25***)
|
3.630
(6.77***)
|
| ROA (%) | 0.174 | 1.011 (-0.61) |
1.126
(4.17***)
|
1.064
(1.56)
|
| Run Risk (Continuous) | 0.174 | 165.850 (13.21***) |
152.046
(7.60***
|
192.772
(14.51**
|
| Run Risk Dummy | 0.174 | 0.318 (8.35***) |
0.248
(3.99***)
|
0.412
(9.53***)
|
| Note: | ||||
| T-statistics in parentheses test difference from Neither group. *** p<0.01, ** p<0.05, * p<0.10 |
4.4 Table 3: Insolvency Distribution by Facility
# ============================================================================
# TABLE 3: INSOLVENCY MEASURES BY FACILITY CHOICE
# ============================================================================
insol_summary <- df %>%
group_by(facility_choice) %>%
summarise(
N = n(),
`MTM Insolvent (%)` = mean(mtm_insolvent, na.rm = TRUE) * 100,
`IDCR<0 (50% run)` = mean(insolvent_idcr_s50, na.rm = TRUE) * 100,
`IDCR<0 (100% run)` = mean(insolvent_idcr_s100, na.rm = TRUE) * 100,
`Adj. Equity (Mean)` = mean(adjusted_equity, na.rm = TRUE),
`IDCR_100 (Mean)` = mean(idcr_2, na.rm = TRUE),
.groups = "drop"
)
table3c <- insol_summary %>%
mutate(across(where(is.numeric), ~round(., 2))) %>%
kable(caption = "Table 3C: Insolvency Measures by Facility Choice (Excl. Failed & GSIBs)") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
footnote(general = "MTM Insolvent: Adjusted Equity < 0. IDCR: Insured Deposit Coverage Ratio (Jiang et al., 2023)")
table3c| facility_choice | N | MTM Insolvent (%) | IDCR<0 (50% run) | IDCR<0 (100% run) | Adj. Equity (Mean) | IDCR_100 (Mean) |
|---|---|---|---|---|---|---|
| Neither | 2749 | 15.12 | 4.13 | 25.74 | 5.22 | 0.10 |
| BTFP_Only | 880 | 29.43 | 4.09 | 32.05 | 2.39 | 0.06 |
| DW_Only | 642 | 14.17 | 5.76 | 30.22 | 4.46 | 0.09 |
| Both | 425 | 23.76 | 4.47 | 31.06 | 2.66 | 0.08 |
| Note: | ||||||
| MTM Insolvent: Adjusted Equity < 0. IDCR: Insured Deposit Coverage Ratio (Jiang et al., 2023) |
4.5 2.4 Correlation Matrices
# ============================================================================
# TABLE 4: CORRELATION MATRIX
# ============================================================================
corr_vars <- c("mtm_btfp", "mtm_other", "mtm_total", "uninsured_lev", "run_risk",
"omo_ratio", "non_omo_ratio", "adjusted_equity",
"ln_assets", "cash_ratio", "securities_ratio", "book_equity_ratio",
"loan_to_deposit", "wholesale", "roa")
corr_matrix <- df %>%
select(all_of(corr_vars)) %>%
cor(use = "pairwise.complete.obs")
table4 <- corr_matrix %>%
round(3) %>%
kable(caption = "Table 4: Correlation Matrix (Excl. Failed & GSIBs)") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE, font_size = 9)
table4| mtm_btfp | mtm_other | mtm_total | uninsured_lev | run_risk | omo_ratio | non_omo_ratio | adjusted_equity | ln_assets | cash_ratio | securities_ratio | book_equity_ratio | loan_to_deposit | wholesale | roa | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| mtm_btfp | 1.000 | -0.018 | 0.259 | 0.038 | 0.199 | 0.728 | -0.403 | -0.298 | 0.100 | -0.129 | 0.463 | -0.232 | -0.331 | 0.117 | -0.145 |
| mtm_other | -0.018 | 1.000 | 0.897 | -0.111 | 0.472 | -0.260 | 0.472 | -0.525 | 0.110 | -0.375 | 0.112 | -0.202 | 0.137 | 0.011 | -0.143 |
| mtm_total | 0.259 | 0.897 | 1.000 | -0.120 | 0.526 | -0.036 | 0.334 | -0.635 | 0.063 | -0.398 | 0.326 | -0.283 | -0.041 | 0.039 | -0.209 |
| uninsured_lev | 0.038 | -0.111 | -0.120 | 1.000 | 0.675 | -0.005 | 0.035 | -0.138 | 0.446 | -0.005 | -0.013 | -0.243 | -0.003 | -0.011 | 0.119 |
| run_risk | 0.199 | 0.472 | 0.526 | 0.675 | 1.000 | -0.029 | 0.220 | -0.452 | 0.403 | -0.262 | 0.220 | -0.289 | -0.048 | 0.065 | 0.017 |
| omo_ratio | 0.728 | -0.260 | -0.036 | -0.005 | -0.029 | 1.000 | -0.675 | -0.072 | -0.078 | 0.037 | 0.534 | -0.093 | -0.461 | 0.090 | -0.133 |
| non_omo_ratio | -0.403 | 0.472 | 0.334 | 0.035 | 0.220 | -0.675 | 1.000 | -0.274 | 0.270 | -0.659 | -0.232 | -0.228 | 0.619 | 0.032 | 0.087 |
| adjusted_equity | -0.298 | -0.525 | -0.635 | -0.138 | -0.452 | -0.072 | -0.274 | 1.000 | -0.139 | 0.355 | -0.352 | 0.909 | 0.143 | -0.092 | 0.201 |
| ln_assets | 0.100 | 0.110 | 0.063 | 0.446 | 0.403 | -0.078 | 0.270 | -0.139 | 1.000 | -0.297 | -0.142 | -0.170 | 0.304 | 0.105 | 0.198 |
| cash_ratio | -0.129 | -0.375 | -0.398 | -0.005 | -0.262 | 0.037 | -0.659 | 0.355 | -0.297 | 1.000 | -0.158 | 0.278 | -0.369 | -0.129 | 0.005 |
| securities_ratio | 0.463 | 0.112 | 0.326 | -0.013 | 0.220 | 0.534 | -0.232 | -0.352 | -0.142 | -0.158 | 1.000 | -0.249 | -0.767 | 0.136 | -0.115 |
| book_equity_ratio | -0.232 | -0.202 | -0.283 | -0.243 | -0.289 | -0.093 | -0.228 | 0.909 | -0.170 | 0.278 | -0.249 | 1.000 | 0.098 | -0.099 | 0.125 |
| loan_to_deposit | -0.331 | 0.137 | -0.041 | -0.003 | -0.048 | -0.461 | 0.619 | 0.143 | 0.304 | -0.369 | -0.767 | 0.098 | 1.000 | 0.024 | 0.060 |
| wholesale | 0.117 | 0.011 | 0.039 | -0.011 | 0.065 | 0.090 | 0.032 | -0.092 | 0.105 | -0.129 | 0.136 | -0.099 | 0.024 | 1.000 | 0.010 |
| roa | -0.145 | -0.143 | -0.209 | 0.119 | 0.017 | -0.133 | 0.087 | 0.201 | 0.198 | 0.005 | -0.115 | 0.125 | 0.060 | 0.010 | 1.000 |
5 Descriptive Figures
5.1 Figure: Borrowing Timeline
# ============================================================================
# FIGURE 1: DAILY BORROWING TIMELINE
# ============================================================================
# Daily BTFP borrowing
btfp_daily <- btfp_loans %>%
filter(btfp_loan_date >= "2023-03-01", btfp_loan_date <= "2024-03-15") %>%
group_by(date = btfp_loan_date) %>%
summarise(amount_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(facility = "BTFP")
# Daily DW borrowing
dw_daily <- dw_loans %>%
filter(dw_loan_date >= "2023-03-01", dw_loan_date <= "2024-03-15") %>%
group_by(date = dw_loan_date) %>%
summarise(amount_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(facility = "Discount Window")
daily_combined <- bind_rows(btfp_daily, dw_daily)
# Create plot
fig1 <- ggplot() +
# Period shading
annotate("rect", xmin = periods$start_date, xmax = periods$end_date,
ymin = -Inf, ymax = Inf,
fill = c("#FFE5E5", "#FC9272", "#A1D99B", "#9ECAE1", "#DADAEB"),
alpha = 0.4) +
# Borrowing bars
geom_col(data = daily_combined,
aes(x = date, y = amount_B, fill = facility),
position = "dodge", width = 1) +
# Event markers
geom_vline(data = key_events %>% filter(date <= "2024-03-15"),
aes(xintercept = date), linetype = "dashed", color = "red", alpha = 0.7) +
# Labels
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "Discount Window" = COLORS$dw)) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = dollar_format(suffix = "B")) +
labs(
title = "Figure : Daily Federal Reserve Emergency Lending During the 2023 Banking Crisis Excluding Failed and G-sib",
subtitle = "Periods: Pre-BTFP (pink) | Acute (red) | Post-Acute (green) | Arbitrage (blue) | Wind-down (purple)",
x = NULL, y = "Daily Borrowing ($B)", fill = "Facility"
) +
theme_pub() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(fig1)
ggsave(file.path(FIG_PATH, "fig_daily_excld.png"), fig1, width = 14, height = 8, dpi = 300, bg = "white")# ============================================================================
# FIGURE 1: DAILY BORROWING TIMELINE
# ============================================================================
# Daily BTFP borrowing
btfp_daily <- btfp_loans_raw %>%
filter(btfp_loan_date >= "2023-03-01", btfp_loan_date <= "2024-03-15") %>%
group_by(date = btfp_loan_date) %>%
summarise(amount_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(facility = "BTFP")
# Daily DW borrowing
dw_daily <- dw_loans_raw %>%
filter(dw_loan_date >= "2023-03-01", dw_loan_date <= "2024-03-15") %>%
group_by(date = dw_loan_date) %>%
summarise(amount_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(facility = "Discount Window")
daily_combined <- bind_rows(btfp_daily, dw_daily)
# Create plot
fig2 <- ggplot() +
# Period shading
annotate("rect", xmin = periods$start_date, xmax = periods$end_date,
ymin = -Inf, ymax = Inf,
fill = c("#FFE5E5", "#FC9272", "#A1D99B", "#9ECAE1", "#DADAEB"),
alpha = 0.4) +
# Borrowing bars
geom_col(data = daily_combined,
aes(x = date, y = amount_B, fill = facility),
position = "dodge", width = 1) +
# Event markers
geom_vline(data = key_events %>% filter(date <= "2024-03-15"),
aes(xintercept = date), linetype = "dashed", color = "red", alpha = 0.7) +
# Labels
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "Discount Window" = COLORS$dw)) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = dollar_format(suffix = "B")) +
labs(
title = "Figure : Daily Federal Reserve Emergency Lending During the 2023 Banking Crisis All Banks",
subtitle = "Periods: Pre-BTFP (pink) | Acute (red) | Post-Acute (green) | Arbitrage (blue) | Wind-down (purple)",
x = NULL, y = "Daily Borrowing ($B)", fill = "Facility"
) +
theme_pub() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(fig2)
5.2 Figure : Bank Characteristics by Facility Choice
# ============================================================================
# FIGURE 2: BORROWER CHARACTERISTICS
# ============================================================================
plot_df <- df %>%
mutate(group = as.character(facility_choice))
# Panel A: Total MTM Loss
p2a <- ggplot(plot_df, aes(x = facility_choice, y = mtm_total, fill = facility_choice)) +
geom_boxplot(outlier.shape = NA, alpha = 0.7) +
coord_cartesian(ylim = c(0, quantile(plot_df$mtm_total, 0.95, na.rm = TRUE))) +
scale_fill_manual(values = c("Neither" = COLORS$neither, "BTFP_Only" = COLORS$btfp,
"DW_Only" = COLORS$dw, "Both" = COLORS$both)) +
labs(title = "A: Total MTM Loss / Assets", x = NULL, y = "%") +
theme_pub() + theme(legend.position = "none")
# Panel B: MTM Loss (BTFP-Eligible)
p2b <- ggplot(plot_df, aes(x = facility_choice, y = mtm_btfp, fill = facility_choice)) +
geom_boxplot(outlier.shape = NA, alpha = 0.7) +
coord_cartesian(ylim = c(0, quantile(plot_df$mtm_btfp, 0.95, na.rm = TRUE))) +
scale_fill_manual(values = c("Neither" = COLORS$neither, "BTFP_Only" = COLORS$btfp,
"DW_Only" = COLORS$dw, "Both" = COLORS$both)) +
labs(title = "B: MTM Loss (BTFP-Eligible) / Assets", x = NULL, y = "%") +
theme_pub() + theme(legend.position = "none")
# Panel C: Uninsured Leverage
p2c <- ggplot(plot_df, aes(x = facility_choice, y = uninsured_lev, fill = facility_choice)) +
geom_boxplot(outlier.shape = NA, alpha = 0.7) +
coord_cartesian(ylim = c(0, quantile(plot_df$uninsured_lev, 0.95, na.rm = TRUE))) +
scale_fill_manual(values = c("Neither" = COLORS$neither, "BTFP_Only" = COLORS$btfp,
"DW_Only" = COLORS$dw, "Both" = COLORS$both)) +
labs(title = "C: Uninsured Deposits / Assets", x = NULL, y = "%") +
theme_pub() + theme(legend.position = "none")
# Panel D: Borrowing Subsidy
p2d <- ggplot(plot_df %>% filter(!is.na(borrowing_subsidy)),
aes(x = facility_choice, y = borrowing_subsidy, fill = facility_choice)) +
geom_boxplot(outlier.shape = NA, alpha = 0.7) +
coord_cartesian(ylim = c(0, quantile(plot_df$borrowing_subsidy, 0.95, na.rm = TRUE))) +
scale_fill_manual(values = c("Neither" = COLORS$neither, "BTFP_Only" = COLORS$btfp,
"DW_Only" = COLORS$dw, "Both" = COLORS$both)) +
labs(title = "D: Borrowing Subsidy (MTM/BTFP Elg.)", x = NULL, y = "%") +
theme_pub() + theme(legend.position = "none")
fig3 <- (p2a + p2b) / (p2c + p2d) +
plot_annotation(
title = "Figure : Bank Characteristics by Facility Choice",
subtitle = "BTFP users have higher MTM losses and borrowing subsidy; Both users show highest vulnerability"
)
print(fig3)
5.3 Figure : Selection Mechanism - MTM Composition
# ============================================================================
# FIGURE 3: MTM COMPOSITION AND FACILITY SELECTION
# ============================================================================
fig4 <- ggplot(plot_df %>% filter(any_fed == 1),
aes(x = mtm_btfp, y = mtm_other, color = facility_choice)) +
geom_point(aes(size = total_fed_pct), alpha = 0.6) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50") +
scale_color_manual(values = c("BTFP_Only" = COLORS$btfp, "DW_Only" = COLORS$dw, "Both" = COLORS$both)) +
scale_size_continuous(range = c(1, 8), name = "Total Borrowing\n(% of Assets)") +
coord_cartesian(xlim = c(0, quantile(plot_df$mtm_btfp, 0.98, na.rm = TRUE)),
ylim = c(0, quantile(plot_df$mtm_other, 0.98, na.rm = TRUE))) +
labs(
title = "Figure: Facility Selection by MTM Loss Composition",
subtitle = "Banks above diagonal: More non-OMO losses | BTFP users: Higher BTFP-eligible losses",
x = "MTM Loss on BTFP-Eligible Securities (%)",
y = "MTM Loss on Other Securities (%)",
color = "Facility"
) +
annotate("text", x = 8, y = 2, label = "Higher BTFP-Eligible\n→ Select BTFP",
size = 3.5, color = COLORS$btfp, fontface = "italic") +
theme_pub()
print(fig4)
5.4 Figure : Historic DW Borrowing Pattern (Mar 2022 - Sep 2023)
# ==========================================================================
# FIGURE 1: HISTORIC DW BORROWING (MONTHLY, ALL BANKS)
# March 2022 to September 2023 - LINE GRAPH
# ==========================================================================
cat("\n=== PART V: VISUALIZATIONS ===\n")=== PART V: VISUALIZATIONS ===
## Aggregate DW loans monthly (all banks)
dw_monthly <- dw_loans_raw %>%
filter(dw_loan_date >= as.Date("2022-03-01"),
dw_loan_date <= as.Date("2023-09-30")) %>%
mutate(month = floor_date(dw_loan_date, "month")) %>%
group_by(month) %>%
summarise(
total_amount = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
n_banks = n_distinct(rssd_id),
avg_rate = weighted.mean(dw_interest_rate, dw_loan_amount, na.rm = TRUE),
.groups = "drop"
)
p_fig01 <- ggplot(dw_monthly, aes(x = month)) +
# Amount line
geom_line(aes(y = total_amount), color = facility_colors["DW"], linewidth = 1.2) +
geom_point(aes(y = total_amount), color = facility_colors["DW"], size = 2.5) +
# BTFP launch event
geom_vline(xintercept = as.Date("2023-03-13"), linetype = "dashed", color = "#2166ac", linewidth = 0.8) +
annotate("text", x = as.Date("2023-03-13"), y = max(dw_monthly$total_amount) * 0.95,
label = "BTFP Launch", hjust = -0.1, size = 3.5, fontface = "bold") +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y") +
scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
labs(
title = "Figure 1: Historic Discount Window Borrowing",
subtitle = "Monthly total borrowing volume (March 2022 - September 2023)",
x = NULL, y = "Total DW Borrowing"
) +
theme_pub()
print(p_fig01)
5.5 Figure : Daily Borrowing March 2023 (All 31 Days)
5.5.1 Panel A: All Banks by Facility
# Create daily aggregates for March 2023
march_dates <- seq(as.Date("2023-03-01"), as.Date("2023-03-31"), by = "day")
# BTFP daily (all banks)
btfp_march_all <- btfp_loans_raw %>%
filter(btfp_loan_date >= "2023-03-01" & btfp_loan_date <= "2023-03-31") %>%
group_by(date = btfp_loan_date) %>%
summarise(
total_borrowing_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
n_banks = n_distinct(rssd_id),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
# DW daily (all banks)
dw_march_all <- dw_loans_raw %>%
filter(dw_loan_date >= "2023-03-01" & dw_loan_date <= "2023-03-31") %>%
group_by(date = dw_loan_date) %>%
summarise(
total_borrowing_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
n_banks = n_distinct(rssd_id),
.groups = "drop"
) %>%
mutate(facility = "Discount Window")
# Combine and fill missing dates
march_all <- bind_rows(btfp_march_all, dw_march_all) %>%
complete(date = march_dates, facility, fill = list(total_borrowing_B = 0, n_loans = 0, n_banks = 0))
# March events for annotation
march_events <- key_events %>%
filter(date >= "2023-03-01" & date <= "2023-03-31")
# Panel A: All Banks
p1a <- ggplot(march_all, aes(x = date, y = total_borrowing_B, fill = facility)) +
geom_bar(stat = "identity", position = "dodge", width = 0.8) +
geom_vline(data = march_events, aes(xintercept = date),
linetype = "dashed", color = "red", alpha = 0.7, inherit.aes = FALSE) +
geom_text(data = march_events, aes(x = date, y = Inf, label = event_short),
angle = 90, hjust = 1.1, vjust = -0.3, size = 3, color = "red", inherit.aes = FALSE) +
scale_x_date(date_breaks = "2 days", date_labels = "%b %d") +
scale_y_continuous(labels = comma) +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(
title = "Figure : Daily Borrowing in March 2023 - All Banks",
subtitle = "Including Failed Banks and G-SIBs",
x = "Date",
y = "Total Borrowing ($B)",
fill = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p1a)
5.5.2 Panel B: Excluding Failed Banks and G-SIBs
# BTFP daily (excluding failed and GSIB)
btfp_march_excl <- btfp_loans %>%
filter(btfp_loan_date >= "2023-03-01" & btfp_loan_date <= "2023-03-31") %>%
group_by(date = btfp_loan_date) %>%
summarise(
total_borrowing_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
n_banks = n_distinct(rssd_id),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
# DW daily (excluding failed and GSIB)
dw_march_excl <- dw_loans %>%
filter(dw_loan_date >= "2023-03-01" & dw_loan_date <= "2023-03-31") %>%
group_by(date = dw_loan_date) %>%
summarise(
total_borrowing_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
n_banks = n_distinct(rssd_id),
.groups = "drop"
) %>%
mutate(facility = "Discount Window")
# Combine
march_excl <- bind_rows(btfp_march_excl, dw_march_excl) %>%
complete(date = march_dates, facility, fill = list(total_borrowing_B = 0, n_loans = 0, n_banks = 0))
# Panel B: Excluding Failed & GSIB
p1b <- ggplot(march_excl, aes(x = date, y = total_borrowing_B, fill = facility)) +
geom_bar(stat = "identity", position = "dodge", width = 0.8) +
geom_vline(data = march_events, aes(xintercept = date),
linetype = "dashed", color = "red", alpha = 0.7, inherit.aes = FALSE) +
geom_text(data = march_events, aes(x = date, y = Inf, label = event_short),
angle = 90, hjust = 1.1, vjust = -0.3, size = 3, color = "red", inherit.aes = FALSE) +
scale_x_date(date_breaks = "2 days", date_labels = "%b %d") +
scale_y_continuous(labels = comma) +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(
title = "Figure: Daily Borrowing in March 2023 - Excluding Failed Banks & G-SIBs",
x = "Date",
y = "Total Borrowing ($B)",
fill = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p1b)
5.6 Figure : Daily Borrowing with Period Shading (Mar 2023 - Mar 2024)
# ============================================================================
# FIGURE 3: DAILY BORROWING WITH PERIOD SHADING
# ============================================================================
## 1. Prepare Daily Data
# Fix: Closed the filter() function properly
btfp_daily <- btfp_loans %>%
filter(btfp_loan_date >= as.Date("2023-03-01"),
btfp_loan_date <= BTFP_CLOSE) %>%
group_by(date = btfp_loan_date) %>%
summarise(amount = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(facility = "BTFP")
# Fix: Closed the filter() function properly
dw_daily <- dw_loans %>%
filter(dw_loan_date >= as.Date("2023-03-01"),
dw_loan_date <= DW_DATA_END) %>%
group_by(date = dw_loan_date) %>%
summarise(amount = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(facility = "DW")
daily_combined <- bind_rows(btfp_daily, dw_daily)
## 2. Define Shading and Events
period_shading <- tibble(
period_code = c("dw_pre", "acute", "post", "arb", "wind_down"),
period_label = c("Pre-BTFP (DW only)",
"Acute Crisis",
"Post-Acute",
"Arbitrage",
"Wind-down"),
xmin = as.Date(c("2023-03-01", "2023-03-13", "2023-05-02", "2023-11-01", "2024-01-25")),
xmax = as.Date(c("2023-03-10", "2023-05-01", "2023-10-31", "2024-01-24", "2024-03-11")),
# Colors: Gray (Pre), Orange (Acute), Yellow (Post), Blue (Arb), Dark Blue (Wind-down)
fill = c("#e0e0e0", "#fc8d59", "#fee08b", "#91bfdb", "#4575b4")
)
key_events <- tibble(
date = as.Date(c("2023-03-10", "2023-05-01", "2023-11-01", "2024-01-24", "2024-03-11")),
label = c("SVB Fails", "FRC Fails", "Arb Window Opens", "Rate Floor Change", "Program End")
)
## 3. Generate Plot
p_fig03 <- ggplot() +
# Period shading
annotate("rect", xmin = period_shading$xmin, xmax = period_shading$xmax,
ymin = 0, ymax = Inf, fill = period_shading$fill, alpha = 0.25) +
# Daily borrowing lines
geom_line(data = daily_combined, aes(x = date, y = amount, color = facility), linewidth = 0.8) +
# Event lines
geom_vline(data = key_events, aes(xintercept = date),
linetype = "dashed", color = "gray30", linewidth = 0.5) +
# Event labels
geom_text(data = key_events, aes(x = date, y = max(daily_combined$amount, na.rm = TRUE) * 1.05, label = label),
angle = 90, hjust = 0, vjust = 0.5, size = 2.8) +
# Colors and Scales
scale_color_manual(values = facility_colors[c("BTFP", "DW")], name = "Facility") +
scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y",
limits = c(as.Date("2023-03-01"), BTFP_CLOSE)) +
scale_y_continuous(labels = scales::dollar_format(suffix = "B"), expand = expansion(mult = c(0, 0.15))) +
# Labels and Theme
labs(
title = "Figure: Daily Emergency Borrowing by Crisis Period",
subtitle = "March 2023 - March 2024 | Excludes GSIBs and failed banks | Shading = period definitions",
x = NULL, y = "Daily Borrowing Volume",
caption = "Periods: P1=Week 1 (red), P2=Crisis Month (orange), P3=FRC May (yellow), P4=Stabilization (green), P5=Arbitrage (blue), P6=Wind-down (dark blue)"
) +
theme_pub() +
theme(legend.position = "bottom")
# Print and Save
print(p_fig03)
5.7 Figure 4: Summary Statistics by Period
# ============================================================================
# FIGURE 4: SUMMARY BY PERIOD
# ============================================================================
btfp_period_viz <- btfp_loans %>%
filter(!is.na(period), period >= 1) %>%
group_by(period) %>%
summarise(
total_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_banks = n_distinct(rssd_id),
n_loans = n(),
avg_rate = mean(btfp_interest_rate, na.rm = TRUE),
avg_term = mean(btfp_term, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "BTFP") %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
dw_period_viz <- dw_loans %>%
filter(!is.na(period)) %>%
group_by(period) %>%
summarise(
total_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_banks = n_distinct(rssd_id),
n_loans = n(),
avg_rate = mean(dw_interest_rate, na.rm = TRUE),
avg_term = mean(dw_term, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "Discount Window") %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
period_viz <- bind_rows(btfp_period_viz, dw_period_viz)
# Panel A: Total volume
p4a <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = total_B, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "Discount Window" = COLORS$dw)) +
scale_y_continuous(labels = dollar_format(suffix = "B")) +
labs(title = "A: Total Volume by Period", y = "Total ($B)", x = NULL) +
theme_pub() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
# Panel B: Number of banks
p4b <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = n_banks, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "Discount Window" = COLORS$dw)) +
labs(title = "B: Unique Borrowers by Period", y = "# Banks", x = NULL) +
theme_pub() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
# Panel C: Average rate
p4c <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = avg_rate, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "Discount Window" = COLORS$dw)) +
labs(title = "C: Average Rate by Period", y = "Rate (%)", x = NULL) +
theme_pub() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
# Panel D: Average term
p4d <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = avg_term, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "Discount Window" = COLORS$dw)) +
labs(title = "D: Average Term by Period", y = "Days", x = NULL, fill = "Facility") +
theme_pub() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom")
fig_comb <- (p4a | p4b) / (p4c | p4d) +
plot_annotation(
title = "Figure 4: Borrowing Summary by Period and Facility",
subtitle = "Excluding Failed Banks and G-SIBs"
)
print(fig_comb)
5.8 Figure : Interest Rate Dynamics (Mar 2023 - Mar 2024)
# ==========================================================================
# FIGURE 4: INTEREST RATE DIFFERENCES
# March 1, 2023 - March 11, 2024
# NEW period shading, event lines
# ==========================================================================
## Weekly average rates for BTFP
btfp_rates <- btfp_loans_raw %>%
filter(btfp_loan_date >= as.Date("2023-03-01"),
btfp_loan_date <= BTFP_CLOSE) %>%
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week) %>%
summarise(
avg_rate = weighted.mean(btfp_interest_rate, btfp_loan_amount, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
## Weekly average rates for DW
dw_rates <- dw_loans_raw %>%
filter(dw_loan_date >= as.Date("2023-03-01"),
dw_loan_date <= DW_DATA_END) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
avg_rate = weighted.mean(dw_interest_rate, dw_loan_amount, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "DW")
weekly_rates <- bind_rows(btfp_rates, dw_rates)
## Rate events
rate_events <- tibble(
date = as.Date(c("2023-03-13", "2023-05-01", "2023-11-06")),
label = c("BTFP Launch", "FRC Fails", "Arb Window Opens")
)
p_fig04 <- ggplot() +
# Period shading using annotate
annotate("rect",
xmin = (period_shading %>% filter(xmax <= as.Date("2024-03-11")))$xmin,
xmax = (period_shading %>% filter(xmax <= as.Date("2024-03-11")))$xmax,
ymin = -Inf, ymax = Inf,
fill = (period_shading %>% filter(xmax <= as.Date("2024-03-11")))$fill,
alpha = 0.2) +
# Rate lines
geom_line(data = weekly_rates, aes(x = week, y = avg_rate, color = facility), linewidth = 1.2) +
geom_point(data = weekly_rates, aes(x = week, y = avg_rate, color = facility), size = 2) +
# Event lines
geom_vline(data = rate_events, aes(xintercept = date),
linetype = "dashed", color = "gray30", linewidth = 0.5) +
geom_text(data = rate_events, aes(x = date, y = max(weekly_rates$avg_rate, na.rm = TRUE) * 1.02, label = label),
angle = 90, hjust = 0, vjust = 0.5, size = 2.8) +
scale_color_manual(values = facility_colors[c("BTFP", "DW")], name = "Facility") +
scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y") +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
labs(
title = "Figure : Weekly Average Interest Rates by Facility",
subtitle = "Weighted by loan amount | March 2023 - March 2024",
x = NULL, y = "Average Interest Rate",
caption = "Shading: P1=Week 1, P2=Crisis Month, P3=FRC May, P4=Stabilization, P5=Arbitrage, P6=Wind-down"
) +
theme_pub() +
theme(legend.position = "bottom")
print(p_fig04)
5.9 Figure : Loan Terms and Maturity Analysis
# Term distribution by facility and period
btfp_terms <- btfp_loans %>%
filter(!is.na(period), ) %>%
mutate(
facility = "BTFP",
term_days = btfp_term,
effective_maturity = btfp_effective_maturity_days
) %>%
select(facility, period, term_days, effective_maturity)
dw_terms <- dw_loans %>%
filter(!is.na(period), ) %>%
mutate(
facility = "Discount Window",
term_days = dw_term,
effective_maturity = dw_effective_maturity_days
) %>%
select(facility, period, term_days, effective_maturity)
terms_combined <- bind_rows(btfp_terms, dw_terms) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
# Box plot of terms by facility and period
p5a <- ggplot(terms_combined %>% filter(!is.na(period_name)),
aes(x = period_name, y = term_days, fill = facility)) +
geom_boxplot(alpha = 0.7, outlier.shape = NA) +
coord_cartesian(ylim = c(0, 400)) +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(
title = "Figure: Loan Term Distribution by Period",
subtitle = "Original loan term in days",
x = "Period",
y = "Loan Term (days)",
fill = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
plot.title = element_text(face = "bold")
)
print(p5a)
ggsave(file.path(FIG_PATH, "term_dynamics.png"), p5a, width = 16, height = 9, dpi = 300, bg = "white")
# Effective maturity distribution
p5b <- ggplot(terms_combined %>% filter(!is.na(period_name)),
aes(x = period_name, y = effective_maturity, fill = facility)) +
geom_boxplot(alpha = 0.7, outlier.shape = NA) +
coord_cartesian(ylim = c(0, 400)) +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(
title = "Figure: Effective Maturity Distribution by Period",
subtitle = "Actual days from loan date to repayment",
x = "Period",
y = "Effective Maturity (days)",
fill = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
plot.title = element_text(face = "bold")
)
print(p5b)
ggsave(file.path(FIG_PATH, "maturity_dynamics.png"), p5b, width = 16, height = 9, dpi = 300, bg = "white")# Define period date range for filtering
period_start <- as.Date("2023-03-01")
period_end <- as.Date("2024-03-11")
# Weekly average terms over time - BTFP period only
btfp_term_weekly <- btfp_loans %>%
filter(btfp_loan_date >= period_start & btfp_loan_date <= period_end) %>%
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week) %>%
summarise(
mean_term = mean(btfp_term, na.rm = TRUE),
mean_effective = mean(btfp_effective_maturity_days, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
dw_term_weekly <- dw_loans %>%
filter(dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
mean_term = mean(dw_term, na.rm = TRUE),
mean_effective = mean(dw_effective_maturity_days, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "Discount Window")
term_weekly <- bind_rows(btfp_term_weekly, dw_term_weekly)
p5c <- ggplot() +
# Period shading
annotate("rect", xmin = periods$start_date, xmax = periods$end_date,
ymin = -Inf, ymax = Inf,
fill = c("#FFE5E5", "#FFB3B3", "#E5F5E0", "#DEEBF7", "#FFF3CD"),
alpha = 0.3) +
geom_line(data = term_weekly,
aes(x = week, y = mean_term, color = facility), size = 1.2) +
geom_point(data = term_weekly,
aes(x = week, y = mean_term, color = facility), size = 2) +
scale_color_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
labs(
title = "Figure : Average Loan Term Over Time",
subtitle = "Weekly average original loan term",
x = "Date",
y = "Average Term (days)",
color = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
plot.title = element_text(face = "bold")
)
print(p5c)
5.10 Figure : Summary Statistics by Period (Visual)
# Create summary for visualization
btfp_period_viz <- btfp_loans %>%
filter(!is.na(period), ) %>%
group_by(period) %>%
summarise(
total_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_banks = n_distinct(rssd_id),
n_loans = n(),
avg_rate = mean(btfp_interest_rate, na.rm = TRUE),
avg_term = mean(btfp_term, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "BTFP") %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
dw_period_viz <- dw_loans %>%
filter(!is.na(period), ) %>%
group_by(period) %>%
summarise(
total_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_banks = n_distinct(rssd_id),
n_loans = n(),
avg_rate = mean(dw_interest_rate, na.rm = TRUE),
avg_term = mean(dw_term, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(facility = "Discount Window") %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
period_viz <- bind_rows(btfp_period_viz, dw_period_viz)
# Multi-panel summary figure
library(patchwork)
p6a <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = total_B, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(title = "Total Borrowing by Period", y = "Total ($B)", x = NULL) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
p6b <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = n_banks, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(title = "Unique Borrowers by Period", y = "# Banks", x = NULL) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
p6c <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = avg_rate, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(title = "Average Rate by Period", y = "Rate (%)", x = NULL) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
p6d <- ggplot(period_viz %>% filter(!is.na(period_name)),
aes(x = period_name, y = avg_term, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
labs(title = "Average Term by Period", y = "Days", x = NULL, fill = "Facility") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom")
# Combine panels
(p6a | p6b) / (p6c | p6d) +
plot_annotation(
title = "Figure: Summary Statistics by Period and Facility",
subtitle = "Excluding Failed Banks"
)
# 1. Assign the combined plot to an object
final_plot <- (p6a | p6b) / (p6c | p6d) +
plot_annotation(
title = "Figure: Summary Statistics by Period and Facility",
subtitle = "Excluding Failed Banks"
)
# 2. Save using ggsave
ggsave(
filename = file.path(FIG_PATH, "fig06_summary_panel.png"), # Update path/name as needed
plot = final_plot,
width = 12, # Adjust width (wider for side-by-side panels)
height = 10, # Adjust height (taller for stacked panels)
dpi = 300, # High resolution for publication
bg = "white" # Ensures background isn't transparent
)# 1. Assign the combined plot to an object
final_plot <- (p6a | p6b) / (p6c | p6d) +
plot_annotation(
title = "Figure: Summary Statistics by Period and Facility",
subtitle = "Excluding Failed Banks"
)
# 2. Save using ggsave
ggsave(
filename = file.path(FIG_PATH, "fig06_summary_panel.png"), # Update path/name as needed
plot = final_plot,
width = 12, # Adjust width (wider for side-by-side panels)
height = 10, # Adjust height (taller for stacked panels)
dpi = 300, # High resolution for publication
bg = "white" # Ensures background isn't transparent
)5.11 Figure : Borrowing by User Group (Jan - Sep 2023)
# ============================================================================
# FIGURE 5: WEEKLY BORROWING BY USER GROUP (FIXED)
# ============================================================================
## 1. Classify banks
# We create a lookup table mapping RSSD ID -> Facility Choice.
# We rename 'idrssd' to 'rssd_id' immediately to match your loan data.
bank_groups <- analysis_df %>%
select(rssd_id = idrssd, facility = facility_choice) %>%
distinct() %>%
mutate(rssd_id = as.numeric(rssd_id)) # Ensure numeric for joining
## 2. Weekly BTFP by user group
btfp_by_group <- btfp_loans_raw %>%
filter(btfp_loan_date >= as.Date("2023-01-01"),
btfp_loan_date <= as.Date("2023-09-30")) %>%
mutate(rssd_id = as.numeric(rssd_id)) %>% # Ensure type matches bank_groups
left_join(bank_groups, by = "rssd_id") %>%
filter(!is.na(facility)) %>% # Exclude banks not in our analysis set (e.g. failed banks)
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week, facility) %>%
summarise(amount = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(loan_type = "BTFP Loans")
## 3. Weekly DW by user group
dw_by_group <- dw_loans_raw %>%
filter(dw_loan_date >= as.Date("2023-01-01"),
dw_loan_date <= as.Date("2023-09-30")) %>%
mutate(rssd_id = as.numeric(rssd_id)) %>%
left_join(bank_groups, by = "rssd_id") %>%
filter(!is.na(facility)) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week, facility) %>%
summarise(amount = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(loan_type = "DW Loans")
## 4. Combine Data
group_weekly <- bind_rows(btfp_by_group, dw_by_group)
## 5. Prepare Plot Elements
period_shading_sub <- period_shading %>%
filter(xmin >= as.Date("2023-01-01"), xmax <= as.Date("2023-09-30"))
group_events <- tibble(
date = as.Date(c("2023-03-13", "2023-05-01")),
label = c("BTFP Launch", "FRC Fails")
)
## 6. Generate Plot
p_fig05 <- ggplot() +
# Period shading
annotate("rect", xmin = period_shading_sub$xmin, xmax = period_shading_sub$xmax,
ymin = 0, ymax = Inf, fill = period_shading_sub$fill, alpha = 0.2) +
# Lines by group
geom_line(data = group_weekly,
aes(x = week, y = amount, color = facility, linetype = loan_type),
linewidth = 1) +
# Event lines
geom_vline(data = group_events, aes(xintercept = date),
linetype = "dashed", color = "gray30", linewidth = 0.5) +
geom_text(data = group_events,
aes(x = date, y = max(group_weekly$amount, na.rm = TRUE) * 1.05, label = label),
angle = 90, hjust = 0, vjust = 0.5, size = 3) +
# Scales
scale_color_manual(values = c("BTFP_Only" = "#2166ac", "DW_Only" = "#b2182b", "Both" = "#762a83"),
name = "User Group") +
scale_linetype_manual(values = c("BTFP Loans" = "solid", "DW Loans" = "dashed"), name = "Loan Type") +
scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y",
limits = c(as.Date("2023-01-01"), as.Date("2023-09-30"))) +
scale_y_continuous(labels = scales::dollar_format(suffix = "B"), expand = expansion(mult = c(0, 0.15))) +
# Labels and Theme
labs(
title = "Figure: Weekly Borrowing by User Group",
subtitle = "January - September 2023 | Banks classified by full-period facility usage",
x = NULL, y = "Weekly Borrowing Volume"
) +
theme_pub() +
theme(legend.position = "bottom", legend.box = "horizontal")
# Print and Save
print(p_fig05)
5.12 Figure: Collateral and Utilization Analysis
# ==========================================================================
# FIGURE 6: PLEDGED COLLATERAL TYPES VS UTILIZATION
# January 1, 2023 - March 11, 2024
#
# Collateral variables:
# btfp_total_collateral = BTFP-eligible (OMO)
# dw_omo_eligible = BTFP-eligible pledged at DW
# dw_non_omo_eligible = Other collateral (DW only, subject to haircut)
#
# Par value, no haircut applied
# ==========================================================================
## Panel A: DW Collateral Composition (OMO vs Non-OMO)
dw_coll_weekly <- dw_loans %>%
filter(dw_loan_date >= as.Date("2023-01-01"),
dw_loan_date <= DW_DATA_END) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
omo_eligible = sum(dw_omo_eligible, na.rm = TRUE) / 1e9,
non_omo_eligible = sum(dw_non_omo_eligible, na.rm = TRUE) / 1e9,
total_collateral = sum(dw_total_collateral, na.rm = TRUE) / 1e9,
loan_amount = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
.groups = "drop"
) %>%
mutate(utilization = loan_amount / total_collateral * 100)
## Reshape for stacked area
dw_coll_long <- dw_coll_weekly %>%
select(week, omo_eligible, non_omo_eligible) %>%
pivot_longer(cols = c(omo_eligible, non_omo_eligible),
names_to = "collateral_type", values_to = "amount") %>%
mutate(collateral_type = factor(collateral_type,
levels = c("non_omo_eligible", "omo_eligible"),
labels = c("Non-OMO (DW Only, w/ Haircut)", "OMO-Eligible (BTFP-Eligible)")))
p_coll_a <- ggplot(dw_coll_long, aes(x = week, y = amount, fill = collateral_type)) +
geom_area(alpha = 0.8) +
geom_vline(xintercept = as.Date("2023-03-13"), linetype = "dashed", color = "gray30") +
annotate("text", x = as.Date("2023-03-13"), y = max(dw_coll_weekly$total_collateral) * 0.9,
label = "BTFP Launch", hjust = -0.1, size = 3.5) +
scale_fill_manual(values = c("OMO-Eligible (BTFP-Eligible)" = "#2166ac",
"Non-OMO (DW Only, w/ Haircut)" = "#b2182b")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
labs(
title = "DW Collateral Composition (Par Value)",
subtitle = "Weekly pledged collateral by type | No haircuts applied",
x = NULL, y = "Collateral Pledged", fill = "Collateral Type"
) +
theme_pub() +
theme(legend.position = "bottom")
## Panel B: BTFP Collateral and Utilization
btfp_coll_weekly <- btfp_loans %>%
filter(btfp_loan_date >= as.Date("2023-01-01"),
btfp_loan_date <= BTFP_CLOSE) %>%
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week) %>%
summarise(
collateral = sum(btfp_total_collateral, na.rm = TRUE) / 1e9,
loan_amount = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
.groups = "drop"
) %>%
mutate(utilization = loan_amount / collateral * 100)
p_coll_b <- ggplot(btfp_coll_weekly, aes(x = week)) +
# Collateral line
geom_line(aes(y = collateral, color = "Collateral Pledged"), linewidth = 1.2) +
geom_point(aes(y = collateral, color = "Collateral Pledged"), size = 2) +
# Loan amount line
geom_line(aes(y = loan_amount, color = "Loan Amount"), linewidth = 1.2) +
geom_point(aes(y = loan_amount, color = "Loan Amount"), size = 2) +
# Arbitrage window
geom_vline(xintercept = ARB_WINDOW_OPEN, linetype = "dashed", color = "#762a83", linewidth = 0.8) +
annotate("text", x = ARB_WINDOW_OPEN, y = max(btfp_coll_weekly$collateral) * 0.95,
label = "Arbitrage Window Opens", hjust = -0.05, size = 3.5, color = "#762a83") +
scale_color_manual(values = c("Collateral Pledged" = "#2166ac", "Loan Amount" = "#d73027")) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y") +
scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
labs(
title = "BTFP Collateral and Borrowing (Par Value)",
subtitle = "Weekly pledged collateral vs loan amounts",
x = NULL, y = "Amount", color = NULL
) +
theme_pub() +
theme(legend.position = "bottom")
## Panel C: Utilization Rates by Facility
util_combined <- bind_rows(
btfp_coll_weekly %>% select(week, utilization) %>% mutate(facility = "BTFP"),
dw_coll_weekly %>% select(week, utilization) %>% mutate(facility = "DW")
)
p_coll_c <- ggplot(util_combined, aes(x = week, y = utilization, color = facility)) +
geom_line(linewidth = 1.2) +
geom_point(size = 2) +
geom_hline(yintercept = 100, linetype = "dotted", color = "gray50") +
annotate("text", x = min(util_combined$week), y = 102, label = "100% Utilization",
hjust = 0, size = 3, color = "gray50") +
# Arbitrage window
geom_vline(xintercept = ARB_WINDOW_OPEN, linetype = "dashed", color = "#762a83", linewidth = 0.8) +
scale_color_manual(values = facility_colors[c("BTFP", "DW")]) +
scale_x_date(date_breaks = "2 months", date_labels = "%b %Y") +
scale_y_continuous(labels = function(x) paste0(x, "%"), limits = c(0, NA)) +
labs(
title = "Collateral Utilization Rates",
subtitle = "Loan Amount / Collateral Pledged",
x = NULL, y = "Utilization Rate", color = "Facility"
) +
theme_pub() +
theme(legend.position = "bottom")
## Combine panels
p_fig06 <- (p_coll_a / p_coll_b / p_coll_c) +
plot_annotation(
title = "Figure 6: Collateral Analysis by Facility",
subtitle = "January 2023 - March 2024 | Par value (no haircuts)",
theme = theme(plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(size = 11))
)
print(p_fig06)
7 Main Regression Results
Note: All regressions use the sample excluding failed banks and G-SIBs with 2022Q4 baseline.
7.1 Table 5: Main Extensive Margin - Bank-Clustered SEs
# ============================================================================
# TABLE 5: MAIN EXTENSIVE MARGIN WITH BANK-CLUSTERED SEs
# ============================================================================
# Model specifications
f1 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev +", CONTROLS))
f2 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f3 <- as.formula(paste("dw ~ mtm_btfp + mtm_other + uninsured_lev +", CONTROLS))
f4 <- as.formula(paste("dw ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f5 <- as.formula(paste("any_fed ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f6 <- as.formula(paste("both ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
# Estimate models with bank-clustered SEs
m5_1 <- feols(f1, data = df, vcov = ~idrssd)
m5_2 <- feols(f2, data = df, vcov = ~idrssd)
m5_3 <- feols(f3, data = df, vcov = ~idrssd)
m5_4 <- feols(f4, data = df, vcov = ~idrssd)
m5_5 <- feols(f5, data = df, vcov = ~idrssd)
m5_6 <- feols(f6, data = df, vcov = ~idrssd)
table5 <- modelsummary(
list("(1) BTFP" = m5_1, "(2) BTFP+Int" = m5_2, "(3) DW" = m5_3,
"(4) DW+Int" = m5_4, "(5) Any Fed" = m5_5, "(6) Both" = m5_6),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 5: Main Extensive Margin - Bank-Clustered Standard Errors",
notes = list("Standard errors clustered at bank (RSSD_ID) level.",
"All variables winsorized at 1-99%.",
"KEY TEST: MTM(BTFP-Eligible) predicts BTFP but NOT DW.",
"Sample excludes failed banks and G-SIBs."),
output = "kableExtra"
)
table5| (1) BTFP | (2) BTFP+Int | (3) DW | (4) DW+Int | (5) Any Fed | (6) Both | |
|---|---|---|---|---|---|---|
| MTM Loss (BTFP-Eligible) | 0.043*** | 0.070*** | 0.010 | −0.003 | 0.058*** | 0.009 |
| (0.011) | (0.021) | (0.010) | (0.018) | (0.021) | (0.014) | |
| MTM Loss (Non-BTFP) | 0.009*** | 0.009*** | 0.001 | 0.001 | 0.007** | 0.002 |
| (0.003) | (0.003) | (0.003) | (0.003) | (0.004) | (0.002) | |
| Uninsured Leverage | 0.002*** | 0.003*** | 0.000 | 0.000 | 0.002** | 0.001** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.000) | |
| MTM(BTFP) × Uninsured | −0.001 | 0.001 | −0.001 | 0.000 | ||
| (0.001) | (0.001) | (0.001) | (0.001) | |||
| Log(Assets) | 0.056*** | 0.057*** | 0.100*** | 0.100*** | 0.112*** | 0.045*** |
| (0.006) | (0.006) | (0.006) | (0.006) | (0.006) | (0.004) | |
| Cash Ratio | −0.005*** | −0.005*** | 0.000 | 0.000 | −0.003** | −0.002*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Securities Ratio | 0.003*** | 0.002*** | 0.000 | 0.000 | 0.003*** | −0.000 |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.000) | |
| Loan/Deposit | −0.000 | −0.000 | 0.001 | 0.001 | 0.001** | −0.001** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.000) | |
| Book Equity | −0.006*** | −0.006*** | −0.001 | −0.001 | −0.007*** | 0.000 |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Wholesale Funding | 0.010** | 0.010** | 0.001 | 0.001 | 0.004 | 0.007*** |
| (0.004) | (0.004) | (0.004) | (0.004) | (0.004) | (0.003) | |
| FHLB Ratio | 0.007*** | 0.007*** | 0.001 | 0.001 | 0.004* | 0.004*** |
| (0.002) | (0.002) | (0.002) | (0.002) | (0.002) | (0.001) | |
| ROA | −0.009 | −0.009 | −0.003 | −0.003 | −0.003 | −0.010 |
| (0.010) | (0.010) | (0.010) | (0.010) | (0.012) | (0.007) | |
| Num.Obs. | 4678 | 4678 | 4678 | 4678 | 4678 | 4678 |
| R2 | 0.113 | 0.114 | 0.122 | 0.122 | 0.162 | 0.078 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||
| Standard errors clustered at bank (RSSD_ID) level. | ||||||
| All variables winsorized at 1-99%. | ||||||
| KEY TEST: MTM(BTFP-Eligible) predicts BTFP but NOT DW. | ||||||
| Sample excludes failed banks and G-SIBs. |
modelsummary(
list("(1) BTFP" = m5_1, "(2) BTFP+Int" = m5_2, "(3) DW" = m5_3,
"(4) DW+Int" = m5_4, "(5) Any Fed" = m5_5, "(6) Both" = m5_6),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 5: Main Extensive Margin",
output = file.path(TABLE_PATH, "table5_main_extensive.html")
)7.2 Table 6: Run Risk Models
# ============================================================================
# TABLE 6: RUN RISK MODELS
# ============================================================================
# Run risk continuous
f_rr1_btfp <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + run_risk +", CONTROLS))
f_rr1_dw <- as.formula(paste("dw ~ mtm_btfp + mtm_other + run_risk +", CONTROLS))
f_rr1_any <- as.formula(paste("any_fed ~ mtm_btfp + mtm_other + run_risk +", CONTROLS))
# Run risk dummy
f_rrd_btfp <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + run_risk_1_dummy +", CONTROLS))
f_rrd_dw <- as.formula(paste("dw ~ mtm_btfp + mtm_other + run_risk_1_dummy +", CONTROLS))
f_rrd_any <- as.formula(paste("any_fed ~ mtm_btfp + mtm_other + run_risk_1_dummy +", CONTROLS))
# Estimate models
m6_1 <- feols(f_rr1_btfp, data = df, vcov = ~idrssd)
m6_2 <- feols(f_rr1_dw, data = df, vcov = ~idrssd)
m6_3 <- feols(f_rr1_any, data = df, vcov = ~idrssd)
m6_4 <- feols(f_rrd_btfp, data = df, vcov = ~idrssd)
m6_5 <- feols(f_rrd_dw, data = df, vcov = ~idrssd)
m6_6 <- feols(f_rrd_any, data = df, vcov = ~idrssd)
table6 <- modelsummary(
list("(1) BTFP" = m6_1, "(2) DW" = m6_2, "(3) Any Fed" = m6_3,
"(4) BTFP" = m6_4, "(5) DW" = m6_5, "(6) Any Fed" = m6_6),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 6: Run Risk Models - Continuous (1-3) and Dummy (4-6)",
notes = list("Bank-clustered SEs.",
"Run Risk = Uninsured Share × MTM Loss.",
"Run Risk Dummy = 1 if both > median."),
output = "kableExtra"
)
table6| (1) BTFP | (2) DW | (3) Any Fed | (4) BTFP | (5) DW | (6) Any Fed | |
|---|---|---|---|---|---|---|
| MTM Loss (BTFP-Eligible) | 0.035*** | 0.007 | 0.028** | 0.038*** | 0.008 | 0.030*** |
| (0.011) | (0.010) | (0.011) | (0.011) | (0.010) | (0.011) | |
| MTM Loss (Non-BTFP) | −0.003 | −0.004 | −0.002 | 0.002 | −0.002 | 0.002 |
| (0.004) | (0.003) | (0.004) | (0.003) | (0.003) | (0.004) | |
| Run Risk (MTM × % Uninsured) | 0.001*** | 0.000** | 0.000*** | |||
| (0.000) | (0.000) | (0.000) | ||||
| Run Risk Dummy | 0.069*** | 0.033** | 0.057*** | |||
| (0.018) | (0.016) | (0.018) | ||||
| Log(Assets) | 0.051*** | 0.097*** | 0.106*** | 0.060*** | 0.100*** | 0.113*** |
| (0.006) | (0.006) | (0.006) | (0.005) | (0.005) | (0.005) | |
| Cash Ratio | −0.004*** | 0.000 | −0.003** | −0.004*** | 0.000 | −0.003** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Securities Ratio | 0.002*** | 0.000 | 0.003*** | 0.003*** | 0.000 | 0.003*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Loan/Deposit | 0.000 | 0.001* | 0.002** | 0.000 | 0.001* | 0.002** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Book Equity | −0.007*** | −0.001 | −0.007*** | −0.007*** | −0.001 | −0.008*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Wholesale Funding | 0.009** | 0.001 | 0.003 | 0.008** | 0.000 | 0.002 |
| (0.004) | (0.004) | (0.004) | (0.004) | (0.004) | (0.004) | |
| FHLB Ratio | 0.006*** | 0.001 | 0.003 | 0.006*** | 0.001 | 0.003 |
| (0.002) | (0.002) | (0.002) | (0.002) | (0.002) | (0.002) | |
| ROA | −0.013 | −0.005 | −0.006 | −0.012 | −0.005 | −0.006 |
| (0.010) | (0.010) | (0.012) | (0.010) | (0.010) | (0.012) | |
| Num.Obs. | 4678 | 4678 | 4678 | 4678 | 4678 | 4678 |
| R2 | 0.118 | 0.123 | 0.165 | 0.115 | 0.122 | 0.163 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||
| Bank-clustered SEs. | ||||||
| Run Risk = Uninsured Share × MTM Loss. | ||||||
| Run Risk Dummy = 1 if both > median. |
modelsummary(
list("(1) BTFP" = m6_1, "(2) DW" = m6_2, "(3) Any Fed" = m6_3,
"(4) BTFP" = m6_4, "(5) DW" = m6_5, "(6) Any Fed" = m6_6),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 6: Run Risk Models",
output = file.path(TABLE_PATH, "table6_run_risk.html")
)7.3 Table 7: Placebo Test - Pre-BTFP DW
# ============================================================================
# TABLE 7: PLACEBO TEST WITH CLUSTERED SEs
# ============================================================================
f_pla1 <- as.formula(paste("dw_pre ~ mtm_total + uninsured_lev +", CONTROLS))
f_pla2 <- as.formula(paste("dw_pre ~ mtm_btfp + mtm_other + uninsured_lev +", CONTROLS))
f_pla3 <- as.formula(paste("dw_pre ~ mtm_total + uninsured_lev + I(mtm_total * uninsured_lev) +", CONTROLS))
f_pla4 <- as.formula(paste("dw_pre ~ mtm_total + uninsured_lev + run_risk +", CONTROLS))
f_pla5 <- as.formula(paste("dw_pre ~ mtm_total + uninsured_lev + run_risk_1_dummy +", CONTROLS))
m7_1 <- feols(f_pla1, data = df, vcov = ~idrssd)
m7_2 <- feols(f_pla2, data = df, vcov = ~idrssd)
m7_3 <- feols(f_pla3, data = df, vcov = ~idrssd)
m7_4 <- feols(f_pla4, data = df, vcov = ~idrssd)
m7_5 <- feols(f_pla5, data = df, vcov = ~idrssd)
# Compare to main BTFP model
m7_main <- m5_2
table7 <- modelsummary(
list("(1) Pre-DW: Total" = m7_1, "(2) Pre-DW: Split" = m7_2,
"(3) Pre-DW: Int" = m7_3, "(4) Pre-DW: RunRisk" = m7_4,
"(5) Pre-DW: RunRisk Dum" = m7_5, "(6) BTFP (Main)" = m7_main),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 7: Placebo Test - Pre-BTFP DW (Mar 1-10, 2023) vs Post-BTFP BTFP",
notes = list("Bank-clustered SEs.",
"Placebo: DW before BTFP existed (Mar 1-10, 2023).",
"VALIDATION: MTM(BTFP) coefficient much larger for BTFP than pre-DW."),
output = "kableExtra"
)
table7| (1) Pre-DW: Total | (2) Pre-DW: Split | (3) Pre-DW: Int | (4) Pre-DW: RunRisk | (5) Pre-DW: RunRisk Dum | (6) BTFP (Main) | |
|---|---|---|---|---|---|---|
| MTM Loss (Total) | 0.000 | −0.001 | −0.000 | 0.001 | ||
| (0.001) | (0.002) | (0.002) | (0.001) | |||
| MTM Loss (BTFP-Eligible) | −0.000 | 0.070*** | ||||
| (0.004) | (0.021) | |||||
| MTM Loss (Non-BTFP) | 0.001 | 0.009*** | ||||
| (0.001) | (0.003) | |||||
| Uninsured Leverage | 0.000 | 0.000 | −0.000 | −0.000 | 0.000 | 0.003*** |
| (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | (0.001) | |
| Run Risk (MTM × % Uninsured) | 0.000 | |||||
| (0.000) | ||||||
| Run Risk Dummy | −0.006 | |||||
| (0.007) | ||||||
| MTM(BTFP) × Uninsured | −0.001 | |||||
| (0.001) | ||||||
| MTM × Uninsured | 0.000 | |||||
| (0.000) | ||||||
| Log(Assets) | 0.016*** | 0.016*** | 0.016*** | 0.016*** | 0.016*** | 0.057*** |
| (0.003) | (0.003) | (0.003) | (0.003) | (0.003) | (0.006) | |
| Cash Ratio | −0.001*** | −0.001*** | −0.001*** | −0.001*** | −0.001*** | −0.005*** |
| (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | (0.001) | |
| Securities Ratio | −0.000 | −0.000 | −0.000 | −0.000 | −0.000 | 0.002*** |
| (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | (0.001) | |
| Loan/Deposit | −0.000** | −0.000** | −0.000** | −0.000** | −0.000** | −0.000 |
| (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | (0.001) | |
| Book Equity | 0.000 | 0.000 | 0.000 | 0.000 | 0.000 | −0.006*** |
| (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | (0.001) | |
| Wholesale Funding | 0.007*** | 0.007*** | 0.007*** | 0.007*** | 0.007*** | 0.010** |
| (0.002) | (0.002) | (0.002) | (0.002) | (0.002) | (0.004) | |
| FHLB Ratio | 0.001 | 0.001 | 0.001 | 0.001 | 0.001 | 0.007*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.002) | |
| ROA | −0.005 | −0.005 | −0.005 | −0.005 | −0.004 | −0.009 |
| (0.003) | (0.003) | (0.003) | (0.003) | (0.003) | (0.010) | |
| Num.Obs. | 4678 | 4678 | 4678 | 4678 | 4678 | 4678 |
| R2 | 0.032 | 0.032 | 0.032 | 0.032 | 0.032 | 0.114 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||
| Bank-clustered SEs. | ||||||
| Placebo: DW before BTFP existed (Mar 1-10, 2023). | ||||||
| VALIDATION: MTM(BTFP) coefficient much larger for BTFP than pre-DW. |
modelsummary(
list("(1) Pre-DW: Total" = m7_1, "(2) Pre-DW: Split" = m7_2,
"(3) Pre-DW: Int" = m7_3, "(4) Pre-DW: RunRisk" = m7_4,
"(5) Pre-DW: RunRisk Dum" = m7_5, "(6) BTFP (Main)" = m7_main),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 7: Placebo Test",
output = file.path(TABLE_PATH, "table7_placebo.html")
)7.4 Table 8: Temporal Dynamics - Period-Specific Entry
# ============================================================================
# TABLE 8: TEMPORAL DYNAMICS
# ============================================================================
# BTFP entry by period
f_acute <- as.formula(paste("btfp_acute ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f_post <- as.formula(paste("btfp_post ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f_arb <- as.formula(paste("btfp_arb ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f_winddown <- as.formula(paste("btfp_winddown ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
# DW entry by period
f_dw_acute <- as.formula(paste("dw_acute ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
f_dw_post <- as.formula(paste("dw_post ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
m8_acute <- feols(f_acute, data = df, vcov = ~idrssd)
m8_post <- feols(f_post, data = df, vcov = ~idrssd)
m8_arb <- feols(f_arb, data = df, vcov = ~idrssd)
m8_winddown <- feols(f_winddown, data = df, vcov = ~idrssd)
m8_dw_acute <- feols(f_dw_acute, data = df, vcov = ~idrssd)
m8_dw_post <- feols(f_dw_post, data = df, vcov = ~idrssd)
table8 <- modelsummary(
list("(1) BTFP Acute" = m8_acute,
"(2) BTFP Post" = m8_post,
"(3) BTFP Arb" = m8_arb,
"(4) BTFP Wind" = m8_winddown,
"(5) DW Acute" = m8_dw_acute,
"(6) DW Post" = m8_dw_post),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 8: Facility Entry by Crisis Phase",
notes = list("Bank-clustered SEs.",
"Acute: Mar 13 - May 1 | Post-Acute: May 2 - Oct 31 | Arbitrage: Nov 1 - Jan 24 | Wind-down: Jan 25 - Mar 11"),
output = "kableExtra"
)
table8| (1) BTFP Acute | (2) BTFP Post | (3) BTFP Arb | (4) BTFP Wind | (5) DW Acute | (6) DW Post | |
|---|---|---|---|---|---|---|
| MTM Loss (BTFP-Eligible) | −0.009 | 0.051*** | 0.028*** | 0.001 | −0.009 | 0.006 |
| (0.014) | (0.016) | (0.011) | (0.004) | (0.013) | (0.016) | |
| MTM Loss (Non-BTFP) | 0.002 | 0.003 | 0.003* | 0.001 | 0.004* | −0.004 |
| (0.002) | (0.002) | (0.002) | (0.001) | (0.002) | (0.003) | |
| Uninsured Leverage | 0.001 | 0.001** | 0.001 | 0.000 | 0.000 | −0.000 |
| (0.001) | (0.001) | (0.000) | (0.000) | (0.001) | (0.001) | |
| MTM(BTFP) × Uninsured | 0.001** | −0.001** | −0.001*** | −0.000 | 0.001 | −0.000 |
| (0.001) | (0.001) | (0.000) | (0.000) | (0.001) | (0.001) | |
| Log(Assets) | 0.032*** | 0.010** | 0.016*** | −0.001 | 0.047*** | 0.053*** |
| (0.004) | (0.004) | (0.003) | (0.001) | (0.004) | (0.005) | |
| Cash Ratio | −0.002*** | −0.002*** | −0.001** | 0.000 | 0.001 | −0.000 |
| (0.001) | (0.001) | (0.000) | (0.000) | (0.001) | (0.001) | |
| Securities Ratio | 0.001 | 0.002*** | −0.000 | 0.000 | 0.000 | −0.000 |
| (0.000) | (0.001) | (0.000) | (0.000) | (0.000) | (0.001) | |
| Loan/Deposit | −0.001** | 0.001 | −0.000 | 0.000 | −0.000 | 0.001* |
| (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | (0.000) | |
| Book Equity | −0.002*** | −0.003*** | −0.001 | −0.000 | −0.000 | −0.000 |
| (0.001) | (0.001) | (0.001) | (0.000) | (0.001) | (0.001) | |
| Wholesale Funding | 0.012*** | −0.001 | −0.001 | 0.001 | 0.008*** | −0.007** |
| (0.003) | (0.003) | (0.002) | (0.001) | (0.003) | (0.003) | |
| FHLB Ratio | 0.008*** | −0.001 | 0.000 | −0.000 | 0.002 | −0.001 |
| (0.001) | (0.001) | (0.001) | (0.000) | (0.001) | (0.002) | |
| ROA | 0.001 | 0.003 | −0.014*** | 0.001 | 0.005 | −0.009 |
| (0.007) | (0.008) | (0.005) | (0.002) | (0.007) | (0.009) | |
| Num.Obs. | 4678 | 4678 | 4678 | 4678 | 4678 | 4678 |
| R2 | 0.072 | 0.028 | 0.017 | 0.002 | 0.068 | 0.051 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||
| Bank-clustered SEs. | ||||||
| Acute: Mar 13 - May 1 | Post-Acute: May 2 - Oct 31 | Arbitrage: Nov 1 - Jan 24 | Wind-down: Jan 25 - Mar 11 |
modelsummary(
list("(1) BTFP Acute" = m8_acute,
"(2) BTFP Post" = m8_post,
"(3) BTFP Arb" = m8_arb,
"(4) BTFP Wind" = m8_winddown,
"(5) DW Acute" = m8_dw_acute,
"(6) DW Post" = m8_dw_post),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 8: Temporal Dynamics",
output = file.path(TABLE_PATH, "table8_temporal.html")
)7.5 Figure 6: Temporal Coefficient Evolution
# ============================================================================
# FIGURE 6: COEFFICIENT COMPARISON ACROSS PERIODS
# ============================================================================
coef_temporal <- bind_rows(
tidy(m8_acute, conf.int = TRUE) %>% mutate(period = "Acute Crisis"),
tidy(m8_post, conf.int = TRUE) %>% mutate(period = "Post-Acute"),
tidy(m8_arb, conf.int = TRUE) %>% mutate(period = "Arbitrage"),
tidy(m8_winddown, conf.int = TRUE) %>% mutate(period = "Wind-down")
) %>%
filter(term %in% c("mtm_btfp", "uninsured_lev", "I(mtm_btfp * uninsured_lev)")) %>%
mutate(
term = case_when(
term == "mtm_btfp" ~ "MTM Loss (BTFP)",
term == "uninsured_lev" ~ "Uninsured Leverage",
term == "I(mtm_btfp * uninsured_lev)" ~ "MTM × Uninsured"
),
period = factor(period, levels = c("Acute Crisis", "Post-Acute", "Arbitrage", "Wind-down"))
)
fig6 <- ggplot(coef_temporal, aes(x = period, y = estimate, fill = period)) +
geom_col(alpha = 0.8) +
geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
geom_hline(yintercept = 0, linetype = "dashed") +
facet_wrap(~term, scales = "free_y") +
scale_fill_manual(values = c("Acute Crisis" = "#FFB3B3", "Post-Acute" = "#90EE90",
"Arbitrage" = "#87CEEB", "Wind-down" = "#DADAEB")) +
labs(
title = "Figure 6: How Borrowing Determinants Changed Across Crisis Phases",
subtitle = "Uninsured leverage strongest in Acute phase; MTM losses matter throughout",
x = NULL, y = "Coefficient Estimate", fill = NULL
) +
theme_pub() +
theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1))
print(fig6)
7.6 Table 9: Insolvency Analysis
# ============================================================================
# TABLE 9: INSOLVENCY ANALYSIS
# ============================================================================
# Various insolvency measures
f_ins1 <- as.formula(paste("btfp ~ adjusted_equity + uninsured_lev +", CONTROLS))
f_ins2 <- as.formula(paste("btfp ~ mtm_insolvent + uninsured_lev +", CONTROLS))
f_ins3 <- as.formula(paste("btfp ~ idcr_1 + uninsured_lev +", CONTROLS))
f_ins4 <- as.formula(paste("btfp ~ idcr_2 + uninsured_lev +", CONTROLS))
f_ins5 <- as.formula(paste("btfp ~ insolvent_idcr_s50 + uninsured_lev +", CONTROLS))
f_ins6 <- as.formula(paste("btfp ~ insolvent_idcr_s100 + uninsured_lev +", CONTROLS))
m9_1 <- feols(f_ins1, data = df, vcov = ~idrssd)
m9_2 <- feols(f_ins2, data = df, vcov = ~idrssd)
m9_3 <- feols(f_ins3, data = df, vcov = ~idrssd)
m9_4 <- feols(f_ins4, data = df, vcov = ~idrssd)
m9_5 <- feols(f_ins5, data = df, vcov = ~idrssd)
m9_6 <- feols(f_ins6, data = df, vcov = ~idrssd)
table9 <- modelsummary(
list("(1) Adj Equity" = m9_1, "(2) MTM Insol" = m9_2,
"(3) IDCR s=0.5" = m9_3, "(4) IDCR s=1.0" = m9_4,
"(5) IDCR Dum s=0.5" = m9_5, "(6) IDCR Dum s=1.0" = m9_6),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 9: Insolvency and Facility Access",
notes = list("Bank-clustered SEs.",
"Insolvent measures following Jiang et al. (2023).",
"MTM Insolvent = Adjusted Equity < 0. IDCR = Insured Deposit Coverage Ratio."),
output = "kableExtra"
)
table9| (1) Adj Equity | (2) MTM Insol | (3) IDCR s=0.5 | (4) IDCR s=1.0 | (5) IDCR Dum s=0.5 | (6) IDCR Dum s=1.0 | |
|---|---|---|---|---|---|---|
| Uninsured Leverage | 0.002*** | 0.002*** | 0.003*** | 0.002*** | 0.002*** | 0.002** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Adjusted Equity | −0.019*** | |||||
| (0.003) | ||||||
| MTM Insolvent | 0.075*** | |||||
| (0.020) | ||||||
| Log(Assets) | 0.059*** | 0.062*** | 0.062*** | 0.061*** | 0.062*** | 0.062*** |
| (0.006) | (0.006) | (0.006) | (0.006) | (0.006) | (0.006) | |
| Cash Ratio | −0.004*** | −0.005*** | −0.004*** | −0.004*** | −0.004*** | −0.004*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Securities Ratio | 0.003*** | 0.003*** | 0.005*** | 0.005*** | 0.005*** | 0.005*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Loan/Deposit | 0.000 | 0.000 | 0.001 | 0.001 | 0.001 | 0.001* |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Book Equity | 0.011*** | −0.005*** | −0.007*** | −0.007*** | −0.009*** | −0.008*** |
| (0.003) | (0.001) | (0.002) | (0.002) | (0.001) | (0.001) | |
| Wholesale Funding | 0.010*** | 0.009** | 0.010** | 0.010** | 0.008** | 0.009** |
| (0.004) | (0.004) | (0.004) | (0.004) | (0.004) | (0.004) | |
| FHLB Ratio | 0.005*** | 0.006*** | 0.006*** | 0.006*** | 0.005** | 0.005*** |
| (0.002) | (0.002) | (0.002) | (0.002) | (0.002) | (0.002) | |
| ROA | −0.012 | −0.018* | −0.021* | −0.021* | −0.024** | −0.023** |
| (0.010) | (0.010) | (0.011) | (0.011) | (0.011) | (0.011) | |
| Num.Obs. | 4678 | 4678 | 4632 | 4632 | 4632 | 4632 |
| R2 | 0.116 | 0.112 | 0.109 | 0.109 | 0.108 | 0.109 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||
| Bank-clustered SEs. | ||||||
| Insolvent measures following Jiang et al. (2023). | ||||||
| MTM Insolvent = Adjusted Equity < 0. IDCR = Insured Deposit Coverage Ratio. |
modelsummary(
list("(1) Adj Equity" = m9_1, "(2) MTM Insol" = m9_2,
"(3) IDCR s=0.5" = m9_3, "(4) IDCR s=1.0" = m9_4,
"(5) IDCR Dum s=0.5" = m9_5, "(6) IDCR Dum s=1.0" = m9_6),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 9: Insolvency Analysis",
output = file.path(TABLE_PATH, "table9_insolvency.html")
)7.7 Table 10: Intensive Margin with IPW Selection Correction
# ============================================================================
# TABLE 10: INTENSIVE MARGIN WITH IPW SELECTION CORRECTION
# ============================================================================
# Create complete cases dataset for propensity score estimation
ps_vars <- c("btfp", "mtm_btfp", "mtm_other", "uninsured_lev", "omo_ratio",
"ln_assets", "cash_ratio", "securities_ratio", "loan_to_deposit",
"book_equity_ratio", "wholesale", "fhlb_ratio", "roa", "idrssd",
"btfp_pct", "btfp_util", "borrowing_subsidy", "prior_dw", "maxed_out",
"non_omo_ratio", "high_uninsured", "high_mtm_btfp")
df_ps <- df %>%
select(any_of(ps_vars)) %>%
drop_na(mtm_btfp, mtm_other, uninsured_lev, omo_ratio, ln_assets, cash_ratio,
securities_ratio, loan_to_deposit, book_equity_ratio, wholesale, fhlb_ratio, roa)
cat("Complete cases for PS estimation:", nrow(df_ps), "\n")Complete cases for PS estimation: 4678
# Estimate propensity score for BTFP participation
ps_formula <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + omo_ratio +", CONTROLS))
ps_model <- glm(ps_formula, data = df_ps, family = binomial(link = "logit"))
df_ps$ps_btfp <- predict(ps_model, type = "response")
# Calculate IPW
df_ps <- df_ps %>%
mutate(
ipw = ifelse(btfp == 1, 1 / ps_btfp, NA_real_),
ipw_stab = ifelse(btfp == 1, mean(btfp) / ps_btfp, NA_real_)
)
# Trim extreme weights
btfp_ipw <- df_ps$ipw[df_ps$btfp == 1 & !is.na(df_ps$ipw)]
btfp_ipw_stab <- df_ps$ipw_stab[df_ps$btfp == 1 & !is.na(df_ps$ipw_stab)]
df_ps <- df_ps %>%
mutate(
ipw_trim = ifelse(!is.na(ipw),
pmin(pmax(ipw, quantile(btfp_ipw, 0.01, na.rm = TRUE)),
quantile(btfp_ipw, 0.99, na.rm = TRUE)), NA_real_),
ipw_stab_trim = ifelse(!is.na(ipw_stab),
pmin(pmax(ipw_stab, quantile(btfp_ipw_stab, 0.01, na.rm = TRUE)),
quantile(btfp_ipw_stab, 0.99, na.rm = TRUE)), NA_real_)
)
# BTFP users subset
df_btfp <- df_ps %>% filter(btfp == 1, !is.na(btfp_pct))
cat("BTFP users for intensive margin:", nrow(df_btfp), "\n")BTFP users for intensive margin: 1305
# Intensive margin models
f_int <- as.formula(paste("btfp_pct ~ mtm_btfp + mtm_other + uninsured_lev + omo_ratio +", CONTROLS))
m10_naive <- feols(f_int, data = df_btfp, vcov = ~idrssd)
m10_ipw <- feols(f_int, data = df_btfp, weights = ~ipw_trim, vcov = ~idrssd)
m10_sipw <- feols(f_int, data = df_btfp, weights = ~ipw_stab_trim, vcov = ~idrssd)
# Utilization models
f_util <- as.formula(paste("btfp_util ~ borrowing_subsidy + uninsured_lev + omo_ratio +", CONTROLS))
f_util2 <- as.formula(paste("btfp_util ~ mtm_btfp + mtm_other + uninsured_lev + omo_ratio +", CONTROLS))
m10_util <- feols(f_util, data = df_btfp, vcov = ~idrssd)
m10_util2 <- feols(f_util2, data = df_btfp, vcov = ~idrssd)
table10 <- modelsummary(
list("(1) Naive OLS" = m10_naive, "(2) IPW" = m10_ipw,
"(3) Stab IPW" = m10_sipw, "(4) Util: Subsidy" = m10_util,
"(5) Util: MTM" = m10_util2),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 10: Intensive Margin with IPW Selection Correction",
notes = list("Sample: BTFP borrowers only. Bank-clustered SEs.",
"Cols 2-3 use inverse probability weights to correct for selection.",
"Cols 4-5: Dependent variable is BTFP utilization (Amount/OMO-Eligible)."),
output = "kableExtra"
)
table10| (1) Naive OLS | (2) IPW | (3) Stab IPW | (4) Util: Subsidy | (5) Util: MTM | |
|---|---|---|---|---|---|
| MTM Loss (BTFP-Eligible) | −1.346 | −2.725* | −2.725* | −0.386 | |
| (1.149) | (1.406) | (1.406) | (0.249) | ||
| MTM Loss (Non-BTFP) | −0.269 | −0.310 | −0.310 | −0.183** | |
| (0.271) | (0.318) | (0.318) | (0.090) | ||
| Uninsured Leverage | 0.116** | 0.113* | 0.113* | 0.033** | 0.026 |
| (0.053) | (0.061) | (0.061) | (0.016) | (0.016) | |
| Borrowing Subsidy | 0.035 | ||||
| (0.043) | |||||
| BTFP-Eligible Ratio | 0.229** | 0.266** | 0.266** | −0.222*** | −0.216*** |
| (0.108) | (0.134) | (0.134) | (0.020) | (0.029) | |
| Log(Assets) | −0.077 | 0.182 | 0.182 | −0.225* | −0.127 |
| (0.432) | (0.588) | (0.588) | (0.134) | (0.135) | |
| Cash Ratio | −0.403*** | −0.430*** | −0.430*** | −0.080** | −0.106*** |
| (0.147) | (0.164) | (0.164) | (0.039) | (0.038) | |
| Securities Ratio | 0.026 | −0.071 | −0.071 | 0.056 | 0.060 |
| (0.149) | (0.171) | (0.171) | (0.038) | (0.037) | |
| Loan/Deposit | −0.156 | −0.263* | −0.263* | −0.007 | −0.009 |
| (0.129) | (0.154) | (0.154) | (0.030) | (0.029) | |
| Book Equity | 0.389* | 0.564** | 0.564** | 0.107** | 0.074 |
| (0.216) | (0.273) | (0.273) | (0.052) | (0.053) | |
| Wholesale Funding | 0.573** | 0.617* | 0.617* | −0.021 | −0.032 |
| (0.291) | (0.321) | (0.321) | (0.082) | (0.083) | |
| FHLB Ratio | 0.684*** | 0.816*** | 0.816*** | 0.140*** | 0.139*** |
| (0.202) | (0.264) | (0.264) | (0.054) | (0.053) | |
| ROA | −0.555 | −0.510 | −0.510 | −0.272 | −0.418 |
| (0.990) | (1.265) | (1.265) | (0.305) | (0.301) | |
| Num.Obs. | 1305 | 1305 | 1305 | 1259 | 1259 |
| R2 | 0.075 | 0.093 | 0.093 | 0.151 | 0.155 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||||
| Sample: BTFP borrowers only. Bank-clustered SEs. | |||||
| Cols 2-3 use inverse probability weights to correct for selection. | |||||
| Cols 4-5: Dependent variable is BTFP utilization (Amount/OMO-Eligible). |
modelsummary(
list("(1) Naive OLS" = m10_naive, "(2) IPW" = m10_ipw,
"(3) Stab IPW" = m10_sipw, "(4) Util: Subsidy" = m10_util,
"(5) Util: MTM" = m10_util2),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 10: Intensive Margin",
output = file.path(TABLE_PATH, "table10_intensive.html")
)7.8 Figure 7: IPW Diagnostics
# ============================================================================
# FIGURE 7: IPW DIAGNOSTICS
# ============================================================================
# Propensity score distribution
p7a <- df_ps %>%
filter(!is.na(ps_btfp)) %>%
ggplot(aes(x = ps_btfp, fill = factor(btfp))) +
geom_histogram(bins = 50, alpha = 0.7, position = "identity") +
scale_fill_manual(values = c("0" = "gray70", "1" = COLORS$btfp),
labels = c("Non-borrower", "BTFP borrower")) +
labs(title = "A: Propensity Score Distribution",
subtitle = "Good overlap supports IPW validity",
x = "Propensity Score", y = "Count", fill = NULL) +
theme_pub()
# Weight distribution
p7b <- df_btfp %>%
filter(!is.na(ipw_trim)) %>%
ggplot(aes(x = ipw_trim)) +
geom_histogram(bins = 30, fill = COLORS$btfp, alpha = 0.7) +
geom_vline(xintercept = 1, linetype = "dashed", color = "red") +
labs(title = "B: IPW Distribution (Trimmed)",
subtitle = sprintf("Mean = %.2f, SD = %.2f",
mean(df_btfp$ipw_trim, na.rm = TRUE),
sd(df_btfp$ipw_trim, na.rm = TRUE)),
x = "Inverse Probability Weight", y = "Count") +
theme_pub()
fig7 <- p7a + p7b + plot_annotation(title = "Figure 7: IPW Diagnostics for Selection Correction")
print(fig7)
7.9 Table 11: Both-Facility Mechanisms
# ============================================================================
# TABLE 11: WHY USE BOTH FACILITIES?
# ============================================================================
df_fed <- df %>% filter(any_fed == 1)
f_maxout <- as.formula(paste("both ~ maxed_out + mtm_btfp + uninsured_lev +", CONTROLS))
f_oper <- as.formula(paste("both ~ prior_dw + mtm_btfp + uninsured_lev +", CONTROLS))
f_coll <- as.formula(paste("both ~ non_omo_ratio + omo_ratio + mtm_btfp + uninsured_lev +", CONTROLS))
f_full <- as.formula(paste("both ~ maxed_out + prior_dw + non_omo_ratio + mtm_btfp + uninsured_lev +", CONTROLS))
f_interact <- as.formula(paste("both ~ mtm_btfp + prior_dw + I(mtm_btfp * prior_dw) + uninsured_lev +", CONTROLS))
m11_1 <- feols(f_maxout, data = df_fed, vcov = ~idrssd)
m11_2 <- feols(f_oper, data = df_fed, vcov = ~idrssd)
m11_3 <- feols(f_coll, data = df_fed, vcov = ~idrssd)
m11_4 <- feols(f_full, data = df_fed, vcov = ~idrssd)
m11_5 <- feols(f_interact, data = df_fed, vcov = ~idrssd)
table11 <- modelsummary(
list("(1) Max-Out" = m11_1, "(2) Operational" = m11_2,
"(3) Collateral" = m11_3, "(4) Combined" = m11_4,
"(5) Interaction" = m11_5),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 11: Why Use Both Facilities? Competing Mechanisms",
notes = list("Sample: Fed borrowers. Bank-clustered SEs.",
"Max-Out: BTFP utilization > 90%. Prior DW: Used DW before BTFP (Mar 1-10, 2023)."),
output = "kableExtra"
)
table11| (1) Max-Out | (2) Operational | (3) Collateral | (4) Combined | (5) Interaction | |
|---|---|---|---|---|---|
| MTM Loss (BTFP-Eligible) | 0.030** | 0.017 | 0.008 | 0.013 | 0.011 |
| (0.015) | (0.015) | (0.021) | (0.020) | (0.015) | |
| Uninsured Leverage | 0.003*** | 0.003*** | 0.003*** | 0.003*** | 0.003*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Prior DW User | 0.238*** | 0.231*** | 0.150** | ||
| (0.052) | (0.049) | (0.071) | |||
| BTFP-Eligible Ratio | 0.004 | ||||
| (0.004) | |||||
| DW-Only Eligible Ratio | 0.003 | −0.002 | |||
| (0.003) | (0.002) | ||||
| Maxed Out (>90%) | 0.138*** | 0.138*** | |||
| (0.022) | (0.021) | ||||
| MTM(BTFP) × Prior DW | 0.115* | ||||
| (0.062) | |||||
| Log(Assets) | 0.052*** | 0.046*** | 0.051*** | 0.049*** | 0.047*** |
| (0.008) | (0.008) | (0.008) | (0.008) | (0.008) | |
| Cash Ratio | −0.003 | −0.004 | −0.004 | −0.003 | −0.004 |
| (0.002) | (0.002) | (0.003) | (0.003) | (0.002) | |
| Securities Ratio | −0.000 | 0.000 | −0.002 | 0.001 | 0.000 |
| (0.002) | (0.002) | (0.003) | (0.002) | (0.002) | |
| Loan/Deposit | −0.001 | −0.001 | −0.002 | 0.000 | −0.001 |
| (0.002) | (0.002) | (0.003) | (0.002) | (0.002) | |
| Book Equity | −0.002 | −0.002 | −0.001 | −0.003 | −0.002 |
| (0.003) | (0.003) | (0.004) | (0.003) | (0.003) | |
| Wholesale Funding | 0.010** | 0.008 | 0.013** | 0.006 | 0.008 |
| (0.005) | (0.005) | (0.006) | (0.005) | (0.005) | |
| FHLB Ratio | 0.005 | 0.006* | 0.008** | 0.003 | 0.006* |
| (0.003) | (0.003) | (0.004) | (0.003) | (0.003) | |
| ROA | −0.013 | −0.014 | −0.017 | −0.009 | −0.015 |
| (0.019) | (0.019) | (0.019) | (0.019) | (0.019) | |
| Num.Obs. | 1947 | 1947 | 1947 | 1947 | 1947 |
| R2 | 0.082 | 0.074 | 0.060 | 0.096 | 0.076 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||||
| Sample: Fed borrowers. Bank-clustered SEs. | |||||
| Max-Out: BTFP utilization > 90%. Prior DW: Used DW before BTFP (Mar 1-10, 2023). |
modelsummary(
list("(1) Max-Out" = m11_1, "(2) Operational" = m11_2,
"(3) Collateral" = m11_3, "(4) Combined" = m11_4,
"(5) Interaction" = m11_5),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 11: Both-Facility Mechanisms",
output = file.path(TABLE_PATH, "table11_both_mechanisms.html")
)7.10 Table 12: Robustness - Alternative Estimators
# ============================================================================
# TABLE 12: LPM vs LOGIT vs PROBIT
# ============================================================================
f_main <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
# Fixed: Added size_cat to the selection
df_complete <- df %>%
select(btfp, dw, any_fed, mtm_btfp, mtm_other, uninsured_lev, ln_assets, cash_ratio,
securities_ratio, loan_to_deposit, book_equity_ratio, wholesale, fhlb_ratio, roa,
idrssd, size_cat) %>%
drop_na()
# LPM with bank-clustered SEs
m12_lpm <- feols(f_main, data = df_complete, vcov = ~idrssd)
# Logit
m12_logit <- glm(f_main, data = df_complete, family = binomial(link = "logit"))
# Probit
m12_probit <- glm(f_main, data = df_complete, family = binomial(link = "probit"))
# Heteroskedastic robust SE
m12_hetero <- feols(f_main, data = df_complete, vcov = "hetero")
# Size-bin clustered SEs - with error handling in case size_cat has issues
m12_size <- tryCatch(
feols(f_main, data = df_complete, vcov = ~size_cat),
error = function(e) {
message("Size clustering failed: ", e$message)
feols(f_main, data = df_complete, vcov = "hetero") # Fallback to hetero
}
)
table12 <- modelsummary(
list("(1) LPM Bank-Clust" = m12_lpm, "(2) LPM Hetero" = m12_hetero,
"(3) LPM Size-Clust" = m12_size, "(4) Logit" = m12_logit,
"(5) Probit" = m12_probit),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared", "AIC"),
title = "Table 12: Robustness - Alternative Estimators and SE Specifications",
notes = list("Col 1: LPM with bank-clustered SEs (preferred).",
"Col 2: Heteroskedastic-robust SEs. Col 3: Size-bin clustered SEs.",
"Cols 4-5: Logit and Probit for comparison."),
output = "kableExtra"
)
table12| (1) LPM Bank-Clust | (2) LPM Hetero | (3) LPM Size-Clust | (4) Logit | (5) Probit | |
|---|---|---|---|---|---|
| MTM Loss (BTFP-Eligible) | 0.070*** | 0.070*** | 0.070 | 0.506*** | 0.295*** |
| (0.021) | (0.021) | (0.021) | (0.115) | (0.068) | |
| MTM Loss (Non-BTFP) | 0.009*** | 0.009*** | 0.009 | 0.039* | 0.023* |
| (0.003) | (0.003) | (0.005) | (0.020) | (0.012) | |
| Uninsured Leverage | 0.003*** | 0.003*** | 0.003 | 0.022*** | 0.013*** |
| (0.001) | (0.001) | (0.001) | (0.005) | (0.003) | |
| MTM(BTFP) × Uninsured | −0.001 | −0.001 | −0.001 | −0.014*** | −0.008*** |
| (0.001) | (0.001) | (0.001) | (0.004) | (0.002) | |
| Log(Assets) | 0.057*** | 0.057*** | 0.057 | 0.297*** | 0.178*** |
| (0.006) | (0.006) | (0.019) | (0.033) | (0.019) | |
| Cash Ratio | −0.005*** | −0.005*** | −0.005** | −0.015 | −0.007 |
| (0.001) | (0.001) | (0.000) | (0.011) | (0.006) | |
| Securities Ratio | 0.002*** | 0.002*** | 0.002 | 0.053*** | 0.031*** |
| (0.001) | (0.001) | (0.001) | (0.010) | (0.006) | |
| Loan/Deposit | −0.000 | −0.000 | −0.000 | 0.033*** | 0.019*** |
| (0.001) | (0.001) | (0.000) | (0.008) | (0.005) | |
| Book Equity | −0.006*** | −0.006*** | −0.006** | −0.091*** | −0.050*** |
| (0.001) | (0.001) | (0.000) | (0.013) | (0.007) | |
| Wholesale Funding | 0.010** | 0.010** | 0.010 | 0.007 | 0.006 |
| (0.004) | (0.004) | (0.006) | (0.021) | (0.012) | |
| FHLB Ratio | 0.007*** | 0.007*** | 0.007 | −0.005 | −0.002 |
| (0.002) | (0.002) | (0.004) | (0.013) | (0.008) | |
| ROA | −0.009 | −0.009 | −0.009 | −0.106 | −0.058 |
| (0.010) | (0.010) | (0.002) | (0.075) | (0.043) | |
| Num.Obs. | 4678 | 4678 | 4678 | 4678 | 4678 |
| R2 | 0.114 | 0.114 | 0.114 | ||
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||||
| Col 1: LPM with bank-clustered SEs (preferred). | |||||
| Col 2: Heteroskedastic-robust SEs. Col 3: Size-bin clustered SEs. | |||||
| Cols 4-5: Logit and Probit for comparison. |
modelsummary(
list("(1) LPM Bank-Clust" = m12_lpm, "(2) LPM Hetero" = m12_hetero,
"(3) LPM Size-Clust" = m12_size, "(4) Logit" = m12_logit,
"(5) Probit" = m12_probit),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared", "AIC"),
title = "Table 12: Robustness",
output = file.path(TABLE_PATH, "table12_robustness.html")
)7.11 Figure 8: ROC Curve - Model Fit
# ============================================================================
# FIGURE 8: ROC CURVE AND AUC
# ============================================================================
df_complete$pred <- predict(m12_logit, type = "response")
roc_obj <- roc(df_complete$btfp, df_complete$pred, quiet = TRUE)
fig8 <- ggroc(roc_obj, color = COLORS$btfp, size = 1.2) +
geom_abline(slope = 1, intercept = 1, linetype = "dashed", color = "gray50") +
annotate("text", x = 0.3, y = 0.2, label = sprintf("AUC = %.3f", auc(roc_obj)),
size = 5, fontface = "bold") +
labs(title = "Figure: ROC Curve - BTFP Selection Model",
subtitle = sprintf("N = %d | Good discrimination despite low R²", nrow(df_complete)),
x = "Specificity", y = "Sensitivity") +
theme_pub()
print(fig8)
7.12 Table 13: Incremental R² Analysis
# ============================================================================
# TABLE 13: INCREMENTAL R² - PREDICTIVE BLOCKS
# ============================================================================
# Block 1: Controls only
f_b1 <- as.formula(paste("btfp ~", CONTROLS))
# Block 2: + MTM decomposition
f_b2 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other +", CONTROLS))
# Block 3: + Uninsured leverage
f_b3 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev +", CONTROLS))
# Block 4: + Interaction
f_b4 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
# Block 5: + Prior DW (operational readiness)
f_b5 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) + prior_dw +", CONTROLS))
# Block 6: + Collateral ratios
f_b6 <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) + prior_dw + omo_ratio + non_omo_ratio +", CONTROLS))
m_b1 <- feols(f_b1, data = df, vcov = ~idrssd)
m_b2 <- feols(f_b2, data = df, vcov = ~idrssd)
m_b3 <- feols(f_b3, data = df, vcov = ~idrssd)
m_b4 <- feols(f_b4, data = df, vcov = ~idrssd)
m_b5 <- feols(f_b5, data = df, vcov = ~idrssd)
m_b6 <- feols(f_b6, data = df, vcov = ~idrssd)
# Extract R² values properly
get_r2 <- function(model) {
r2_vals <- fixest::r2(model)
as.numeric(r2_vals["r2"])
}
r2_vals <- c(get_r2(m_b1), get_r2(m_b2), get_r2(m_b3), get_r2(m_b4), get_r2(m_b5), get_r2(m_b6))
# Create incremental R² table
r2_table <- tibble(
Block = c("(1) Controls Only", "(2) + MTM Decomposition", "(3) + Uninsured Leverage",
"(4) + Interaction", "(5) + Prior DW", "(6) + Collateral Ratios"),
`R²` = r2_vals,
`Δ R²` = c(NA, diff(r2_vals)),
`% Increase` = c(NA, diff(r2_vals) / head(r2_vals, -1) * 100)
)
table13 <- r2_table %>%
mutate(across(c(`R²`, `Δ R²`), ~round(., 4)),
`% Increase` = round(`% Increase`, 1)) %>%
kable(caption = "Table 13: Incremental R² - Building Explanatory Power") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
footnote(general = "MTM decomposition adds substantial predictive power. Low overall R² is expected for binary choice models.")
table13| Block | R² | Δ R² | % Increase |
|---|---|---|---|
|
0.1092 | ||
|
0.1117 | 0.0024 | 2.2 |
|
0.1134 | 0.0017 | 1.6 |
|
0.1138 | 0.0004 | 0.4 |
|
0.1151 | 0.0013 | 1.1 |
|
0.1167 | 0.0016 | 1.4 |
| Note: | |||
| MTM decomposition adds substantial predictive power. Low overall R² is expected for binary choice models. |
8 Summary of Findings
# ============================================================================
# SUMMARY OF KEY FINDINGS
# ============================================================================
findings <- tribble(
~Question, ~Finding, ~Evidence,
"1. Par Valuation Selection",
"Banks with higher MTM(BTFP-eligible) systematically select BTFP",
"Table 5: Significant effect for BTFP; No effect on DW",
"2. Run Risk",
"Run risk (MTM × Uninsured) predicts Fed borrowing",
"Table 6: Both continuous and dummy measures significant",
"3. Placebo Validation",
"Effect absent pre-BTFP when par valuation didn't exist",
"Table 7: Pre-DW coefficient insignificant vs BTFP significant",
"4. Temporal Evolution",
"Acute: Run-driven | Post: Par valuation | Arb: Rate advantage",
"Table 8: Interaction sig in Acute; MTM sig throughout",
"5. Insolvency Channel",
"MTM-insolvent banks more likely to use BTFP",
"Table 9: MTM Insolvent and IDCR measures significant",
"6. Intensive Margin",
"Selection correction does not change main results",
"Table 10: IPW results consistent with naive estimates",
"7. Both-Facility Mechanisms",
"Operational/timing dominates max-out hypothesis",
"Table 11: Prior DW > Maxed Out in predictive power",
"8. Robustness",
"Results robust across estimators and SE specifications",
"Table 12: LPM, Logit, Probit yield consistent conclusions"
)
findings_table <- findings %>%
kable(caption = "Summary of Key Findings") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE) %>%
column_spec(1, bold = TRUE, width = "20%") %>%
column_spec(2, width = "40%") %>%
column_spec(3, width = "40%")
findings_table| Question | Finding | Evidence |
|---|---|---|
|
Banks with higher MTM(BTFP-eligible) systematically select BTFP | Table 5: Significant effect for BTFP; No effect on DW |
|
Run risk (MTM × Uninsured) predicts Fed borrowing | Table 6: Both continuous and dummy measures significant |
|
Effect absent pre-BTFP when par valuation didn’t exist | Table 7: Pre-DW coefficient insignificant vs BTFP significant |
|
Acute: Run-driven | Post: Par valuation | Arb: Rate advantage | Table 8: Interaction sig in Acute; MTM sig throughout |
|
MTM-insolvent banks more likely to use BTFP | Table 9: MTM Insolvent and IDCR measures significant |
|
Selection correction does not change main results | Table 10: IPW results consistent with naive estimates |
|
Operational/timing dominates max-out hypothesis | Table 11: Prior DW > Maxed Out in predictive power |
|
Results robust across estimators and SE specifications | Table 12: LPM, Logit, Probit yield consistent conclusions |
8.1 Figure 9: Summary Visualization
# ============================================================================
# FIGURE 9: SUMMARY VISUALIZATION
# ============================================================================
# Panel 1: Facility usage distribution
p_sum1 <- df %>%
count(facility_choice) %>%
mutate(pct = n / sum(n) * 100) %>%
ggplot(aes(x = facility_choice, y = pct, fill = facility_choice)) +
geom_col() +
geom_text(aes(label = paste0(round(pct, 1), "%\n(n=", n, ")")), vjust = -0.2) +
scale_fill_manual(values = c("Neither" = "gray70", "BTFP_Only" = COLORS$btfp,
"DW_Only" = COLORS$dw, "Both" = COLORS$both)) +
scale_y_continuous(limits = c(0, 100)) +
labs(title = "A: Facility Usage Distribution", x = NULL, y = "% of Banks") +
theme_pub() + theme(legend.position = "none")
# Panel 2: Key coefficients comparison
coef_compare <- bind_rows(
tidy(m5_2, conf.int = TRUE) %>% filter(term == "mtm_btfp") %>% mutate(model = "BTFP", var = "MTM BTFP"),
tidy(m5_4, conf.int = TRUE) %>% filter(term == "mtm_btfp") %>% mutate(model = "DW", var = "MTM BTFP"),
tidy(m7_2, conf.int = TRUE) %>% filter(term == "mtm_btfp") %>% mutate(model = "Pre-DW", var = "MTM BTFP")
)
p_sum2 <- ggplot(coef_compare, aes(x = model, y = estimate, fill = model)) +
geom_col(alpha = 0.8) +
geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
geom_hline(yintercept = 0, linetype = "dashed") +
scale_fill_manual(values = c("BTFP" = COLORS$btfp, "DW" = COLORS$dw, "Pre-DW" = "gray50")) +
labs(title = "B: MTM(BTFP-Eligible) Effect by Facility",
subtitle = "Par valuation drives BTFP selection (not DW)",
x = NULL, y = "Coefficient") +
theme_pub() + theme(legend.position = "none")
fig9 <- p_sum1 + p_sum2 +
plot_annotation(
title = "Figure 9: Summary - Key Findings",
subtitle = "Par valuation drove BTFP selection; MTM effect significant for BTFP but not DW or Pre-BTFP DW"
)
print(fig9)
8.2 IPW Diagnostics
# ============================================================================
# IPW DIAGNOSTICS
# ============================================================================
# Check propensity score distribution
p_ps <- df_ps %>%
filter(!is.na(ps_btfp)) %>%
ggplot(aes(x = ps_btfp, fill = factor(btfp))) +
geom_histogram(bins = 50, alpha = 0.7, position = "identity") +
scale_fill_manual(values = c("0" = "gray70", "1" = COLORS$btfp),
labels = c("Non-borrower", "BTFP borrower")) +
labs(title = "A: Propensity Score Distribution",
subtitle = "Good overlap supports IPW validity",
x = "Propensity Score", y = "Count", fill = NULL) +
theme_pub()
# Check weight distribution
p_wt <- df_btfp %>%
filter(!is.na(ipw_trim)) %>%
ggplot(aes(x = ipw_trim)) +
geom_histogram(bins = 30, fill = COLORS$btfp, alpha = 0.7) +
geom_vline(xintercept = 1, linetype = "dashed", color = "red") +
labs(title = "B: IPW Distribution (Trimmed)",
subtitle = sprintf("Mean = %.2f, SD = %.2f",
mean(df_btfp$ipw_trim, na.rm = TRUE),
sd(df_btfp$ipw_trim, na.rm = TRUE)),
x = "Inverse Probability Weight", y = "Count") +
theme_pub()
p_ps + p_wt + plot_annotation(title = "IPW Diagnostics for Selection Correction")
9 Both Facilities: Mechanism Analysis
9.1 Timing Analysis: Who Borrowed First?
# ============================================================================
# BOTH-FACILITY TIMING ANALYSIS
# ============================================================================
both_users <- df %>%
filter(both == 1) %>%
mutate(
# Calculate timing
btfp_first_indicator = as.integer(btfp_first_date < dw_first_date),
dw_first_indicator = as.integer(dw_first_date < btfp_first_date),
same_day = as.integer(btfp_first_date == dw_first_date),
# Days between facilities
days_gap = as.numeric(abs(btfp_first_date - dw_first_date)),
# Sequence type
sequence = case_when(
btfp_first_indicator == 1 ~ "BTFP → DW",
dw_first_indicator == 1 ~ "DW → BTFP",
same_day == 1 ~ "Same Day",
TRUE ~ "Unknown"
)
)
# Sequence summary
seq_summary <- both_users %>%
group_by(sequence) %>%
summarise(
N = n(),
`%` = n() / nrow(both_users) * 100,
`Avg Gap (days)` = mean(days_gap, na.rm = TRUE),
`Median Gap` = median(days_gap, na.rm = TRUE),
`Avg MTM (BTFP)` = mean(mtm_btfp, na.rm = TRUE),
`Avg Uninsured` = mean(uninsured_lev, na.rm = TRUE),
`Avg BTFP Util` = mean(btfp_util, na.rm = TRUE),
`% Maxed Out` = mean(maxed_out, na.rm = TRUE) * 100,
.groups = "drop"
)
seq_summary %>%
mutate(across(where(is.numeric), ~round(., 2))) %>%
kable(caption = "**Table 11: Both-Facility Users - Timing Analysis**") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
footnote(general = "BTFP→DW: Used BTFP first, then DW. Gap = days between first loans at each facility.")| sequence | N | % | Avg Gap (days) | Median Gap | Avg MTM (BTFP) | Avg Uninsured | Avg BTFP Util | % Maxed Out |
|---|---|---|---|---|---|---|---|---|
| BTFP → DW | 120 | 28.24 | 82.36 | 78.5 | 0.88 | 27.45 | 2.39 | 51.67 |
| DW → BTFP | 261 | 61.41 | 100.31 | 64.0 | 0.77 | 28.24 | 2.83 | 44.83 |
| Same Day | 44 | 10.35 | 0.00 | 0.0 | 0.83 | 29.58 | 0.74 | 20.45 |
| Note: | ||||||||
| BTFP→DW: Used BTFP first, then DW. Gap = days between first loans at each facility. |
9.2 Table 12: Why Use Both - Competing Mechanisms
# ============================================================================
# TABLE 12: COMPETING MECHANISMS FOR BOTH-FACILITY USE
# ============================================================================
df_fed <- df %>% filter(any_fed == 1)
# Mechanism 1: Max-out hypothesis
f_maxout <- as.formula(paste("both ~ maxed_out + mtm_btfp + uninsured_lev +", CONTROLS))
# Mechanism 2: Operational/timing (prior DW reveals readiness)
f_oper <- as.formula(paste("both ~ prior_dw + mtm_btfp + uninsured_lev +", CONTROLS))
# Mechanism 3: Collateral composition
f_coll <- as.formula(paste("both ~ non_omo_ratio + omo_ratio + mtm_btfp + uninsured_lev +", CONTROLS))
# Mechanism 4: Combined
f_full <- as.formula(paste("both ~ maxed_out + prior_dw + non_omo_ratio + mtm_btfp + uninsured_lev +", CONTROLS))
# Mechanism 5: Interaction - Does operational readiness moderate MTM effect?
f_interact <- as.formula(paste("both ~ mtm_btfp + prior_dw + I(mtm_btfp * prior_dw) + uninsured_lev +", CONTROLS))
m12_1 <- feols(f_maxout, data = df_fed, vcov = ~idrssd)
m12_2 <- feols(f_oper, data = df_fed, vcov = ~idrssd)
m12_3 <- feols(f_coll, data = df_fed, vcov = ~idrssd)
m12_4 <- feols(f_full, data = df_fed, vcov = ~idrssd)
m12_5 <- feols(f_interact, data = df_fed, vcov = ~idrssd)
modelsummary(
list("(1) Max-Out" = m12_1, "(2) Operational" = m12_2, "(3) Collateral" = m12_3,
"(4) Combined" = m12_4, "(5) Interaction" = m12_5),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 12: Why Use Both Facilities? Competing Mechanisms",
notes = list("Sample: Fed borrowers. Bank-clustered SEs.",
"Max-Out: BTFP utilization > 90%. Prior DW: Used DW before BTFP announcement.",
"Interaction: Does prior DW experience amplify MTM effect on both-facility use?")
)| (1) Max-Out | (2) Operational | (3) Collateral | (4) Combined | (5) Interaction | |
|---|---|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||||
| Sample: Fed borrowers. Bank-clustered SEs. | |||||
| Max-Out: BTFP utilization > 90%. Prior DW: Used DW before BTFP announcement. | |||||
| Interaction: Does prior DW experience amplify MTM effect on both-facility use? | |||||
| MTM Loss (BTFP-Eligible) | 0.030** | 0.017 | 0.008 | 0.013 | 0.011 |
| (0.015) | (0.015) | (0.021) | (0.020) | (0.015) | |
| Uninsured Leverage | 0.003*** | 0.003*** | 0.003*** | 0.003*** | 0.003*** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.001) | |
| Prior DW User | 0.238*** | 0.231*** | 0.150** | ||
| (0.052) | (0.049) | (0.071) | |||
| BTFP-Eligible Ratio | 0.004 | ||||
| (0.004) | |||||
| DW-Only Eligible Ratio | 0.003 | -0.002 | |||
| (0.003) | (0.002) | ||||
| Maxed Out (>90%) | 0.138*** | 0.138*** | |||
| (0.022) | (0.021) | ||||
| MTM(BTFP) × Prior DW | 0.115* | ||||
| (0.062) | |||||
| Log(Assets) | 0.052*** | 0.046*** | 0.051*** | 0.049*** | 0.047*** |
| (0.008) | (0.008) | (0.008) | (0.008) | (0.008) | |
| Cash Ratio | -0.003 | -0.004 | -0.004 | -0.003 | -0.004 |
| (0.002) | (0.002) | (0.003) | (0.003) | (0.002) | |
| Securities Ratio | -0.000 | 0.000 | -0.002 | 0.001 | 0.000 |
| (0.002) | (0.002) | (0.003) | (0.002) | (0.002) | |
| Loan/Deposit | -0.001 | -0.001 | -0.002 | 0.000 | -0.001 |
| (0.002) | (0.002) | (0.003) | (0.002) | (0.002) | |
| Book Equity | -0.002 | -0.002 | -0.001 | -0.003 | -0.002 |
| (0.003) | (0.003) | (0.004) | (0.003) | (0.003) | |
| Wholesale Funding | 0.010** | 0.008 | 0.013** | 0.006 | 0.008 |
| (0.005) | (0.005) | (0.006) | (0.005) | (0.005) | |
| FHLB Ratio | 0.005 | 0.006* | 0.008** | 0.003 | 0.006* |
| (0.003) | (0.003) | (0.004) | (0.003) | (0.003) | |
| ROA | -0.013 | -0.014 | -0.017 | -0.009 | -0.015 |
| (0.019) | (0.019) | (0.019) | (0.019) | (0.019) | |
| Num.Obs. | 1947 | 1947 | 1947 | 1947 | 1947 |
| R2 | 0.082 | 0.074 | 0.060 | 0.096 | 0.076 |
9.3 Mechanism Interpretation
# ============================================================================
# MECHANISM INTERPRETATION
# ============================================================================
cat("=== MECHANISM INTERPRETATION ===\n\n")=== MECHANISM INTERPRETATION ===
# Extract key coefficients
maxout_coef <- coef(m12_4)["maxed_out"]
prior_dw_coef <- coef(m12_4)["prior_dw"]
non_omo_coef <- coef(m12_4)["non_omo_ratio"]
cat("From Combined Model (Column 4):\n")From Combined Model (Column 4):
Maxed Out effect: 0.1377
Prior DW effect: 0.2313
Non-OMO Ratio effect: -0.0020
— INTERPRETATION —
if (!is.na(maxout_coef) && maxout_coef > 0.05 && summary(m12_4)$coeftable["maxed_out", "Pr(>|t|)"] < 0.05) {
cat("✓ Max-Out hypothesis SUPPORTED: Banks exhausting BTFP capacity turn to DW.\n")
} else {
cat("✗ Max-Out hypothesis WEAK: Capacity constraint is not the dominant story.\n")
}✓ Max-Out hypothesis SUPPORTED: Banks exhausting BTFP capacity turn to DW.
if (!is.na(prior_dw_coef) && prior_dw_coef > 0.05 && summary(m12_4)$coeftable["prior_dw", "Pr(>|t|)"] < 0.05) {
cat("✓ Operational/Timing hypothesis SUPPORTED: Banks with DW experience use both facilities.\n")
} else {
cat("? Operational hypothesis needs further investigation.\n")
}✓ Operational/Timing hypothesis SUPPORTED: Banks with DW experience use both facilities.
if (!is.na(non_omo_coef) && non_omo_coef > 0.001 && summary(m12_4)$coeftable["non_omo_ratio", "Pr(>|t|)"] < 0.05) {
cat("✓ Collateral hypothesis SUPPORTED: Non-OMO holdings predict DW supplementation.\n")
} else {
cat("? Collateral hypothesis needs further investigation.\n")
}? Collateral hypothesis needs further investigation.
Keep the current analysis. Banks using both facilities are NOT doing so primarily because they have lots of non-BTFP-eligible collateral to pledge at DW.
PAPER CONTRIBUTION: Banks using both BTFP and DW did so primarily for: ✓ Operational readiness (prior DW experience) ✓ Capacity exhaustion (maxed out BTFP) ✗ NOT collateral composition
This suggests facility design should focus on operational frictions, not just collateral eligibility. We test whether collateral composition drives multi-facility use. If banks used both facilities to deploy non-OMO collateral at DW, we would expect a positive coefficient on non-OMO ratio. Instead, we find no significant relationship (Table 12, Col 3), suggesting collateral constraints are not the primary mechanism.
9.4 Figure: Both-Facility Mechanisms
# ============================================================================
# FIGURE: BOTH-FACILITY MECHANISMS
# ============================================================================
# Panel A: Sequence distribution
p_seq <- seq_summary %>%
filter(sequence != "Unknown") %>%
ggplot(aes(x = reorder(sequence, -N), y = N, fill = sequence)) +
geom_col(alpha = 0.8) +
geom_text(aes(label = sprintf("%.0f%%", `%`)), vjust = -0.1, size = 3) +
scale_fill_manual(values = c("BTFP → DW" = COLORS$btfp, "DW → BTFP" = COLORS$dw, "Same Day" = COLORS$both)) +
labs(title = "A: Borrowing Sequence", subtitle = "Which facility came first?",
x = NULL, y = "Number of Banks") +
theme_pub() + theme(legend.position = "none")
# Panel B: Days gap distribution
p_gap <- both_users %>%
filter(sequence %in% c("BTFP → DW", "DW → BTFP")) %>%
ggplot(aes(x = days_gap, fill = sequence)) +
geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
scale_fill_manual(values = c("BTFP → DW" = COLORS$btfp, "DW → BTFP" = COLORS$dw)) +
labs(title = "B: Days Between Facilities",
subtitle = sprintf("Median gap: %.0f days", median(both_users$days_gap, na.rm = TRUE)),
x = "Days Between First Loans", y = "Count", fill = "Sequence") +
theme_pub()
# Panel C: Utilization by sequence
p_util <- both_users %>%
filter(sequence %in% c("BTFP → DW", "DW → BTFP"), !is.na(btfp_util)) %>%
ggplot(aes(x = sequence, y = btfp_util, fill = sequence)) +
geom_boxplot(alpha = 0.7) +
geom_hline(yintercept = 0.9, linetype = "dashed", color = "red") +
annotate("text", x = 1.5, y = 0.95, label = "90% threshold", color = "red", size = 2) +
scale_fill_manual(values = c("BTFP → DW" = COLORS$btfp, "DW → BTFP" = COLORS$dw)) +
labs(title = "C: BTFP Utilization by Sequence",
subtitle = "Do BTFP-first banks max out?",
x = NULL, y = "BTFP Utilization") +
theme_pub() + theme(legend.position = "none")
# Panel D: Characteristics comparison
char_comp <- both_users %>%
filter(sequence %in% c("BTFP → DW", "DW → BTFP")) %>%
group_by(sequence) %>%
summarise(
`MTM (BTFP)` = mean(mtm_btfp, na.rm = TRUE),
`Uninsured Lev` = mean(uninsured_lev, na.rm = TRUE),
`Prior DW` = mean(prior_dw, na.rm = TRUE) * 100,
`Maxed Out` = mean(maxed_out, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
pivot_longer(-sequence, names_to = "Variable", values_to = "Value")
p_char <- char_comp %>%
ggplot(aes(x = Variable, y = Value, fill = sequence)) +
geom_col(position = "dodge", alpha = 0.8) +
scale_fill_manual(values = c("BTFP → DW" = COLORS$btfp, "DW → BTFP" = COLORS$dw)) +
labs(title = "D: Characteristics by Sequence",
subtitle = "DW-first banks: more prior DW experience",
x = NULL, y = "Value", fill = "Sequence") +
theme_pub() +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
(p_seq + p_gap) / (p_util + p_char) +
plot_annotation(title = "Figure: Both-Facility Use Mechanisms",
subtitle = "Evidence favors operational/timing over max-out hypothesis")
# 1. Combine and assign to an object
fig_mechanisms <- (p_seq + p_gap) / (p_util + p_char) +
plot_annotation(
title = "Figure: Both-Facility Use Mechanisms",
subtitle = "Evidence favors operational/timing over max-out hypothesis"
)
# 2. Save the plot
ggsave(
filename = file.path(FIG_PATH, "fig_both_facility_mechanisms.png"),
plot = fig_mechanisms,
width = 14, # Wide enough for two columns
height = 10, # Tall enough for two rows
dpi = 300,
bg = "white"
)10 Partial Utilization Puzzle
10.1 Table 13: Why Don’t Banks Maximize Par Valuation?
# ============================================================================
# TABLE 13: PARTIAL UTILIZATION ANALYSIS
# ============================================================================
# Utilization summary (df_btfp already created in IPW section)
util_summary <- df_btfp %>%
summarise(
N = n(),
`Mean Utilization` = mean(btfp_util, na.rm = TRUE),
`Median Utilization` = median(btfp_util, na.rm = TRUE),
`SD` = sd(btfp_util, na.rm = TRUE),
`% Below 50%` = mean(btfp_util < 0.5, na.rm = TRUE) * 100,
`% Above 90%` = mean(btfp_util > 0.9, na.rm = TRUE) * 100
)
cat("=== UTILIZATION SUMMARY ===\n")=== UTILIZATION SUMMARY ===
11 A tibble: 1 × 6
N `Mean Utilization` `Median Utilization` SD `% Below 50%` `% Above 90%`# Add low/high utilization indicators to df_btfp
df_btfp <- df_btfp %>%
mutate(
low_util = as.integer(btfp_util < 0.5),
high_util = as.integer(btfp_util > 0.9)
)
# What predicts LOW vs HIGH utilization?
f_low <- as.formula("low_util ~ mtm_btfp + uninsured_lev + ln_assets + omo_ratio + cash_ratio + book_equity_ratio")
f_high <- as.formula("high_util ~ mtm_btfp + uninsured_lev + ln_assets + omo_ratio + cash_ratio + book_equity_ratio")
m13_low <- feols(f_low, data = df_btfp, vcov = ~idrssd)
m13_high <- feols(f_high, data = df_btfp, vcov = ~idrssd)
modelsummary(
list("(1) Low Util (<50%)" = m13_low, "(2) High Util (>90%)" = m13_high),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared"),
title = "Table 13: Determinants of Low vs High BTFP Utilization",
notes = list("Sample: BTFP borrowers. Bank-clustered SEs.",
"Low utilization suggests precautionary/option value; High suggests distress.")
)| (1) Low Util (<50%) | (2) High Util (>90%) | |
|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||
| Sample: BTFP borrowers. Bank-clustered SEs. | ||
| Low utilization suggests precautionary/option value; High suggests distress. | ||
| MTM Loss (BTFP-Eligible) | 0.047 | -0.031 |
| (0.031) | (0.031) | |
| Uninsured Leverage | -0.002 | 0.000 |
| (0.001) | (0.001) | |
| BTFP-Eligible Ratio | 0.011*** | -0.017*** |
| (0.003) | (0.003) | |
| Log(Assets) | 0.027** | -0.019 |
| (0.013) | (0.013) | |
| Cash Ratio | 0.016*** | -0.014*** |
| (0.003) | (0.003) | |
| Book Equity | -0.003 | 0.003 |
| (0.004) | (0.004) | |
| Num.Obs. | 1259 | 1259 |
| R2 | 0.099 | 0.138 |
11.1 Story Arc: Selection + Partial Utilization
# ============================================================================
# NARRATIVE: SELECTION + PARTIAL UTILIZATION
# ============================================================================
cat("
================================================================================
PAPER STORY ARC: RECONCILING SELECTION WITH PARTIAL UTILIZATION
================================================================================
FINDING 1: PAR VALUATION CREATES SELECTION
- Banks with high MTM losses on BTFP-eligible securities systematically chose BTFP
- Validated by placebo (no effect pre-BTFP when par valuation didn't exist)
- Effect size: 4.4 pp per 1% MTM loss (economically large)
FINDING 2: BUT MOST BANKS DON'T MAX OUT
- Mean utilization: ~45% of OMO-eligible capacity
- Only ~10% of borrowers exceed 90% utilization
- This is the puzzle: Why not exploit par valuation fully?
RECONCILIATION: BTFP AS TARGETED LIQUIDITY INSURANCE
- Banks used BTFP for targeted liquidity needs, not balance-sheet refinancing
- Option value: Keeping capacity unused provides contingency buffer
- Operational frictions: Arranging large collateral pledges is costly
- Intraday needs: Many loans were for specific short-term needs
IMPLICATION FOR BOTH-FACILITY USE
- Dominant story is NOT max-out → supplement with DW
- Instead: Operational/timing considerations drive multi-facility use
- Banks with prior DW experience (operational readiness) more likely to use both
- Sequence analysis: DW-first banks had different profiles than BTFP-first
POLICY IMPLICATION
- BTFP's design attracted distressed banks (selection working)
- But usage patterns suggest precautionary demand, not just desperation
- Future facility design should consider this targeted insurance role
================================================================================
")================================================================================ PAPER STORY ARC: RECONCILING SELECTION WITH PARTIAL UTILIZATION ================================================================================
FINDING 1: PAR VALUATION CREATES SELECTION - Banks with high MTM losses on BTFP-eligible securities systematically chose BTFP - Validated by placebo (no effect pre-BTFP when par valuation didn’t exist) - Effect size: 4.4 pp per 1% MTM loss (economically large)
FINDING 2: BUT MOST BANKS DON’T MAX OUT - Mean utilization: ~45% of OMO-eligible capacity - Only ~10% of borrowers exceed 90% utilization - This is the puzzle: Why not exploit par valuation fully?
RECONCILIATION: BTFP AS TARGETED LIQUIDITY INSURANCE - Banks used BTFP for targeted liquidity needs, not balance-sheet refinancing - Option value: Keeping capacity unused provides contingency buffer - Operational frictions: Arranging large collateral pledges is costly - Intraday needs: Many loans were for specific short-term needs
IMPLICATION FOR BOTH-FACILITY USE - Dominant story is NOT max-out → supplement with DW - Instead: Operational/timing considerations drive multi-facility use - Banks with prior DW experience (operational readiness) more likely to use both - Sequence analysis: DW-first banks had different profiles than BTFP-first
POLICY IMPLICATION - BTFP’s design attracted distressed banks (selection working) - But usage patterns suggest precautionary demand, not just desperation - Future facility design should consider this targeted insurance role ================================================================================
12 Robustness
12.1 Table 14: Alternative Estimators
# ============================================================================
# TABLE 14: LPM vs LOGIT vs PROBIT
# ============================================================================
f_main <- as.formula(paste("btfp ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +", CONTROLS))
# Complete cases for comparison
df_complete <- df %>%
select(btfp, mtm_btfp, mtm_other, uninsured_lev, ln_assets, cash_ratio,
securities_ratio, loan_to_deposit, book_equity_ratio, wholesale, fhlb_ratio, roa, idrssd) %>%
drop_na()
m14_lpm <- feols(f_main, data = df_complete, vcov = ~idrssd)
m14_logit <- glm(f_main, data = df_complete, family = binomial(link = "logit"))
m14_probit <- glm(f_main, data = df_complete, family = binomial(link = "probit"))
modelsummary(
list("(1) LPM" = m14_lpm, "(2) Logit" = m14_logit, "(3) Probit" = m14_probit),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared", "AIC"),
title = "Table 14: Alternative Estimators",
notes = "LPM with bank-clustered SEs (Col 1) is preferred for interpretability."
)| (1) LPM | (2) Logit | (3) Probit | |
|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||
| LPM with bank-clustered SEs (Col 1) is preferred for interpretability. | |||
| MTM Loss (BTFP-Eligible) | 0.070*** | 0.506*** | 0.295*** |
| (0.021) | (0.115) | (0.068) | |
| MTM Loss (Non-BTFP) | 0.009*** | 0.039* | 0.023* |
| (0.003) | (0.020) | (0.012) | |
| Uninsured Leverage | 0.003*** | 0.022*** | 0.013*** |
| (0.001) | (0.005) | (0.003) | |
| MTM(BTFP) × Uninsured | -0.001 | -0.014*** | -0.008*** |
| (0.001) | (0.004) | (0.002) | |
| Log(Assets) | 0.057*** | 0.297*** | 0.178*** |
| (0.006) | (0.033) | (0.019) | |
| Cash Ratio | -0.005*** | -0.015 | -0.007 |
| (0.001) | (0.011) | (0.006) | |
| Securities Ratio | 0.002*** | 0.053*** | 0.031*** |
| (0.001) | (0.010) | (0.006) | |
| Loan/Deposit | -0.000 | 0.033*** | 0.019*** |
| (0.001) | (0.008) | (0.005) | |
| Book Equity | -0.006*** | -0.091*** | -0.050*** |
| (0.001) | (0.013) | (0.007) | |
| Wholesale Funding | 0.010** | 0.007 | 0.006 |
| (0.004) | (0.021) | (0.012) | |
| FHLB Ratio | 0.007*** | -0.005 | -0.002 |
| (0.002) | (0.013) | (0.008) | |
| ROA | -0.009 | -0.106 | -0.058 |
| (0.010) | (0.075) | (0.043) | |
| Num.Obs. | 4678 | 4678 | 4678 |
| R2 | 0.114 | ||
12.2 Model Fit
# ============================================================================
# ROC CURVE AND AUC
# ============================================================================
df_complete$pred <- predict(m14_logit, type = "response")
roc_obj <- roc(df_complete$btfp, df_complete$pred, quiet = TRUE)
ggroc(roc_obj, color = COLORS$btfp, size = 1.2) +
geom_abline(slope = 1, intercept = 1, linetype = "dashed", color = "gray50") +
annotate("text", x = 0.3, y = 0.2, label = sprintf("AUC = %.3f", auc(roc_obj)),
size = 5, fontface = "bold") +
labs(title = "Figure: ROC Curve - BTFP Selection Model",
subtitle = sprintf("N = %d | Good discrimination despite low R²", nrow(df_complete)),
x = "Specificity", y = "Sensitivity") +
theme_pub()
13 Summary of Findings
findings <- tribble(
~Question, ~Finding, ~Evidence,
"1. Par Valuation Selection",
"Banks with higher MTM(BTFP-eligible) systematically select BTFP",
"Table 4: 0.044*** (clustered); No effect on DW",
"2. Placebo Validation",
"Effect absent pre-BTFP when par valuation didn't exist",
"Table 7: Pre-DW coef = 0.010 (insig) vs BTFP 0.065***",
"3. Insolvency Channel",
"MTM-insolvent banks 9.4 pp more likely to use BTFP",
"Table 8: MTM Insolvent = 0.094***",
"4. Temporal Evolution",
"Acute: Run-driven | Post: Par valuation | Arb: Rate",
"Table 9: Interaction sig in Acute; MTM sig in Post",
"5. Partial Utilization",
"Mean utilization ~45%; Banks keep capacity in reserve",
"Table 13: Low util predicted by high cash",
"6. Both-Facility Mechanisms",
"Operational/timing dominates max-out hypothesis",
"Table 12: Prior DW > Maxed Out in predictive power",
"7. Selection Correction",
"IPW results consistent with naive estimates",
"Table 10: Coefficients stable across specifications"
)
findings %>%
kable(caption = "**Summary of Key Findings**") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE) %>%
column_spec(1, bold = TRUE, width = "20%") %>%
column_spec(2, width = "40%") %>%
column_spec(3, width = "40%")| Question | Finding | Evidence |
|---|---|---|
|
Banks with higher MTM(BTFP-eligible) systematically select BTFP | Table 4: 0.044*** (clustered); No effect on DW |
|
Effect absent pre-BTFP when par valuation didn’t exist | Table 7: Pre-DW coef = 0.010 (insig) vs BTFP 0.065*** |
|
MTM-insolvent banks 9.4 pp more likely to use BTFP | Table 8: MTM Insolvent = 0.094*** |
|
Acute: Run-driven | Post: Par valuation | Arb: Rate | Table 9: Interaction sig in Acute; MTM sig in Post |
|
Mean utilization ~45%; Banks keep capacity in reserve | Table 13: Low util predicted by high cash |
|
Operational/timing dominates max-out hypothesis | Table 12: Prior DW > Maxed Out in predictive power |
|
IPW results consistent with naive estimates | Table 10: Coefficients stable across specifications |
14 Regression Visualization
# ============================================================================
# MODEL 1: COEFFICIENT PLOT FOR BTFP MAIN MODEL (m5_2)
# Fixed: Changed m1_interact -> m5_2
# ============================================================================
coef_df_m1 <- tidy(m5_2, conf.int = TRUE) %>%
filter(!str_detect(term, "Intercept")) %>%
mutate(
term = case_when(
term == "mtm_btfp" ~ "MTM Loss (BTFP-Eligible)",
term == "mtm_other" ~ "MTM Loss (Non-BTFP)",
term == "uninsured_lev" ~ "Uninsured Leverage",
term == "I(mtm_btfp * uninsured_lev)" ~ "MTM(BTFP) × Uninsured",
term == "ln_assets" ~ "Log(Assets)",
term == "cash_ratio" ~ "Cash Ratio",
term == "book_equity_ratio" ~ "Book Equity",
term == "securities_ratio" ~ "Securities Ratio",
term == "loan_to_deposit" ~ "Loan/Deposit",
term == "wholesale" ~ "Wholesale Funding",
term == "fhlb_ratio" ~ "FHLB Ratio",
term == "roa" ~ "ROA",
TRUE ~ term
),
significant = p.value < 0.05
)
p_m1 <- ggplot(coef_df_m1, aes(x = reorder(term, estimate), y = estimate)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high, color = significant), size = 0.8) +
scale_color_manual(values = c("TRUE" = "#2E86AB", "FALSE" = "gray50"), guide = "none") +
coord_flip() +
labs(
title = "Model 1: Determinants of BTFP Borrowing",
subtitle = "Banks with higher MTM losses on BTFP-eligible securities more likely to access BTFP",
x = NULL, y = "Coefficient Estimate (95% CI)"
) +
theme_pub()
print(p_m1)
ggsave(file.path(FIG_PATH, "fig_m1_coef_plot.png"), p_m1, width = 10, height = 6, dpi = 300, bg = "white")# ============================================================================
# MODEL 2: PREDICTED PROBABILITY SURFACE FOR ANY FED FACILITY (m5_5)
# Fixed: Changed m2_base -> m5_5, analysis_df -> df
# ============================================================================
pred_grid <- expand.grid(
mtm_btfp = seq(0, max(df$mtm_btfp, na.rm = TRUE), length.out = 20),
uninsured_lev = seq(0, max(df$uninsured_lev, na.rm = TRUE), length.out = 20),
mtm_other = mean(df$mtm_other, na.rm = TRUE),
ln_assets = mean(df$ln_assets, na.rm = TRUE),
cash_ratio = mean(df$cash_ratio, na.rm = TRUE),
securities_ratio = mean(df$securities_ratio, na.rm = TRUE),
book_equity_ratio = mean(df$book_equity_ratio, na.rm = TRUE),
loan_to_deposit = mean(df$loan_to_deposit, na.rm = TRUE),
wholesale = mean(df$wholesale, na.rm = TRUE),
fhlb_ratio = mean(df$fhlb_ratio, na.rm = TRUE),
roa = mean(df$roa, na.rm = TRUE)
)
# Using a logit model for prediction (since LPM can give probabilities outside 0-1)
pred_logit <- glm(any_fed ~ mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) +
ln_assets + cash_ratio + securities_ratio + loan_to_deposit +
book_equity_ratio + wholesale + fhlb_ratio + roa,
data = df, family = binomial(link = "logit"))
pred_grid$prob <- predict(pred_logit, newdata = pred_grid, type = "response")
p_m2 <- ggplot(pred_grid, aes(x = mtm_btfp, y = uninsured_lev, fill = prob)) +
geom_tile() +
geom_contour(aes(z = prob), color = "white", alpha = 0.5) +
scale_fill_viridis_c(option = "plasma", labels = percent_format()) +
labs(
title = "Model 2: Predicted Probability of Accessing Any Fed Facility",
subtitle = "Higher MTM losses + Higher uninsured leverage → Higher probability of Fed borrowing",
x = "MTM Loss on BTFP-Eligible (% of Assets)",
y = "Uninsured Deposits (% of Assets)",
fill = "Probability"
) +
geom_point(data = df %>% filter(any_fed == 1),
aes(x = mtm_btfp, y = uninsured_lev),
inherit.aes = FALSE, color = "white", alpha = 0.3, size = 1) +
theme_pub()
print(p_m2)
ggsave(file.path(FIG_PATH, "fig_m2_prob_surface.png"), p_m2, width = 12, height = 7, dpi = 300, bg = "white")# ============================================================================
# MODEL 3: BTFP USAGE BY BORROWING SUBSIDY QUINTILES
# Fixed: Changed data_borrowers -> df_btfp, m3_split/m3_full -> proper model refs
# ============================================================================
# Create subsidy quintiles among Fed borrowers
data_fed_borrowers <- df %>%
filter(any_fed == 1, !is.na(borrowing_subsidy)) %>%
mutate(subsidy_quintile = ntile(borrowing_subsidy, 5))
subsidy_summary <- data_fed_borrowers %>%
group_by(subsidy_quintile) %>%
summarise(
n = n(),
mean_subsidy = mean(borrowing_subsidy, na.rm = TRUE),
pct_btfp = mean(btfp, na.rm = TRUE) * 100,
pct_dw = mean(dw, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
filter(!is.na(subsidy_quintile))
p_m3a <- ggplot(subsidy_summary, aes(x = factor(subsidy_quintile))) +
geom_col(aes(y = pct_btfp), fill = "#2E86AB", alpha = 0.8) +
geom_text(aes(y = pct_btfp + 3, label = paste0(round(pct_btfp), "%")), size = 4) +
scale_y_continuous(limits = c(0, 100)) +
labs(
title = "BTFP Usage by Borrowing Subsidy Quintile",
subtitle = "Higher subsidy (larger MTM loss rate on OMO) → More likely to use BTFP",
x = "Borrowing Subsidy Quintile (1=Lowest, 5=Highest)",
y = "% of Fed Borrowers Using BTFP"
) +
theme_pub()
# Coefficient comparison between BTFP and DW models (m5_2 and m5_4)
coef_df_m3 <- bind_rows(
tidy(m5_2, conf.int = TRUE) %>% mutate(model = "BTFP Model"),
tidy(m5_4, conf.int = TRUE) %>% mutate(model = "DW Model")
) %>%
filter(term %in% c("mtm_btfp", "mtm_other")) %>%
mutate(term = case_when(
term == "mtm_btfp" ~ "MTM Loss\n(BTFP-Eligible)",
term == "mtm_other" ~ "MTM Loss\n(Non-BTFP)"
))
p_m3b <- ggplot(coef_df_m3, aes(x = term, y = estimate, fill = model)) +
geom_col(position = position_dodge(0.8), width = 0.7) +
geom_errorbar(aes(ymin = conf.low, ymax = conf.high),
position = position_dodge(0.8), width = 0.2) +
geom_hline(yintercept = 0, linetype = "dashed") +
scale_fill_manual(values = c("BTFP Model" = "#2E86AB", "DW Model" = "#A23B72")) +
labs(
title = "Key Coefficients: BTFP vs DW Selection",
subtitle = "MTM loss on BTFP-eligible securities predicts BTFP but not DW",
x = NULL, y = "Coefficient", fill = "Model"
) +
theme_pub()
p_m3a + p_m3b +
plot_annotation(title = "Figure : Par Valuation Drives BTFP Selection")
# 1. Create the combined plot object
final_plot <- p_m3a + p_m3b +
plot_annotation(title = "Figure : Par Valuation Drives BTFP Selection")
# 2. Save the object
ggsave(
filename = file.path(FIG_PATH, "fig_par_valuation.png"),
plot = final_plot,
width = 12, # Adjust width (wider for side-by-side)
height = 6, # Adjust height
dpi = 300,
bg = "white"
)# ============================================================================
# MODEL 4: PRIOR DW USERS' SUBSEQUENT BEHAVIOR
# Fixed: Changed prior_dw_user -> prior_dw, analysis_df -> df
# ============================================================================
prior_dw_summary <- df %>%
mutate(prior_dw_label = ifelse(prior_dw == 1, "Used DW Pre-BTFP", "Did Not Use DW Pre-BTFP")) %>%
group_by(prior_dw_label) %>%
summarise(
n = n(),
pct_btfp = mean(btfp, na.rm = TRUE) * 100,
pct_dw_post = mean(dw, na.rm = TRUE) * 100,
pct_both = mean(both, na.rm = TRUE) * 100,
pct_any = mean(any_fed, na.rm = TRUE) * 100,
.groups = "drop"
)
prior_dw_long <- prior_dw_summary %>%
pivot_longer(cols = starts_with("pct_"), names_to = "outcome", values_to = "pct") %>%
mutate(outcome = case_when(
outcome == "pct_btfp" ~ "Used BTFP",
outcome == "pct_dw_post" ~ "Used DW (Post-BTFP)",
outcome == "pct_both" ~ "Used Both",
outcome == "pct_any" ~ "Used Any Fed Facility"
))
p_m4 <- ggplot(prior_dw_long %>% filter(outcome != "Used Any Fed Facility"),
aes(x = outcome, y = pct, fill = prior_dw_label)) +
geom_col(position = position_dodge(0.8), width = 0.7) +
geom_text(aes(label = paste0(round(pct, 1), "%")),
position = position_dodge(0.8), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = c("Used DW Pre-BTFP" = "#A23B72", "Did Not Use DW Pre-BTFP" = "gray60")) +
labs(
title = "Figure : Pre-BTFP DW Users' Subsequent Facility Usage",
subtitle = "Banks that used DW pre-BTFP were MORE likely to use BTFP → DW alone was insufficient",
x = NULL, y = "% of Banks", fill = NULL
) +
theme_pub() +
theme(axis.text.x = element_text(angle = 15, hjust = 1))
print(p_m4)
ggsave(file.path(FIG_PATH, "fig_m4_prior_dw.png"), p_m4, width = 10, height = 6, dpi = 300, bg = "white")# ============================================================================
# MODEL 5: TEMPORAL COEFFICIENT EVOLUTION
# Fixed: Changed m5_acute -> m8_acute, m5_post -> m8_post, m5_arb -> m8_arb
# ============================================================================
coef_temporal <- bind_rows(
tidy(m8_acute, conf.int = TRUE) %>% mutate(period = "Acute Crisis"),
tidy(m8_post, conf.int = TRUE) %>% mutate(period = "Post-Acute"),
tidy(m8_arb, conf.int = TRUE) %>% mutate(period = "Arbitrage")
) %>%
filter(term %in% c("mtm_btfp", "uninsured_lev", "I(mtm_btfp * uninsured_lev)")) %>%
mutate(
term = case_when(
term == "mtm_btfp" ~ "MTM Loss (BTFP)",
term == "uninsured_lev" ~ "Uninsured Leverage",
term == "I(mtm_btfp * uninsured_lev)" ~ "MTM × Uninsured"
),
period = factor(period, levels = c("Acute Crisis", "Post-Acute", "Arbitrage"))
)
p_m5 <- ggplot(coef_temporal, aes(x = period, y = estimate, fill = period)) +
geom_col(alpha = 0.8) +
geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0.2) +
geom_hline(yintercept = 0, linetype = "dashed") +
facet_wrap(~term, scales = "free_y") +
scale_fill_manual(values = c("Acute Crisis" = "#FFB3B3", "Post-Acute" = "#90EE90", "Arbitrage" = "#87CEEB")) +
labs(
title = "Figure: How Borrowing Determinants Changed Across Crisis Phases",
subtitle = "Uninsured leverage strongest in Acute phase; MTM losses matter throughout",
x = NULL, y = "Coefficient Estimate", fill = NULL
) +
theme_pub() +
theme(legend.position = "none")
print(p_m5)
ggsave(file.path(FIG_PATH, "coeff_estimator.png"), p_m5, width = 10, height = 6, dpi = 300, bg = "white")# ============================================================================
# MODEL 6: INTENSIVE MARGIN - BORROWING AMOUNT AND UTILIZATION
# Fixed: Changed data_btfp_users -> df_btfp
# ============================================================================
# Scatter with fitted line - BTFP Amount vs Borrowing Subsidy
p_m6a <- ggplot(df_btfp, aes(x = borrowing_subsidy, y = btfp_pct)) +
geom_point(aes(color = uninsured_lev), alpha = 0.6, size = 2) +
geom_smooth(method = "lm", color = "#2E86AB", fill = "#2E86AB", alpha = 0.2) +
scale_color_viridis_c(option = "plasma", name = "Uninsured\nLeverage") +
coord_cartesian(xlim = c(0, quantile(df_btfp$borrowing_subsidy, 0.95, na.rm = TRUE)),
ylim = c(0, quantile(df_btfp$btfp_pct, 0.95, na.rm = TRUE))) +
labs(
title = "A: BTFP Borrowing Amount vs. Borrowing Subsidy",
x = "Borrowing Subsidy (MTM Loss Rate on BTFP Eligible, %)",
y = "BTFP Amount (% of Assets)"
) +
theme_pub()
# Utilization vs Borrowing Subsidy
p_m6b <- ggplot(df_btfp %>% filter(!is.na(btfp_util)),
aes(x = borrowing_subsidy, y = btfp_util)) +
geom_point(alpha = 0.5, color = "#2E86AB") +
geom_smooth(method = "lm", color = "#F18F01", fill = "#F18F01", alpha = 0.2) +
geom_hline(yintercept = 0.9, linetype = "dashed", color = "red") +
annotate("text", x = 15, y = 0.95, label = "90% Utilization\n(Maxed Out)", color = "red", size = 3) +
coord_cartesian(xlim = c(0, quantile(df_btfp$borrowing_subsidy, 0.95, na.rm = TRUE)),
ylim = c(0, 1.1)) +
labs(
title = "B: BTFP Collateral Utilization vs. Borrowing Subsidy",
x = "Borrowing Subsidy (MTM Loss Rate on BTFP Eligible, %)",
y = "BTFP Utilization (Amount / BTFP-Eligible)"
) +
theme_pub()
p_m6a + p_m6b +
plot_annotation(title = "Figure: Intensive Margin - Banks with Larger Losses Borrowed More")
# 1. Combine and assign to an object
fig07_combined <- p_m6a + p_m6b +
plot_annotation(title = "Figure : Intensive Margin - Banks with Larger Losses Borrowed More")
# 2. Save the plot
ggsave(
filename = file.path(FIG_PATH, "fig07_intensive_margin.png"),
plot = fig07_combined,
width = 14, # Wide format for side-by-side panels
height = 6, # Standard height
dpi = 300,
bg = "white"
)# ============================================================================
# MODEL 7: BTFP UTILIZATION - BOTH VS SINGLE FACILITY USERS
# Fixed: Changed data_model7 -> df_fed (Fed borrowers), size -> linewidth
# ============================================================================
# Create Fed borrowers dataset
df_fed <- df %>% filter(any_fed == 1)
# Comparison table
both_comparison <- df_fed %>%
filter(btfp == 1) %>% # Among BTFP users
mutate(group = ifelse(both == 1, "Both Facilities", "BTFP Only")) %>%
group_by(group) %>%
summarise(
N = n(),
`Mean MTM (BTFP)` = mean(mtm_btfp, na.rm = TRUE),
`Mean MTM (Other)` = mean(mtm_other, na.rm = TRUE),
`Mean OMO Ratio` = mean(omo_ratio, na.rm = TRUE),
`Mean Non-OMO Ratio` = mean(non_omo_ratio, na.rm = TRUE),
`Mean Utilization` = mean(btfp_util, na.rm = TRUE),
`% Maxed Out` = mean(maxed_out, na.rm = TRUE) * 100,
.groups = "drop"
)
both_comparison %>%
kable(caption = "Comparison: Banks Using Both Facilities vs. BTFP Only",
format = "html", digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| group | N | Mean MTM (BTFP) | Mean MTM (Other) | Mean OMO Ratio | Mean Non-OMO Ratio | Mean Utilization | % Maxed Out |
|---|---|---|---|---|---|---|---|
| BTFP Only | 880 | 0.76 | 4.98 | 10.56 | 77.96 | 2.57 | 45.91 |
| Both Facilities | 425 | 0.80 | 4.96 | 10.30 | 78.76 | 2.49 | 44.24 |
# Visualization - Fixed: size -> linewidth
p_m7 <- df_fed %>%
filter(btfp == 1, !is.na(btfp_util)) %>% # BTFP users with valid utilization
mutate(used_both = ifelse(both == 1, "Both", "BTFP Only")) %>%
ggplot(aes(x = btfp_util, fill = used_both)) +
geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
geom_vline(xintercept = 0.9, linetype = "dashed", color = "red", linewidth = 1) + # Fixed: size -> linewidth
annotate("text", x = 0.95, y = Inf, vjust = 2, label = "90% Threshold", color = "red") +
scale_fill_manual(values = c("Both" = "#F18F01", "BTFP Only" = "#2E86AB")) +
labs(
title = "Figure: BTFP Utilization - Both vs. BTFP Only Users",
subtitle = "Banks using both facilities have higher utilization (maxed out BTFP, turned to DW)",
x = "BTFP Utilization (Amount / BTFP-Eligible)",
y = "Count", fill = "Facility Usage"
) +
theme_pub()
print(p_m7)
15 Conclusion
This paper makes three contributions:
Selection via Par Valuation: BTFP’s par valuation design created systematic selection—banks with underwater OMO-eligible securities chose BTFP to avoid market-value haircuts. This is validated by placebo tests showing no effect before BTFP existed.
Targeted Liquidity Insurance: Despite par valuation benefits, most banks used only 35-53% of capacity, suggesting BTFP served as targeted liquidity insurance rather than balance-sheet refinancing. This reconciles the selection evidence with the partial utilization puzzle.
Multi-Facility Mechanisms: Banks using both BTFP and DW did so primarily for operational/timing reasons, not because they exhausted BTFP capacity. Prior DW experience (operational readiness) was a stronger predictor than the “maxed out” hypothesis.
Policy Implications: Future emergency facility design should consider that (i) design features create selection effects, and (ii) banks may use facilities for precautionary/insurance purposes rather than maximizing borrowing.
Analysis completed: December 29, 2025 at 10:23
R version 4.3.1 (2023-06-16 ucrt) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 11 x64 (build 26200)
Matrix products: default
locale: [1] LC_COLLATE=English_United States.utf8 LC_CTYPE=English_United States.utf8 LC_MONETARY=English_United States.utf8 [4] LC_NUMERIC=C LC_TIME=English_United States.utf8
time zone: America/Chicago tzcode source: internal
attached base packages: [1] stats graphics grDevices utils datasets methods base
other attached packages: [1] psych_2.5.6 viridis_0.6.5
viridisLite_0.4.2 scales_1.4.0 patchwork_1.3.2
[6] kableExtra_1.4.0 modelsummary_2.4.0 sampleSelection_1.2-12
maxLik_1.5-2.1 miscTools_0.6-28
[11] pROC_1.18.5 margins_0.3.28 broom_1.0.9 lmtest_0.9-40
zoo_1.8-13
[16] sandwich_3.1-1 fixest_0.12.1 data.table_1.17.0 lubridate_1.9.4
forcats_1.0.0
[21] stringr_1.5.1 dplyr_1.1.4 purrr_1.0.4 readr_2.1.5 tidyr_1.3.1
[26] tibble_3.2.1 ggplot2_3.5.2 tidyverse_2.0.0
loaded via a namespace (and not attached): [1] mnormt_2.1.1
gridExtra_2.3 rlang_1.1.1 magrittr_2.0.3 dreamerr_1.4.0
[6] prediction_0.3.18 compiler_4.3.1 mgcv_1.8-42 systemfonts_1.2.2
vctrs_0.6.5
[11] pkgconfig_2.0.3 crayon_1.5.3 fastmap_1.2.0 backports_1.5.0
labeling_0.4.3
[16] rmarkdown_2.29 tzdb_0.5.0 ragg_1.3.3 bit_4.6.0 xfun_0.52
[21] cachem_1.1.0 litedown_0.7 jsonlite_2.0.0 tinytable_0.13.0
stringmagic_1.1.2
[26] systemfit_1.1-30 VGAM_1.1-13 parallel_4.3.1 R6_2.6.1
bslib_0.9.0
[31] tables_0.9.31 stringi_1.8.7 RColorBrewer_1.1-3 car_3.1-3
jquerylib_0.1.4
[36] numDeriv_2016.8-1.1 estimability_1.5.1 Rcpp_1.0.14 knitr_1.50
parameters_0.27.0
[41] Matrix_1.5-4.1 splines_4.3.1 timechange_0.3.0 tidyselect_1.2.1
rstudioapi_0.17.1
[46] abind_1.4-8 yaml_2.3.10 lattice_0.21-8 plyr_1.8.9 withr_3.0.2
[51] bayestestR_0.16.1 coda_0.19-4.1 evaluate_1.0.4 isoband_0.2.7
xml2_1.3.8
[56] pillar_1.11.0 carData_3.0-5 checkmate_2.3.2 stats4_4.3.1
insight_1.3.1
[61] generics_0.1.4 vroom_1.6.5 hms_1.1.3 xtable_1.8-4 glue_1.8.0
[66] emmeans_1.11.2-8 tools_4.3.1 mvtnorm_1.3-3 grid_4.3.1
datawizard_1.2.0
[71] nlme_3.1-162 performance_0.15.0 Formula_1.2-5 cli_3.6.1
textshaping_1.0.0
[76] fansi_1.0.6 svglite_2.1.3 gtable_0.3.6 sass_0.4.10
digest_0.6.33
[81] farver_2.1.2 htmltools_0.5.9 lifecycle_1.0.4 bit64_4.6.0-1
MASS_7.3-60