Borrowing Behavior Nuances & Structural Run Pressure (\(\phi\))
Part A: Loan-Level Descriptives | Part B: Structural \(\phi\) Estimation
March 30, 2026
1 SETUP
rm(list = ls())
library(data.table); library(dplyr); library(tidyr); library(stringr)
library(lubridate); library(purrr); library(tibble)
library(fixest); library(modelsummary)
library(knitr); library(kableExtra)
library(ggplot2); library(scales); library(patchwork)
library(readr); library(readxl)
winsorize <- function(x, probs = c(0.025, 0.975)) {
if (all(is.na(x))) return(x)
q <- quantile(x, probs = probs, na.rm = TRUE, names = FALSE)
pmax(pmin(x, q[2]), q[1])
}
standardize_z <- function(x) {
if (all(is.na(x))) return(x)
s <- sd(x, na.rm = TRUE)
if (is.na(s) || s == 0) return(rep(0, length(x)))
(x - mean(x, na.rm = TRUE)) / s
}
safe_div <- function(num, denom, default = NA_real_) {
ifelse(is.na(denom) | denom == 0, default, num / denom)
}
format_pval <- function(p) {
case_when(is.na(p) ~ "", p < 0.01 ~ "***", p < 0.05 ~ "**", p < 0.10 ~ "*", TRUE ~ "")
}
save_figure <- function(plot_obj, filename, width = 12, height = 8) {
ggsave(file.path(FIG_PATH, paste0(filename, ".pdf")),
plot = plot_obj, width = width, height = height, device = "pdf")
message("Saved: ", filename, ".pdf")
}
save_kbl_latex <- function(df, filename, col.names = NULL, caption = "", align = NULL) {
tex <- kbl(df, format = "latex", booktabs = TRUE, escape = FALSE,
col.names = col.names, caption = caption, align = align) %>%
kable_styling(latex_options = c("hold_position", "scale_down"))
writeLines(tex, file.path(TABLE_PATH, paste0(filename, ".tex")))
cat(sprintf("Saved: %s.tex\n", filename))
}
save_reg_latex <- function(model_list, filename, ...) {
msummary(model_list, output = file.path(TABLE_PATH, paste0(filename, ".tex")),
stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE", ...)
cat(sprintf("Saved: %s.tex\n", filename))
}
BASE_PATH <- "C:/Users/mferdo2/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025"
DATA_PROC <- file.path(BASE_PATH, "01_data/processed")
OUTPUT_PATH <- file.path(BASE_PATH, "03_documentation/Borrowing_Nuance_Phi")
TABLE_PATH <- file.path(OUTPUT_PATH, "tables"); FIG_PATH <- file.path(OUTPUT_PATH, "figures")
for (p in c(TABLE_PATH, FIG_PATH)) if (!dir.exists(p)) dir.create(p, recursive = TRUE)
BASELINE_MAIN <- "2022Q4"
DW_DATA_END <- as.Date("2023-12-31")
y_10yr <- 0.0392; delta_decay <- 0.10; cap_factor <- 1 / (y_10yr + delta_decay)
# ── Crisis phases ──
PHASES <- tribble(
~phase, ~start, ~end, ~label,
"P0", as.Date("2023-03-01"), as.Date("2023-03-07"), "Pre-Crisis (Mar 1-7)",
"P1", as.Date("2023-03-08"), as.Date("2023-03-12"), "SVB Fail, Pre-BTFP (Mar 8-12)",
"P2", as.Date("2023-03-13"), as.Date("2023-04-27"), "BTFP Active (Mar 13 - Apr 27)",
"P3", as.Date("2023-04-28"), as.Date("2023-05-04"), "First Republic Week (Apr 28 - May 4)"
)
ACUTE_START <- as.Date("2023-03-13")
ACUTE_END <- as.Date("2023-04-30")
BTFP_END <- as.Date("2024-03-11")
dist_names <- c("1"="Boston", "2"="New York", "3"="Philadelphia", "4"="Cleveland",
"5"="Richmond", "6"="Atlanta", "7"="Chicago", "8"="St. Louis",
"9"="Minneapolis", "10"="Kansas City", "11"="Dallas", "12"="San Francisco")
theme_gp <- theme_minimal(base_size = 13) +
theme(plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(color = "grey40", size = 11),
legend.position = "bottom", panel.grid.minor = element_blank())
phase_colors <- c("P0" = "#78909C", "P1" = "#FF8F00", "P2" = "#1565C0", "P3" = "#C62828")
fac_colors <- c("BTFP" = "#1565C0", "DW" = "#E53935")2 LOAD DATA
# ── Call report ──
call_q <- read_csv(file.path(DATA_PROC, "final_call_gsib.csv"), show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd))
# ── Loan-level data ──
btfp_loans_raw <- read_csv(file.path(DATA_PROC, "btfp_loan_bank_only.csv"), show_col_types = FALSE) %>%
mutate(rssd_id = as.character(rssd_id),
btfp_loan_date = mdy(btfp_loan_date),
btfp_repayment_date = mdy(btfp_repayment_date),
btfp_maturity_date = mdy(btfp_maturity_date))
dw_loans_raw <- read_csv(file.path(DATA_PROC, "dw_loan_bank_2023.csv"), show_col_types = FALSE) %>%
mutate(rssd_id = as.character(rssd_id),
dw_loan_date = ymd(dw_loan_date),
dw_repayment_date = ymd(dw_repayment_date))
# ── Deposit betas (DSSW) ──
dssw_betas <- read_csv(file.path(DATA_PROC, "dssw_deposit_betas.csv"), show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd))
dssw_beta_2022q4 <- dssw_betas %>% filter(estimation_date == "2022Q4") %>%
select(idrssd, beta_overall, beta_insured, beta_uninsured,
beta_insured_w, beta_uninsured_w, gamma_hat, alpha_hat)
# ── Public flag & deposit costs (optional) ──
public_flag <- read_csv(file.path(DATA_PROC, "public_bank_flag.csv"), show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd)) %>% select(idrssd, period, is_public)
deposit_costs_file <- file.path(DATA_PROC, "dssw_deposit_costs.csv")
if (file.exists(deposit_costs_file)) {
deposit_costs <- read_csv(deposit_costs_file, show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd))
deposit_costs_2022q4 <- deposit_costs %>% filter(period == "2022Q4") %>%
select(idrssd, deposit_cost_weighted, deposit_cost_insured, deposit_cost_uninsured)
HAS_DEPOSIT_COSTS <- TRUE
} else { deposit_costs_2022q4 <- NULL; HAS_DEPOSIT_COSTS <- FALSE }
# ── Excluded banks (failed + GSIBs) ──
excluded_banks <- call_q %>%
filter(period == BASELINE_MAIN, failed_bank == 1 | gsib == 1) %>% pull(idrssd)
btfp_loans <- btfp_loans_raw %>% filter(!rssd_id %in% excluded_banks)
dw_loans <- dw_loans_raw %>% filter(!rssd_id %in% excluded_banks)
# ── Phase assignment ──
assign_phase <- function(d) {
case_when(d >= PHASES$start[1] & d <= PHASES$end[1] ~ "P0",
d >= PHASES$start[2] & d <= PHASES$end[2] ~ "P1",
d >= PHASES$start[3] & d <= PHASES$end[3] ~ "P2",
d >= PHASES$start[4] & d <= PHASES$end[4] ~ "P3",
TRUE ~ NA_character_)
}
cat(sprintf("DW loans: %d transactions, %d unique banks\n", nrow(dw_loans), n_distinct(dw_loans$rssd_id)))## DW loans: 9935 transactions, 1479 unique bankscat(sprintf("BTFP loans: %d transactions, %d unique banks\n", nrow(btfp_loans), n_distinct(btfp_loans$rssd_id)))## BTFP loans: 6695 transactions, 1316 unique bankscat(sprintf("Call report: %d obs, %d banks, periods: %s\n",
nrow(call_q), n_distinct(call_q$idrssd), paste(unique(call_q$period), collapse=", ")))## Call report: 75989 obs, 5074 banks, periods: 2021Q1, 2021Q2, 2021Q3, 2021Q4, 2022Q1, 2022Q2, 2022Q3, 2022Q4, 2023Q1, 2023Q2, 2023Q3, 2023Q4, 2024Q1, 2024Q2, 2024Q3, 2024Q43 PART A: BORROWING BEHAVIOR NUANCES
Institutional background: A bank must have pre-pledged securities at the Discount Window on or before March 12, 2023 to be BTFP-eligible. The pre-pledged OMO-eligible collateral at DW consists of
dw_treasury_agency+dw_mbs_agency(=dw_omo_eligible), which maps to BTFP-eligible collateral (btfp_treasury_sec,btfp_agency_cmo,btfp_agency_mbs,btfp_agency_debt).
3.1 A1. DW Loan-Level Nuances
3.1.1 A1.1 Basic Dimensions
cat("DW LOAN DATA DIMENSIONS\n")## DW LOAN DATA DIMENSIONScat(sprintf("Total loan transactions: %s\n", format(nrow(dw_loans), big.mark = ",")))## Total loan transactions: 9,935cat(sprintf("Unique borrower banks (rssd_id): %s\n", format(n_distinct(dw_loans$rssd_id), big.mark = ",")))## Unique borrower banks (rssd_id): 1,479cat(sprintf("Date range: %s to %s\n", min(dw_loans$dw_loan_date), max(dw_loans$dw_loan_date)))## Date range: 2023-01-03 to 2023-12-29cat(sprintf("Maturity range: %s to %s\n", min(dw_loans$dw_maturity_date, na.rm=T),
max(dw_loans$dw_maturity_date, na.rm=T)))## Maturity range: 2023-01-04 to 2024-03-27cat(sprintf("Total $ lent: $%s\n", format(sum(dw_loans$dw_loan_amount), big.mark = ",")))## Total $ lent: $753,366,669,950cat(sprintf("Total $ collateral: $%s\n", format(sum(dw_loans$dw_total_collateral), big.mark = ",")))## Total $ collateral: $4.242292e+123.1.2 A1.2 Credit Type Breakdown
ct <- dw_loans %>%
group_by(`Credit Type` = dw_credit_type) %>%
summarise(
`N Loans` = n(),
`N Banks` = n_distinct(rssd_id),
`Total ($M)` = round(sum(dw_loan_amount) / 1e6, 0),
`Mean ($M)` = round(mean(dw_loan_amount) / 1e6, 1),
`Median ($M)` = round(median(dw_loan_amount) / 1e6, 1),
`Mean Rate (%)` = round(mean(dw_interest_rate, na.rm = TRUE), 3),
`Mean Term (d)` = round(mean(dw_term, na.rm = TRUE), 1),
.groups = "drop"
) %>%
mutate(`% of Total $` = round(100 * `Total ($M)` / sum(`Total ($M)`), 1))
kbl(ct, format = "html", caption = "DW Loans by Credit Type") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "Primary credit is standard; secondary is for banks not qualifying for primary;
seasonal for small agricultural/tourism banks. Trailing * indicates multiple same-day loans aggregated.")| Credit Type | N Loans | N Banks | Total (\(M) </th> <th style="text-align:right;"> Mean (\)M) | Median ($M) | Mean Rate (%) | Mean Term (d) | % of Total $ | |
|---|---|---|---|---|---|---|---|---|
| Primary Credit | 9433 | 1445 | 636783 | 67.5 | 7.0 | 5.176 | 4.6 | 84.5 |
| Primary Credit* | 167 | 58 | 116068 | 695.0 | 27.0 | 5.052 | 5.9 | 15.4 |
| Seasonal Credit | 327 | 41 | 512 | 1.6 | 0.8 | 5.332 | 19.1 | 0.1 |
| Seasonal Credit* | 3 | 3 | 4 | 1.2 | 1.5 | 5.350 | 6.0 | 0.0 |
| Secondary Credit | 5 | 5 | 0 | 0.0 | 0.0 | 5.950 | 1.0 | 0.0 |
| Note: | ||||||||
|
Primary credit is standard; secondary is for banks not
qualifying for primary; seasonal for small agricultural/tourism banks. Trailing * indicates multiple same-day loans aggregated. |
save_kbl_latex(ct, "Table_DW_CreditType", caption = "DW Loans by Credit Type")## Saved: Table_DW_CreditType.tex3.1.3 A1.3 Term Structure
dw_loans <- dw_loans %>%
mutate(
term_bucket = cut(dw_term,
breaks = c(0, 1, 7, 14, 28, 60, 90, 180, 365, Inf),
labels = c("Overnight", "2-7d", "8-14d", "15-28d", "29-60d", "61-90d", "91-180d", "181-365d", ">365d"),
right = TRUE)
)
tb <- dw_loans %>%
group_by(`Term Bucket` = term_bucket) %>%
summarise(
`N Loans` = n(),
`N Banks` = n_distinct(rssd_id),
`Total ($M)` = round(sum(dw_loan_amount) / 1e6, 0),
`Mean Amount ($M)` = round(mean(dw_loan_amount) / 1e6, 1),
.groups = "drop"
) %>%
mutate(`% of Loans` = round(100 * `N Loans` / sum(`N Loans`), 1),
`% of Amount` = round(100 * `Total ($M)` / sum(`Total ($M)`), 1))
kbl(tb, format = "html", caption = "DW Term Structure") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
footnote(general = "Overnight = 1-day. Longer terms during crisis signal genuine distress vs routine liquidity.")| Term Bucket | N Loans | N Banks | Total (\(M) </th> <th style="text-align:right;"> Mean Amount (\)M) | % of Loans | % of Amount | |
|---|---|---|---|---|---|---|
| Overnight | 6695 | 1317 | 562116 | 84.0 | 67.4 | 74.6 |
| 2-7d | 2175 | 294 | 162625 | 74.8 | 21.9 | 21.6 |
| 8-14d | 258 | 78 | 3946 | 15.3 | 2.6 | 0.5 |
| 15-28d | 378 | 87 | 15309 | 40.5 | 3.8 | 2.0 |
| 29-60d | 248 | 66 | 4159 | 16.8 | 2.5 | 0.6 |
| 61-90d | 170 | 47 | 4086 | 24.0 | 1.7 | 0.5 |
| 91-180d | 11 | 4 | 1125 | 102.3 | 0.1 | 0.1 |
| Note: | ||||||
| Overnight = 1-day. Longer terms during crisis signal genuine distress vs routine liquidity. |
save_kbl_latex(tb, "Table_DW_TermStructure", caption = "DW Term Structure")## Saved: Table_DW_TermStructure.tex# Distribution
cat("\nDW Term Summary Statistics:\n")##
## DW Term Summary Statistics:print(summary(dw_loans$dw_term))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 1.000 5.101 3.000 92.000cat(sprintf("Std Dev: %.1f\n", sd(dw_loans$dw_term, na.rm = TRUE)))## Std Dev: 13.13.1.4 A1.4 Early Repayment (Pre-payment)
dw_loans <- dw_loans %>%
mutate(
held_days = as.integer(dw_repayment_date - dw_loan_date),
early_repay_days = dw_term - held_days,
prepaid = as.integer(early_repay_days > 0)
)
n_prepaid <- sum(dw_loans$prepaid, na.rm = TRUE)
cat(sprintf("Loans prepaid (repaid before maturity): %d / %d (%.1f%%)\n",
n_prepaid, nrow(dw_loans), 100 * n_prepaid / nrow(dw_loans)))## Loans prepaid (repaid before maturity): 602 / 9935 (6.1%)cat(sprintf("Banks that prepaid at least once: %d\n",
n_distinct(dw_loans$rssd_id[dw_loans$prepaid == 1])))## Banks that prepaid at least once: 114pp <- dw_loans %>% filter(prepaid == 1)
if (nrow(pp) > 0) {
cat(sprintf("\nAmong prepaid DW loans:\n"))
cat(sprintf(" Mean days early: %.1f\n", mean(pp$early_repay_days, na.rm = TRUE)))
cat(sprintf(" Median days early: %.1f\n", median(pp$early_repay_days, na.rm = TRUE)))
cat(sprintf(" Max days early: %d\n", max(pp$early_repay_days, na.rm = TRUE)))
cat(sprintf(" Total $ prepaid: $%s (%.1f%% of total DW)\n",
format(sum(pp$dw_loan_amount), big.mark = ","),
100 * sum(pp$dw_loan_amount) / sum(dw_loans$dw_loan_amount)))
}##
## Among prepaid DW loans:
## Mean days early: 22.0
## Median days early: 12.0
## Max days early: 89
## Total $ prepaid: $22,059,739,711 (2.9% of total DW)# Prepayment by term bucket
pp_by_term <- dw_loans %>%
group_by(term_bucket) %>%
summarise(
N = n(),
`Prepaid %` = round(100 * mean(prepaid, na.rm = TRUE), 1),
`Mean Days Early` = round(mean(early_repay_days[prepaid == 1], na.rm = TRUE), 1),
.groups = "drop"
)
kbl(pp_by_term, format = "html", caption = "DW Pre-payment by Term Bucket") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| term_bucket | N | Prepaid % | Mean Days Early |
|---|---|---|---|
| Overnight | 6695 | 0.0 | NaN |
| 2-7d | 2175 | 3.7 | 2.6 |
| 8-14d | 258 | 29.8 | 5.3 |
| 15-28d | 378 | 47.1 | 11.7 |
| 29-60d | 248 | 55.2 | 18.5 |
| 61-90d | 170 | 73.5 | 62.5 |
| 91-180d | 11 | 36.4 | 44.8 |
3.1.5 A1.5 Repeat Borrowers (Capacity Re-use)
dw_bank <- dw_loans %>%
group_by(rssd_id) %>%
summarise(
n_loans = n(),
total_borrowed = sum(dw_loan_amount),
first_loan = min(dw_loan_date),
last_loan = max(dw_loan_date),
n_distinct_dates = n_distinct(dw_loan_date),
mean_loan = mean(dw_loan_amount),
.groups = "drop"
) %>%
mutate(span_days = as.integer(last_loan - first_loan))
# Frequency table
freq <- dw_bank %>% count(n_loans, name = "n_banks") %>% arrange(n_loans)
kbl(freq %>% head(15), format = "html", col.names = c("# Loans", "# Banks"),
caption = "DW: Number of Loans per Bank") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| # Loans | # Banks |
|---|---|
| 1 | 996 |
| 2 | 162 |
| 3 | 56 |
| 4 | 59 |
| 5 | 22 |
| 6 | 20 |
| 7 | 9 |
| 8 | 8 |
| 9 | 12 |
| 10 | 2 |
| 11 | 5 |
| 12 | 9 |
| 13 | 3 |
| 14 | 5 |
| 15 | 2 |
cat(sprintf("\nDistribution of # loans per bank:\n"))##
## Distribution of # loans per bank:print(summary(dw_bank$n_loans))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 1.000 6.717 2.000 250.000multi <- dw_bank %>% filter(n_loans > 1)
cat(sprintf("\nMulti-loan banks: %d / %d (%.1f%%)\n",
nrow(multi), nrow(dw_bank), 100 * nrow(multi) / nrow(dw_bank)))##
## Multi-loan banks: 483 / 1479 (32.7%)cat(sprintf("Mean span (first to last loan): %.1f days\n", mean(multi$span_days)))## Mean span (first to last loan): 193.7 dayscat(sprintf("Mean total borrowed per repeat bank: $%s\n", format(mean(multi$total_borrowed), big.mark = ",")))## Mean total borrowed per repeat bank: $1,555,972,368cat(sprintf("Median total borrowed per repeat bank: $%s\n", format(median(multi$total_borrowed), big.mark = ",")))## Median total borrowed per repeat bank: $1e+073.1.6 A1.6 Federal Reserve District
dw_dist <- dw_loans %>%
group_by(dw_fed_district) %>%
summarise(
`N Loans` = n(),
`N Banks` = n_distinct(rssd_id),
`Total ($M)` = round(sum(dw_loan_amount) / 1e6, 0),
`Mean Rate (%)` = round(mean(dw_interest_rate, na.rm = TRUE), 3),
`Mean Term (d)` = round(mean(dw_term, na.rm = TRUE), 1),
.groups = "drop"
) %>%
mutate(District = dist_names[as.character(dw_fed_district)],
`% of Amount` = round(100 * `Total ($M)` / sum(`Total ($M)`), 1)) %>%
select(dw_fed_district, District, everything())
kbl(dw_dist, format = "html", caption = "DW Lending by Federal Reserve District") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| dw_fed_district | District | N Loans | N Banks | Total ($M) | Mean Rate (%) | Mean Term (d) | % of Amount |
|---|---|---|---|---|---|---|---|
| Atlanta (6) | NA | 520 | 154 | 5603 | 5.188 | 17.9 | 0.7 |
| Boston (1) | NA | 571 | 107 | 12777 | 5.157 | 8.6 | 1.7 |
| Chicago (7) | NA | 1977 | 226 | 49466 | 5.196 | 3.5 | 6.6 |
| Cleveland (4) | NA | 214 | 67 | 472 | 5.246 | 2.5 | 0.1 |
| Dallas (11) | NA | 959 | 126 | 25742 | 5.139 | 4.9 | 3.4 |
| Kansas City (10) | NA | 931 | 173 | 50884 | 5.143 | 5.3 | 6.8 |
| Minneapolis (9) | NA | 1085 | 108 | 15229 | 5.177 | 4.3 | 2.0 |
| New York (2) | NA | 336 | 69 | 17935 | 5.117 | 2.6 | 2.4 |
| Philadelphia (3) | NA | 698 | 59 | 23968 | 5.168 | 1.6 | 3.2 |
| Richmond (5) | NA | 582 | 101 | 10927 | 5.131 | 9.7 | 1.5 |
| San Francisco (12) | NA | 1434 | 151 | 529631 | 5.193 | 2.4 | 70.3 |
| St. Louis (8) | NA | 628 | 138 | 10732 | 5.293 | 5.7 | 1.4 |
save_kbl_latex(dw_dist, "Table_DW_ByDistrict", caption = "DW Lending by Federal Reserve District")## Saved: Table_DW_ByDistrict.tex3.1.7 A1.7 Interest Rate
cat("DW Interest Rate Distribution:\n")## DW Interest Rate Distribution:print(summary(dw_loans$dw_interest_rate))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.500 5.000 5.250 5.179 5.500 6.000cat(sprintf("Std Dev: %.4f\n", sd(dw_loans$dw_interest_rate, na.rm = TRUE)))## Std Dev: 0.3401# Rate over time (monthly)
dw_rate_m <- dw_loans %>%
mutate(loan_month = floor_date(dw_loan_date, "month")) %>%
group_by(loan_month) %>%
summarise(
mean_rate = round(mean(dw_interest_rate, na.rm = TRUE), 3),
median_rate = round(median(dw_interest_rate, na.rm = TRUE), 3),
n_loans = n(),
total_m = round(sum(dw_loan_amount) / 1e6, 0),
.groups = "drop"
)
kbl(dw_rate_m, format = "html", caption = "DW Rate by Month",
col.names = c("Month", "Mean Rate (%)", "Median Rate (%)", "N Loans", "Total ($M)")) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Month | Mean Rate (%) | Median Rate (%) | N Loans | Total ($M) |
|---|---|---|---|---|
| 2023-01-01 | 4.500 | 4.50 | 877 | 32157 |
| 2023-02-01 | 4.733 | 4.75 | 693 | 32630 |
| 2023-03-01 | 4.821 | 4.75 | 1077 | 480281 |
| 2023-04-01 | 4.999 | 5.00 | 758 | 60341 |
| 2023-05-01 | 5.210 | 5.25 | 872 | 41222 |
| 2023-06-01 | 5.251 | 5.25 | 896 | 22371 |
| 2023-07-01 | 5.278 | 5.25 | 770 | 19029 |
| 2023-08-01 | 5.489 | 5.50 | 842 | 15141 |
| 2023-09-01 | 5.496 | 5.50 | 883 | 15980 |
| 2023-10-01 | 5.498 | 5.50 | 881 | 15003 |
| 2023-11-01 | 5.497 | 5.50 | 672 | 9652 |
| 2023-12-01 | 5.494 | 5.50 | 714 | 9559 |
# Rate vs term
p_rate_term <- ggplot(dw_loans, aes(x = dw_term, y = dw_interest_rate)) +
geom_point(alpha = 0.2, size = 1, color = "#E53935") +
geom_smooth(method = "loess", color = "black", se = TRUE) +
labs(title = "DW: Interest Rate vs Contractual Term",
x = "Term (days)", y = "Interest Rate (%)") + theme_gp
print(p_rate_term)
save_figure(p_rate_term, "Fig_DW_Rate_vs_Term", width = 10, height = 6)3.1.8 A1.8 Other Outstanding (Concurrent Borrowing)
has_other <- dw_loans$dw_other_outstanding > 0
cat(sprintf("Loans with other outstanding > 0: %d / %d (%.1f%%)\n",
sum(has_other), nrow(dw_loans), 100 * mean(has_other)))## Loans with other outstanding > 0: 1348 / 9935 (13.6%)cat(sprintf("Banks with other outstanding > 0: %d\n",
n_distinct(dw_loans$rssd_id[has_other])))## Banks with other outstanding > 0: 109if (sum(has_other) > 0) {
oth <- dw_loans %>% filter(dw_other_outstanding > 0)
cat(sprintf("\nAmong those with other outstanding:\n"))
cat(sprintf(" Mean other outstanding: $%s\n", format(round(mean(oth$dw_other_outstanding)), big.mark = ",")))
cat(sprintf(" Mean total outstanding: $%s\n", format(round(mean(oth$dw_total_outstanding)), big.mark = ",")))
cat(sprintf(" Ratio new_loan/total_out: %.3f\n",
mean(oth$dw_loan_amount / oth$dw_total_outstanding, na.rm = TRUE)))
}##
## Among those with other outstanding:
## Mean other outstanding: $71,414,662
## Mean total outstanding: $107,885,407
## Ratio new_loan/total_out: 0.297# Histogram: other outstanding relative to current loan
p_oth <- ggplot(dw_loans %>% filter(dw_other_outstanding > 0),
aes(x = dw_other_outstanding / 1e6)) +
geom_histogram(bins = 50, fill = "#E53935", alpha = 0.7) +
labs(title = "DW: Distribution of Other Outstanding Loans (when > 0)",
subtitle = "Each point is a loan-transaction; shows concurrent DW exposure",
x = "Other Outstanding ($M)", y = "Count") + theme_gp
print(p_oth)
3.1.9 A1.9 Collateral Composition (Pre-Pledged)
dw_coll_cols <- c("dw_comm_loans", "dw_res_mortgages", "dw_cre_loans", "dw_consumer_loans",
"dw_treasury_agency", "dw_municipal_sec", "dw_corporate_instruments",
"dw_mbs_agency", "dw_mbs_other", "dw_abs", "dw_intl_securities",
"dw_tdf_deposits", "dw_other_collateral")
coll_agg <- map_dfr(dw_coll_cols, function(col) {
tibble(
`Collateral Type` = str_replace(col, "dw_", ""),
Total = sum(dw_loans[[col]], na.rm = TRUE),
Mean = mean(dw_loans[[col]], na.rm = TRUE),
N_Nonzero = sum(dw_loans[[col]] > 0, na.rm = TRUE)
)
}) %>%
mutate(`% of Total Coll` = round(100 * Total / sum(dw_loans$dw_total_collateral, na.rm = TRUE), 1),
`% Loans Pledging` = round(100 * N_Nonzero / nrow(dw_loans), 1)) %>%
arrange(desc(`% of Total Coll`))
kbl(coll_agg, format = "html", caption = "DW Collateral Composition",
digits = c(0, 0, 0, 0, 1, 1)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "OMO-eligible = treasury_agency + mbs_agency. These are what qualify banks for BTFP.")| Collateral Type | Total | Mean | N_Nonzero | % of Total Coll | % Loans Pledging |
|---|---|---|---|---|---|
| comm_loans | 1.615697e+12 | 162626810 | 3379 | 38.1 | 34.0 |
| cre_loans | 8.684530e+11 | 87413491 | 2745 | 20.5 | 27.6 |
| consumer_loans | 6.172107e+11 | 62124879 | 1405 | 14.5 | 14.1 |
| mbs_agency | 4.456680e+11 | 44858376 | 3101 | 10.5 | 31.2 |
| municipal_sec | 2.875086e+11 | 28938962 | 3114 | 6.8 | 31.3 |
| res_mortgages | 1.503206e+11 | 15130407 | 965 | 3.5 | 9.7 |
| abs | 1.035596e+11 | 10423717 | 1142 | 2.4 | 11.5 |
| treasury_agency | 9.089308e+10 | 9148775 | 3226 | 2.1 | 32.5 |
| corporate_instruments | 3.558981e+10 | 3582266 | 1604 | 0.8 | 16.1 |
| mbs_other | 2.436777e+10 | 2452719 | 513 | 0.6 | 5.2 |
| intl_securities | 3.023548e+09 | 304333 | 5 | 0.1 | 0.1 |
| tdf_deposits | 0.000000e+00 | 0 | 0 | 0.0 | 0.0 |
| other_collateral | 0.000000e+00 | 0 | 0 | 0.0 | 0.0 |
| Note: | |||||
| OMO-eligible = treasury_agency + mbs_agency. These are what qualify banks for BTFP. |
save_kbl_latex(coll_agg, "Table_DW_CollateralComposition", caption = "DW Collateral Composition")## Saved: Table_DW_CollateralComposition.tex# OMO-eligible summary
omo_total <- sum(dw_loans$dw_treasury_agency, na.rm=T) + sum(dw_loans$dw_mbs_agency, na.rm=T)
total_coll <- sum(dw_loans$dw_total_collateral, na.rm = TRUE)
cat(sprintf("\nOMO-eligible collateral (treasury_agency + mbs_agency):\n"))##
## OMO-eligible collateral (treasury_agency + mbs_agency):cat(sprintf(" Total: $%s (%.1f%% of total collateral)\n",
format(omo_total, big.mark = ","), 100 * omo_total / total_coll))## Total: $5.36561e+11 (12.6% of total collateral)cat(sprintf(" This is what qualified banks for BTFP (pre-pledged on or before March 12)\n"))## This is what qualified banks for BTFP (pre-pledged on or before March 12)# Non-OMO-eligible breakdown
non_omo_cols <- c("dw_comm_loans", "dw_res_mortgages", "dw_cre_loans", "dw_consumer_loans",
"dw_municipal_sec", "dw_corporate_instruments", "dw_mbs_other", "dw_abs",
"dw_intl_securities", "dw_tdf_deposits", "dw_other_collateral")
non_omo_total <- sum(sapply(non_omo_cols, function(c) sum(dw_loans[[c]], na.rm=T)))
cat(sprintf(" Non-OMO-eligible: $%s (%.1f%%)\n",
format(non_omo_total, big.mark = ","), 100 * non_omo_total / total_coll))## Non-OMO-eligible: $3.705731e+12 (87.4%)3.1.10 A1.10 Loan-to-Collateral Ratios
dw_loans <- dw_loans %>%
mutate(
ltc_total = safe_div(dw_loan_amount, dw_total_collateral, NA),
ltc_omo = safe_div(dw_loan_amount, dw_omo_eligible, NA)
)
cat("Loan / Total Collateral:\n")## Loan / Total Collateral:print(summary(dw_loans$ltc_total))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000e-08 3.461e-02 1.438e-01 2.292e-01 3.606e-01 1.000e+00cat("\nLoan / OMO-Eligible Collateral (when OMO > 0):\n")##
## Loan / OMO-Eligible Collateral (when OMO > 0):print(summary(dw_loans$ltc_omo[dw_loans$dw_omo_eligible > 0]))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000e+00 9.000e-02 3.007e-01 1.891e+02 6.841e-01 1.585e+04# Plot
p_ltc <- ggplot(dw_loans %>% filter(!is.na(ltc_total)),
aes(x = ltc_total)) +
geom_histogram(bins = 80, fill = "#E53935", alpha = 0.7) +
geom_vline(xintercept = 1, linetype = "dashed", color = "black") +
coord_cartesian(xlim = c(0, 2)) +
labs(title = "DW Loan-to-Collateral Ratio", x = "Loan / Total Collateral", y = "Count") + theme_gp
print(p_ltc)
3.2 A2. BTFP Loan-Level Nuances
3.2.1 A2.1 Basic Dimensions
cat("BTFP LOAN DATA DIMENSIONS\n")## BTFP LOAN DATA DIMENSIONScat(sprintf("Total loan transactions: %s\n", format(nrow(btfp_loans), big.mark = ",")))## Total loan transactions: 6,695cat(sprintf("Unique borrower banks (rssd_id): %s\n", format(n_distinct(btfp_loans$rssd_id), big.mark = ",")))## Unique borrower banks (rssd_id): 1,316cat(sprintf("Date range: %s to %s\n", min(btfp_loans$btfp_loan_date), max(btfp_loans$btfp_loan_date)))## Date range: 2023-03-13 to 2024-03-11cat(sprintf("Maturity range: %s to %s\n", min(btfp_loans$btfp_maturity_date, na.rm=T),
max(btfp_loans$btfp_maturity_date, na.rm=T)))## Maturity range: 2023-03-14 to 2025-03-11cat(sprintf("Total $ lent: $%s\n", format(sum(btfp_loans$btfp_loan_amount), big.mark = ",")))## Total $ lent: $4.10358e+11cat(sprintf("Total $ collateral: $%s\n", format(sum(btfp_loans$btfp_total_collateral), big.mark = ",")))## Total $ collateral: $1.28049e+123.2.2 A2.2 Collateral Composition
btfp_coll_cols <- c("btfp_treasury_sec", "btfp_agency_cmo", "btfp_agency_mbs", "btfp_agency_debt")
btfp_coll_agg <- map_dfr(btfp_coll_cols, function(col) {
tibble(
`Collateral Type` = str_replace(col, "btfp_", ""),
Total = sum(btfp_loans[[col]], na.rm = TRUE),
Mean = mean(btfp_loans[[col]], na.rm = TRUE),
N_Nonzero = sum(btfp_loans[[col]] > 0, na.rm = TRUE)
)
}) %>%
mutate(`% of Total` = round(100 * Total / sum(btfp_loans$btfp_total_collateral, na.rm = TRUE), 1),
`% Loans With` = round(100 * N_Nonzero / nrow(btfp_loans), 1)) %>%
arrange(desc(`% of Total`))
kbl(btfp_coll_agg, format = "html",
caption = "BTFP Collateral Composition (Treasury + Agency only, valued at PAR)") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
footnote(general = "BTFP accepted ONLY Treasury, Agency CMO, Agency MBS, and Agency Debt.
These are the SAME securities pre-pledged at DW as dw_treasury_agency + dw_mbs_agency.
BTFP lends at PAR (face) value, not market value -- the subsidy equals the MTM loss.")| Collateral Type | Total | Mean | N_Nonzero | % of Total | % Loans With |
|---|---|---|---|---|---|
| agency_mbs | 641725476088 | 95851453 | 4399 | 50.1 | 65.7 |
| agency_cmo | 302775455877 | 45224116 | 3087 | 23.6 | 46.1 |
| treasury_sec | 202464164442 | 30241100 | 2821 | 15.8 | 42.1 |
| agency_debt | 133524816817 | 19943961 | 3381 | 10.4 | 50.5 |
| Note: | |||||
|
BTFP accepted ONLY Treasury, Agency CMO, Agency MBS, and
Agency Debt. These are the SAME securities pre-pledged at DW as dw_treasury_agency + dw_mbs_agency. BTFP lends at PAR (face) value, not market value – the subsidy equals the MTM loss. |
save_kbl_latex(btfp_coll_agg, "Table_BTFP_CollateralComposition",
caption = "BTFP Collateral Composition")## Saved: Table_BTFP_CollateralComposition.tex3.2.3 A2.3 Term and Early Repayment
btfp_loans <- btfp_loans %>%
mutate(
held_days = as.integer(btfp_repayment_date - btfp_loan_date),
early_repay_days = btfp_term - held_days,
prepaid = as.integer(early_repay_days > 0)
)
cat("BTFP Contractual Term (days):\n")## BTFP Contractual Term (days):print(summary(btfp_loans$btfp_term))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.0 364.0 365.0 311.1 366.0 369.0n_pp <- sum(btfp_loans$prepaid, na.rm = TRUE)
cat(sprintf("\nPrepaid (repaid before maturity): %d / %d (%.1f%%)\n",
n_pp, nrow(btfp_loans), 100 * n_pp / nrow(btfp_loans)))##
## Prepaid (repaid before maturity): 5321 / 6695 (79.5%)cat(sprintf("Banks that prepaid: %d\n", n_distinct(btfp_loans$rssd_id[btfp_loans$prepaid == 1])))## Banks that prepaid: 1023if (n_pp > 0) {
pp <- btfp_loans %>% filter(prepaid == 1)
cat(sprintf(" Mean days early: %.1f\n", mean(pp$early_repay_days, na.rm = TRUE)))
cat(sprintf(" Median days early: %.1f\n", median(pp$early_repay_days, na.rm = TRUE)))
cat(sprintf(" Total $ prepaid: $%s (%.1f%% of total BTFP $)\n",
format(sum(pp$btfp_loan_amount), big.mark = ","),
100 * sum(pp$btfp_loan_amount) / sum(btfp_loans$btfp_loan_amount)))
}## Mean days early: 260.0
## Median days early: 350.0
## Total $ prepaid: $353,702,839,293 (86.2% of total BTFP $)# Term distribution
btfp_term_tbl <- btfp_loans %>%
mutate(term_bucket = cut(btfp_term,
breaks = c(0, 30, 90, 180, 350, 366, Inf),
labels = c("<30d", "30-90d", "91-180d", "181-350d", "~365d", ">365d"))) %>%
group_by(`Term Bucket` = term_bucket) %>%
summarise(N = n(), `Total ($M)` = round(sum(btfp_loan_amount)/1e6, 0),
`Prepaid %` = round(100*mean(prepaid, na.rm=T), 1),
`Mean Held (d)` = round(mean(held_days, na.rm=T), 1), .groups = "drop") %>%
mutate(`% of Loans` = round(100 * N / sum(N), 1))
kbl(btfp_term_tbl, format = "html", caption = "BTFP Term Distribution") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
footnote(general = "Most BTFP loans are ~365 days (precautionary). Early repay = liquidity need resolved.")| Term Bucket | N | Total ($M) | Prepaid % | Mean Held (d) | % of Loans |
|---|---|---|---|---|---|
| <30d | 868 | 23273 | 12.4 | 3.6 | 13.0 |
| 30-90d | 82 | 2959 | 52.4 | 31.8 | 1.2 |
| 91-180d | 53 | 1155 | 60.4 | 63.2 | 0.8 |
| 181-350d | 100 | 7297 | 73.0 | 130.4 | 1.5 |
| ~365d | 4931 | 350927 | 91.2 | 121.3 | 73.7 |
| >365d | 661 | 24746 | 85.9 | 119.8 | 9.9 |
| Note: | |||||
| Most BTFP loans are ~365 days (precautionary). Early repay = liquidity need resolved. |
3.2.4 A2.4 Repeat Borrowers
btfp_bank <- btfp_loans %>%
group_by(rssd_id) %>%
summarise(
n_loans = n(),
total_borrowed = sum(btfp_loan_amount),
first_loan = min(btfp_loan_date),
last_loan = max(btfp_loan_date),
n_distinct_dates = n_distinct(btfp_loan_date),
.groups = "drop"
) %>%
mutate(span_days = as.integer(last_loan - first_loan))
freq_b <- btfp_bank %>% count(n_loans, name = "n_banks") %>% arrange(n_loans)
kbl(freq_b %>% head(15), format = "html", col.names = c("# Loans", "# Banks"),
caption = "BTFP: Number of Loans per Bank") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| # Loans | # Banks |
|---|---|
| 1 | 401 |
| 2 | 229 |
| 3 | 156 |
| 4 | 98 |
| 5 | 74 |
| 6 | 67 |
| 7 | 44 |
| 8 | 40 |
| 9 | 27 |
| 10 | 21 |
| 11 | 21 |
| 12 | 21 |
| 13 | 16 |
| 14 | 11 |
| 15 | 14 |
cat(sprintf("\nDistribution of # loans per bank:\n"))##
## Distribution of # loans per bank:print(summary(btfp_bank$n_loans))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 3.000 5.087 6.000 97.000multi_b <- btfp_bank %>% filter(n_loans > 1)
cat(sprintf("\nMulti-loan banks: %d / %d (%.1f%%)\n",
nrow(multi_b), nrow(btfp_bank), 100 * nrow(multi_b) / nrow(btfp_bank)))##
## Multi-loan banks: 915 / 1316 (69.5%)if (nrow(multi_b) > 0) {
cat(sprintf("Mean span (first to last): %.1f days\n", mean(multi_b$span_days)))
cat(sprintf("Mean total borrowed per repeat bank: $%s\n",
format(mean(multi_b$total_borrowed), big.mark = ",")))
}## Mean span (first to last): 183.6 days
## Mean total borrowed per repeat bank: $437,817,1483.2.5 A2.5 Federal Reserve District and Interest Rate
btfp_dist <- btfp_loans %>%
group_by(btfp_fed_district) %>%
summarise(
`N Loans` = n(),
`N Banks` = n_distinct(rssd_id),
`Total ($M)` = round(sum(btfp_loan_amount) / 1e6, 0),
`Mean Rate (%)` = round(mean(btfp_interest_rate, na.rm = TRUE), 3),
`Mean Term (d)` = round(mean(btfp_term, na.rm = TRUE), 0),
.groups = "drop"
) %>%
mutate(District = dist_names[as.character(btfp_fed_district)],
`% of Amount` = round(100 * `Total ($M)` / sum(`Total ($M)`), 1)) %>%
select(btfp_fed_district, District, everything())
kbl(btfp_dist, format = "html", caption = "BTFP by Federal Reserve District") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| btfp_fed_district | District | N Loans | N Banks | Total ($M) | Mean Rate (%) | Mean Term (d) | % of Amount |
|---|---|---|---|---|---|---|---|
| Atlanta | NA | 563 | 134 | 16237 | 5.053 | 311 | 4.0 |
| Boston | NA | 508 | 75 | 17437 | 4.958 | 331 | 4.2 |
| Chicago | NA | 902 | 179 | 21056 | 5.005 | 344 | 5.1 |
| Cleveland | NA | 269 | 62 | 11924 | 4.949 | 329 | 2.9 |
| Dallas | NA | 947 | 166 | 78828 | 5.082 | 276 | 19.2 |
| Kansas City | NA | 868 | 194 | 36748 | 4.979 | 335 | 9.0 |
| Minneapolis | NA | 754 | 147 | 14290 | 5.017 | 312 | 3.5 |
| New York | NA | 231 | 62 | 9336 | 5.019 | 318 | 2.3 |
| Philadelphia | NA | 232 | 34 | 13697 | 5.022 | 214 | 3.3 |
| Richmond | NA | 289 | 62 | 11740 | 5.004 | 297 | 2.9 |
| San Francisco | NA | 536 | 94 | 140223 | 5.009 | 299 | 34.2 |
| St. Louis | NA | 596 | 107 | 38842 | 5.066 | 311 | 9.5 |
save_kbl_latex(btfp_dist, "Table_BTFP_ByDistrict", caption = "BTFP by Federal Reserve District")## Saved: Table_BTFP_ByDistrict.texcat("\nBTFP Interest Rate Distribution:\n")##
## BTFP Interest Rate Distribution:print(summary(btfp_loans$btfp_interest_rate))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.370 4.810 4.900 5.019 5.310 5.590# Rate over time
btfp_rate_m <- btfp_loans %>%
mutate(loan_month = floor_date(btfp_loan_date, "month")) %>%
group_by(loan_month) %>%
summarise(
mean_rate = round(mean(btfp_interest_rate, na.rm = TRUE), 3),
n_loans = n(),
total_m = round(sum(btfp_loan_amount) / 1e6, 0),
.groups = "drop"
)
kbl(btfp_rate_m, format = "html", caption = "BTFP Rate and Volume by Month",
col.names = c("Month", "Mean Rate (%)", "N Loans", "Total ($M)")) %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Month | Mean Rate (%) | N Loans | Total ($M) |
|---|---|---|---|
| 2023-03-01 | 4.564 | 520 | 74373 |
| 2023-04-01 | 4.801 | 527 | 46484 |
| 2023-05-01 | 4.842 | 759 | 23612 |
| 2023-06-01 | 5.275 | 350 | 11025 |
| 2023-07-01 | 5.432 | 250 | 5255 |
| 2023-08-01 | 5.463 | 235 | 4396 |
| 2023-09-01 | 5.538 | 191 | 1859 |
| 2023-10-01 | 5.488 | 200 | 5430 |
| 2023-11-01 | 5.289 | 667 | 28269 |
| 2023-12-01 | 4.936 | 1519 | 108818 |
| 2024-01-01 | 4.850 | 1132 | 88102 |
| 2024-02-01 | 5.400 | 147 | 2440 |
| 2024-03-01 | 5.400 | 198 | 10295 |
3.2.6 A2.6 Loan-to-Collateral (Par Value Subsidy)
btfp_loans <- btfp_loans %>%
mutate(ltc = safe_div(btfp_loan_amount, btfp_total_collateral, NA))
cat("BTFP Loan/Collateral Ratio:\n")## BTFP Loan/Collateral Ratio:cat("(BTFP lends at PAR value, so ratio near 1 means borrowing close to face value of pledged securities)\n\n")## (BTFP lends at PAR value, so ratio near 1 means borrowing close to face value of pledged securities)print(summary(btfp_loans$ltc))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 6.000e-08 1.492e-01 3.717e-01 4.513e-01 8.000e-01 1.000e+00# By collateral type
for (col in btfp_coll_cols) {
mask <- btfp_loans[[col]] > 0
if (sum(mask) > 0) {
ratio <- btfp_loans$btfp_loan_amount[mask] / btfp_loans[[col]][mask]
cat(sprintf("Loan / %s: mean=%.3f, median=%.3f (N=%d)\n",
str_replace(col, "btfp_", ""), mean(ratio, na.rm=T), median(ratio, na.rm=T), sum(mask)))
}
}## Loan / treasury_sec: mean=2.197, median=0.950 (N=2821)
## Loan / agency_cmo: mean=22.456, median=1.196 (N=3087)
## Loan / agency_mbs: mean=38.542, median=0.683 (N=4399)
## Loan / agency_debt: mean=3.918, median=0.998 (N=3381)3.3 A3. Cross-Facility: DW vs BTFP Overlap
3.3.1 A3.1 Overlap and Substitution
dw_banks <- unique(dw_loans$rssd_id)
btfp_banks <- unique(btfp_loans$rssd_id)
both_banks <- intersect(dw_banks, btfp_banks)
dw_only_banks <- setdiff(dw_banks, btfp_banks)
btfp_only_banks <- setdiff(btfp_banks, dw_banks)
venn_tbl <- tibble(
Category = c("DW Only", "BTFP Only", "Both DW + BTFP", "Total Unique"),
`N Banks` = c(length(dw_only_banks), length(btfp_only_banks), length(both_banks),
length(union(dw_banks, btfp_banks)))
)
kbl(venn_tbl, format = "html", caption = "DW vs BTFP Facility Usage") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Category | N Banks |
|---|---|
| DW Only | 887 |
| BTFP Only | 724 |
| Both DW + BTFP | 592 |
| Total Unique | 2203 |
# For 'both' banks: who borrowed first?
if (length(both_banks) > 0) {
dw_first <- dw_loans %>% filter(rssd_id %in% both_banks) %>%
group_by(rssd_id) %>% summarise(dw_first = min(dw_loan_date), .groups = "drop")
btfp_first <- btfp_loans %>% filter(rssd_id %in% both_banks) %>%
group_by(rssd_id) %>% summarise(btfp_first = min(btfp_loan_date), .groups = "drop")
timing <- inner_join(dw_first, btfp_first, by = "rssd_id") %>%
mutate(order = case_when(
dw_first < btfp_first ~ "DW first",
dw_first == btfp_first ~ "Same day",
dw_first > btfp_first ~ "BTFP first"))
cat("\nAmong 'both' banks -- which facility first?\n")
print(table(timing$order))
cat(sprintf("\nMedian gap (BTFP date - DW date): %.0f days\n",
median(as.integer(timing$btfp_first - timing$dw_first))))
}##
## Among 'both' banks -- which facility first?
##
## BTFP first DW first Same day
## 175 356 61
##
## Median gap (BTFP date - DW date): 16 days3.3.2 A3.2 Acute Crisis Period Comparison
dw_acute <- dw_loans %>% filter(dw_loan_date >= ACUTE_START, dw_loan_date <= ACUTE_END)
btfp_acute <- btfp_loans %>% filter(btfp_loan_date >= ACUTE_START, btfp_loan_date <= ACUTE_END)
comp <- tibble(
Metric = c("N Loan Transactions", "N Unique Banks", "Total ($M)",
"Mean $ per Loan ($M)", "Mean Rate (%)", "Mean Term (days)"),
DW = c(nrow(dw_acute), n_distinct(dw_acute$rssd_id),
round(sum(dw_acute$dw_loan_amount)/1e6, 0),
round(mean(dw_acute$dw_loan_amount)/1e6, 1),
round(mean(dw_acute$dw_interest_rate, na.rm=T), 3),
round(mean(dw_acute$dw_term, na.rm=T), 1)),
BTFP = c(nrow(btfp_acute), n_distinct(btfp_acute$rssd_id),
round(sum(btfp_acute$btfp_loan_amount)/1e6, 0),
round(mean(btfp_acute$btfp_loan_amount)/1e6, 1),
round(mean(btfp_acute$btfp_interest_rate, na.rm=T), 3),
round(mean(btfp_acute$btfp_term, na.rm=T), 1))
)
kbl(comp, format = "html",
caption = sprintf("Acute Crisis Period: %s to %s", ACUTE_START, ACUTE_END)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Metric | DW | BTFP |
|---|---|---|
| N Loan Transactions | 1539.000 | 1047.000 |
| N Unique Banks | 408.000 | 475.000 |
| Total ($M) | 521061.000 | 120857.000 |
| Mean $ per Loan ($M) | 338.600 | 115.400 |
| Mean Rate (%) | 4.923 | 4.683 |
| Mean Term (days) | 4.500 | 313.000 |
save_kbl_latex(comp, "Table_AcuteDW_vs_BTFP",
caption = sprintf("DW vs BTFP: %s to %s", ACUTE_START, ACUTE_END))## Saved: Table_AcuteDW_vs_BTFP.tex3.3.3 A3.3 Pre-Pledged Collateral and BTFP Eligibility
cat("KEY INSTITUTIONAL FACT:\n")## KEY INSTITUTIONAL FACT:cat("Banks must have pre-pledged securities at the DW on or before March 12, 2023\n")## Banks must have pre-pledged securities at the DW on or before March 12, 2023cat("to be BTFP-eligible. The pre-pledged OMO-eligible collateral at DW consists of:\n")## to be BTFP-eligible. The pre-pledged OMO-eligible collateral at DW consists of:cat(" dw_treasury_agency -> maps to btfp_treasury_sec + btfp_agency_debt\n")## dw_treasury_agency -> maps to btfp_treasury_sec + btfp_agency_debtcat(" dw_mbs_agency -> maps to btfp_agency_mbs + btfp_agency_cmo\n")## dw_mbs_agency -> maps to btfp_agency_mbs + btfp_agency_cmocat(" Together: dw_omo_eligible = dw_treasury_agency + dw_mbs_agency\n\n")## Together: dw_omo_eligible = dw_treasury_agency + dw_mbs_agency# DW loans on or before March 12 with OMO-eligible collateral
dw_pre <- dw_loans %>% filter(dw_loan_date <= as.Date("2023-03-12"))
dw_pre_omo_banks <- dw_pre %>% filter(dw_omo_eligible > 0) %>% pull(rssd_id) %>% unique()
cat(sprintf("DW borrowers before March 13 with OMO-eligible > 0: %d\n", length(dw_pre_omo_banks)))## DW borrowers before March 13 with OMO-eligible > 0: 113cat(sprintf("BTFP borrowers (all time): %d\n", length(btfp_banks)))## BTFP borrowers (all time): 1316cat(sprintf("BTFP borrowers also in pre-Mar-13 DW OMO set: %d\n",
length(intersect(btfp_banks, dw_pre_omo_banks))))## BTFP borrowers also in pre-Mar-13 DW OMO set: 58cat(sprintf("BTFP borrowers NOT in pre-Mar-13 DW borrower set: %d\n",
length(setdiff(btfp_banks, dw_pre_omo_banks))))## BTFP borrowers NOT in pre-Mar-13 DW borrower set: 1258cat("\nNote: Banks can pre-pledge collateral at DW without borrowing.\n")##
## Note: Banks can pre-pledge collateral at DW without borrowing.cat("The DW data only records actual borrowers, so some BTFP banks may have\n")## The DW data only records actual borrowers, so some BTFP banks may havecat("pre-pledged without appearing as DW borrowers.\n")## pre-pledged without appearing as DW borrowers.3.4 A4. Time-Series Dynamics
3.4.1 A4.1 Daily Lending Volume
daily_dw <- dw_loans %>%
group_by(date = dw_loan_date) %>%
summarise(n = n(), total_m = sum(dw_loan_amount)/1e6,
n_banks = n_distinct(rssd_id), .groups = "drop") %>%
mutate(facility = "DW")
daily_btfp <- btfp_loans %>%
group_by(date = btfp_loan_date) %>%
summarise(n = n(), total_m = sum(btfp_loan_amount)/1e6,
n_banks = n_distinct(rssd_id), .groups = "drop") %>%
mutate(facility = "BTFP")
daily <- bind_rows(daily_dw, daily_btfp)
# Top 5 days
cat("Top 5 DW days by total amount:\n")## Top 5 DW days by total amount:print(daily_dw %>% arrange(desc(total_m)) %>% head(5))## # A tibble: 5 × 5
## date n total_m n_banks facility
## <date> <int> <dbl> <int> <chr>
## 1 2023-03-13 81 43827. 79 DW
## 2 2023-03-15 59 43066. 58 DW
## 3 2023-03-16 58 41588. 57 DW
## 4 2023-03-14 71 41323. 70 DW
## 5 2023-03-17 50 41199. 50 DWcat("\nTop 5 BTFP days by total amount:\n")##
## Top 5 BTFP days by total amount:print(daily_btfp %>% arrange(desc(total_m)) %>% head(5))## # A tibble: 5 × 5
## date n total_m n_banks facility
## <date> <int> <dbl> <int> <chr>
## 1 2024-01-16 348 37705. 319 BTFP
## 2 2024-01-12 254 27309. 237 BTFP
## 3 2023-12-14 292 20843. 265 BTFP
## 4 2023-03-20 84 19235. 77 BTFP
## 5 2023-03-24 133 16339. 119 BTFP# Plots
p1 <- ggplot(daily, aes(x = date, y = total_m, fill = facility)) +
geom_col(position = "stack", alpha = 0.8) +
geom_vline(xintercept = as.Date("2023-03-10"), linetype = "dashed", color = "#E53935") +
geom_vline(xintercept = as.Date("2023-03-13"), linetype = "dashed", color = "#1565C0") +
geom_vline(xintercept = as.Date("2023-05-01"), linetype = "dashed", color = "#C62828") +
annotate("text", x = as.Date("2023-03-10"), y = Inf, vjust = 2, label = "SVB", size = 3) +
annotate("text", x = as.Date("2023-03-13"), y = Inf, vjust = 4, label = "BTFP", size = 3) +
annotate("text", x = as.Date("2023-05-01"), y = Inf, vjust = 2, label = "FRC", size = 3) +
scale_fill_manual(values = fac_colors) +
scale_y_continuous(labels = label_comma()) +
labs(title = "Daily Total Lending ($M)", x = NULL, y = "$M") + theme_gp
p2 <- ggplot(daily, aes(x = date, y = n_banks, color = facility)) +
geom_line(linewidth = 0.8) + geom_point(size = 1) +
geom_vline(xintercept = as.Date("2023-03-10"), linetype = "dashed", color = "#E53935") +
geom_vline(xintercept = as.Date("2023-03-13"), linetype = "dashed", color = "#1565C0") +
scale_color_manual(values = fac_colors) +
labs(title = "Daily Unique Banks Borrowing", x = NULL, y = "N Banks") + theme_gp
print(p1 / p2)
save_figure(p1 / p2, "Fig_DailyVolume", width = 14, height = 10)3.4.2 A4.2 Outstanding Balance Over Time
# Build daily outstanding
date_grid <- seq(as.Date("2023-01-01"), as.Date("2024-04-01"), by = "day")
compute_outstanding_ts <- function(loans_df, date_col, repay_col, amt_col) {
out <- numeric(length(date_grid))
names(out) <- as.character(date_grid)
for (i in seq_len(nrow(loans_df))) {
s <- loans_df[[date_col]][i]; e <- loans_df[[repay_col]][i]; a <- loans_df[[amt_col]][i]
if (is.na(s) | is.na(e) | is.na(a)) next
mask <- date_grid >= s & date_grid <= e
out[mask] <- out[mask] + a
}
tibble(date = date_grid, outstanding = out)
}
dw_out <- compute_outstanding_ts(dw_loans, "dw_loan_date", "dw_repayment_date", "dw_loan_amount") %>%
mutate(facility = "DW")
btfp_out <- compute_outstanding_ts(btfp_loans, "btfp_loan_date", "btfp_repayment_date", "btfp_loan_amount") %>%
mutate(facility = "BTFP")
outstanding <- bind_rows(dw_out, btfp_out)
p_out <- ggplot(outstanding, aes(x = date, y = outstanding / 1e9, color = facility)) +
geom_line(linewidth = 1.2) +
geom_vline(xintercept = as.Date("2023-03-13"), linetype = "dashed", color = "red", alpha = 0.7) +
annotate("text", x = as.Date("2023-03-13"), y = Inf, vjust = 2, label = "BTFP Launch", size = 3) +
scale_color_manual(values = fac_colors) +
scale_y_continuous(labels = label_dollar(suffix = "B")) +
labs(title = "Daily Outstanding Balance: DW vs BTFP",
x = NULL, y = "Outstanding ($B)") + theme_gp
print(p_out)
save_figure(p_out, "Fig_OutstandingBalance", width = 14, height = 6)
cat(sprintf("Peak DW outstanding: $%.2fB on %s\n",
max(dw_out$outstanding)/1e9, dw_out$date[which.max(dw_out$outstanding)]))## Peak DW outstanding: $90.65B on 2023-03-16cat(sprintf("Peak BTFP outstanding: $%.2fB on %s\n",
max(btfp_out$outstanding)/1e9, btfp_out$date[which.max(btfp_out$outstanding)]))## Peak BTFP outstanding: $133.35B on 2024-01-164 PART B: STRUCTURAL RUN PRESSURE \(\phi\)
Model (from standalone theory concept):
Pre-crisis liquidity coverage: \[\phi = \frac{C + S^{\text{OMO}}_{MV}}{D^U}\]
where \(C\) = cash, \(S^{\text{OMO}}_{MV}\) = market value of OMO-eligible securities, \(D^U\) = uninsured deposits. All measured at 2022Q4 (pre-crisis).
Borrowing intensity (separate from \(\phi\)): \[g / D^U\] where \(g\) = total borrowed (DW + BTFP). This is NOT added to \(\phi\) because borrowing \(g\) is obtained by pledging securities already in \(S^{\text{OMO}}\); including both would double-count.
Run value: \(v = E^{MV} - F^U\). Run equilibrium exists when \(v < 0\).
Franchise value (Approach A): \(F = (1-\beta^U) \cdot r \cdot D / (r + \delta)\), scaled by \(D/TA\). \(F^U = (D^U/D) \cdot F\).
4.1 B0. Build Merged Panel
# ── Bank-level borrowing aggregates (post-crisis) ──
dw_bank_agg <- dw_loans %>%
filter(dw_loan_date >= ACUTE_START) %>%
group_by(rssd_id) %>%
summarise(
dw_total_borrowed = sum(dw_loan_amount),
dw_n_loans = n(),
dw_max_collateral = max(dw_total_collateral, na.rm = TRUE),
dw_max_omo_eligible = max(dw_omo_eligible, na.rm = TRUE),
dw_mean_rate = mean(dw_interest_rate, na.rm = TRUE),
dw_mean_term = mean(dw_term, na.rm = TRUE),
dw_n_prepaid = sum(prepaid, na.rm = TRUE),
dw_first_loan = min(dw_loan_date),
dw_last_loan = max(dw_loan_date),
dw_fed_district = first(dw_fed_district),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
btfp_bank_agg <- btfp_loans %>%
group_by(rssd_id) %>%
summarise(
btfp_total_borrowed = sum(btfp_loan_amount),
btfp_n_loans = n(),
btfp_max_collateral = max(btfp_total_collateral, na.rm = TRUE),
btfp_mean_rate = mean(btfp_interest_rate, na.rm = TRUE),
btfp_mean_term = mean(btfp_term, na.rm = TRUE),
btfp_n_prepaid = sum(prepaid, na.rm = TRUE),
btfp_first_loan = min(btfp_loan_date),
btfp_last_loan = max(btfp_loan_date),
btfp_fed_district = first(btfp_fed_district),
.groups = "drop"
) %>% rename(idrssd = rssd_id)
# ── Start from 2022Q4 call report baseline ──
df <- call_q %>%
filter(period == BASELINE_MAIN, !idrssd %in% excluded_banks) %>%
left_join(dssw_beta_2022q4, by = "idrssd") %>%
{ if (HAS_DEPOSIT_COSTS) left_join(., deposit_costs_2022q4, by = "idrssd") else . } %>%
left_join(public_flag %>% filter(period == "2022Q4") %>% select(idrssd, is_public), by = "idrssd") %>%
mutate(is_public = replace_na(is_public, 0L))
# ── Merge borrowing ──
df <- df %>%
left_join(dw_bank_agg, by = "idrssd") %>%
left_join(btfp_bank_agg, by = "idrssd") %>%
mutate(
dw_total_borrowed = replace_na(dw_total_borrowed, 0),
btfp_total_borrowed = replace_na(btfp_total_borrowed, 0),
dw_n_loans = replace_na(dw_n_loans, 0L),
btfp_n_loans = replace_na(btfp_n_loans, 0L),
g = dw_total_borrowed + btfp_total_borrowed,
used_dw = as.integer(dw_total_borrowed > 0),
used_btfp = as.integer(btfp_total_borrowed > 0),
borrower_type = case_when(
used_dw == 1 & used_btfp == 1 ~ "Both",
used_dw == 1 ~ "DW Only",
used_btfp == 1 ~ "BTFP Only",
TRUE ~ "Non-Borrower"),
borrowed = as.integer(g > 0)
)
cat(sprintf("Panel: %d banks\n", nrow(df)))## Panel: 4696 bankscat(sprintf("Usage flag distribution:\n"))## Usage flag distribution:print(table(df$borrower_type))##
## Both BTFP Only DW Only Non-Borrower
## 551 754 826 25654.2 B1. Franchise Value (Approach A Only)
# ==============================================================================
# FRANCHISE VALUE — APPROACH A
# ==============================================================================
# F = (1 - beta^U) * r * (D/TA) * cap_factor * 100 [in pp of TA]
# F^U = (D^U / D) * F [uninsured share of F]
#
# This uses total D/TA for F, then extracts the uninsured portion via D^U/D.
# No double-counting of D^U.
# ==============================================================================
# Clip beta to [0, 1]
df <- df %>%
mutate(
beta_u_clipped = pmin(pmax(ifelse(!is.na(beta_uninsured), beta_uninsured, NA_real_), 0), 1),
one_minus_beta = 1 - beta_u_clipped,
cost_u_raw = ifelse(HAS_DEPOSIT_COSTS & !is.na(deposit_cost_uninsured),
deposit_cost_uninsured, 0)
)
cat(sprintf("Banks with beta available: %d / %d (%.1f%%)\n",
sum(!is.na(df$beta_u_clipped)), nrow(df),
100 * sum(!is.na(df$beta_u_clipped)) / nrow(df)))## Banks with beta available: 4602 / 4696 (98.0%)cat("\nbeta_uninsured distribution:\n")##
## beta_uninsured distribution:print(summary(df$beta_u_clipped))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.0000 0.2671 0.3123 0.3337 0.3774 1.0000 94df <- df %>%
mutate(
# Key ratios
mu_decimal = uninsured_deposit / total_asset, # D^U / TA
d_over_ta = (insured_deposit + uninsured_deposit) / total_asset, # D / TA
insured_share = safe_div(insured_deposit, insured_deposit + uninsured_deposit, NA_real_),
uninsured_share_d = safe_div(uninsured_deposit, insured_deposit + uninsured_deposit, NA_real_),
gross_rent = (1 - beta_u_clipped) * y_10yr,
net_rent = gross_rent - cost_u_raw,
# Franchise: F uses D/TA, then F^U = (D^U/D) * F
f_pp = ifelse(!is.na(beta_u_clipped),
pmax(net_rent * cap_factor * d_over_ta, 0) * 100, NA_real_),
f_u_pp = ifelse(!is.na(f_pp) & !is.na(uninsured_share_d),
uninsured_share_d * f_pp, NA_real_)
)
cat(sprintf("\nFranchise value (Approach A):\n"))##
## Franchise value (Approach A):cat(sprintf(" F (pp): mean=%.3f, median=%.3f\n", mean(df$f_pp, na.rm=T), median(df$f_pp, na.rm=T)))## F (pp): mean=9.479, median=9.945cat(sprintf(" F^U (pp): mean=%.3f, median=%.3f\n", mean(df$f_u_pp, na.rm=T), median(df$f_u_pp, na.rm=T)))## F^U (pp): mean=2.611, median=2.3304.3 B2. Run Value (\(v\)) and MTM Losses
# E^MV = book_equity (pp) - mtm_loss (pp) + F (pp)
# v = E^MV - F^U
df <- df %>%
mutate(
mtm_total_raw = mtm_loss_to_total_asset,
mtm_sec_raw = mtm_loss_to_total_asset - mtm_loss_total_loan_to_total_asset,
mtm_loan_raw = mtm_loss_total_loan_to_total_asset,
book_eq_raw = book_equity_to_total_asset,
cash_ratio_raw = cash_to_total_asset,
# Market-value equity (pp of assets)
emv_pp = ifelse(!is.na(f_pp), book_eq_raw - mtm_total_raw + f_pp, NA_real_),
# Run value
v_pp = ifelse(!is.na(emv_pp) & !is.na(f_u_pp), emv_pp - f_u_pp, NA_real_),
# Run possible: v < 0
run_possible = as.integer(!is.na(v_pp) & v_pp < 0)
)
cat("Run value v (pp of assets) distribution:\n")## Run value v (pp of assets) distribution:print(summary(df$v_pp))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -5.055 7.898 10.565 11.404 13.708 95.469 94cat(sprintf("\nBanks with v < 0 (run equilibrium possible): %d / %d (%.1f%%)\n",
sum(df$run_possible, na.rm=T), sum(!is.na(df$v_pp)),
100 * mean(df$run_possible, na.rm=T)))##
## Banks with v < 0 (run equilibrium possible): 34 / 4602 (0.7%)# By borrower type
cat("\nRun-possible by borrower type:\n")##
## Run-possible by borrower type:df %>%
filter(!is.na(v_pp)) %>%
group_by(borrower_type) %>%
summarise(N = n(), run_pct = round(100 * mean(run_possible), 1),
mean_v = round(mean(v_pp, na.rm=T), 3),
median_v = round(median(v_pp, na.rm=T), 3), .groups = "drop") %>%
kbl(format = "html", caption = "Run Value by Borrower Type") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
print()## <table class="table table-striped table-condensed" style="width: auto !important; margin-left: auto; margin-right: auto;">
## <caption>Run Value by Borrower Type</caption>
## <thead>
## <tr>
## <th style="text-align:left;"> borrower_type </th>
## <th style="text-align:right;"> N </th>
## <th style="text-align:right;"> run_pct </th>
## <th style="text-align:right;"> mean_v </th>
## <th style="text-align:right;"> median_v </th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td style="text-align:left;"> BTFP Only </td>
## <td style="text-align:right;"> 746 </td>
## <td style="text-align:right;"> 0.9 </td>
## <td style="text-align:right;"> 9.461 </td>
## <td style="text-align:right;"> 9.347 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Both </td>
## <td style="text-align:right;"> 546 </td>
## <td style="text-align:right;"> 1.1 </td>
## <td style="text-align:right;"> 8.662 </td>
## <td style="text-align:right;"> 8.605 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> DW Only </td>
## <td style="text-align:right;"> 824 </td>
## <td style="text-align:right;"> 0.7 </td>
## <td style="text-align:right;"> 10.897 </td>
## <td style="text-align:right;"> 10.429 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Non-Borrower </td>
## <td style="text-align:right;"> 2486 </td>
## <td style="text-align:right;"> 0.6 </td>
## <td style="text-align:right;"> 12.758 </td>
## <td style="text-align:right;"> 11.649 </td>
## </tr>
## </tbody>
## </table>4.4 B3. OMO-Eligible Securities and MTM Losses
cat("OMO-eligible securities = BTFP-eligible collateral\n")## OMO-eligible securities = BTFP-eligible collateralcat("= Treasury + Agency Debt + Agency MBS + Agency CMO\n\n")## = Treasury + Agency Debt + Agency MBS + Agency CMO# Check which OMO columns are available
omo_available <- intersect(c("omo_eligible", "btfp_eligible_book", "omo_eligible_book"),
names(df))
cat(sprintf("OMO-eligible column found: %s\n",
ifelse(length(omo_available) > 0, paste(omo_available, collapse=", "), "NONE -- reconstructing")))## OMO-eligible column found: omo_eligible# Use omo_eligible if available, otherwise reconstruct
if ("omo_eligible" %in% names(df)) {
df$omo_book <- df$omo_eligible
} else {
omo_parts <- intersect(c("treasury_security_book", "agency_debt_book",
"agency_mbs_book", "agency_cmo_book"), names(df))
if (length(omo_parts) > 0) {
df$omo_book <- rowSums(df[omo_parts], na.rm = TRUE)
} else {
df$omo_book <- 0
cat("WARNING: Could not find OMO-eligible book value columns\n")
}
}
# MTM loss on OMO-eligible
mtm_omo_candidates <- intersect(c("mtm_loss_omo_eligible", "mtm_loss_btfp_bucket",
"mtm_loss_btfp_to_total_asset"), names(df))
cat(sprintf("MTM loss on OMO column: %s\n",
ifelse(length(mtm_omo_candidates) > 0, paste(mtm_omo_candidates, collapse=", "),
"Using total MTM pro-rated")))## MTM loss on OMO column: mtm_loss_omo_eligibleif ("mtm_loss_omo_eligible" %in% names(df)) {
df$lambda_omo <- df$mtm_loss_omo_eligible
} else if ("mtm_loss_btfp_bucket" %in% names(df)) {
df$lambda_omo <- df$mtm_loss_btfp_bucket
} else {
df <- df %>%
mutate(
omo_share_of_sec = safe_div(omo_book, omo_book + 1, 0),
lambda_omo = mtm_total_raw * total_asset * omo_share_of_sec / 100
)
cat("Using pro-rated MTM loss for OMO-eligible\n")
}
# Market value of OMO-eligible = book - loss
df <- df %>%
mutate(omo_mv = pmax(omo_book - lambda_omo, 0))
cat(sprintf("\nOMO-eligible book (mean): $%s\n",
format(round(mean(df$omo_book, na.rm=T)), big.mark = ",")))##
## OMO-eligible book (mean): $315,023cat(sprintf("OMO-eligible MTM loss (mean): $%s\n",
format(round(mean(df$lambda_omo, na.rm=T)), big.mark = ",")))## OMO-eligible MTM loss (mean): $32,318cat(sprintf("OMO-eligible market value (mean): $%s\n",
format(round(mean(df$omo_mv, na.rm=T)), big.mark = ",")))## OMO-eligible market value (mean): $283,8814.5 B4. Compute \(\phi\) (Pre-Crisis Liquidity Coverage)
cat("PRE-CRISIS LIQUIDITY COVERAGE: phi\n\n")## PRE-CRISIS LIQUIDITY COVERAGE: phicat("Formula:\n")## Formula:cat(" phi = (C + S^OMO_MV) / D^U\n\n")## phi = (C + S^OMO_MV) / D^Ucat("This measures how much of the uninsured deposit base the bank\n")## This measures how much of the uninsured deposit base the bankcat("can cover using its own pre-crisis liquid resources (cash +\n")## can cover using its own pre-crisis liquid resources (cash +cat("market value of pledgeable securities), WITHOUT borrowing.\n\n")## market value of pledgeable securities), WITHOUT borrowing.cat("Borrowing intensity g/D^U is tracked separately.\n")## Borrowing intensity g/D^U is tracked separately.cat("We do NOT add g to the numerator because g is obtained by\n")## We do NOT add g to the numerator because g is obtained bycat("pledging the same securities already in S^OMO_MV.\n")## pledging the same securities already in S^OMO_MV.cat("Including both would double-count.\n\n")## Including both would double-count.df <- df %>%
mutate(
C = replace_na(cash, 0),
D_U = replace_na(uninsured_deposit, 0),
D = replace_na(insured_deposit, 0) + D_U,
# g in $000s to match call report units
g_000 = g / 1000,
# phi = pre-crisis coverage (NO g in numerator)
phi_num = C + omo_mv,
phi = safe_div(phi_num, D_U, NA_real_),
# Borrowing intensity (separate measure)
g_over_du = safe_div(g_000, D_U, NA_real_),
# Components of phi
phi_C = safe_div(C, D_U, NA_real_),
phi_omo = safe_div(omo_mv, D_U, NA_real_)
)
borrowers <- df %>% filter(g > 0)
cat(sprintf("phi distribution (ALL %d banks):\n", nrow(df)))## phi distribution (ALL 4696 banks):print(summary(df$phi))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 3.740e-03 3.326e-01 6.305e-01 2.339e+00 1.193e+00 2.698e+03 74cat(sprintf("\nphi distribution (BORROWERS, n=%d):\n", nrow(borrowers)))##
## phi distribution (BORROWERS, n=2131):print(summary(borrowers$phi))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 3.212e-02 2.811e-01 5.170e-01 2.648e+00 9.044e-01 2.698e+03 5cat(sprintf("\nphi distribution (NON-BORROWERS, n=%d):\n", sum(df$g == 0)))##
## phi distribution (NON-BORROWERS, n=2565):print(summary(df$phi[df$g == 0]))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.00374 0.38741 0.76003 2.07580 1.56798 386.18630 69cat(sprintf("\nBorrowing intensity g/D^U (borrowers only):\n"))##
## Borrowing intensity g/D^U (borrowers only):print(summary(borrowers$g_over_du))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.000000 0.000155 0.101399 0.734012 0.515102 91.824645 5cat(sprintf("\nBanks with phi < 1 (cannot cover full run pre-crisis): %d / %d (%.1f%%)\n",
sum(df$phi < 1, na.rm=T), sum(!is.na(df$phi)),
100 * mean(df$phi < 1, na.rm=T)))##
## Banks with phi < 1 (cannot cover full run pre-crisis): 3167 / 4622 (68.5%)cat(sprintf("Among borrowers: %d / %d (%.1f%%)\n",
sum(borrowers$phi < 1, na.rm=T), sum(!is.na(borrowers$phi)),
100 * mean(borrowers$phi < 1, na.rm=T)))## Among borrowers: 1670 / 2126 (78.6%)4.5.1 B4b. \(\phi\) by Usage Flag
phi_flag <- df %>%
group_by(borrower_type) %>%
summarise(
N = n(),
`Mean phi` = round(mean(phi, na.rm=T), 4),
`Median phi` = round(median(phi, na.rm=T), 4),
`Std phi` = round(sd(phi, na.rm=T), 4),
`Mean g/D^U` = round(mean(g_over_du, na.rm=T), 4),
`Mean C/D^U` = round(mean(phi_C, na.rm=T), 4),
`Mean OMO/D^U` = round(mean(phi_omo, na.rm=T), 4),
`Mean v (pp)` = round(mean(v_pp, na.rm=T), 3),
`Run % (v<0)` = round(100*mean(run_possible, na.rm=T), 1),
.groups = "drop"
)
kbl(phi_flag, format = "html",
caption = "Pre-Crisis Liquidity Coverage (phi) and Borrowing Intensity by Group") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "phi = (C + S^OMO_MV) / D^U measures pre-crisis coverage.
g/D^U measures borrowing intensity (separate, not added to phi).
Non-borrowers have g/D^U = 0 by definition.")| borrower_type | N | Mean phi | Median phi | Std phi | Mean g/D^U | Mean C/D^U | Mean OMO/D^U | Mean v (pp) | Run % (v<0) |
|---|---|---|---|---|---|---|---|---|---|
| BTFP Only | 754 | 0.8807 | 0.5960 | 1.2027 | 0.8147 | 0.3194 | 0.5612 | 9.461 | 0.9 |
| Both | 551 | 0.6299 | 0.4386 | 0.7079 | 1.0115 | 0.2125 | 0.4175 | 8.662 | 1.1 |
| DW Only | 826 | 5.6134 | 0.4995 | 99.3965 | 0.4745 | 4.8621 | 0.7512 | 10.897 | 0.7 |
| Non-Borrower | 2565 | 2.0758 | 0.7600 | 11.1939 | 0.0000 | 1.3691 | 0.7113 | 12.758 | 0.6 |
| Note: | |||||||||
|
phi = (C + S^OMO_MV) / D^U measures pre-crisis coverage. g/D^U measures borrowing intensity (separate, not added to phi). Non-borrowers have g/D^U = 0 by definition. |
save_kbl_latex(phi_flag, "Table_Phi_ByFacility",
caption = "Pre-Crisis Liquidity Coverage and Borrowing Intensity")## Saved: Table_Phi_ByFacility.tex4.6 B5. \(\phi\) Decomposition
decomp <- tibble(
Component = c("C / D^U (cash)", "OMO_MV / D^U (securities)",
"phi (pre-crisis coverage)", "g / D^U (borrowing intensity)"),
Mean = c(mean(borrowers$phi_C, na.rm=T), mean(borrowers$phi_omo, na.rm=T),
mean(borrowers$phi, na.rm=T), mean(borrowers$g_over_du, na.rm=T)),
Median = c(median(borrowers$phi_C, na.rm=T), median(borrowers$phi_omo, na.rm=T),
median(borrowers$phi, na.rm=T), median(borrowers$g_over_du, na.rm=T)),
Std = c(sd(borrowers$phi_C, na.rm=T), sd(borrowers$phi_omo, na.rm=T),
sd(borrowers$phi, na.rm=T), sd(borrowers$g_over_du, na.rm=T))
) %>% mutate(across(where(is.numeric), ~round(., 4)))
kbl(decomp, format = "html", caption = "phi Decomposition and Borrowing Intensity (borrowers)") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE) %>%
footnote(general = "phi = C/D^U + OMO_MV/D^U. g/D^U is NOT part of phi (reported separately).")| Component | Mean | Median | Std |
|---|---|---|---|
| C / D^U (cash) | 2.0502 | 0.1735 | 58.9087 |
| OMO_MV / D^U (securities) | 0.5975 | 0.2664 | 3.5177 |
| phi (pre-crisis coverage) | 2.6478 | 0.5170 | 61.8700 |
| g / D^U (borrowing intensity) | 0.7340 | 0.1014 | 3.4860 |
| Note: | |||
| phi = C/D^U + OMO_MV/D^U. g/D^U is NOT part of phi (reported separately). |
save_kbl_latex(decomp, "Table_Phi_Decomposition",
caption = "phi Decomposition and Borrowing Intensity")## Saved: Table_Phi_Decomposition.tex4.7 B6. \(\phi\) by Bank Size
asset_breaks <- quantile(borrowers$total_asset, probs = c(0, .25, .50, .75, 1), na.rm = TRUE)
borrowers <- borrowers %>%
mutate(size_bucket = cut(total_asset, breaks = asset_breaks,
labels = c("Q1 (Small)", "Q2", "Q3", "Q4 (Large)"), include.lowest = TRUE))
phi_size <- borrowers %>%
group_by(size_bucket) %>%
summarise(
N = n(),
`Mean phi` = round(mean(phi, na.rm=T), 4),
`Median phi` = round(median(phi, na.rm=T), 4),
`Mean g/D^U` = round(mean(g_over_du, na.rm=T), 4),
`Mean v (pp)` = round(mean(v_pp, na.rm=T), 3),
`Run % (v<0)` = round(100*mean(run_possible, na.rm=T), 1),
.groups = "drop"
)
kbl(phi_size, format = "html", caption = "phi by Bank Size Quartile (borrowers)") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| size_bucket | N | Mean phi | Median phi | Mean g/D^U | Mean v (pp) | Run % (v<0) |
|---|---|---|---|---|---|---|
| Q1 (Small) | 533 | 1.2178 | 0.8468 | 0.8833 | 11.053 | 0.9 |
| Q2 | 533 | 5.8128 | 0.5731 | 0.7021 | 9.503 | 1.1 |
| Q3 | 532 | 0.5793 | 0.4361 | 0.6716 | 9.423 | 0.9 |
| Q4 (Large) | 533 | 2.9660 | 0.3731 | 0.6796 | 9.297 | 0.6 |
save_kbl_latex(phi_size, "Table_Phi_BySize", caption = "phi by Bank Size Quartile")## Saved: Table_Phi_BySize.tex4.8 B7. Correlations with Bank Characteristics
corr_vars <- c("phi", "g_over_du", "v_pp", "beta_u_clipped", "mtm_total_raw", "mtm_sec_raw",
"emv_pp", "f_u_pp", "book_eq_raw", "cash_ratio_raw",
"mu_decimal", "uninsured_share_d")
corr_avail <- intersect(corr_vars, names(borrowers))
corr_mat <- cor(borrowers[corr_avail], use = "pairwise.complete.obs")
phi_corr <- sort(corr_mat["phi", ], decreasing = TRUE)
corr_tbl <- tibble(Variable = names(phi_corr), `Corr with phi` = round(phi_corr, 4))
kbl(corr_tbl, format = "html", caption = "Correlation with phi (borrowers)") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Variable | Corr with phi |
|---|---|
| phi | 1.0000 |
| cash_ratio_raw | 0.2100 |
| book_eq_raw | 0.1466 |
| v_pp | 0.1142 |
| beta_u_clipped | 0.0992 |
| emv_pp | 0.0907 |
| g_over_du | 0.0260 |
| mtm_sec_raw | -0.0238 |
| f_u_pp | -0.0571 |
| mtm_total_raw | -0.0679 |
| uninsured_share_d | -0.0720 |
| mu_decimal | -0.0721 |
4.9 B8. Cross-Partial: MTM Loss \(\times\) Uninsured Franchise
cat("Testing equation (11): d^2 Pr(borrow) / d(lambda) d(F^U) > 0\n\n")## Testing equation (11): d^2 Pr(borrow) / d(lambda) d(F^U) > 0df_test <- df %>% filter(!is.na(mtm_total_raw), !is.na(f_u_pp))
df_test <- df_test %>%
mutate(
lambda_q = ntile(mtm_total_raw, 3),
lambda_q = factor(lambda_q, labels = c("Low MTM", "Med MTM", "High MTM")),
FU_q = ntile(f_u_pp, 3),
FU_q = factor(FU_q, labels = c("Low F^U", "Med F^U", "High F^U"))
)
cross <- df_test %>%
group_by(lambda_q, FU_q) %>%
summarise(
Pr_borrow = round(mean(borrowed), 4),
N = n(),
.groups = "drop"
) %>%
pivot_wider(names_from = FU_q, values_from = c(Pr_borrow, N))
kbl(cross, format = "html",
caption = "Pr(Borrow) by MTM Loss Tercile x F^U Tercile") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "Positive cross-partial: effect of MTM loss on borrowing is larger when F^U is larger.")| lambda_q | Pr_borrow_Low F^U | Pr_borrow_Med F^U | Pr_borrow_High F^U | N_Low F^U | N_Med F^U | N_High F^U |
|---|---|---|---|---|---|---|
| Low MTM | 0.3034 | 0.3625 | 0.4208 | 524 | 480 | 530 |
| Med MTM | 0.4190 | 0.4888 | 0.5966 | 463 | 538 | 533 |
| High MTM | 0.4004 | 0.5368 | 0.6136 | 547 | 516 | 471 |
| Note: | ||||||
| Positive cross-partial: effect of MTM loss on borrowing is larger when F^U is larger. |
save_kbl_latex(cross, "Table_CrossPartial",
caption = "Pr(Borrow) by MTM Loss Tercile x Uninsured Franchise Tercile")## Saved: Table_CrossPartial.tex# Difference-in-differences
cat("\nInteraction check (High - Low MTM effect across F^U terciles):\n")##
## Interaction check (High - Low MTM effect across F^U terciles):for (fu in c("Low F^U", "Med F^U", "High F^U")) {
high <- df_test %>% filter(lambda_q == "High MTM", FU_q == fu) %>% pull(borrowed) %>% mean()
low <- df_test %>% filter(lambda_q == "Low MTM", FU_q == fu) %>% pull(borrowed) %>% mean()
cat(sprintf(" %s: Pr(borrow|High MTM) - Pr(borrow|Low MTM) = %.4f\n", fu, high - low))
}## Low F^U: Pr(borrow|High MTM) - Pr(borrow|Low MTM) = 0.0969
## Med F^U: Pr(borrow|High MTM) - Pr(borrow|Low MTM) = 0.1743
## High F^U: Pr(borrow|High MTM) - Pr(borrow|Low MTM) = 0.19284.10 B9. Run Threshold \(\lambda^\dagger\)
# lambda^dagger = E + F - F^U (in pp of assets)
df <- df %>%
mutate(
lambda_dagger_pp = book_eq_raw + f_pp - f_u_pp,
excess_loss_pp = mtm_total_raw - lambda_dagger_pp,
above_threshold = as.integer(!is.na(excess_loss_pp) & excess_loss_pp > 0)
)
cat("lambda^dagger (run threshold, pp of assets):\n")## lambda^dagger (run threshold, pp of assets):print(summary(df$lambda_dagger_pp))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 3.715 13.875 15.999 16.857 18.372 95.638 94cat(sprintf("\nBanks above run threshold (lambda > lambda^dagger): %d / %d (%.1f%%)\n",
sum(df$above_threshold, na.rm=T), sum(!is.na(df$lambda_dagger_pp)),
100 * mean(df$above_threshold, na.rm=T)))##
## Banks above run threshold (lambda > lambda^dagger): 34 / 4602 (0.7%)# By borrower type
thresh_by_type <- df %>%
filter(!is.na(lambda_dagger_pp)) %>%
group_by(borrower_type) %>%
summarise(
N = n(),
`Mean lambda^dag (pp)` = round(mean(lambda_dagger_pp, na.rm=T), 3),
`Mean excess loss (pp)` = round(mean(excess_loss_pp, na.rm=T), 3),
`% Above Threshold` = round(100*mean(above_threshold), 1),
.groups = "drop"
)
kbl(thresh_by_type, format = "html",
caption = "Run Threshold by Borrower Type") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| borrower_type | N | Mean lambda^dag (pp) | Mean excess loss (pp) | % Above Threshold |
|---|---|---|---|---|
| BTFP Only | 746 | 15.538 | -9.461 | 0.9 |
| Both | 546 | 14.657 | -8.662 | 1.1 |
| DW Only | 824 | 16.193 | -10.897 | 0.7 |
| Non-Borrower | 2486 | 17.957 | -12.758 | 0.6 |
save_kbl_latex(thresh_by_type, "Table_RunThreshold", caption = "Run Threshold by Borrower Type")## Saved: Table_RunThreshold.tex4.11 B10. Sensitivity of \(v\) to Beta
cat("Sensitivity: how v changes with different beta assumptions.\n")## Sensitivity: how v changes with different beta assumptions.cat("Uses Approach A: F = (1-beta)*r*cap_factor*(D/TA)*100.\n\n")## Uses Approach A: F = (1-beta)*r*cap_factor*(D/TA)*100.beta_grid <- c(0, 0.10, 0.20, 0.30, 0.38, 0.50, 0.60, 0.80, 1.0)
sens <- map_dfr(beta_grid, function(b) {
# Approach A: F uses d_over_ta
F_b <- (1 - b) * pmax(y_10yr * cap_factor * df$d_over_ta, 0) * 100
FU_b <- df$uninsured_share_d * F_b
emv_b <- df$book_eq_raw - df$mtm_total_raw + F_b
v_b <- emv_b - FU_b
borr_mask <- df$g > 0
tibble(
beta = b,
mean_FU = round(mean(FU_b, na.rm=T), 3),
mean_v = round(mean(v_b, na.rm=T), 3),
pct_v_neg = round(100 * mean(v_b < 0, na.rm=T), 1),
mean_v_borrowers = round(mean(v_b[borr_mask], na.rm=T), 3),
pct_v_neg_borrowers = round(100 * mean(v_b[borr_mask] < 0, na.rm=T), 1)
)
})
kbl(sens, format = "html",
col.names = c("beta", "Mean F^U (pp)", "Mean v (pp)", "% v<0 (all)",
"Mean v (borr)", "% v<0 (borr)"),
caption = "Sensitivity of Run Value to Different Beta Assumptions (Approach A)") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "Higher beta = smaller franchise = lower v. When beta=1, franchise=0.")| beta | Mean F^U (pp) | Mean v (pp) | % v<0 (all) | Mean v (borr) | % v<0 (borr) |
|---|---|---|---|---|---|
| 0.00 | 6.620 | 21.957 | 0.1 | 20.186 | 0.0 |
| 0.10 | 5.958 | 20.208 | 0.1 | 18.489 | 0.0 |
| 0.20 | 5.296 | 18.460 | 0.1 | 16.792 | 0.0 |
| 0.30 | 4.634 | 16.712 | 0.2 | 15.095 | 0.1 |
| 0.38 | 4.104 | 15.313 | 0.2 | 13.738 | 0.1 |
| 0.50 | 3.310 | 13.215 | 0.3 | 11.702 | 0.3 |
| 0.60 | 2.648 | 11.466 | 0.6 | 10.005 | 0.8 |
| 0.80 | 1.324 | 7.969 | 4.1 | 6.611 | 5.6 |
| 1.00 | 0.000 | 4.472 | 18.7 | 3.217 | 22.1 |
| Note: | |||||
| Higher beta = smaller franchise = lower v. When beta=1, franchise=0. |
save_kbl_latex(sens, "Table_Sensitivity_Beta", caption = "Sensitivity of Run Value to Beta")## Saved: Table_Sensitivity_Beta.tex4.12 B11. Summary Panel: Structural Variables
summary_vars <- list(
c("Total Assets ($000s)", "total_asset"),
c("Cash ($000s)", "C"),
c("Total Deposits ($000s)", "D"),
c("Uninsured Deposits ($000s)", "D_U"),
c("D^U / D", "uninsured_share_d"),
c("Book Equity / TA (pp)", "book_eq_raw"),
c("MTM Loss / TA (pp)", "mtm_total_raw"),
c("Sec MTM Loss / TA (pp)", "mtm_sec_raw"),
c("Deposit Beta (uninsured)", "beta_u_clipped"),
c("Franchise F (pp)", "f_pp"),
c("Uninsured Franchise F^U (pp)", "f_u_pp"),
c("E^MV (pp)", "emv_pp"),
c("Run Value v (pp)", "v_pp"),
c("OMO-Eligible Book ($000s)", "omo_book"),
c("OMO-Eligible MV ($000s)", "omo_mv"),
c("phi (pre-crisis coverage)", "phi"),
c("g / D^U (borrowing intensity)", "g_over_du")
)
panel <- map_dfr(summary_vars, function(v) {
label <- v[1]; col <- v[2]
if (!col %in% names(borrowers)) return(NULL)
x <- borrowers[[col]]
tibble(
Variable = label,
Mean = round(mean(x, na.rm=T), 4),
Std = round(sd(x, na.rm=T), 4),
P10 = round(quantile(x, 0.10, na.rm=T), 4),
P25 = round(quantile(x, 0.25, na.rm=T), 4),
Median = round(median(x, na.rm=T), 4),
P75 = round(quantile(x, 0.75, na.rm=T), 4),
P90 = round(quantile(x, 0.90, na.rm=T), 4)
)
})
kbl(panel, format = "html",
caption = sprintf("Summary Statistics: Structural Variables (Borrowers, N=%d)", nrow(borrowers))) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Variable | Mean | Std | P10 | P25 | Median | P75 | P90 |
|---|---|---|---|---|---|---|---|
| Total Assets ($000s) | 4360061.8766 | 2.752284e+07 | 131978.0000 | 255914.5000 | 563092.0000 | 1506156.5000 | 4592140.0000 |
| Cash ($000s) | 260972.7611 | 2.106955e+06 | 5577.0000 | 10316.5000 | 24108.0000 | 68192.5000 | 196511.0000 |
| Total Deposits ($000s) | 3582488.7823 | 2.224189e+07 | 114549.0000 | 223791.0000 | 493465.0000 | 1272521.5000 | 4041710.0000 |
| Uninsured Deposits ($000s) | 1442063.6035 | 9.819428e+06 | 21237.0000 | 50554.5000 | 131596.0000 | 397697.0000 | 1500955.0000 |
| D^U / D | 0.2988 | 1.377000e-01 | 0.1419 | 0.2037 | 0.2792 | 0.3732 | 0.4826 |
| Book Equity / TA (pp) | 8.9792 | 3.675400e+00 | 5.2236 | 6.9679 | 8.5855 | 10.3740 | 12.8268 |
| MTM Loss / TA (pp) | 5.7621 | 2.107600e+00 | 3.1439 | 4.2839 | 5.6349 | 7.1685 | 8.6376 |
| Sec MTM Loss / TA (pp) | 2.2566 | 1.716600e+00 | 0.3316 | 0.9435 | 1.9057 | 3.2187 | 4.6755 |
| Deposit Beta (uninsured) | 0.3414 | 1.129000e-01 | 0.2337 | 0.2695 | 0.3183 | 0.3854 | 0.4756 |
| Franchise F (pp) | 9.3559 | 2.787900e+00 | 5.7413 | 7.9776 | 9.8254 | 11.2806 | 12.3052 |
| Uninsured Franchise F^U (pp) | 2.8047 | 1.628900e+00 | 1.0387 | 1.7546 | 2.5434 | 3.5915 | 4.8110 |
| E^MV (pp) | 12.6188 | 4.626200e+00 | 7.2202 | 9.6983 | 12.3756 | 15.3135 | 18.0118 |
| Run Value v (pp) | 9.8142 | 4.493700e+00 | 4.6761 | 7.1162 | 9.4873 | 12.0963 | 15.0263 |
| OMO-Eligible Book ($000s) | 533945.1023 | 4.563888e+06 | 2596.0000 | 10728.0000 | 35582.0000 | 116716.0000 | 451361.0000 |
| OMO-Eligible MV ($000s) | 477373.6953 | 3.991335e+06 | 2294.1066 | 10166.2796 | 33192.6965 | 107535.1168 | 415788.7777 |
| phi (pre-crisis coverage) | 2.6478 | 6.187000e+01 | 0.1677 | 0.2811 | 0.5170 | 0.9045 | 1.5730 |
| g / D^U (borrowing intensity) | 0.7340 | 3.486000e+00 | 0.0000 | 0.0002 | 0.1014 | 0.5151 | 1.3867 |
save_kbl_latex(panel, "Table_SummaryPanel_Structural",
caption = sprintf("Summary Statistics: Structural Variables (Borrowers, N=%d)", nrow(borrowers)))## Saved: Table_SummaryPanel_Structural.tex4.13 B12. Visualizations
# (a) Histogram of phi (pre-crisis coverage)
p_phi_hist <- ggplot(df %>% filter(!is.na(phi)),
aes(x = pmin(phi, 5))) +
geom_histogram(bins = 60, fill = "#1565C0", alpha = 0.7, color = "white") +
geom_vline(xintercept = 1, linetype = "dashed", color = "red", linewidth = 0.8) +
annotate("text", x = 1.05, y = Inf, vjust = 2, hjust = 0, label = "phi=1 (full coverage)", color = "red") +
labs(title = "Distribution of phi (All Banks)",
subtitle = "Pre-crisis liquidity coverage = (C + OMO_MV) / D^U",
x = "phi", y = "Count") +
theme_gp
# (b) phi by facility
p_phi_fac <- ggplot(df %>% filter(!is.na(phi), borrower_type != "Non-Borrower"),
aes(x = pmin(phi, 5), fill = borrower_type)) +
geom_histogram(bins = 40, alpha = 0.6, position = "identity") +
geom_vline(xintercept = 1, linetype = "dashed", color = "red") +
scale_fill_manual(values = c("DW Only"="#E53935", "BTFP Only"="#1565C0", "Both"="#7B1FA2")) +
labs(title = "phi by Facility Used (Borrowers)", x = "phi", y = "Count") + theme_gp
# (c) phi vs v
p_phi_v <- ggplot(df %>% filter(!is.na(phi), !is.na(v_pp)),
aes(x = v_pp, y = pmin(phi, 5), color = factor(borrowed))) +
geom_point(alpha = 0.3, size = 1.5) +
geom_hline(yintercept = 1, linetype = "dashed", color = "red", alpha = 0.5) +
geom_vline(xintercept = 0, linetype = "dotted", color = "grey50") +
scale_color_manual(values = c("0"="grey70", "1"="#1565C0"), labels = c("Non-Borrower", "Borrower")) +
labs(title = "phi vs Run Value v",
subtitle = "phi < 1 = insufficient pre-crisis coverage; v < 0 = run possible",
x = "Run value v (pp of assets)", y = "phi", color = "") + theme_gp
# (d) g/D^U vs phi (borrowers only)
p_g_phi <- ggplot(borrowers %>% filter(!is.na(phi), !is.na(g_over_du)),
aes(x = pmin(phi, 5), y = pmin(g_over_du, 5))) +
geom_point(alpha = 0.3, size = 1.5, color = "#E53935") +
geom_smooth(method = "loess", color = "black", se = TRUE) +
geom_vline(xintercept = 1, linetype = "dashed", color = "red", alpha = 0.5) +
labs(title = "Borrowing Intensity vs Pre-Crisis Coverage",
subtitle = "Lower phi -> higher g/D^U (banks with less coverage borrow more)",
x = "phi (pre-crisis coverage)", y = "g / D^U (borrowing intensity)") + theme_gp
print((p_phi_hist | p_phi_fac) / (p_phi_v | p_g_phi))
save_figure((p_phi_hist | p_phi_fac) / (p_phi_v | p_g_phi),
"Fig_Phi_Panel", width = 16, height = 12)4.14 B13. Save Dataset
out_path <- file.path(DATA_PROC, "bank_phi_structural.csv")
save_cols <- c("idrssd", "total_asset", "C", "D", "D_U",
"book_eq_raw", "mtm_total_raw", "mtm_sec_raw", "mtm_loan_raw",
"cash_ratio_raw", "mu_decimal", "uninsured_share_d",
"beta_u_clipped", "one_minus_beta", "f_pp", "f_u_pp", "emv_pp", "v_pp",
"run_possible", "lambda_dagger_pp", "above_threshold",
"omo_book", "lambda_omo", "omo_mv",
"dw_total_borrowed", "btfp_total_borrowed", "g", "g_000",
"phi_num", "phi", "phi_C", "phi_omo", "g_over_du",
"used_dw", "used_btfp", "borrower_type", "borrowed")
save_avail <- intersect(save_cols, names(df))
write_csv(df[save_avail], out_path)
cat(sprintf("Saved %d banks (%d columns) to:\n %s\n", nrow(df), length(save_avail), out_path))## Saved 4696 banks (37 columns) to:
## C:/Users/mferdo2/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025/01_data/processed/bank_phi_structural.csv4.15 B14. Key Findings
cat("KEY FINDINGS\n\n")## KEY FINDINGScat(sprintf("1. BORROWING BEHAVIOR:\n"))## 1. BORROWING BEHAVIOR:cat(sprintf(" DW: %d transactions, %d banks\n", nrow(dw_loans), n_distinct(dw_loans$rssd_id)))## DW: 9935 transactions, 1479 bankscat(sprintf(" BTFP: %d transactions, %d banks\n", nrow(btfp_loans), n_distinct(btfp_loans$rssd_id)))## BTFP: 6695 transactions, 1316 bankscat(sprintf(" Both: %d banks\n\n", length(both_banks)))## Both: 592 bankscat(sprintf("2. PHI (pre-crisis liquidity coverage = (C + OMO_MV) / D^U):\n"))## 2. PHI (pre-crisis liquidity coverage = (C + OMO_MV) / D^U):cat(sprintf(" Mean phi (all): %.4f\n", mean(df$phi, na.rm=T)))## Mean phi (all): 2.3389cat(sprintf(" Median phi (all): %.4f\n", median(df$phi, na.rm=T)))## Median phi (all): 0.6305cat(sprintf(" Mean phi (borrowers): %.4f\n", mean(borrowers$phi, na.rm=T)))## Mean phi (borrowers): 2.6478cat(sprintf(" Median phi (borr): %.4f\n", median(borrowers$phi, na.rm=T)))## Median phi (borr): 0.5170cat(sprintf(" phi < 1 (all): %d / %d (%.1f%%)\n",
sum(df$phi < 1, na.rm=T), sum(!is.na(df$phi)),
100*mean(df$phi < 1, na.rm=T)))## phi < 1 (all): 3167 / 4622 (68.5%)cat(sprintf(" phi < 1 (borrowers): %d / %d (%.1f%%)\n\n",
sum(borrowers$phi < 1, na.rm=T), sum(!is.na(borrowers$phi)),
100*mean(borrowers$phi < 1, na.rm=T)))## phi < 1 (borrowers): 1670 / 2126 (78.6%)cat(sprintf("3. BORROWING INTENSITY (g/D^U, borrowers only):\n"))## 3. BORROWING INTENSITY (g/D^U, borrowers only):cat(sprintf(" Mean g/D^U: %.4f\n", mean(borrowers$g_over_du, na.rm=T)))## Mean g/D^U: 0.7340cat(sprintf(" Median g/D^U: %.4f\n\n", median(borrowers$g_over_du, na.rm=T)))## Median g/D^U: 0.1014cat(sprintf("4. RUN VALUE (v = E^MV - F^U, Approach A):\n"))## 4. RUN VALUE (v = E^MV - F^U, Approach A):cat(sprintf(" Banks with v < 0: %d / %d (%.1f%%)\n",
sum(df$run_possible, na.rm=T), sum(!is.na(df$v_pp)),
100*mean(df$run_possible, na.rm=T)))## Banks with v < 0: 34 / 4602 (0.7%)cat(sprintf(" Among borrowers: %d / %d (%.1f%%)\n\n",
sum(borrowers$run_possible, na.rm=T), nrow(borrowers),
100*mean(borrowers$run_possible, na.rm=T)))## Among borrowers: 19 / 2131 (0.9%)cat("5. INTERPRETATION:\n")## 5. INTERPRETATION:cat(" phi measures pre-crisis liquidity coverage. Banks with low phi\n")## phi measures pre-crisis liquidity coverage. Banks with low phicat(" had insufficient buffers and were more likely to need emergency borrowing.\n")## had insufficient buffers and were more likely to need emergency borrowing.cat(" g/D^U measures how much they actually borrowed relative to run exposure.\n")## g/D^U measures how much they actually borrowed relative to run exposure.cat(" Double-counting is avoided: phi and g/D^U are separate measures.\n")## Double-counting is avoided: phi and g/D^U are separate measures.