BTFP and DW Borrowing Analysis
Facility choice
Mohua Ferdousi
2025-12-22
1 Introduction and Research Context
1.1 Research Questions
This analysis supports investigating four key 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 Analysis Periods
The BTFP operated from March 12, 2023 through March 11, 2024. We define five distinct periods:
| Period | Date Range | Description |
|---|---|---|
| Period 1 | March 1-10, 2023 | Pre-BTFP (SVB crisis onset) |
| Period 2 | March 13 - May 1, 2023 | Acute Crisis Phase |
| Period 3 | May 2 - Oct 31, 2023 | Post-Acute / Stabilization |
| Period 4 | Nov 1, 2023 - Jan 24, 2024 | Arbitrage Phase (rate spread favorable) |
| Period 5 | Jan 25 - March 11, 2024 | Closing Phase of BTFP |
1.3 Data Sources
- Call Report Data:
final_call_gsib.csv- Quarterly bank balance sheet data (baseline: 2022Q4) - BTFP Loans:
btfp_loan_bank_only.csv- Individual BTFP loan transactions - Discount Window Loans:
dw_loan_bank_2023.csv- Individual DW loan transactions
1.3.1 Important Notes on Units:
- Call Report items: Values in thousands ($000s), Ratios: Already converted to percentages (0-100 scale)
- Loan data (DW/BTFP): Daily actual values (no conversion, in dollars)
- Collateral shares: Expressed as fractions (0-1 scale) in loan data
2 Variable Definitions
2.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]] |
2.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 | BTFP-Eligible Securitiess_i / Total Assets_i |
| BorrowingSubsidy_i | MTM loss rate on eligible collateral | MTM Loss on OMO-Eligible_i / OMO-Eligible_i |
2.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] |
2.4 Jiang et al. Insolvency Measures
2.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
2.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 |
2.4.3 Adjusted Equity (Jiang-Style)
AdjustedEquity_i = EquityRatio_i - MTMLoss_i
MTM_Insolvent_i = 1[AdjustedEquity_i < 0]
2.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 |
2.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 |
2.7 Facility Design Variables (Loan-Level Aggregated to Bank)
| Variable | Definition | Source |
|---|---|---|
| btfp_avg_term | Weighted avg BTFP loan term (days) | Loan data |
| btfp_avg_rate | Weighted avg BTFP interest rate (%) | Loan data |
| btfp_n_loans | Number of BTFP loans | Loan data |
| btfp_max_term | Maximum BTFP term chosen | Loan data |
| dw_avg_term | Weighted avg DW loan term (days) | Loan data |
| dw_avg_rate | Weighted avg DW interest rate (%) | Loan data |
| dw_n_loans | Number of DW loans | Loan data |
| dw_max_term | Maximum DW term chosen | Loan data |
| rate_diff | DW rate - BTFP rate | Loan data |
2.8 Facility Design Choice Indicators
| Variable | Definition | Interpretation |
|---|---|---|
| high_uninsured | Above-median uninsured deposits | Needs stable funding |
| high_wholesale | Above-median wholesale funding | Needs stable funding |
| funding_stability_need | high_uninsured + high_wholesale (0-2) | Higher = more need for BTFP 1-yr term |
| collateral_constrained | Below-median OMO-eligible collateral | May need DW |
| low_liquidity | Below-median liquid assets | Acute liquidity need |
| stress_indicator | high_uninsured × high_mtm_loss | Run risk measure |
2.9 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] |
2.10 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.
2.11 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\]
2.12 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\]
2.13 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\]
3 Data Loading and Preparation
# Define base path
base_path <- "../../01_data/processed/"
# Load datasets
call_report <- read_csv(paste0(base_path, "final_call_gsib.csv"), show_col_types = FALSE)
btfp_loans <- read_csv(paste0(base_path, "btfp_loan_bank_only.csv"), show_col_types = FALSE)
dw_loans <- read_csv(paste0(base_path, "dw_loan_bank_2023.csv"), show_col_types = FALSE)
# Display basic info
cat("=== DATASETS LOADED ===\n")## === DATASETS LOADED ===cat("Call Report: ", nrow(call_report), " rows x ", ncol(call_report), " columns\n")## Call Report: 61002 rows x 362 columnscat("BTFP Loans: ", nrow(btfp_loans), " rows x ", ncol(btfp_loans), " columns\n")## BTFP Loans: 6734 rows x 26 columnscat("DW Loans: ", nrow(dw_loans), " rows x ", ncol(dw_loans), " columns\n")## DW Loans: 20219 rows x 46 columns# Convert dates for loan data (format is M/D/YYYY, e.g., 3/13/2023)
btfp_loans <- btfp_loans %>%
mutate(
btfp_loan_date = mdy(btfp_loan_date),
btfp_maturity_date = mdy(btfp_maturity_date),
btfp_repayment_date = mdy(btfp_repayment_date)
)
dw_loans <- dw_loans %>%
mutate(
dw_loan_date = ymd(dw_loan_date),
dw_maturity_date = ymd(dw_maturity_date),
dw_repayment_date = ymd(dw_repayment_date)
)
# Define period boundaries
periods <- tribble(
~period_num, ~period_name, ~start_date, ~end_date,
1, "Pre-BTFP (SVB Crisis)", "2023-03-01", "2023-03-10",
2, "Acute Crisis", "2023-03-13", "2023-05-01",
3, "Post-Acute", "2023-05-02", "2023-10-31",
4, "Arbitrage Phase", "2023-11-01", "2024-01-24",
5, "Wind-down", "2024-01-25", "2024-03-11"
) %>%
mutate(
start_date = as.Date(start_date),
end_date = as.Date(end_date)
)
# Function to assign periods
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) return(NA_integer_)
return(match[1])
})
}
# Assign periods to loan data
btfp_loans <- btfp_loans %>%
mutate(period = assign_period(btfp_loan_date, periods))
dw_loans <- dw_loans %>%
mutate(period = assign_period(dw_loan_date, periods))
# Print period assignments
cat("=== BTFP LOANS BY PERIOD ===\n")## === BTFP LOANS BY PERIOD ===btfp_loans %>% count(period) %>% print()## # A tibble: 4 × 2
## period n
## <dbl> <int>
## 1 2 1087
## 2 3 1972
## 3 4 3279
## 4 5 396cat("\n=== DW LOANS BY PERIOD ===\n")##
## === DW LOANS BY PERIOD ===dw_loans %>% count(period) %>% print()## # A tibble: 4 × 2
## period n
## <dbl> <int>
## 1 1 299
## 2 2 1619
## 3 3 4237
## 4 NA 14064# Extract 2022Q4 baseline call report data
baseline_2022q4 <- call_report %>%
filter(quarter == "2022Q4")
cat("=== BASELINE 2022Q4 DATA ===\n")## === BASELINE 2022Q4 DATA ===cat("Banks: ", n_distinct(baseline_2022q4$idrssd), "\n")## Banks: 4737cat("Observations: ", nrow(baseline_2022q4), "\n")## Observations: 47374 Part 1: Loan-Level Summary Statistics by Period
4.1 BTFP Loan Summary by Period
# BTFP Summary by Period
btfp_period_summary <- btfp_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
group_by(period) %>%
summarise(
# Counts
n_loans = n(),
n_unique_banks = n_distinct(rssd_id),
# Borrowing amounts (convert to millions)
total_borrowing_M = sum(btfp_loan_amount, na.rm = TRUE) / 1e6,
mean_loan_M = mean(btfp_loan_amount, na.rm = TRUE) / 1e6,
median_loan_M = median(btfp_loan_amount, na.rm = TRUE) / 1e6,
sd_loan_M = sd(btfp_loan_amount, na.rm = TRUE) / 1e6,
min_loan_M = min(btfp_loan_amount, na.rm = TRUE) / 1e6,
max_loan_M = max(btfp_loan_amount, na.rm = TRUE) / 1e6,
# Collateral (convert to millions)
total_collateral_M = sum(btfp_total_collateral, na.rm = TRUE) / 1e6,
mean_collateral_M = mean(btfp_total_collateral, na.rm = TRUE) / 1e6,
# Loan to collateral ratio (BTFP uses par value)
mean_loan_to_collateral = mean(btfp_loan_amount / btfp_total_collateral, na.rm = TRUE),
# Interest rate
mean_rate = mean(btfp_interest_rate, na.rm = TRUE),
sd_rate = sd(btfp_interest_rate, na.rm = TRUE),
min_rate = min(btfp_interest_rate, na.rm = TRUE),
max_rate = max(btfp_interest_rate, na.rm = TRUE),
# Term (in days)
mean_term = mean(btfp_term, na.rm = TRUE),
mean_effective_maturity = mean(btfp_effective_maturity_days, na.rm = TRUE),
# Collateral composition
mean_share_treasury = mean(btfp_share_treasury_sec, na.rm = TRUE) * 100,
mean_share_agency_mbs = mean(btfp_share_agency_mbs, na.rm = TRUE) * 100,
mean_share_agency_cmo = mean(btfp_share_agency_cmo, na.rm = TRUE) * 100,
mean_share_agency_debt = mean(btfp_share_agency_debt, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
# Add period names
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
# Display BTFP summary
btfp_period_summary %>%
select(period_name, n_loans, n_unique_banks, total_borrowing_M, mean_loan_M,
median_loan_M, mean_rate, mean_term) %>%
mutate(
across(c(total_borrowing_M, mean_loan_M, median_loan_M), ~round(., 1)),
mean_rate = round(mean_rate, 2),
mean_term = round(mean_term, 0)
) %>%
kable(
col.names = c("Period", "# Loans", "Unique Banks", "Total ($M)",
"Mean ($M)", "Median ($M)", "Avg Rate (%)", "Avg Term (days)"),
caption = "BTFP Borrowing Summary by Period (Excluding Failed Banks)",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Period | # Loans | Unique Banks | Total (\(M) </th> <th style="text-align:right;"> Mean (\)M) | Median ($M) | Avg Rate (%) | Avg Term (days) | |
|---|---|---|---|---|---|---|---|
| Acute Crisis | 1079 | 491 | 123328.9 | 114.3 | 13.5 | 4.69 | 311 |
| Post-Acute | 1972 | 816 | 51381.9 | 26.1 | 5.0 | 5.20 | 272 |
| Arbitrage Phase | 3279 | 801 | 229811.2 | 70.1 | 15.0 | 4.97 | 335 |
| Wind-down | 396 | 240 | 17115.6 | 43.2 | 7.5 | 5.40 | 294 |
4.2 Cumulative BTFP Statistics
# Cumulative BTFP statistics
btfp_cumulative <- btfp_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
arrange(period) %>%
group_by(period) %>%
summarise(
period_borrowing = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
period_banks = n_distinct(rssd_id),
period_loans = n(),
.groups = "drop"
) %>%
mutate(
cumulative_borrowing_B = cumsum(period_borrowing),
cumulative_loans = cumsum(period_loans)
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
btfp_cumulative %>%
select(period_name, period_loans, period_borrowing, cumulative_loans, cumulative_borrowing_B) %>%
mutate(across(c(period_borrowing, cumulative_borrowing_B), ~round(., 2))) %>%
kable(
col.names = c("Period", "Period Loans", "Period ($B)",
"Cumulative Loans", "Cumulative ($B)"),
caption = "BTFP Cumulative Borrowing Over Time (Excluding Failed Banks)",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Period | Period Loans | Period (\(B) </th> <th style="text-align:right;"> Cumulative Loans </th> <th style="text-align:right;"> Cumulative (\)B) | ||
|---|---|---|---|---|
| Acute Crisis | 1079 | 123.33 | 1079 | 123.33 |
| Post-Acute | 1972 | 51.38 | 3051 | 174.71 |
| Arbitrage Phase | 3279 | 229.81 | 6330 | 404.52 |
| Wind-down | 396 | 17.12 | 6726 | 421.64 |
4.3 Discount Window Loan Summary by Period
# DW Summary by Period
dw_period_summary <- dw_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
group_by(period) %>%
summarise(
# Counts
n_loans = n(),
n_unique_banks = n_distinct(rssd_id),
# Borrowing amounts (convert to millions)
total_borrowing_M = sum(dw_loan_amount, na.rm = TRUE) / 1e6,
mean_loan_M = mean(dw_loan_amount, na.rm = TRUE) / 1e6,
median_loan_M = median(dw_loan_amount, na.rm = TRUE) / 1e6,
sd_loan_M = sd(dw_loan_amount, na.rm = TRUE) / 1e6,
min_loan_M = min(dw_loan_amount, na.rm = TRUE) / 1e6,
max_loan_M = max(dw_loan_amount, na.rm = TRUE) / 1e6,
# Collateral (convert to millions)
total_collateral_M = sum(dw_total_collateral, na.rm = TRUE) / 1e6,
mean_collateral_M = mean(dw_total_collateral, na.rm = TRUE) / 1e6,
# OMO vs Non-OMO collateral
mean_omo_share = mean(dw_omo_eligible / dw_total_collateral, na.rm = TRUE) * 100,
mean_non_omo_share = mean(dw_non_omo_eligible / dw_total_collateral, na.rm = TRUE) * 100,
# Loan to collateral ratio
mean_loan_to_collateral = mean(dw_loan_amount / dw_total_collateral, na.rm = TRUE),
# Interest rate
mean_rate = mean(dw_interest_rate, na.rm = TRUE),
sd_rate = sd(dw_interest_rate, na.rm = TRUE),
# Term and maturity
mean_term = mean(dw_term, na.rm = TRUE),
mean_effective_maturity = mean(dw_effective_maturity_days, na.rm = TRUE),
.groups = "drop"
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
# Display DW summary
dw_period_summary %>%
select(period_name, n_loans, n_unique_banks, total_borrowing_M, mean_loan_M,
median_loan_M, mean_rate, mean_term, mean_omo_share) %>%
mutate(
across(c(total_borrowing_M, mean_loan_M, median_loan_M), ~round(., 1)),
across(c(mean_rate, mean_omo_share), ~round(., 2)),
mean_term = round(mean_term, 0)
) %>%
kable(
col.names = c("Period", "# Loans", "Unique Banks", "Total ($M)",
"Mean ($M)", "Median ($M)", "Avg Rate (%)",
"Avg Term (days)", "OMO Collateral (%)"),
caption = "Discount Window Borrowing Summary by Period (Excluding Failed Banks)",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Period | # Loans | Unique Banks | Total (\(M) </th> <th style="text-align:right;"> Mean (\)M) | Median ($M) | Avg Rate (%) | Avg Term (days) | OMO Collateral (%) | |
|---|---|---|---|---|---|---|---|---|
| Pre-BTFP (SVB Crisis) | 298 | 108 | 53538.4 | 179.7 | 10.2 | 4.75 | 5 | 32.65 |
| Acute Crisis | 1609 | 423 | 2036877.8 | 1265.9 | 10.0 | 4.92 | 5 | 36.69 |
| Post-Acute | 4237 | 846 | 111552.1 | 26.3 | 5.4 | 5.35 | 5 | 34.35 |
4.4 DW Collateral Composition by Period
# DW Collateral composition
dw_collateral_summary <- dw_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
group_by(period) %>%
summarise(
# Collateral shares (as percentages)
Treasury_Agency = mean(dw_share_treasury_agency, na.rm = TRUE) * 100,
MBS_Agency = mean(dw_share_mbs_agency, na.rm = TRUE) * 100,
MBS_Other = mean(dw_share_mbs_other, na.rm = TRUE) * 100,
Res_Mortgages = mean(dw_share_res_mortgages, na.rm = TRUE) * 100,
CRE_Loans = mean(dw_share_cre_loans, na.rm = TRUE) * 100,
Comm_Loans = mean(dw_share_comm_loans, na.rm = TRUE) * 100,
Consumer_Loans = mean(dw_share_consumer_loans, na.rm = TRUE) * 100,
Municipal = mean(dw_share_municipal_sec, na.rm = TRUE) * 100,
Other = mean(dw_share_other_collateral, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
dw_collateral_summary %>%
select(period_name, Treasury_Agency, MBS_Agency, Res_Mortgages, CRE_Loans,
Comm_Loans, Consumer_Loans, Other) %>%
mutate(across(2:8, ~round(., 1))) %>%
kable(
col.names = c("Period", "Treasury/Agency", "MBS Agency", "Res Mortgages",
"CRE Loans", "Comm Loans", "Consumer Loans", "Other"),
caption = "DW Collateral Composition by Period - Average Share of Total Collateral (%)",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Period | Treasury/Agency | MBS Agency | Res Mortgages | CRE Loans | Comm Loans | Consumer Loans | Other |
|---|---|---|---|---|---|---|---|
| Pre-BTFP (SVB Crisis) | 13.2 | 19.5 | 3.6 | 10.1 | 28.7 | 4.3 | 0 |
| Acute Crisis | 17.7 | 19.0 | 4.0 | 11.9 | 19.9 | 3.9 | 0 |
| Post-Acute | 19.6 | 14.8 | 3.4 | 12.1 | 15.8 | 5.8 | 0 |
5 Part 2: Borrower Classification and User Groups
5.1 Define User Groups
# Get unique borrowers by facility
btfp_borrowers <- btfp_loans %>%
filter(failed_bank == 0) %>%
distinct(rssd_id) %>%
mutate(used_btfp = 1)
dw_borrowers <- dw_loans %>%
filter(failed_bank == 0) %>%
distinct(rssd_id) %>%
mutate(used_dw = 1)
# Merge to create user groups
user_groups <- baseline_2022q4 %>%
select(idrssd) %>%
left_join(btfp_borrowers, by = c("idrssd" = "rssd_id")) %>%
left_join(dw_borrowers, by = c("idrssd" = "rssd_id")) %>%
mutate(
used_btfp = replace_na(used_btfp, 0),
used_dw = replace_na(used_dw, 0),
user_group = case_when(
used_btfp == 1 & used_dw == 1 ~ "Both",
used_btfp == 1 & used_dw == 0 ~ "BTFP Only",
used_btfp == 0 & used_dw == 1 ~ "DW Only",
TRUE ~ "Neither"
)
)
# Summary of user groups
user_group_counts <- user_groups %>%
count(user_group) %>%
mutate(
pct = n / sum(n) * 100
)
user_group_counts %>%
mutate(pct = round(pct, 1)) %>%
kable(
col.names = c("User Group", "Number of Banks", "Percentage (%)"),
caption = "Bank User Groups - Based on Facility Usage During BTFP Period",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| User Group | Number of Banks | Percentage (%) |
|---|---|---|
| BTFP Only | 651 | 13.7 |
| Both | 664 | 14.0 |
| DW Only | 946 | 20.0 |
| Neither | 2476 | 52.3 |
6 Part 5: Comparison Tables (Publication Quality)
6.1 Table 1: BTFP Borrowing by Period
# Create publication-quality BTFP table
btfp_pub_table <- btfp_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
group_by(period) %>%
summarise(
`Number of Loans` = n(),
`Unique Borrowers` = n_distinct(rssd_id),
`Total Borrowing ($B)` = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
`Mean Loan ($M)` = mean(btfp_loan_amount, na.rm = TRUE) / 1e6,
`Median Loan ($M)` = median(btfp_loan_amount, na.rm = TRUE) / 1e6,
`SD Loan ($M)` = sd(btfp_loan_amount, na.rm = TRUE) / 1e6,
`Min Loan ($M)` = min(btfp_loan_amount, na.rm = TRUE) / 1e6,
`Max Loan ($M)` = max(btfp_loan_amount, na.rm = TRUE) / 1e6,
`Mean Rate (%)` = mean(btfp_interest_rate, na.rm = TRUE),
`Mean Term (days)` = mean(btfp_term, na.rm = TRUE),
`Mean 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")) %>%
select(period_name, everything(), -period)
btfp_pub_table %>%
mutate(
`Total Borrowing ($B)` = round(`Total Borrowing ($B)`, 2),
across(c(`Mean Loan ($M)`, `Median Loan ($M)`, `SD Loan ($M)`,
`Min Loan ($M)`, `Max Loan ($M)`), ~round(., 1)),
across(c(`Mean Rate (%)`, `Mean Loan/Collateral`), ~round(., 3)),
`Mean Term (days)` = round(`Mean Term (days)`, 0)
) %>%
kable(
caption = "**Table 1: BTFP Borrowing Statistics by Period** - Excluding Failed Banks",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| period_name | Number of Loans | Unique Borrowers | Total Borrowing (\(B) </th> <th style="text-align:right;"> Mean Loan (\)M) | Median Loan (\(M) </th> <th style="text-align:right;"> SD Loan (\)M) | Min Loan (\(M) </th> <th style="text-align:right;"> Max Loan (\)M) | Mean Rate (%) | Mean Term (days) | Mean Loan/Collateral | |||
|---|---|---|---|---|---|---|---|---|---|---|---|
| Acute Crisis | 1079 | 491 | 123.33 | 114.3 | 13.5 | 572.1 | 0 | 8900 | 4.689 | 311 | 0.526 |
| Post-Acute | 1972 | 816 | 51.38 | 26.1 | 5.0 | 103.7 | 0 | 3500 | 5.203 | 272 | 0.347 |
| Arbitrage Phase | 3279 | 801 | 229.81 | 70.1 | 15.0 | 259.1 | 0 | 3900 | 4.972 | 335 | 0.496 |
| Wind-down | 396 | 240 | 17.12 | 43.2 | 7.5 | 192.8 | 0 | 2590 | 5.400 | 294 | 0.390 |
6.2 Table 2: DW Borrowing by Period
# Create publication-quality DW table
dw_pub_table <- dw_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
group_by(period) %>%
summarise(
`Number of Loans` = n(),
`Unique Borrowers` = n_distinct(rssd_id),
`Total Borrowing ($B)` = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
`Mean Loan ($M)` = mean(dw_loan_amount, na.rm = TRUE) / 1e6,
`Median Loan ($M)` = median(dw_loan_amount, na.rm = TRUE) / 1e6,
`SD Loan ($M)` = sd(dw_loan_amount, na.rm = TRUE) / 1e6,
`Min Loan ($M)` = min(dw_loan_amount, na.rm = TRUE) / 1e6,
`Max Loan ($M)` = max(dw_loan_amount, na.rm = TRUE) / 1e6,
`Mean Rate (%)` = mean(dw_interest_rate, na.rm = TRUE),
`Mean Term` = mean(dw_term, na.rm = TRUE),
`OMO Collateral Share (%)` = mean(dw_omo_eligible / dw_total_collateral, na.rm = TRUE) * 100,
`Mean Loan/Collateral` = mean(dw_loan_amount / dw_total_collateral, na.rm = TRUE),
.groups = "drop"
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num")) %>%
select(period_name, everything(), -period)
dw_pub_table %>%
mutate(
`Total Borrowing ($B)` = round(`Total Borrowing ($B)`, 2),
across(c(`Mean Loan ($M)`, `Median Loan ($M)`, `SD Loan ($M)`,
`Min Loan ($M)`, `Max Loan ($M)`), ~round(., 1)),
across(c(`Mean Rate (%)`, `OMO Collateral Share (%)`, `Mean Loan/Collateral`), ~round(., 2)),
`Mean Term` = round(`Mean Term`, 0)
) %>%
kable(
caption = "**Table 2: Discount Window Borrowing Statistics by Period** - Excluding Failed Banks",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| period_name | Number of Loans | Unique Borrowers | Total Borrowing (\(B) </th> <th style="text-align:right;"> Mean Loan (\)M) | Median Loan (\(M) </th> <th style="text-align:right;"> SD Loan (\)M) | Min Loan (\(M) </th> <th style="text-align:right;"> Max Loan (\)M) | Mean Rate (%) | Mean Term | OMO Collateral Share (%) | Mean Loan/Collateral | |||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Pre-BTFP (SVB Crisis) | 298 | 108 | 53.54 | 179.7 | 10.2 | 1421.1 | 0 | 20377.6 | 4.75 | 5 | 32.65 | 0.24 |
| Acute Crisis | 1609 | 423 | 2036.88 | 1265.9 | 10.0 | 8415.2 | 0 | 107046.4 | 4.92 | 5 | 36.69 | 0.28 |
| Post-Acute | 4237 | 846 | 111.55 | 26.3 | 5.4 | 99.0 | 0 | 5600.0 | 5.35 | 5 | 34.35 | 0.23 |
7 Part 6: Visualizations
7.1 Borrowing Volume Over Time
# Define period date range for filtering
period_start <- as.Date("2023-03-01")
period_end <- as.Date("2024-03-11")
# Daily borrowing volume - BTFP period only
btfp_daily <- btfp_loans %>%
filter(failed_bank == 0, !is.na(btfp_loan_date),
btfp_loan_date >= period_start & btfp_loan_date <= period_end) %>%
group_by(date = btfp_loan_date) %>%
summarise(
total_M = sum(btfp_loan_amount, na.rm = TRUE) / 1e6,
n_loans = n(),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
dw_daily <- dw_loans %>%
filter(failed_bank == 0, !is.na(dw_loan_date),
dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
group_by(date = dw_loan_date) %>%
summarise(
total_M = sum(dw_loan_amount, na.rm = TRUE) / 1e6,
n_loans = n(),
.groups = "drop"
) %>%
mutate(facility = "Discount Window")
daily_combined <- bind_rows(btfp_daily, dw_daily)
# Plot
ggplot(daily_combined, aes(x = date, y = total_M, fill = facility)) +
geom_bar(stat = "identity", position = "dodge") +
scale_y_continuous(labels = comma) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
geom_vline(xintercept = as.Date("2023-03-12"), linetype = "dashed", color = "red") +
annotate("text", x = as.Date("2023-03-12"), y = Inf, label = "BTFP Launch",
vjust = 2, hjust = -0.1, color = "red", size = 3) +
labs(
title = "Daily Borrowing Volume by Facility",
subtitle = "Excluding Failed Banks",
x = "Date",
y = "Total Borrowing ($M)",
fill = "Facility"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom"
)
8 Part 7: Collateral Utilization Analysis
8.1 BTFP Collateral Utilization
btfp_utilization <- btfp_loans %>%
filter(failed_bank == 0, !is.na(period)) %>%
group_by(period) %>%
summarise(
`Mean Loan/Collateral` = mean(btfp_loan_amount / btfp_total_collateral, na.rm = TRUE),
`Median Loan/Collateral` = median(btfp_loan_amount / btfp_total_collateral, na.rm = TRUE),
`Max Loan/Collateral` = max(btfp_loan_amount / btfp_total_collateral, na.rm = TRUE),
`Pct at Par` = mean((btfp_loan_amount / btfp_total_collateral) > 0.99, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
left_join(periods %>% select(period_num, period_name), by = c("period" = "period_num"))
btfp_utilization %>%
select(period_name, everything(), -period) %>%
mutate(across(2:5, ~round(., 2))) %>%
kable(
caption = "BTFP Collateral Utilization by Period - BTFP lends at par value (100%)",
format = "html"
) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| period_name | Mean Loan/Collateral | Median Loan/Collateral | Max Loan/Collateral | Pct at Par |
|---|---|---|---|---|
| Acute Crisis | 0.53 | 0.50 | 1 | 12.42 |
| Post-Acute | 0.35 | 0.23 | 1 | 6.64 |
| Arbitrage Phase | 0.50 | 0.43 | 1 | 8.97 |
| Wind-down | 0.39 | 0.28 | 1 | 8.33 |
9 Part 8: Detailed Borrowing Visualizations
9.1 Key Event Dates
# Define key event dates for annotations
key_events <- tribble(
~date, ~event, ~event_short,
"2023-03-08", "Silvergate Liquidation Announced", "Silvergate",
"2023-03-10", "SVB Failure", "SVB",
"2023-03-12", "Signature Bank Closure / BTFP Announced", "Signature/BTFP",
"2023-03-16", "First Republic $30B Deposit Injection", "FRB Rescue",
"2023-05-01", "First Republic Seized by FDIC", "FRB Failure",
"2024-01-24", "Fed Announces BTFP Closure + Rate Adjustment", "BTFP Rate Change",
"2024-03-11", "BTFP Program Ends", "BTFP Ends"
) %>%
mutate(date = as.Date(date))
# Create GSIB flag in loan data by merging with call report
gsib_banks <- call_report %>%
filter(gsib == 1) %>%
distinct(idrssd) %>%
pull(idrssd)
btfp_loans <- btfp_loans %>%
mutate(is_gsib = ifelse(rssd_id %in% gsib_banks, 1, 0))
dw_loans <- dw_loans %>%
mutate(is_gsib = ifelse(rssd_id %in% gsib_banks, 1, 0))
cat("BTFP loans from GSIB banks:", sum(btfp_loans$is_gsib), "\n")## BTFP loans from GSIB banks: 31cat("DW loans from GSIB banks:", sum(dw_loans$is_gsib), "\n")## DW loans from GSIB banks: 1279.2 Figure 1: Daily Borrowing March 2023 (All 31 Days)
9.2.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 %>%
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 %>%
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 1A: 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)
9.2.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",
failed_bank == 0, is_gsib == 0) %>%
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",
failed_bank == 0, is_gsib == 0) %>%
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 1B: Daily Borrowing in March 2023 - Excluding Failed Banks & G-SIBs",
subtitle = "Core sample for analysis",
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)
9.3 Figure 2: Borrowing Patterns Over Full BTFP Period (With Period Shading)
# Define period shading colors
period_colors <- c(
"Pre-BTFP (SVB Crisis)" = "#FFE5E5",
"Acute Crisis" = "#FFB3B3",
"Post-Acute" = "#E5F5E0",
"Pre-Arbitrage" = "#DEEBF7",
"Arbitrage Phase" = "#FFF3CD"
)
# Define period date range for filtering
period_start <- as.Date("2023-03-01")
period_end <- as.Date("2024-03-11")
# Weekly aggregates for smoother visualization (all banks) - BTFP period only
btfp_weekly_all <- btfp_loans %>%
filter(!is.na(btfp_loan_date),
btfp_loan_date >= period_start & btfp_loan_date <= period_end) %>%
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week) %>%
summarise(
total_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
.groups = "drop"
) %>%
mutate(facility = "BTFP", sample = "All Banks")
btfp_weekly_excl <- btfp_loans %>%
filter(!is.na(btfp_loan_date), failed_bank == 0, is_gsib == 0,
btfp_loan_date >= period_start & btfp_loan_date <= period_end) %>%
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week) %>%
summarise(
total_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
.groups = "drop"
) %>%
mutate(facility = "BTFP", sample = "Excl. Failed & GSIB")
dw_weekly_all <- dw_loans %>%
filter(!is.na(dw_loan_date),
dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
total_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
.groups = "drop"
) %>%
mutate(facility = "Discount Window", sample = "All Banks")
dw_weekly_excl <- dw_loans %>%
filter(!is.na(dw_loan_date), failed_bank == 0, is_gsib == 0,
dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
total_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_loans = n(),
.groups = "drop"
) %>%
mutate(facility = "Discount Window", sample = "Excl. Failed & GSIB")
# Combine all
weekly_combined <- bind_rows(btfp_weekly_all, btfp_weekly_excl, dw_weekly_all, dw_weekly_excl)
# Create the plot with period shading using annotate (no ggnewscale needed)
p2 <- ggplot() +
# Period shading using annotate
annotate("rect", xmin = periods$start_date, xmax = periods$end_date,
ymin = -Inf, ymax = Inf,
fill = c("#FFE5E5", "#FFB3B3", "#E5F5E0", "#DEEBF7", "#FFF3CD"),
alpha = 0.3) +
# Lines for borrowing
geom_line(data = weekly_combined,
aes(x = week, y = total_B, color = facility, linetype = sample),
linewidth = 1.2) +
geom_point(data = weekly_combined,
aes(x = week, y = total_B, color = facility, shape = sample),
size = 2) +
# Event lines
geom_vline(data = key_events, aes(xintercept = date),
linetype = "dotted", color = "darkred", alpha = 0.8) +
scale_color_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
scale_linetype_manual(values = c("All Banks" = "solid", "Excl. Failed & GSIB" = "dashed")) +
scale_shape_manual(values = c("All Banks" = 16, "Excl. Failed & GSIB" = 17)) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = comma) +
labs(
title = "Figure 2: Weekly Borrowing by Facility Over BTFP Period",
subtitle = "Solid lines = All Banks; Dashed lines = Excluding Failed Banks & G-SIBs | Shaded regions = Period phases",
x = "Date",
y = "Total Weekly Borrowing ($B)",
color = "Facility",
linetype = "Sample",
shape = "Sample"
) +
theme_minimal(base_size = 12) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
legend.box = "vertical",
plot.title = element_text(face = "bold")
)
print(p2)
9.4 Figure 3: Collateral Utilization Over Time
# Define period date range for filtering
period_start <- as.Date("2023-03-01")
period_end <- as.Date("2024-03-11")
# Weekly collateral utilization (loan/collateral ratio) - BTFP period only
btfp_util_daily <- btfp_loans %>%
filter(!is.na(btfp_loan_date), failed_bank == 0,
btfp_loan_date >= period_start & btfp_loan_date <= period_end) %>%
mutate(
loan_collateral_ratio = btfp_loan_amount / btfp_total_collateral,
week = floor_date(btfp_loan_date, "week")
) %>%
group_by(week) %>%
summarise(
mean_ratio = mean(loan_collateral_ratio, na.rm = TRUE),
median_ratio = median(loan_collateral_ratio, na.rm = TRUE),
pct_at_par = mean(loan_collateral_ratio >= 0.99, na.rm = TRUE) * 100,
n = n(),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
dw_util_daily <- dw_loans %>%
filter(!is.na(dw_loan_date), failed_bank == 0,
dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
mutate(
loan_collateral_ratio = dw_loan_amount / dw_total_collateral,
week = floor_date(dw_loan_date, "week")
) %>%
group_by(week) %>%
summarise(
mean_ratio = mean(loan_collateral_ratio, na.rm = TRUE),
median_ratio = median(loan_collateral_ratio, na.rm = TRUE),
pct_at_par = NA_real_, # Not applicable for DW
n = n(),
.groups = "drop"
) %>%
mutate(facility = "Discount Window")
util_combined <- bind_rows(btfp_util_daily, dw_util_daily)
# Plot collateral utilization
p3 <- 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) +
# Lines
geom_line(data = util_combined,
aes(x = week, y = mean_ratio, color = facility), size = 1.2) +
geom_point(data = util_combined,
aes(x = week, y = mean_ratio, color = facility), size = 2) +
# Reference lines
geom_hline(yintercept = 1.0, linetype = "dashed", color = "darkgreen", alpha = 0.7) +
annotate("text", x = as.Date("2023-04-01"), y = 1.02,
label = "Par Value (100%)", color = "darkgreen", size = 3) +
# Event lines
geom_vline(data = key_events %>% filter(date <= max(util_combined$week, na.rm = TRUE)),
aes(xintercept = date), linetype = "dotted", color = "darkred", alpha = 0.6) +
scale_color_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = percent_format(accuracy = 1), limits = c(0, 1.1)) +
labs(
title = "Figure 3: Collateral Utilization Over Time",
subtitle = "Loan Amount / Collateral Value (BTFP lends at par; DW applies haircuts)",
x = "Date",
y = "Loan / Collateral Ratio",
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(p3)
# Define period date range for filtering
period_start <- as.Date("2023-03-01")
period_end <- as.Date("2024-03-11")
# DW OMO vs Non-OMO collateral usage over time - BTFP period only
dw_omo_util <- dw_loans %>%
filter(!is.na(dw_loan_date), failed_bank == 0,
dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
mean_omo_share = mean(dw_omo_eligible / dw_total_collateral, na.rm = TRUE) * 100,
mean_non_omo_share = mean(dw_non_omo_eligible / dw_total_collateral, na.rm = TRUE) * 100,
total_omo = sum(dw_omo_eligible, na.rm = TRUE) / 1e9,
total_non_omo = sum(dw_non_omo_eligible, na.rm = TRUE) / 1e9,
.groups = "drop"
)
# Reshape for plotting
dw_omo_long <- dw_omo_util %>%
pivot_longer(cols = c(mean_omo_share, mean_non_omo_share),
names_to = "collateral_type", values_to = "share") %>%
mutate(collateral_type = case_when(
collateral_type == "mean_omo_share" ~ "OMO-Eligible",
collateral_type == "mean_non_omo_share" ~ "Non-OMO"
))
p3b <- 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_area(data = dw_omo_long,
aes(x = week, y = share, fill = collateral_type),
position = "stack", alpha = 0.7) +
scale_fill_manual(values = c("OMO-Eligible" = "#2E86AB", "Non-OMO" = "#E8573C")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
labs(
title = "Figure 3B: DW Collateral Composition Over Time",
subtitle = "OMO-Eligible (Treasury, Agency MBS) vs Non-OMO (Loans, Other Securities)",
x = "Date",
y = "Share of Total Collateral (%)",
fill = "Collateral Type"
) +
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(p3b)
9.5 Figure 4: Interest Rate Differences Over Time
# Define period date range for filtering
period_start <- as.Date("2023-03-01")
period_end <- as.Date("2024-03-11")
# Weekly average rates - BTFP period only
btfp_rates <- btfp_loans %>%
filter(!is.na(btfp_loan_date), failed_bank == 0,
btfp_loan_date >= period_start & btfp_loan_date <= period_end) %>%
mutate(week = floor_date(btfp_loan_date, "week")) %>%
group_by(week) %>%
summarise(
mean_rate = mean(btfp_interest_rate, na.rm = TRUE),
median_rate = median(btfp_interest_rate, na.rm = TRUE),
min_rate = min(btfp_interest_rate, na.rm = TRUE),
max_rate = max(btfp_interest_rate, na.rm = TRUE),
n = n(),
.groups = "drop"
) %>%
mutate(facility = "BTFP")
dw_rates <- dw_loans %>%
filter(!is.na(dw_loan_date), failed_bank == 0,
dw_loan_date >= period_start & dw_loan_date <= period_end) %>%
mutate(week = floor_date(dw_loan_date, "week")) %>%
group_by(week) %>%
summarise(
mean_rate = mean(dw_interest_rate, na.rm = TRUE),
median_rate = median(dw_interest_rate, na.rm = TRUE),
min_rate = min(dw_interest_rate, na.rm = TRUE),
max_rate = max(dw_interest_rate, na.rm = TRUE),
n = n(),
.groups = "drop"
) %>%
mutate(facility = "Discount Window")
rates_combined <- bind_rows(btfp_rates, dw_rates)
# Calculate rate spread (DW - BTFP)
rate_spread <- rates_combined %>%
select(week, facility, mean_rate) %>%
pivot_wider(names_from = facility, values_from = mean_rate) %>%
mutate(spread = `Discount Window` - BTFP)
# Plot rates with period shading
p4a <- 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) +
# Rate lines
geom_line(data = rates_combined,
aes(x = week, y = mean_rate, color = facility), size = 1.2) +
geom_point(data = rates_combined,
aes(x = week, y = mean_rate, color = facility), size = 2) +
# Event lines
geom_vline(data = key_events %>% filter(date <= max(rates_combined$week, na.rm = TRUE)),
aes(xintercept = date), linetype = "dotted", color = "darkred", alpha = 0.6) +
scale_color_manual(values = c("BTFP" = "#2E86AB", "Discount Window" = "#A23B72")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
labs(
title = "Figure 4A: Interest Rates by Facility Over Time",
subtitle = "Weekly average borrowing rates",
x = "Date",
y = "Interest Rate (%)",
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(p4a)
# Plot rate spread
p4b <- 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 = rate_spread %>% filter(!is.na(spread)),
aes(x = week, y = spread), color = "#4A4A4A", size = 1.2) +
geom_point(data = rate_spread %>% filter(!is.na(spread)),
aes(x = week, y = spread), color = "#4A4A4A", size = 2) +
geom_hline(yintercept = 0, linetype = "dashed", color = "darkgreen") +
annotate("text", x = as.Date("2023-04-01"), y = 0.05,
label = "No Spread", color = "darkgreen", size = 3) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = function(x) paste0(x, " pp")) +
labs(
title = "Figure 4B: DW-BTFP Rate Spread Over Time",
subtitle = "Positive = DW more expensive | Negative = BTFP more expensive (arbitrage incentive)",
x = "Date",
y = "Rate Spread (DW - BTFP, percentage points)",
caption = "Note: Late-period negative spread indicates BTFP arbitrage opportunity"
) +
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(p4b)
9.6 Figure 5: Loan Terms and Maturity Analysis
# Term distribution by facility and period
btfp_terms <- btfp_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
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), failed_bank == 0) %>%
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 5A: Loan Term Distribution by Period",
subtitle = "Original loan term in days (outliers trimmed)",
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)
# 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 5B: Effective Maturity Distribution by Period",
subtitle = "Actual days from loan date to repayment (outliers trimmed)",
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)
# 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(!is.na(btfp_loan_date), failed_bank == 0,
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(!is.na(dw_loan_date), failed_bank == 0,
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 5C: 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)
9.7 Figure 6: Summary Statistics by Period (Visual)
# Create summary for visualization
btfp_period_viz <- btfp_loans %>%
filter(!is.na(period), failed_bank == 0) %>%
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), failed_bank == 0) %>%
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 6: Summary Statistics by Period and Facility",
subtitle = "Excluding Failed Banks"
)
10 Descriptive Statistics: Asset and Liability Composition
################################################################################
# ASSET AND LIABILITY COMPOSITION TABLES
################################################################################
cat("\n")cat(strrep("=", 80), "\n", sep = "")## ================================================================================cat("ASSET AND LIABILITY COMPOSITION TABLES\n")## ASSET AND LIABILITY COMPOSITION TABLEScat(strrep("=", 80), "\n", sep = "")## ================================================================================cat("\nGenerating descriptive tables for 2022Q4 and 2023Q1\n\n")##
## Generating descriptive tables for 2022Q4 and 2023Q1# Helper function for winsorization at 5-95 percentiles
winsorize_5_95 <- function(x) {
if (all(is.na(x))) return(x)
q <- quantile(x, probs = c(0.05, 0.95), na.rm = TRUE, names = FALSE)
# Clip values outside the 5th-95th range
pmax(pmin(x, q[2]), q[1])
}
# Helper to safely sum columns (treating NA as 0)
safe_sum <- function(...) {
rowSums(cbind(...), na.rm = TRUE)
}# Asset Configuration
ASSET_CONFIG <- list(
list("Cash", "cash"),
list("Securities", "security"),
list("\\quad Treasury", "treasury"),
list("\\quad RMBS", "total_rmbs"),
list("\\quad CMBS", "total_cmbs"),
list("\\quad ABS", "abs"),
list("\\quad Other Securities", "other_security"), # Residual
list("Total Loans", "total_loan"),
list("\\quad Real Estate Loans", "reloan"),
list("\\quad\\quad Residential Mortgage", "reloan_residential1to4"),
list("\\quad\\quad Commercial Mortgage", "reloan_residential5"),
list("\\quad\\quad Other Real Estate", "other_re_residual"), # Residual
list("\\quad Agricultural Loans", "agloan"),
list("\\quad Commercial & Industrial", "ciloan"),
list("\\quad Consumer Loans", "hhloan"),
list("\\quad Loans to Non-Depositories", "loans_to_nonbank"),
list("Fed Funds Sold", "fed_fund_sold"),
list("Reverse Repo", "rerepo")
)
# Liability Configuration
LIAB_CONFIG <- list(
list("Total Liabilities", "r_total_liability"),
list("Domestic Deposits", "r_dom_deposit"),
list("\\quad Insured Deposits", "r_insured_deposit"),
list("\\quad Uninsured Deposits", "r_uninsured_deposit"),
list("\\quad\\quad Uninsured Time Deposits (Total)", "r_uninsured_tot_time_deposit"),
list("\\quad\\quad\\quad Long-term Time Deposits", "r_uninsured_long_time_account"),
list("\\quad\\quad\\quad Short-term Time Deposits", "r_uninsured_short_time_deposit"),
list("Foreign Deposits", "r_foreign_deposit"),
list("Fed Funds Purchased", "r_fed_fund_purchase"),
list("Repo", "r_repo"),
list("Other Liabilities", "r_other_liab"),
list("Total Equity", "r_total_equity"),
list("\\quad Common Stock", "r_common_stock"),
list("\\quad Preferred Stock", "r_preferred_stock"),
list("\\quad Retained Earnings", "r_retained_earning")
)# Function to prepare data (calculate residuals and ensure grouping)
prepare_data <- function(df) {
# --- 1. Pre-calculation helpers ---
# Get column or 0 if missing
get_col <- function(var) if(var %in% names(df)) df[[var]] else 0
# --- 2. Create Raw Components needed for Residuals ---
# These sums match the "Strict Jiang" definition in the Python notebook
# ABS = HTM Amortized + HFS Fair
abs_val <- safe_sum(get_col("abs_htm_amortize"), get_col("abs_hfs_fair"))
# RMBS = Agency (HTM+HFS) + Other (HTM+HFS)
rmbs_val <- safe_sum(get_col("agency_rmbs_htm_amortize"), get_col("agency_rmbs_hfs_fair"),
get_col("other_rmbs_htm_amortize"), get_col("other_rmbs_hfs_fair"))
# CMBS = Agency (HTM+HFS) + Other (HTM+HFS)
cmbs_val <- safe_sum(get_col("agency_cmbs_htm_amortize"), get_col("agency_cmbs_hfs_fair"),
get_col("other_cmbs_htm_amortize"), get_col("other_cmbs_hfs_fair"))
df %>%
mutate(
# --- Categories ---
bank_category = case_when(
size_bin == "small" ~ "Small",
size_bin == "large" ~ "Large",
size_bin == "gsib" ~ "GSIB",
TRUE ~ NA_character_
),
# --- Assign Constructed Variables ---
abs = abs_val,
total_rmbs = rmbs_val,
total_cmbs = cmbs_val,
# --- Calculate Asset Residuals ---
# Other Securities = Security - (Treasury + RMBS + CMBS + ABS)
other_security = security - safe_sum(treasury, rmbs_val, cmbs_val, abs_val),
# Other Real Estate = Reloan - (Res + Comm)
other_re_residual = reloan - safe_sum(reloan_residential1to4, reloan_residential5),
# --- Calculate Missing Liability Ratios (r_*) ---
# If these columns are missing, calculate them as: 100 * Raw / Total Assets
r_uninsured_long_time_account = if("r_uninsured_long_time_account" %in% names(.))
r_uninsured_long_time_account
else
100 * get_col("uninsured_long_time_account") / total_asset,
r_uninsured_short_time_deposit = if("r_uninsured_short_time_deposit" %in% names(.))
r_uninsured_short_time_deposit
else
100 * get_col("uninsured_short_time_deposit") / total_asset,
r_uninsured_tot_time_deposit = if("r_uninsured_tot_time_deposit" %in% names(.))
r_uninsured_tot_time_deposit
else
100 * safe_sum(get_col("uninsured_long_time_account"), get_col("uninsured_short_time_deposit")) / total_asset
)
}
# Apply preparation
df_2022Q4 <- prepare_data(call_report %>% filter(quarter == "2022Q4"))
df_2023Q1 <- prepare_data(call_report%>% filter(quarter == "2023Q1"))
cat("✓ Data Prepared successfully.\n")## ✓ Data Prepared successfully.generate_jiang_table <- function(df, config, type = "asset") {
# --- 1. Calculate N (Counts) ---
n_total <- nrow(df)
n_small <- sum(df$bank_category == "Small", na.rm = TRUE)
n_large <- sum(df$bank_category == "Large", na.rm = TRUE)
n_gsib <- sum(df$bank_category == "GSIB", na.rm = TRUE)
# Initialize DataFrame with N row
stats_df <- data.frame(
Component = "Number of Banks",
Agg = format(n_total, big.mark=","),
Full = format(n_total, big.mark=","),
Small = format(n_small, big.mark=","),
Large = format(n_large, big.mark=","),
GSIB = format(n_gsib, big.mark=","),
stringsAsFactors = FALSE
)
total_asset_sum <- sum(df$total_asset, na.rm = TRUE)
# --- 2. Process Components ---
for (item in config) {
label <- item[[1]]
var_name <- item[[2]]
# Get Data
if (!var_name %in% names(df)) {
vals <- rep(0, nrow(df))
} else {
vals <- df[[var_name]]
}
# Standardize to Percentage
if (type == "asset") {
bank_ratios <- 100 * vals / df$total_asset
agg_val <- 100 * sum(vals, na.rm = TRUE) / total_asset_sum
} else {
bank_ratios <- vals
agg_val <- sum(vals * df$total_asset, na.rm = TRUE) / total_asset_sum
}
# GLOBAL WINSORIZATION
winsorized_ratios <- winsorize_5_95(bank_ratios)
# Calculate Stats on Winsorized Vector
calc_stat <- function(data_vec) {
if (length(data_vec) == 0) return(c(0, 0))
return(c(mean(data_vec, na.rm = TRUE), sd(data_vec, na.rm = TRUE)))
}
full_stats <- calc_stat(winsorized_ratios)
small_stats <- calc_stat(winsorized_ratios[df$bank_category == "Small"])
large_stats <- calc_stat(winsorized_ratios[df$bank_category == "Large"])
gsib_stats <- calc_stat(winsorized_ratios[df$bank_category == "GSIB"])
# Format Row
fmt <- function(s) sprintf("%.1f\n(%.1f)", s[1], s[2])
stats_df[nrow(stats_df) + 1, ] <- list(
Component = label,
Agg = sprintf("%.1f", agg_val),
Full = fmt(full_stats),
Small = fmt(small_stats),
Large = fmt(large_stats),
GSIB = fmt(gsib_stats)
)
}
return(stats_df)
}
render_table <- function(stats_df, title) {
stats_df %>%
kbl(caption = title,
col.names = c("", "Aggregate", "Full Sample", "Small", "Large", "GSIB"),
align = c("l", "c", "c", "c", "c", "c"),
escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F) %>%
add_header_above(c(" " = 1, "(1)" = 1, "(2)" = 1, "(3)" = 1, "(4)" = 1, "(5)" = 1)) %>%
row_spec(0, bold = TRUE) %>%
# Add a line after the N row (row 1)
row_spec(1, hline_after = TRUE) %>%
footnote(general = "Values are percentages of total assets. Row 1 shows number of banks. Column (1) is aggregate. Columns (2)-(5) are bank-level averages. Standard deviations in parentheses. All bank-level statistics (Cols 2-5) are winsorized at the 5th and 95th percentiles.")
}# --- 2022Q4 ---
asset_stats_22q4 <- generate_jiang_table(df_2022Q4, ASSET_CONFIG, type = "asset")
render_table(asset_stats_22q4, "Bank Asset Composition, 2022Q4")| Aggregate | Full Sample | Small | Large | GSIB | |
|---|---|---|---|---|---|
| Number of Banks | 4,737 | 4,737 | 3,967 | 737 | 33 |
| Cash | 11.0 | 8.1 (7.4) | 8.5 (7.5) | 5.2 (5.6) | 18.7 (10.1) |
| Securities | 24.0 | 24.0 (14.9) | 24.7 (15.2) | 20.5 (12.2) | 17.4 (17.4) |
| Treasury | 6.0 | 3.3 (4.8) | 3.5 (5.0) | 2.3 (3.7) | 5.1 (6.1) |
| RMBS | 11.2 | 3.0 (4.3) | 2.4 (3.9) | 6.1 (5.1) | 4.9 (6.1) |
| CMBS | 1.8 | 0.8 (1.4) | 0.6 (1.3) | 1.3 (1.6) | 0.8 (1.4) |
| ABS | 3.1 | 1.0 (1.7) | 0.9 (1.6) | 1.5 (1.9) | 1.4 (2.3) |
| Other Securities | 1.9 | 14.5 (12.2) | 15.9 (12.4) | 7.4 (7.7) | 2.3 (5.9) |
| Total Loans | 51.0 | 60.8 (16.5) | 59.7 (16.6) | 67.4 (13.6) | 43.6 (18.9) |
| Real Estate Loans | 24.2 | 45.9 (18.3) | 45.4 (18.2) | 49.7 (17.4) | 22.0 (18.6) |
| Residential Mortgage | 11.7 | 17.3 (12.8) | 17.7 (13.0) | 15.6 (11.7) | 11.8 (15.4) |
| Commercial Mortgage | 2.5 | 2.3 (2.8) | 2.0 (2.6) | 4.0 (3.1) | 1.1 (2.1) |
| Other Real Estate | 10.0 | 24.8 (12.9) | 24.5 (12.7) | 27.9 (12.8) | 4.3 (6.2) |
| Agricultural Loans | 0.3 | 3.0 (4.8) | 3.4 (5.1) | 0.8 (2.1) | 0.1 (0.4) |
| Commercial & Industrial | 9.8 | 7.2 (5.4) | 6.8 (5.1) | 9.4 (6.4) | 4.4 (5.9) |
| Consumer Loans | 8.6 | 2.4 (2.7) | 2.3 (2.5) | 2.5 (3.4) | 3.5 (4.3) |
| Loans to Non-Depositories | 3.2 | 0.1 (0.2) | 0.0 (0.2) | 0.2 (0.3) | 0.4 (0.4) |
| Fed Funds Sold | 0.1 | 0.8 (1.8) | 0.9 (1.9) | 0.1 (0.6) | 0.6 (1.9) |
| Reverse Repo | 1.3 | 0.0 (0.0) | 0.0 (0.0) | 0.0 (0.0) | 0.0 (0.0) |
| Note: | |||||
| Values are percentages of total assets. Row 1 shows number of banks. Column (1) is aggregate. Columns (2)-(5) are bank-level averages. Standard deviations in parentheses. All bank-level statistics (Cols 2-5) are winsorized at the 5th and 95th percentiles. |
liab_stats_22q4 <- generate_jiang_table(df_2022Q4, LIAB_CONFIG, type = "liability")
render_table(liab_stats_22q4, "Bank Liability Composition, 2022Q4")| Aggregate | Full Sample | Small | Large | GSIB | |
|---|---|---|---|---|---|
| Number of Banks | 4,737 | 4,737 | 3,967 | 737 | 33 |
| Total Liabilities | 90.6 | 90.3 (3.7) | 90.3 (3.8) | 90.4 (2.9) | 86.9 (4.7) |
| Domestic Deposits | 75.1 | 85.7 (6.4) | 86.1 (6.4) | 83.6 (5.7) | 77.0 (7.9) |
| Insured Deposits | 42.1 | 61.8 (12.7) | 63.6 (11.9) | 52.8 (12.0) | 46.9 (18.4) |
| Uninsured Deposits | 35.8 | 23.0 (11.0) | 21.7 (10.4) | 30.2 (11.0) | 23.1 (17.0) |
| Uninsured Time Deposits (Total) | 2.2 | 4.1 (3.4) | 4.3 (3.4) | 3.4 (3.0) | 1.5 (2.4) |
| Long-term Time Deposits | 0.3 | 1.1 (1.2) | 1.1 (1.2) | 0.8 (0.9) | 0.1 (0.3) |
| Short-term Time Deposits | 1.9 | 2.9 (2.6) | 3.0 (2.6) | 2.6 (2.4) | 1.3 (2.2) |
| Foreign Deposits | 6.3 | 0.0 (0.0) | 0.0 (0.0) | 0.0 (0.0) | 0.0 (0.0) |
| Fed Funds Purchased | 0.2 | 0.2 (0.5) | 0.2 (0.5) | 0.1 (0.4) | 0.0 (0.0) |
| Repo | 0.6 | 0.2 (0.7) | 0.2 (0.6) | 0.5 (0.9) | 0.2 (0.6) |
| Other Liabilities | 7.2 | 3.6 (4.0) | 3.2 (3.9) | 5.5 (4.1) | 6.2 (4.4) |
| Total Equity | 9.4 | 9.7 (3.7) | 9.7 (3.8) | 9.6 (2.9) | 13.1 (4.7) |
| Common Stock | 0.2 | 0.4 (0.6) | 0.4 (0.6) | 0.2 (0.6) | 0.7 (1.0) |
| Preferred Stock | 0.1 | 0.0 (0.0) | 0.0 (0.0) | 0.0 (0.0) | 0.0 (0.0) |
| Retained Earnings | 4.4 | 7.2 (4.2) | 7.4 (4.3) | 6.1 (3.2) | 7.4 (5.3) |
| Note: | |||||
| Values are percentages of total assets. Row 1 shows number of banks. Column (1) is aggregate. Columns (2)-(5) are bank-level averages. Standard deviations in parentheses. All bank-level statistics (Cols 2-5) are winsorized at the 5th and 95th percentiles. |
11 Analysis
# BTFP borrowers (excluding failed banks and GSIBs)
btfp_borrowers <- btfp_loans %>%
filter(failed_bank == 0) %>%
group_by(rssd_id) %>%
summarise(
used_btfp = 1,
btfp_first_date = min(btfp_loan_date, na.rm = TRUE),
btfp_first_period = min(period, na.rm = TRUE),
btfp_n_loans = n(),
btfp_total_amount = sum(btfp_loan_amount, na.rm = TRUE),
btfp_total_collateral = sum(btfp_total_collateral, na.rm = TRUE),
btfp_avg_rate = weighted.mean(btfp_interest_rate, btfp_loan_amount, na.rm = TRUE),
btfp_avg_term = weighted.mean(btfp_term, btfp_loan_amount, na.rm = TRUE),
.groups = "drop"
)
# DW borrowers - POST BTFP
dw_borrowers_post <- dw_loans %>%
filter(failed_bank == 0, dw_loan_date >= as.Date("2023-03-13")) %>%
group_by(rssd_id) %>%
summarise(
used_dw_post = 1,
dw_first_date_post = min(dw_loan_date, na.rm = TRUE),
dw_first_period_post = min(period, na.rm = TRUE),
dw_n_loans_post = n(),
dw_total_amount_post = sum(dw_loan_amount, na.rm = TRUE),
dw_total_collateral_post = sum(dw_total_collateral, na.rm = TRUE),
dw_omo_collateral_post = sum(dw_omo_eligible, na.rm = TRUE),
dw_non_omo_collateral_post = sum(dw_non_omo_eligible, na.rm = TRUE),
dw_avg_rate_post = weighted.mean(dw_interest_rate, dw_loan_amount, na.rm = TRUE),
.groups = "drop"
)
# DW borrowers - PRE BTFP (revealed preference)
dw_borrowers_pre <- dw_loans %>%
filter(failed_bank == 0, dw_loan_date < as.Date("2023-03-13")) %>%
group_by(rssd_id) %>%
summarise(
used_dw_pre = 1,
dw_first_date_pre = min(dw_loan_date, na.rm = TRUE),
dw_n_loans_pre = n(),
dw_total_amount_pre = sum(dw_loan_amount, na.rm = TRUE),
.groups = "drop"
)
cat("=== BORROWER COUNTS ===\n")## === BORROWER COUNTS ===cat("BTFP borrowers:", nrow(btfp_borrowers), "\n")## BTFP borrowers: 1326cat("DW borrowers post-BTFP:", nrow(dw_borrowers_post), "\n")## DW borrowers post-BTFP: 1091cat("DW borrowers pre-BTFP:", nrow(dw_borrowers_pre), "\n")## DW borrowers pre-BTFP: 1373# Merge all borrower data with baseline call report
analysis_df <- baseline_2022q4 %>%
left_join(btfp_borrowers, by = c("idrssd" = "rssd_id")) %>%
left_join(dw_borrowers_post, by = c("idrssd" = "rssd_id")) %>%
left_join(dw_borrowers_pre, by = c("idrssd" = "rssd_id")) %>%
mutate(
used_btfp = replace_na(used_btfp, 0),
used_dw_post = replace_na(used_dw_post, 0),
used_dw_pre = replace_na(used_dw_pre, 0)
)winsorize <- function(x, probs = c(0.01, 0.99)) {
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_div <- function(num, denom) {
ifelse(is.na(denom) | denom == 0, NA_real_, num / denom)
}
analysis_df <- analysis_df %>%
mutate(
# ============================================
# DEPENDENT VARIABLES
# ============================================
btfp = as.integer(used_btfp == 1),
dw = as.integer(used_dw_post == 1),
dw_pre_btfp = as.integer(used_dw_pre == 1),
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),
neither = as.integer(btfp == 0 & dw == 0),
# Facility choice factor
facility_choice = factor(
case_when(
btfp == 1 & dw == 1 ~ "Both",
btfp == 1 & dw == 0 ~ "BTFP_Only",
btfp == 0 & dw == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both")
),
# Period-specific BTFP entry
btfp_acute = as.integer(!is.na(btfp_first_period) & btfp_first_period == 2),
btfp_post_acute = as.integer(!is.na(btfp_first_period) & btfp_first_period == 3),
btfp_arbitrage = as.integer(!is.na(btfp_first_period) & btfp_first_period == 4),
# Intensive margin
btfp_amount_pct = ifelse(btfp == 1, 100 * btfp_total_amount / (total_asset * 1000), 0),
dw_amount_pct = ifelse(dw == 1, 100 * dw_total_amount_post / (total_asset * 1000), 0),
total_fed_amount_pct = btfp_amount_pct + dw_amount_pct,
btfp_utilization = ifelse(btfp == 1 & omo_eligible > 0,
btfp_total_amount / (omo_eligible * 1000), NA_real_),
maxed_out_btfp = as.integer(!is.na(btfp_utilization) & btfp_utilization > 0.90),
# ============================================
# KEY EXPLANATORY VARIABLES
# ============================================
# MTM Loss Variables - NOTE: mtm_total = mtm_btfp + mtm_other (DO NOT use together!)
mtm_btfp = mtm_loss_omo_eligible_to_total_asset,
mtm_other = mtm_loss_non_omo_eligible_to_total_asset,
mtm_total = mtm_loss_to_total_asset,
borrowing_subsidy = mtm_loss_omo_eligible_to_omo_eligible,
# Uninsured Deposit / Run Risk Variables
uninsured_lev = uninsured_deposit_to_total_asset,
uninsured_share = uninsured_to_deposit,
uninsured_lev_jiang = uninsured_to_mtm_asset,
# Run Risk Measures
run_risk = uninsured_lev * mtm_total,
wholesale_funding = safe_div(fed_fund_purchase + repo + replace_na(other_borrowed_less_than_1yr, 0),
total_liability) * 100,
runable_liability = safe_div(uninsured_deposit + fed_fund_purchase + repo +
replace_na(other_borrowed_less_than_1yr, 0), total_liability) * 100,
# Binary Risk Indicators
high_uninsured = as.integer(uninsured_lev > median(uninsured_lev, na.rm = TRUE)),
high_mtm = as.integer(mtm_total > median(mtm_total, na.rm = TRUE)),
high_mtm_btfp = as.integer(mtm_btfp > median(mtm_btfp, na.rm = TRUE)),
run_risk_dummy = as.integer(high_uninsured == 1 & high_mtm == 1),
# Jiang Insolvency Measures
mv_asset = mm_asset,
mv_adjustment = if_else(mv_asset == 0 | is.na(mv_asset), NA_real_, (total_asset / mv_asset) - 1),
idcr_1 = safe_div(mv_asset - 0.5 * uninsured_deposit - insured_deposit, insured_deposit),
idcr_2 = safe_div(mv_asset - 1.0 * uninsured_deposit - insured_deposit, insured_deposit),
insolvency_1 = safe_div((total_asset - total_liability) - 0.5 * uninsured_deposit * mv_adjustment, total_asset),
insolvency_2 = safe_div((total_asset - total_liability) - 1.0 * uninsured_deposit * mv_adjustment, total_asset),
adjusted_equity = book_equity_to_total_asset - mtm_loss_to_total_asset ,
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),
# Collateral Variables
omo_ratio = omo_eligible_to_total_asset,
non_omo_ratio = non_omo_eligible_to_total_asset,
# Revealed Preference
prior_dw_user = dw_pre_btfp,
fhlb_heavy = as.integer(fhlb_to_total_asset > median(fhlb_to_total_asset, na.rm = TRUE)),
# ============================================
# CONTROL VARIABLES
# ============================================
ln_assets = log(total_asset),
cash_ratio = cash_to_total_asset,
securities_ratio = security_to_total_asset,
loan_ratio = total_loan_to_total_asset,
book_equity_ratio = book_equity_to_total_asset,
tier1_ratio = tier1cap_to_total_asset,
roa_pct = roa,
deposit_ratio = total_deposit_to_total_asset,
loan_to_deposit = loan_to_deposit,
fhlb_ratio = fhlb_to_total_asset,
wholesale_ratio = wholesale_funding,
# Size category
size_category = factor(size_bin, levels = c("small", "large"))
)
# Winsorize key variables
analysis_df <- analysis_df %>%
mutate(
mtm_btfp_w = winsorize(mtm_btfp),
mtm_other_w = winsorize(mtm_other),
mtm_total_w = winsorize(mtm_total),
uninsured_lev_w = winsorize(uninsured_lev),
borrowing_subsidy_w = winsorize(borrowing_subsidy)
)
cat("\n=== ANALYSIS SAMPLE ===\n")##
## === ANALYSIS SAMPLE ===cat("Total banks:", nrow(analysis_df), "\n")## Total banks: 4737cat("BTFP users:", sum(analysis_df$btfp), "\n")## BTFP users: 1315cat("DW users (post-BTFP):", sum(analysis_df$dw), "\n")## DW users (post-BTFP): 1081cat("Both:", sum(analysis_df$both), "\n")## Both: 43412 Variable Summary Statistics
# ============================================
# DESCRIPTIVE STATISTICS (ACADEMIC FORMAT)
# ============================================
# Define the exact variables to summarize
vars_summary <- c(
# Outcome Variables (Future)
"btfp", "dw", "both",
# Key Independent Variables (Risk Measures)
"mtm_total", "mtm_btfp", "mtm_other",
"uninsured_lev", "run_risk", "borrowing_subsidy",
"omo_ratio", "maxed_out_btfp",
# Control Variables (Bank Characteristics)
"ln_assets", "cash_ratio", "securities_ratio",
"loan_to_deposit", "wholesale_ratio", "fhlb_ratio",
"book_equity_ratio", "roa_pct"
)
# Create a clean label map for publication tables
var_labels <- c(
"btfp" = "Used BTFP (Dummy)",
"dw" = "Used DW (Dummy)",
"both" = "Used Both Facilities (Dummy)",
"mtm_total" = "Total MTM Loss (% Assets)",
"mtm_btfp" = "MTM Loss on BTFP-Eligible (% Assets)",
"mtm_other" = "MTM Loss on Non-Eligible (% Assets)",
"uninsured_lev" = "Uninsured Deposits (% Assets)",
"run_risk" = "Run Risk (MTM * Uninsured)",
"borrowing_subsidy" = "Borrowing Subsidy (MTM/Eligible %)",
"omo_ratio" = "OMO-Eligible Collateral (% Assets)",
"maxed_out_btfp" = "Maxed Out BTFP (Utilization > 90%)",
"ln_assets" = "Log(Total Assets)",
"cash_ratio" = "Cash (% Assets)",
"securities_ratio" = "Securities (% Assets)",
"loan_to_deposit" = "Loan-to-Deposit Ratio",
"wholesale_ratio" = "Wholesale Funding Ratio",
"fhlb_ratio" = "FHLB Advances (% Assets)",
"book_equity_ratio" = "Book Equity (% Assets)",
"roa_pct" = "ROA (%)"
)
# 2. TABLE 1: SUMMARY STATISTICS (Full Baseline Sample)
# ---------------------------------------------------------
# Standard academic format: N, Mean, SD, P25, Median, P75
# Subset and Rename
table1_data <- analysis_df %>%
dplyr::select(all_of(vars_summary)) %>%
rename(any_of(var_labels))
# Generate Table
datasummary(
All(table1_data) ~ N + Mean + SD + Min + Median + Max,
data = table1_data,
title = "Table 1: Summary Statistics of Analysis Variables (Baseline: 2022Q4)",
notes = "This table presents summary statistics for all commercial banks in the sample as of 2022Q4. Failed banks and GSIBs are excluded.",
align = "lcccccc"
)| N | Mean | SD | Min | Median | Max | |
|---|---|---|---|---|---|---|
| This table presents summary statistics for all commercial banks in the sample as of 2022Q4. Failed banks and GSIBs are excluded. | ||||||
| btfp | 0.00 | 0.28 | 0.45 | 0.00 | 0.00 | 1.00 |
| dw | 0.00 | 0.23 | 0.42 | 0.00 | 0.00 | 1.00 |
| both | 0.00 | 0.09 | 0.29 | 0.00 | 0.00 | 1.00 |
| mtm_total | 10.69 | 4.33 | -0.14 | 257.24 | ||
| mtm_btfp | 0.57 | 0.84 | -0.14 | 16.39 | ||
| mtm_other | 9.04 | 3.76 | -0.10 | 217.29 | ||
| uninsured_lev | 8.03 | 23.32 | 12.53 | 0.00 | 21.97 | 94.60 |
| run_risk | 85.82 | 78.04 | -2.35 | 919.50 | ||
| borrowing_subsidy | 10.97 | 190.16 | -16.70 | 12482.97 | ||
| omo_ratio | 5.17 | 9.87 | 10.51 | 0.00 | 6.74 | 91.52 |
| maxed_out_btfp | 0.00 | 0.12 | 0.33 | 0.00 | 0.00 | 1.00 |
| ln_assets | 11.31 | 12.84 | 1.55 | 8.02 | 12.68 | 21.89 |
| cash_ratio | 11.36 | 8.96 | 11.29 | 0.00 | 5.23 | 100.00 |
| securities_ratio | 62.02 | 24.49 | 16.38 | 0.00 | 22.22 | 97.61 |
| loan_to_deposit | 26.19 | 71.43 | 28.43 | 0.00 | 72.63 | 890.48 |
| wholesale_ratio | 0.00 | 3.11 | 0.00 | 85.02 | ||
| fhlb_ratio | 0.00 | 2.72 | 4.40 | 0.00 | 0.30 | 48.71 |
| book_equity_ratio | 13.34 | 11.00 | 10.90 | 0.11 | 9.01 | 100.00 |
| roa_pct | 0.85 | 1.37 | 11.44 | -46.56 | 1.02 | 761.53 |
# 3. TABLE 2: COMPARISON BY FACILITY USAGE (Balance Table)
# ---------------------------------------------------------
# Function to calculate Mean and T-stat for difference from "Neither"
calc_group_stats <- function(var, group_col, target_group, baseline_group="Neither") {
# 1. T-test
t_res <- t.test(
analysis_df[[var]][analysis_df[[group_col]] == target_group],
analysis_df[[var]][analysis_df[[group_col]] == baseline_group]
)
# 2. Extract Mean of Target Group
mean_val <- mean(analysis_df[[var]][analysis_df[[group_col]] == target_group], na.rm=TRUE)
# 3. Extract T-statistic
t_stat <- t_res$statistic
# 4. Significance Stars
stars <- case_when(
t_res$p.value < 0.01 ~ "***",
t_res$p.value < 0.05 ~ "**",
t_res$p.value < 0.1 ~ "*",
TRUE ~ ""
)
# Return: "Mean*** (T-stat)"
paste0(sprintf("%.2f", mean_val), stars, " (", sprintf("%.2f", t_stat), ")")
}
# Define variables to compare
vars_compare <- c("mtm_total", "uninsured_lev", "borrowing_subsidy", "omo_ratio",
"ln_assets", "cash_ratio", "book_equity_ratio", "roa_pct")
# --- Step A: Calculate Sample Sizes (N) ---
group_counts <- analysis_df %>%
count(facility_choice) %>%
pivot_wider(names_from = facility_choice, values_from = n)
# --- Step B: Construct Variable Rows ---
# 1. Create Data Frame
table2_df <- data.frame(Variable = unname(var_labels[vars_compare]))
# 2. Fill Baseline Mean (Neither)
table2_df$Neither <- sapply(vars_compare, function(v) {
m <- mean(analysis_df[[v]][analysis_df$facility_choice == "Neither"], na.rm=TRUE)
sprintf("%.2f", m)
})
# 3. Fill Treatment Columns (Mean + T-stat)
table2_df$BTFP_Only <- sapply(vars_compare, function(v) calc_group_stats(v, "facility_choice", "BTFP_Only"))
table2_df$DW_Only <- sapply(vars_compare, function(v) calc_group_stats(v, "facility_choice", "DW_Only"))
table2_df$Both <- sapply(vars_compare, function(v) calc_group_stats(v, "facility_choice", "Both"))
# --- Step C: Add 'Observations' as the First Row ---
row_n <- data.frame(
Variable = "Observations (N)",
Neither = as.character(group_counts$Neither),
BTFP_Only = as.character(group_counts$BTFP_Only),
DW_Only = as.character(group_counts$DW_Only),
Both = as.character(group_counts$Both)
)
# Bind N row to the top
final_table2 <- bind_rows(row_n, table2_df)
# --- Step D: Display ---
final_table2 %>%
kable(
caption = "Table 2: Univariate Comparison by Facility Choice (2022Q4 Baseline)",
col.names = c("Variable", "Neither", "BTFP Only", "DW Only", "Both"),
align = c("l", "c", "c", "c", "c")
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
add_header_above(c(" " = 2, "Difference vs. Neither [Mean (T-stat)]" = 3)) %>%
footnote(
general = "Notes: 'Observations' row shows the sample size for each group. For other rows, the 'Neither' column reports the group mean. Treatment columns report the group mean followed by the T-statistic (in parentheses) for the difference in means relative to the 'Neither' group. *** p<0.01, ** p<0.05, * p<0.1."
)| Variable | Neither | BTFP Only | DW Only | Both |
|---|---|---|---|---|
| Observations (N) | 2775 | 881 | 647 | 434 |
| Total MTM Loss (% Assets) | 5.21 | 6.08*** (7.15) | 5.27 (0.51) | 5.95*** (5.22) |
| Uninsured Deposits (% Assets) | 21.54 | 24.53*** (6.74) | 25.74*** (7.58) | 28.59*** (11.23) |
| Borrowing Subsidy (MTM/Eligible %) | 6.79 | 22.99 (1.10) | 7.78*** (3.10) | 8.64*** (4.32) |
| OMO-Eligible Collateral (% Assets) | 9.87 | 10.85** (2.42) | 8.03*** (-4.77) | 10.66 (1.52) |
| Log(Total Assets) | 12.39 | 13.08*** (13.62) | 13.61*** (18.38) | 14.13*** (19.42) |
| Cash (% Assets) | 10.91 | 5.72*** (-16.54) | 7.59*** (-8.15) | 5.09*** (-16.37) |
| Book Equity (% Assets) | 12.48 | 8.41*** (-14.20) | 9.82*** (-8.76) | 8.59*** (-13.07) |
| ROA (%) | 1.57 | 1.01* (-1.96) | 1.20 (-1.24) | 1.08* (-1.72) |
| Note: | ||||
| Notes: ‘Observations’ row shows the sample size for each group. For other rows, the ‘Neither’ column reports the group mean. Treatment columns report the group mean followed by the T-statistic (in parentheses) for the difference in means relative to the ‘Neither’ group. *** p<0.01, ** p<0.05, * p<0.1. |
13 Global Model Settings
# ============================================
# GLOBAL SETTINGS FOR ALL MODELS
# ============================================
# Define Standard Controls (Fixed for all models)
controls <- paste(
"ln_assets",
"cash_ratio",
"securities_ratio",
"loan_to_deposit",
"wholesale_ratio",
"fhlb_ratio",
"book_equity_ratio",
"roa_pct",
sep = " + "
)
cat("=== GLOBAL SETTINGS ===\n")## === GLOBAL SETTINGS ===cat("Controls:", controls, "\n")## Controls: ln_assets + cash_ratio + securities_ratio + loan_to_deposit + wholesale_ratio + fhlb_ratio + book_equity_ratio + roa_pctcat("Full Sample Size:", nrow(analysis_df), "\n")## Full Sample Size: 473714 Descriptive Visualizations: Setting the Stage
14.1 Figure 1: The Crisis Timeline - Borrowing by Facility
btfp_daily <- btfp_loans %>%
filter(failed_bank == 0, !is.na(btfp_loan_date)) %>%
filter(btfp_loan_date >= as.Date("2023-03-01"), btfp_loan_date <= as.Date("2024-03-11")) %>%
group_by(date = btfp_loan_date) %>%
summarise(amount_B = sum(btfp_loan_amount, na.rm = TRUE) / 1e9,
n_banks = n_distinct(rssd_id), .groups = "drop") %>%
mutate(facility = "BTFP")
dw_daily <- dw_loans %>%
filter(failed_bank == 0, !is.na(dw_loan_date)) %>%
filter(dw_loan_date >= as.Date("2023-03-01"), dw_loan_date <= as.Date("2024-03-11")) %>%
group_by(date = dw_loan_date) %>%
summarise(amount_B = sum(dw_loan_amount, na.rm = TRUE) / 1e9,
n_banks = n_distinct(rssd_id), .groups = "drop") %>%
mutate(facility = "DW")
daily_combined <- bind_rows(btfp_daily, dw_daily)
# Key events
events_plot <- tibble(
date = as.Date(c("2023-03-10", "2023-03-12", "2023-05-01", "2023-11-06", "2024-01-24")),
event = c("SVB Failure", "BTFP Launch", "FRB Failure", "Arbitrage Opens", "Rate Floor"),
y = c(12, 12, 10, 8, 6)
)
p1 <- ggplot() +
# Period shading
annotate("rect", xmin = as.Date("2023-03-01"), xmax = as.Date("2023-03-10"),
ymin = -Inf, ymax = Inf, fill = "#FFE5E5", alpha = 0.4) +
annotate("rect", xmin = as.Date("2023-03-13"), xmax = as.Date("2023-05-01"),
ymin = -Inf, ymax = Inf, fill = "#FFB3B3", alpha = 0.4) +
annotate("rect", xmin = as.Date("2023-05-02"), xmax = as.Date("2023-10-31"),
ymin = -Inf, ymax = Inf, fill = "#E5F5E0", alpha = 0.4) +
annotate("rect", xmin = as.Date("2023-11-01"), xmax = as.Date("2024-01-24"),
ymin = -Inf, ymax = Inf, fill = "#DEEBF7", 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 = events_plot, aes(xintercept = date), linetype = "dashed", color = "red", alpha = 0.7) +
geom_label(data = events_plot, aes(x = date, y = y, label = event),
size = 3, fill = "white", alpha = 0.8) +
scale_fill_manual(values = c("BTFP" = "#2E86AB", "DW" = "#A23B72")) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
scale_y_continuous(labels = dollar_format(suffix = "B")) +
labs(
title = "Figure 1: Daily Borrowing from Federal Reserve Emergency Facilities",
subtitle = "Shaded regions: Pre-BTFP (pink) | Acute Crisis (red) | Post-Acute (green) | Arbitrage (blue)",
x = NULL, y = "Daily Borrowing ($B)", fill = "Facility"
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p1)
14.2 Figure 2: Who Borrowed? Distribution by Bank Characteristics
# Prepare data for visualization
plot_df <- analysis_df %>%
mutate(group = case_when(
both == 1 ~ "Both",
btfp_only == 1 ~ "BTFP Only",
dw_only == 1 ~ "DW Only",
TRUE ~ "Neither"
)) %>%
mutate(group = factor(group, levels = c("Neither", "DW Only", "BTFP Only", "Both")))
# Panel A: MTM Losses by Borrower Type
p2a <- ggplot(plot_df, aes(x = group, y = mtm_total, fill = group)) +
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" = "gray70", "DW Only" = "#A23B72",
"BTFP Only" = "#2E86AB", "Both" = "#F18F01")) +
labs(title = "A: Total MTM Loss / Assets", x = NULL, y = "MTM Loss (%)") +
theme(legend.position = "none")
# Panel B: Uninsured Leverage by Borrower Type
p2b <- ggplot(plot_df, aes(x = group, y = uninsured_lev, fill = group)) +
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" = "gray70", "DW Only" = "#A23B72",
"BTFP Only" = "#2E86AB", "Both" = "#F18F01")) +
labs(title = "B: Uninsured Deposits / Assets", x = NULL, y = "Uninsured Leverage (%)") +
theme(legend.position = "none")
# Panel C: OMO-Eligible Ratio by Borrower Type
p2c <- ggplot(plot_df, aes(x = group, y = omo_ratio, fill = group)) +
geom_boxplot(outlier.shape = NA, alpha = 0.7) +
coord_cartesian(ylim = c(0, quantile(plot_df$omo_ratio, 0.95, na.rm = TRUE))) +
scale_fill_manual(values = c("Neither" = "gray70", "DW Only" = "#A23B72",
"BTFP Only" = "#2E86AB", "Both" = "#F18F01")) +
labs(title = "C: OMO-Eligible Securities / Assets", x = NULL, y = "OMO-Eligible Ratio (%)") +
theme(legend.position = "none")
# Panel D: Borrowing Subsidy (par valuation benefit)
p2d <- ggplot(plot_df %>% filter(!is.na(borrowing_subsidy)),
aes(x = group, y = borrowing_subsidy, fill = group)) +
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" = "gray70", "DW Only" = "#A23B72",
"BTFP Only" = "#2E86AB", "Both" = "#F18F01")) +
labs(title = "D: Borrowing Subsidy (MTM Loss on OMO/OMO)", x = NULL, y = "Subsidy Rate (%)") +
theme(legend.position = "none")
(p2a + p2b) / (p2c + p2d) +
plot_annotation(
title = "Figure 2: Bank Characteristics by Facility Usage",
subtitle = "BTFP users have higher MTM losses and borrowing subsidy; Both users have highest vulnerability"
)
14.3 Figure 3: The Selection Mechanism - MTM Loss vs Facility Choice
# Scatter plot: MTM on BTFP-eligible vs MTM on Other
p3 <- ggplot(plot_df %>% filter(any_fed == 1),
aes(x = mtm_btfp, y = mtm_other, color = group, size = total_fed_amount_pct)) +
geom_point(alpha = 0.6) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "gray50") +
scale_color_manual(values = c("DW Only" = "#A23B72", "BTFP Only" = "#2E86AB", "Both" = "#F18F01")) +
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 3: Facility Selection by MTM Loss Composition",
subtitle = "Banks above diagonal have more non-OMO losses; BTFP users cluster with high BTFP-eligible losses",
x = "MTM Loss on BTFP-Eligible (OMO) Securities (%)",
y = "MTM Loss on Non-BTFP-Eligible Securities (%)",
color = "Facility Used"
) +
annotate("text", x = 8, y = 2, label = "Higher BTFP-Eligible Losses\n→ Select BTFP",
size = 3.5, color = "#2E86AB", fontface = "italic") +
annotate("text", x = 2, y = 8, label = "Higher Non-OMO Losses\n→ Need DW for non-OMO collateral",
size = 3.5, color = "#A23B72", fontface = "italic")
print(p3)
15 Model 1: Pre-BTFP DW Borrowing (Revealed Preference)
15.1 Economic Story
Banks that borrowed from DW before BTFP existed (March 1-12, 2023) revealed:
- Acute Liquidity Need: Stress severe enough to seek Fed funding
- Stigma Tolerance: Willing to bear DW stigma when it was the only option
# ============================================
# MODEL 1: Pre-BTFP DW (Revealed Preference)
# ============================================
# Specification 1: Total MTM (aggregate view)
rhs_m1_total <- paste(
"mtm_total + uninsured_lev",
controls,
sep = " + "
)
# Specification 2: Split MTM (which type of loss matters?)
# NOTE: mtm_btfp + mtm_other ≈ mtm_total, so we use EITHER total OR split, not both
rhs_m1_split <- paste(
"mtm_btfp + mtm_other + uninsured_lev",
controls,
sep = " + "
)
# Specification 3: Interaction (do losses and uninsured deposits compound?)
rhs_m1_interact <- paste(
"mtm_total + uninsured_lev + I(mtm_total * uninsured_lev)",
controls,
sep = " + "
)
# Run Models
m1_total <- glm(as.formula(paste("dw_pre_btfp ~", rhs_m1_total)),
data = analysis_df, family = binomial(link = "logit"))
m1_split <- glm(as.formula(paste("dw_pre_btfp ~", rhs_m1_split)),
data = analysis_df, family = binomial(link = "logit"))
m1_interact <- glm(as.formula(paste("dw_pre_btfp ~", rhs_m1_interact)),
data = analysis_df, family = binomial(link = "logit"))
# Display Results
modelsummary(
list(
"(1) Total MTM" = m1_total,
"(2) Split MTM" = m1_split,
"(3) Interaction" = m1_interact
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"mtm_total" = "MTM Loss (Total)",
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"uninsured_lev" = "Uninsured Leverage",
"I(mtm_total * uninsured_lev)" = "MTM × Uninsured"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 1: Pre-BTFP Discount Window Usage (Revealed Preference)",
notes = "Dependent: DW borrowing during March 1-12, 2023 (before BTFP). Identifies stigma-tolerant, vulnerable banks."
)| (1) Total MTM | (2) Split MTM | (3) Interaction | |
|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||
| Dependent: DW borrowing during March 1-12, 2023 (before BTFP). Identifies stigma-tolerant, vulnerable banks. | |||
| (Intercept) | -10.796*** | -10.819*** | -10.669*** |
| (0.549) | (0.552) | (0.570) | |
| MTM Loss (Total) | 0.008 | -0.010 | |
| (0.011) | (0.032) | ||
| Uninsured Leverage | -0.003 | -0.003 | -0.009 |
| (0.003) | (0.003) | (0.007) | |
| ln_assets | 0.749*** | 0.749*** | 0.747*** |
| (0.034) | (0.034) | (0.034) | |
| cash_ratio | -0.006 | -0.006 | -0.005 |
| (0.006) | (0.006) | (0.006) | |
| securities_ratio | 0.003 | 0.003 | 0.002 |
| (0.005) | (0.005) | (0.005) | |
| loan_to_deposit | 0.004 | 0.004 | 0.004 |
| (0.003) | (0.003) | (0.003) | |
| wholesale_ratio | 0.010 | 0.010 | 0.010 |
| (0.012) | (0.012) | (0.012) | |
| fhlb_ratio | 0.009 | 0.008 | 0.009 |
| (0.009) | (0.009) | (0.009) | |
| book_equity_ratio | -0.025*** | -0.025*** | -0.024** |
| (0.009) | (0.010) | (0.009) | |
| roa_pct | -0.023 | -0.023 | -0.023 |
| (0.029) | (0.029) | (0.028) | |
| MTM Loss (BTFP-Eligible) | -0.007 | ||
| (0.054) | |||
| MTM Loss (Non-BTFP) | 0.011 | ||
| (0.011) | |||
| MTM × Uninsured | 0.001 | ||
| (0.001) | |||
| Num.Obs. | 4718 | 4718 | 4718 |
# Coefficient plot for Model 1 Interaction
coef_df_m1 <- tidy(m1_interact, conf.int = TRUE) %>%
filter(!str_detect(term, "Intercept")) %>%
mutate(
term = case_when(
term == "mtm_total" ~ "MTM Loss (Total)",
term == "uninsured_lev" ~ "Uninsured Leverage",
term == "I(mtm_total * uninsured_lev)" ~ "MTM × 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_ratio" ~ "Wholesale Funding",
term == "fhlb_ratio" ~ "FHLB Ratio",
term == "roa_pct" ~ "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 Pre-BTFP DW Borrowing",
subtitle = "Banks with higher MTM losses AND uninsured deposits accessed DW when it was the only option",
x = NULL, y = "Coefficient Estimate (95% CI)"
)
print(p_m1)
16 Model 2: Any Fed Facility Access (Survival Hypothesis)
16.1 Economic Story
Core Intuition: When facing severe uninsured deposit runs, banks will access ANY available Fed facility. The choice of which facility is secondary to survival.
# ============================================
# MODEL 2: Any Fed Facility Access (Survival Hypothesis)
# ============================================
# Specification 1: Base (Total MTM)
rhs_m2_base <- paste(
"mtm_total + uninsured_lev",
controls,
sep = " + "
)
# Specification 2: Interaction (compound vulnerability)
rhs_m2_interact <- paste(
"mtm_total + uninsured_lev + I(mtm_total * uninsured_lev)",
controls,
sep = " + "
)
# Specification 3: Split MTM + Prior DW User
rhs_m2_full <- paste(
"mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev) + prior_dw_user",
controls,
sep = " + "
)
# Run Models
m2_base <- glm(as.formula(paste("any_fed ~", rhs_m2_base)),
data = analysis_df, family = binomial(link = "logit"))
m2_interact <- glm(as.formula(paste("any_fed ~", rhs_m2_interact)),
data = analysis_df, family = binomial(link = "logit"))
m2_full <- glm(as.formula(paste("any_fed ~", rhs_m2_full)),
data = analysis_df, family = binomial(link = "logit"))
# Display Results
modelsummary(
list(
"(1) Base" = m2_base,
"(2) Interaction" = m2_interact,
"(3) Full (Split MTM)" = m2_full
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"mtm_total" = "MTM Loss (Total)",
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"uninsured_lev" = "Uninsured Leverage",
"I(mtm_total * uninsured_lev)" = "MTM(Total) × Uninsured",
"I(mtm_btfp * uninsured_lev)" = "MTM(BTFP) × Uninsured",
"prior_dw_user" = "Prior DW User"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 2: Determinants of Any Fed Facility Access (Survival)",
notes = "Dependent: any_fed (1 if used BTFP or DW). Tests survival hypothesis."
)| (1) Base | (2) Interaction | (3) Full (Split MTM) | |
|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||
| Dependent: any_fed (1 if used BTFP or DW). Tests survival hypothesis. | |||
| (Intercept) | -7.353*** | -7.015*** | -5.158*** |
| (0.478) | (0.505) | (0.521) | |
| MTM Loss (Total) | 0.023*** | -0.016 | |
| (0.007) | (0.031) | ||
| Uninsured Leverage | 0.005* | -0.012* | 0.012*** |
| (0.003) | (0.007) | (0.004) | |
| ln_assets | 0.477*** | 0.474*** | 0.250*** |
| (0.029) | (0.029) | (0.032) | |
| cash_ratio | -0.021*** | -0.017*** | -0.021*** |
| (0.006) | (0.006) | (0.006) | |
| securities_ratio | 0.020*** | 0.015*** | 0.020*** |
| (0.004) | (0.004) | (0.005) | |
| loan_to_deposit | 0.012*** | 0.010*** | 0.013*** |
| (0.003) | (0.003) | (0.004) | |
| wholesale_ratio | 0.003 | 0.006 | -0.001 |
| (0.011) | (0.011) | (0.012) | |
| fhlb_ratio | 0.000 | 0.003 | -0.003 |
| (0.009) | (0.009) | (0.009) | |
| book_equity_ratio | -0.062*** | -0.053*** | -0.064*** |
| (0.010) | (0.010) | (0.011) | |
| roa_pct | 0.002 | 0.001 | 0.003 |
| (0.006) | (0.006) | (0.006) | |
| MTM(Total) × Uninsured | 0.004*** | ||
| (0.001) | |||
| MTM Loss (BTFP-Eligible) | 0.261*** | ||
| (0.087) | |||
| MTM Loss (Non-BTFP) | 0.019* | ||
| (0.011) | |||
| MTM(BTFP) × Uninsured | -0.006** | ||
| (0.003) | |||
| Prior DW User | 1.843*** | ||
| (0.083) | |||
| Num.Obs. | 4718 | 4718 | 4718 |
# Predicted probability surface
pred_grid <- expand.grid(
mtm_total = seq(0, 10, 0.5),
uninsured_lev = seq(0, 40, 2),
ln_assets = mean(analysis_df$ln_assets, na.rm = TRUE),
cash_ratio = mean(analysis_df$cash_ratio, na.rm = TRUE),
securities_ratio = mean(analysis_df$securities_ratio, na.rm = TRUE),
book_equity_ratio = mean(analysis_df$book_equity_ratio, na.rm = TRUE),
loan_to_deposit = mean(analysis_df$loan_to_deposit, na.rm = TRUE),
wholesale_ratio = mean(analysis_df$wholesale_ratio, na.rm = TRUE),
fhlb_ratio = mean(analysis_df$fhlb_ratio, na.rm = TRUE),
roa_pct = mean(analysis_df$roa_pct, na.rm = TRUE)
)
pred_grid$prob <- predict(m2_base, newdata = pred_grid, type = "response")
p_m2 <- ggplot(pred_grid, aes(x = mtm_total, 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 (% of Assets)",
y = "Uninsured Deposits (% of Assets)",
fill = "Probability"
) +
geom_point(data = analysis_df %>% filter(any_fed == 1),
aes(x = mtm_total, y = uninsured_lev),
inherit.aes = FALSE, color = "white", alpha = 0.3, size = 1) +
theme_minimal()
print(p_m2)
17 Model 3: BTFP Selection (Par Valuation Hypothesis)
17.1 Economic Story
Conditional on borrowing from the Fed, what explains BTFP over DW?
- Par Valuation: Banks with larger MTM losses on BTFP-eligible securities gain more from par valuation
- Borrowing Subsidy: The MTM loss rate measures the % gain from borrowing at par vs. market value
# ============================================
# MODEL 3: BTFP Selection (Conditional on Fed Borrowing)
# ============================================
# Define borrowers sample
data_borrowers <- analysis_df %>% filter(any_fed == 1)
cat("=== FED BORROWERS SAMPLE ===\n")## === FED BORROWERS SAMPLE ===cat("Total Borrowers:", nrow(data_borrowers), "\n")## Total Borrowers: 1962cat("BTFP Users:", sum(data_borrowers$btfp), "\n")## BTFP Users: 1315cat("DW Users:", sum(data_borrowers$dw), "\n")## DW Users: 1081# Specification 1: Split MTM (core test - does loss composition matter?)
rhs_m3_split <- paste(
"mtm_btfp + mtm_other + uninsured_lev",
controls,
sep = " + "
)
# Specification 2: Borrowing Subsidy (explicit par valuation benefit)
rhs_m3_subsidy <- paste(
"borrowing_subsidy + mtm_other + uninsured_lev",
controls,
sep = " + "
)
# Specification 3: Interaction (does vulnerability amplify subsidy-seeking?)
rhs_m3_interact <- paste(
"mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
controls,
sep = " + "
)
# Specification 4: Full (add prior DW user + OMO capacity)
rhs_m3_full <- paste(
"borrowing_subsidy + mtm_other + uninsured_lev + I(borrowing_subsidy * uninsured_lev) + prior_dw_user + omo_ratio",
controls,
sep = " + "
)
# Run Models
m3_split <- glm(as.formula(paste("btfp ~", rhs_m3_split)),
data = data_borrowers, family = binomial(link = "logit"))
m3_subsidy <- glm(as.formula(paste("btfp ~", rhs_m3_subsidy)),
data = data_borrowers, family = binomial(link = "logit"))
m3_interact <- glm(as.formula(paste("btfp ~", rhs_m3_interact)),
data = data_borrowers, family = binomial(link = "logit"))
m3_full <- glm(as.formula(paste("btfp ~", rhs_m3_full)),
data = data_borrowers, family = binomial(link = "logit"))
# Display Results
modelsummary(
list(
"(1) Split MTM" = m3_split,
"(2) Subsidy" = m3_subsidy,
"(3) Interaction" = m3_interact,
"(4) Full" = m3_full
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"borrowing_subsidy" = "Borrowing Subsidy",
"uninsured_lev" = "Uninsured Leverage",
"I(mtm_btfp * uninsured_lev)" = "MTM(BTFP) × Uninsured",
"I(borrowing_subsidy * uninsured_lev)" = "Subsidy × Uninsured",
"prior_dw_user" = "Prior DW User",
"omo_ratio" = "OMO-Eligible Ratio"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 3: BTFP Selection Conditional on Fed Borrowing",
notes = "Sample: Banks that borrowed from BTFP or DW. Dependent = 1 if BTFP used."
)| (1) Split MTM | (2) Subsidy | (3) Interaction | (4) Full | |
|---|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| Sample: Banks that borrowed from BTFP or DW. Dependent = 1 if BTFP used. | ||||
| (Intercept) | 1.525 | 0.290 | 1.290 | -0.804 |
| (1.189) | (1.256) | (1.199) | (1.327) | |
| MTM Loss (BTFP-Eligible) | 0.157** | 0.371** | ||
| (0.079) | (0.154) | |||
| MTM Loss (Non-BTFP) | 0.015 | 0.008 | 0.017 | 0.040 |
| (0.029) | (0.030) | (0.029) | (0.033) | |
| Uninsured Leverage | 0.011** | 0.007 | 0.016*** | 0.013* |
| (0.005) | (0.005) | (0.006) | (0.007) | |
| ln_assets | -0.096** | -0.067* | -0.088** | 0.060 |
| (0.038) | (0.038) | (0.038) | (0.041) | |
| cash_ratio | -0.039*** | -0.024 | -0.039*** | -0.028* |
| (0.014) | (0.015) | (0.014) | (0.016) | |
| securities_ratio | 0.026** | 0.041*** | 0.026* | 0.032** |
| (0.013) | (0.014) | (0.013) | (0.015) | |
| loan_to_deposit | -0.000 | 0.009 | -0.001 | 0.008 |
| (0.011) | (0.011) | (0.011) | (0.012) | |
| wholesale_ratio | 0.015 | 0.004 | 0.016 | 0.021 |
| (0.020) | (0.021) | (0.020) | (0.022) | |
| fhlb_ratio | 0.024 | 0.025 | 0.025 | 0.033* |
| (0.017) | (0.019) | (0.017) | (0.019) | |
| book_equity_ratio | -0.040** | -0.045** | -0.040** | -0.045** |
| (0.018) | (0.019) | (0.019) | (0.020) | |
| roa_pct | -0.033 | -0.076 | -0.029 | -0.051 |
| (0.068) | (0.083) | (0.067) | (0.087) | |
| Borrowing Subsidy | 0.003 | 0.022 | ||
| (0.007) | (0.019) | |||
| MTM(BTFP) × Uninsured | -0.008* | |||
| (0.005) | ||||
| Subsidy × Uninsured | -0.001 | |||
| (0.001) | ||||
| Prior DW User | -1.397*** | |||
| (0.120) | ||||
| OMO-Eligible Ratio | 0.016** | |||
| (0.008) | ||||
| Num.Obs. | 1962 | 1865 | 1962 | 1865 |
# BTFP usage by borrowing subsidy quintiles
data_borrowers <- data_borrowers %>%
mutate(subsidy_quintile = ntile(borrowing_subsidy, 5))
subsidy_summary <- data_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 on OMO) → More likely to use BTFP",
x = "Borrowing Subsidy Quintile (1=Lowest, 5=Highest)",
y = "% of Fed Borrowers Using BTFP"
)
# Coefficient comparison
coef_df_m3 <- bind_rows(
tidy(m3_split, conf.int = TRUE) %>% mutate(model = "Split MTM"),
tidy(m3_full, conf.int = TRUE) %>% mutate(model = "Full Model")
) %>%
filter(term %in% c("mtm_btfp", "mtm_other", "borrowing_subsidy")) %>%
mutate(term = case_when(
term == "mtm_btfp" ~ "MTM Loss\n(BTFP-Eligible)",
term == "mtm_other" ~ "MTM Loss\n(Non-BTFP)",
term == "borrowing_subsidy" ~ "Borrowing\nSubsidy"
))
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("Split MTM" = "#2E86AB", "Full Model" = "#F18F01")) +
labs(
title = "Key Coefficients: BTFP Selection",
subtitle = "MTM loss on BTFP-eligible securities strongly predicts BTFP choice",
x = NULL, y = "Coefficient", fill = "Model"
)
p_m3a + p_m3b +
plot_annotation(title = "Figure 4: Par Valuation Drives BTFP Selection")
18 Model 4: Was DW Sufficient?
18.1 Economic Story
If DW was sufficient, banks that used it pre-BTFP should NOT need to
also use BTFP. A positive coefficient on prior_dw_user
indicates DW was insufficient.
# ============================================
# MODEL 4: Discount Window Insufficiency
# ============================================
# Specification 1: Base test (does prior DW use predict BTFP usage?)
rhs_m4_base <- paste(
"prior_dw_user + mtm_total",
controls,
sep = " + "
)
# Specification 2: Interaction (do prior DW users with high BTFP-eligible losses switch faster?)
rhs_m4_interact <- paste(
"prior_dw_user + mtm_btfp + I(prior_dw_user * mtm_btfp)",
controls,
sep = " + "
)
# Specification 3: Full (subsidy-driven switching?)
rhs_m4_full <- paste(
"prior_dw_user + borrowing_subsidy + I(prior_dw_user * borrowing_subsidy) + uninsured_lev + omo_ratio",
controls,
sep = " + "
)
# Run Models
m4_base <- glm(as.formula(paste("btfp ~", rhs_m4_base)),
data = analysis_df, family = binomial(link = "logit"))
m4_interact <- glm(as.formula(paste("btfp ~", rhs_m4_interact)),
data = analysis_df, family = binomial(link = "logit"))
m4_full <- glm(as.formula(paste("btfp ~", rhs_m4_full)),
data = analysis_df, family = binomial(link = "logit"))
# Display Results
modelsummary(
list(
"(1) Base" = m4_base,
"(2) Interaction" = m4_interact,
"(3) Full" = m4_full
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"prior_dw_user" = "Prior DW User (Pre-BTFP)",
"mtm_total" = "MTM Loss (Total)",
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"borrowing_subsidy" = "Borrowing Subsidy",
"I(prior_dw_user * mtm_btfp)" = "Prior DW × MTM(BTFP)",
"I(prior_dw_user * borrowing_subsidy)" = "Prior DW × Subsidy",
"uninsured_lev" = "Uninsured Leverage",
"omo_ratio" = "OMO-Eligible Ratio"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 4: Did Pre-BTFP DW Users Need BTFP? (DW Insufficiency Test)",
notes = "Dependent: btfp. Positive 'Prior DW User' coefficient implies DW was insufficient."
)| (1) Base | (2) Interaction | (3) Full | |
|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||
| Dependent: btfp. Positive 'Prior DW User' coefficient implies DW was insufficient. | |||
| (Intercept) | -5.188*** | -4.828*** | -4.854*** |
| (0.688) | (0.723) | (0.610) | |
| Prior DW User (Pre-BTFP) | 0.487*** | 0.569*** | 0.487*** |
| (0.080) | (0.101) | (0.103) | |
| MTM Loss (Total) | 0.030*** | ||
| (0.007) | |||
| ln_assets | 0.245*** | 0.234*** | 0.201*** |
| (0.026) | (0.027) | (0.030) | |
| cash_ratio | -0.034*** | -0.037*** | -0.034*** |
| (0.009) | (0.009) | (0.008) | |
| securities_ratio | 0.031*** | 0.028*** | 0.031*** |
| (0.007) | (0.008) | (0.006) | |
| loan_to_deposit | 0.014** | 0.013** | 0.016*** |
| (0.006) | (0.006) | (0.005) | |
| wholesale_ratio | 0.003 | 0.002 | 0.003 |
| (0.013) | (0.013) | (0.013) | |
| fhlb_ratio | -0.003 | 0.000 | 0.008 |
| (0.011) | (0.011) | (0.010) | |
| book_equity_ratio | -0.089*** | -0.088*** | -0.083*** |
| (0.012) | (0.012) | (0.013) | |
| roa_pct | -0.034 | -0.031 | -0.055 |
| (0.053) | (0.053) | (0.054) | |
| MTM Loss (BTFP-Eligible) | 0.150*** | ||
| (0.054) | |||
| Prior DW × MTM(BTFP) | -0.117 | ||
| (0.089) | |||
| Borrowing Subsidy | 0.003 | ||
| (0.005) | |||
| Prior DW × Subsidy | 0.003 | ||
| (0.008) | |||
| Uninsured Leverage | 0.008** | ||
| (0.003) | |||
| OMO-Eligible Ratio | 0.004 | ||
| (0.004) | |||
| Num.Obs. | 4718 | 4718 | 4316 |
# Visualization: Prior DW users' subsequent behavior
prior_dw_summary <- analysis_df %>%
mutate(prior_dw = ifelse(prior_dw_user == 1, "Used DW Pre-BTFP", "Did Not Use DW Pre-BTFP")) %>%
group_by(prior_dw) %>%
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)) +
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 5: 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(axis.text.x = element_text(angle = 15, hjust = 1))
print(p_m4)
19 Model 5: Temporal Dynamics
19.1 Economic Story
Did borrowing determinants differ across crisis phases?
- Acute Phase: Run pressure (uninsured leverage) should dominate
- Post-Acute: Facility design features (MTM, subsidy) matter more
- Arbitrage: Rate incentives may dominate
# ============================================
# MODEL 5: Temporal Dynamics (Crisis Phases)
# ============================================
# Use same specification across periods to compare coefficients
# NOTE: Using split MTM (not total) since we want to see BTFP-specific effects
rhs_m5 <- paste(
"mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
controls,
sep = " + "
)
# Run Models for Each Phase
m5_acute <- glm(as.formula(paste("btfp_acute ~", rhs_m5)),
data = analysis_df, family = binomial(link = "logit"))
m5_post <- glm(as.formula(paste("btfp_post_acute ~", rhs_m5)),
data = analysis_df, family = binomial(link = "logit"))
m5_arb <- glm(as.formula(paste("btfp_arbitrage ~", rhs_m5)),
data = analysis_df, family = binomial(link = "logit"))
# Display Results
modelsummary(
list(
"Phase 1: Acute" = m5_acute,
"Phase 2: Post-Acute" = m5_post,
"Phase 3: Arbitrage" = m5_arb
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"uninsured_lev" = "Uninsured Leverage",
"I(mtm_btfp * uninsured_lev)" = "MTM(BTFP) × Uninsured"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 5: What Drove BTFP Entry Across Different Crisis Phases?",
notes = "Dependent variable: First BTFP entry in each period. Same specification for comparability."
)| Phase 1: Acute | Phase 2: Post-Acute | Phase 3: Arbitrage | |
|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||
| Dependent variable: First BTFP entry in each period. Same specification for comparability. | |||
| (Intercept) | -6.216*** | -4.388*** | -6.032*** |
| (1.062) | (0.649) | (1.096) | |
| MTM Loss (BTFP-Eligible) | 0.200* | 0.260** | 0.327** |
| (0.114) | (0.102) | (0.154) | |
| MTM Loss (Non-BTFP) | 0.011 | 0.013 | 0.026* |
| (0.028) | (0.023) | (0.014) | |
| Uninsured Leverage | 0.018*** | 0.008 | 0.012 |
| (0.006) | (0.005) | (0.007) | |
| MTM(BTFP) × Uninsured | -0.005 | -0.006 | -0.014** |
| (0.004) | (0.004) | (0.006) | |
| ln_assets | 0.303*** | 0.092** | 0.183*** |
| (0.036) | (0.036) | (0.048) | |
| cash_ratio | -0.058*** | -0.032*** | -0.031** |
| (0.015) | (0.010) | (0.015) | |
| securities_ratio | 0.014 | 0.026*** | 0.013 |
| (0.011) | (0.006) | (0.012) | |
| loan_to_deposit | 0.002 | 0.015*** | 0.011 |
| (0.009) | (0.005) | (0.009) | |
| wholesale_ratio | 0.047*** | -0.035* | -0.034 |
| (0.015) | (0.020) | (0.030) | |
| fhlb_ratio | 0.040*** | -0.032** | -0.003 |
| (0.014) | (0.013) | (0.019) | |
| book_equity_ratio | -0.096*** | -0.064*** | -0.047** |
| (0.020) | (0.016) | (0.023) | |
| roa_pct | -0.005 | -0.001 | -0.116** |
| (0.069) | (0.042) | (0.050) | |
| Num.Obs. | 4718 | 4718 | 4718 |
# Extract and compare coefficients across periods
coef_temporal <- bind_rows(
tidy(m5_acute, conf.int = TRUE) %>% mutate(period = "Acute Crisis"),
tidy(m5_post, conf.int = TRUE) %>% mutate(period = "Post-Acute"),
tidy(m5_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 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(legend.position = "none")
print(p_m5)
20 Model 6: Intensive Margin
20.1 Economic Story
Among BTFP users, did larger MTM losses → larger borrowing amounts?
# ============================================
# MODEL 6: Intensive Margin (How much did they borrow?)
# ============================================
# Define BTFP users sample
data_btfp_users <- analysis_df %>% filter(btfp == 1)
cat("=== BTFP USERS SAMPLE ===\n")## === BTFP USERS SAMPLE ===cat("N:", nrow(data_btfp_users), "\n")## N: 1315cat("Mean BTFP Amount (% of Assets):", round(mean(data_btfp_users$btfp_amount_pct, na.rm = TRUE), 2), "\n")## Mean BTFP Amount (% of Assets): 12.9cat("Mean Utilization:", round(mean(data_btfp_users$btfp_utilization, na.rm = TRUE), 2), "\n")## Mean Utilization: 9.03# Specification 1: Split MTM
rhs_m6_split <- paste(
"mtm_btfp + mtm_other + uninsured_lev",
controls,
sep = " + "
)
# Specification 2: Borrowing Subsidy + OMO Capacity
rhs_m6_subsidy <- paste(
"borrowing_subsidy + mtm_other + uninsured_lev + omo_ratio",
controls,
sep = " + "
)
# Specification 3: Utilization (Amount / OMO-Eligible)
rhs_m6_util <- paste(
"borrowing_subsidy + uninsured_lev",
controls,
sep = " + "
)
# Run Models (OLS for continuous outcomes)
m6_split <- lm(as.formula(paste("btfp_amount_pct ~", rhs_m6_split)), data = data_btfp_users)
m6_subsidy <- lm(as.formula(paste("btfp_amount_pct ~", rhs_m6_subsidy)), data = data_btfp_users)
m6_util <- lm(as.formula(paste("btfp_utilization ~", rhs_m6_util)), data = data_btfp_users)
# Display Results
modelsummary(
list(
"(1) Amount: Split MTM" = m6_split,
"(2) Amount: Subsidy" = m6_subsidy,
"(3) Utilization" = m6_util
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"borrowing_subsidy" = "Borrowing Subsidy",
"uninsured_lev" = "Uninsured Leverage",
"omo_ratio" = "OMO-Eligible Ratio"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 6: Intensive Margin - BTFP Borrowing Amount",
notes = "Sample: BTFP users only. Amount = % of assets; Utilization = Amount / OMO-eligible."
)| (1) Amount: Split MTM | (2) Amount: Subsidy | (3) Utilization | |
|---|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||
| Sample: BTFP users only. Amount = % of assets; Utilization = Amount / OMO-eligible. | |||
| (Intercept) | 37.035*** | 40.866*** | -57.297 |
| (13.798) | (14.104) | (60.626) | |
| MTM Loss (BTFP-Eligible) | -0.070 | ||
| (0.657) | |||
| MTM Loss (Non-BTFP) | -0.634** | -0.400 | |
| (0.307) | (0.341) | ||
| Uninsured Leverage | 0.127** | 0.144*** | -0.102 |
| (0.052) | (0.054) | (0.229) | |
| ln_assets | -0.489 | -0.711* | 0.662 |
| (0.410) | (0.414) | (1.765) | |
| cash_ratio | -0.610*** | -0.624*** | 0.163 |
| (0.169) | (0.173) | (0.742) | |
| securities_ratio | -0.051 | -0.146 | 0.587 |
| (0.148) | (0.153) | (0.647) | |
| loan_to_deposit | -0.339*** | -0.371*** | 0.644 |
| (0.123) | (0.126) | (0.543) | |
| wholesale_ratio | 0.582*** | 0.607*** | -0.894 |
| (0.223) | (0.227) | (0.978) | |
| fhlb_ratio | 1.044*** | 1.115*** | 0.317 |
| (0.180) | (0.184) | (0.795) | |
| book_equity_ratio | 0.683*** | 0.730*** | -0.957 |
| (0.197) | (0.202) | (0.862) | |
| roa_pct | 1.426 | 1.981* | 2.725 |
| (0.976) | (1.055) | (4.513) | |
| Borrowing Subsidy | -0.000 | 0.111*** | |
| (0.002) | (0.007) | ||
| OMO-Eligible Ratio | 0.126* | ||
| (0.069) | |||
| Num.Obs. | 1315 | 1269 | 1269 |
| R2 | 0.080 | 0.081 | 0.192 |
| R2 Adj. | 0.072 | 0.073 | 0.185 |
# Scatter with fitted line
p_m6a <- ggplot(data_btfp_users, aes(x = borrowing_subsidy, y = btfp_amount_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(data_btfp_users$borrowing_subsidy, 0.95, na.rm = TRUE)),
ylim = c(0, quantile(data_btfp_users$btfp_amount_pct, 0.95, na.rm = TRUE))) +
labs(
title = "A: BTFP Borrowing Amount vs. Borrowing Subsidy",
x = "Borrowing Subsidy (MTM Loss Rate on OMO, %)",
y = "BTFP Amount (% of Assets)"
)
p_m6b <- ggplot(data_btfp_users, aes(x = borrowing_subsidy, y = btfp_utilization)) +
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(data_btfp_users$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 OMO, %)",
y = "BTFP Utilization (Amount / OMO-Eligible)"
)
p_m6a + p_m6b +
plot_annotation(title = "Figure 7: Intensive Margin - Banks with Larger Losses Borrowed More")
21 Model 7: Both Facilities - Collateral Constraints
21.1 Economic Story
Banks using BOTH BTFP and DW likely:
- Maxed out BTFP-eligible collateral
- Needed to pledge non-OMO collateral at DW for additional liquidity
# ============================================
# MODEL 7: Using Both Facilities (Collateral Constraints)
# ============================================
# Sample: Fed borrowers only
data_model7 <- analysis_df %>% filter(any_fed == 1)
# Specification 1: Collateral mix view
rhs_m7_mix <- paste(
"mtm_btfp + mtm_other + omo_ratio",
controls,
sep = " + "
)
# Specification 2: Maxed-out hypothesis
rhs_m7_maxed <- paste(
"maxed_out_btfp + non_omo_ratio + uninsured_lev",
controls,
sep = " + "
)
# Run Models
m7_mix <- glm(as.formula(paste("both ~", rhs_m7_mix)),
data = data_model7, family = binomial(link = "logit"))
m7_maxed <- glm(as.formula(paste("both ~", rhs_m7_maxed)),
data = data_model7, family = binomial(link = "logit"))
# Display Results
modelsummary(
list(
"(1) Collateral Mix" = m7_mix,
"(2) Maxed Out" = m7_maxed
),
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_rename = c(
"mtm_btfp" = "MTM Loss (BTFP-Eligible)",
"mtm_other" = "MTM Loss (Non-BTFP)",
"omo_ratio" = "OMO-Eligible Ratio",
"maxed_out_btfp" = "Maxed Out BTFP (>90%)",
"non_omo_ratio" = "Non-OMO Ratio",
"uninsured_lev" = "Uninsured Leverage"
),
gof_omit = "AIC|BIC|Log.Lik|F|RMSE",
title = "Model 7: Why Use Both Facilities? (Collateral Constraint Hypothesis)",
notes = "Sample: Fed Borrowers. Positive 'Maxed Out' coefficient confirms banks turned to DW after exhausting BTFP."
)| (1) Collateral Mix | (2) Maxed Out | |
|---|---|---|
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||
| Sample: Fed Borrowers. Positive 'Maxed Out' coefficient confirms banks turned to DW after exhausting BTFP. | ||
| (Intercept) | -5.596*** | -5.586*** |
| (1.370) | (1.439) | |
| MTM Loss (BTFP-Eligible) | 0.018 | |
| (0.104) | ||
| MTM Loss (Non-BTFP) | 0.007 | |
| (0.034) | ||
| OMO-Eligible Ratio | 0.006 | |
| (0.011) | ||
| ln_assets | 0.322*** | 0.297*** |
| (0.037) | (0.041) | |
| cash_ratio | -0.027 | -0.027 |
| (0.017) | (0.018) | |
| securities_ratio | 0.006 | 0.015 |
| (0.015) | (0.015) | |
| loan_to_deposit | 0.001 | 0.010 |
| (0.012) | (0.013) | |
| wholesale_ratio | 0.026 | 0.018 |
| (0.021) | (0.022) | |
| fhlb_ratio | 0.017 | 0.005 |
| (0.018) | (0.019) | |
| book_equity_ratio | -0.038* | -0.038* |
| (0.022) | (0.023) | |
| roa_pct | -0.018 | -0.021 |
| (0.085) | (0.083) | |
| Maxed Out BTFP (>90%) | 0.826*** | |
| (0.123) | ||
| Non-OMO Ratio | -0.014** | |
| (0.007) | ||
| Uninsured Leverage | 0.014*** | |
| (0.005) | ||
| Num.Obs. | 1962 | 1962 |
# Comparison table
both_comparison <- data_model7 %>%
mutate(group = ifelse(both == 1, "Both Facilities", "Single Facility")) %>%
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_utilization, na.rm = TRUE),
`% Maxed Out` = mean(maxed_out_btfp, na.rm = TRUE) * 100,
.groups = "drop"
)
both_comparison %>%
kable(caption = "Comparison: Banks Using Both Facilities vs. Single Facility",
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 |
|---|---|---|---|---|---|---|---|
| Both Facilities | 434 | 0.87 | 4.93 | 10.66 | 78.20 | 12.83 | 43.32 |
| Single Facility | 1528 | 0.70 | 4.83 | 9.66 | 77.99 | 7.14 | 26.44 |
# Visualization
p_m7 <- data_model7 %>%
mutate(used_both = ifelse(both == 1, "Both", "Single")) %>%
ggplot(aes(x = btfp_utilization, fill = used_both)) +
geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
geom_vline(xintercept = 0.9, linetype = "dashed", color = "red", size = 1) +
annotate("text", x = 0.95, y = Inf, vjust = 2, label = "90% Threshold", color = "red") +
scale_fill_manual(values = c("Both" = "#F18F01", "Single" = "#2E86AB")) +
labs(
title = "Figure 8: BTFP Utilization - Both vs. Single Facility Users",
subtitle = "Banks using both facilities have higher utilization (maxed out BTFP, turned to DW)",
x = "BTFP Utilization (Amount / OMO-Eligible)",
y = "Count", fill = "Facility Usage"
)
print(p_m7)
22 Summary: The Complete Story
# Panel 1: Who borrowed what
p_sum1 <- analysis_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" = "#2E86AB",
"DW_Only" = "#A23B72", "Both" = "#F18F01")) +
labs(title = "A: Facility Usage Distribution", x = NULL, y = "% of Banks") +
theme(legend.position = "none")
# Panel 2: Timeline of key findings
findings_df <- data.frame(
x = 1:4,
finding = c(
"1. Pre-BTFP: Vulnerable banks\naccess DW (stigma-tolerant)",
"2. Acute Crisis: Run pressure\ndrives ANY Fed access",
"3. Par Valuation: High MTM\nbanks select BTFP",
"4. Collateral Constraint:\nMax BTFP → Add DW"
)
)
p_sum2 <- ggplot(findings_df, aes(x = x, y = 1)) +
geom_tile(aes(fill = factor(x)), width = 0.9, height = 0.8, alpha = 0.3) +
geom_text(aes(label = finding), size = 3.5) +
scale_fill_manual(values = c("#FFB3B3", "#90EE90", "#87CEEB", "#F18F01")) +
theme_void() +
theme(legend.position = "none") +
labs(title = "B: Sequence of Key Findings")
# Combined
p_sum1 / p_sum2 +
plot_annotation(
title = "Summary: Facility Choice During the 2023 Banking Crisis",
subtitle = "Par valuation drove BTFP selection; DW was insufficient; collateral constraints explain 'Both' users"
)
23 Conclusion
23.1 Key Findings
findings <- tribble(
~`Research Question`, ~Finding, ~Evidence,
"Pre-BTFP DW (Revealed Preference)", "Vulnerable banks with high MTM losses and uninsured deposits accessed DW when it was the only option", "Model 1: Positive coefficients on MTM, uninsured leverage",
"Any Fed Access (Survival)", "Run pressure drives banks to access ANY Fed facility regardless of design", "Model 2: Uninsured leverage strongly significant",
"BTFP Selection (Par Valuation)", "Banks with higher MTM losses on BTFP-eligible securities systematically select BTFP", "Model 3: Borrowing subsidy predicts BTFP choice",
"DW Insufficiency", "Prior DW users MORE likely to also use BTFP → DW alone was insufficient", "Model 4: Positive coefficient on prior_dw_user",
"Temporal Dynamics", "Uninsured leverage strongest in Acute phase; MTM matters throughout", "Model 5: Coefficient magnitudes differ by period",
"Intensive Margin", "Banks with larger MTM losses borrowed more from BTFP", "Model 6: Positive coefficient on borrowing subsidy",
"Collateral Constraints", "Banks that maxed out BTFP turned to DW for additional liquidity via non-OMO collateral", "Model 7: Maxed-out indicator predicts using Both"
)
findings %>%
kable(caption = "Summary of Key Findings", format = "html") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE) %>%
column_spec(1, bold = TRUE, width = "20%") %>%
column_spec(2, width = "45%") %>%
column_spec(3, width = "35%")| Research Question | Finding | Evidence |
|---|---|---|
| Pre-BTFP DW (Revealed Preference) | Vulnerable banks with high MTM losses and uninsured deposits accessed DW when it was the only option | Model 1: Positive coefficients on MTM, uninsured leverage |
| Any Fed Access (Survival) | Run pressure drives banks to access ANY Fed facility regardless of design | Model 2: Uninsured leverage strongly significant |
| BTFP Selection (Par Valuation) | Banks with higher MTM losses on BTFP-eligible securities systematically select BTFP | Model 3: Borrowing subsidy predicts BTFP choice |
| DW Insufficiency | Prior DW users MORE likely to also use BTFP → DW alone was insufficient | Model 4: Positive coefficient on prior_dw_user |
| Temporal Dynamics | Uninsured leverage strongest in Acute phase; MTM matters throughout | Model 5: Coefficient magnitudes differ by period |
| Intensive Margin | Banks with larger MTM losses borrowed more from BTFP | Model 6: Positive coefficient on borrowing subsidy |
| Collateral Constraints | Banks that maxed out BTFP turned to DW for additional liquidity via non-OMO collateral | Model 7: Maxed-out indicator predicts using Both |