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_reg_latex <- function(model_list, filename, ...) {
tex_path <- file.path(TABLE_PATH, paste0(filename, ".tex"))
msummary(model_list, output = tex_path,
stars = c("*" = .10, "**" = .05, "***" = .01),
gof_omit = "AIC|BIC|Log|RMSE", ...)
cat(sprintf("Saved: %s.tex\n", filename))
}
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))
}
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/new_run_Analysis_revised")
TABLE_PATH <- file.path(OUTPUT_PATH, "tables")
FIG_PATH <- file.path(OUTPUT_PATH, "figures")
for (path in c(TABLE_PATH, FIG_PATH)) if (!dir.exists(path)) dir.create(path, recursive = TRUE)
BASELINE_MAIN <- "2022Q4"
CRISIS_START <- as.Date("2023-03-08"); CRISIS_END <- as.Date("2023-05-04")
DW_DATA_END <- as.Date("2023-12-31")
y_10yr <- 0.0392; delta_decay <- 0.10; cap_factor <- 1 / (y_10yr + delta_decay)
LOAD DATA
call_q <- read_csv(file.path(DATA_PROC, "final_call_gsib.csv"), show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd))
btfp_loans_raw <- read_csv(file.path(DATA_PROC, "btfp_loan_bank_only.csv"), show_col_types = FALSE) %>%
mutate(rssd_id = as.character(rssd_id), btfp_loan_date = mdy(btfp_loan_date))
dw_loans_raw <- read_csv(file.path(DATA_PROC, "dw_loan_bank_2023.csv"), show_col_types = FALSE) %>%
mutate(rssd_id = as.character(rssd_id), dw_loan_date = ymd(dw_loan_date))
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 <- 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 <- 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)
CONSTRUCT
VARIABLES
df_base <- call_q %>%
filter(period == BASELINE_MAIN, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
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),
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,
mtm_btfp_raw = mtm_loss_omo_eligible_to_total_asset,
uninsured_lev_raw = uninsured_deposit_to_total_asset,
uninsured_share_raw = uninsured_to_deposit,
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
roa_raw = roa,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(replace_na(fed_fund_purchase, 0) + replace_na(repo, 0) +
replace_na(other_borrowed_less_than_1yr, 0), total_liability, 0) * 100,
beta_u_clipped = pmin(pmax(ifelse(!is.na(beta_uninsured), beta_uninsured, NA_real_), 0), 1),
cost_u_raw = ifelse(!is.na(deposit_cost_uninsured), deposit_cost_uninsured, 0),
mu_decimal = uninsured_deposit / total_asset,
uninsured_share_d = safe_div(uninsured_deposit, insured_deposit + uninsured_deposit, NA_real_),
net_rent = (1 - beta_u_clipped) * y_10yr - cost_u_raw,
f_pp = ifelse(!is.na(beta_u_clipped), pmax(net_rent * cap_factor * mu_decimal, 0) * 100, NA_real_),
f_u_pp = ifelse(!is.na(f_pp) & !is.na(uninsured_share_d), uninsured_share_d * f_pp, NA_real_),
emv_pp = ifelse(!is.na(f_pp), book_equity_ratio_raw - mtm_total_raw + f_pp, NA_real_),
v_pp = ifelse(!is.na(emv_pp) & !is.na(f_u_pp), emv_pp - f_u_pp, NA_real_),
one_minus_beta = 1 - beta_u_clipped,
# Winsorize + z-score
mtm_total = standardize_z(winsorize(mtm_total_raw)),
mtm_sec = standardize_z(winsorize(mtm_sec_raw)),
mtm_loan = standardize_z(winsorize(mtm_loan_raw)),
uninsured_franchise = standardize_z(winsorize(f_u_pp)),
uninsured_lev = standardize_z(winsorize(uninsured_lev_raw)),
ln_assets = standardize_z(winsorize(ln_assets_raw)),
cash_ratio = standardize_z(winsorize(cash_ratio_raw)),
book_equity_ratio = standardize_z(winsorize(book_equity_ratio_raw)),
roa = standardize_z(winsorize(roa_raw)),
loan_to_deposit = standardize_z(winsorize(loan_to_deposit_raw)),
wholesale = standardize_z(winsorize(wholesale_raw)),
mtm_x_f_u = mtm_total * uninsured_franchise
)
CONSTRUCT DV: ρ =
Amount Borrowed / Pledged Collateral
Collateral is a pre-pledged pool at the Fed.
Banks must pre-pledge collateral at the DW before borrowing from either
BTFP or DW. Both btfp_total_collateral and
dw_total_collateral report this standing pool at each loan
record.
- Aggregation:
max() for collateral
(same pool across loans), sum() for amounts (total
drawn).
- Combined capacity: For banks using both facilities,
the pools overlap.
dw_total_collateral is the superset
(includes non-OMO).
- Units: Loan amounts & collateral in
actual dollars. Call Report in
thousands.
# ── Bank-level: MAX collateral (pool), SUM amounts (draws) ──
btfp_bank <- btfp_loans %>%
filter(btfp_loan_date >= CRISIS_START, btfp_loan_date <= CRISIS_END) %>%
group_by(rssd_id) %>%
summarise(btfp_n = n(),
btfp_amt = sum(btfp_loan_amount, na.rm = TRUE),
btfp_coll = max(btfp_total_collateral, na.rm = TRUE),
.groups = "drop") %>%
rename(idrssd = rssd_id)
dw_bank <- dw_loans %>%
filter(dw_loan_date >= CRISIS_START, dw_loan_date <= min(CRISIS_END, DW_DATA_END)) %>%
group_by(rssd_id) %>%
summarise(dw_n = n(),
dw_amt = sum(dw_loan_amount, na.rm = TRUE),
dw_coll = max(dw_total_collateral, na.rm = TRUE),
dw_omo = max(dw_omo_eligible, na.rm = TRUE),
dw_non_omo = max(dw_non_omo_eligible, na.rm = TRUE),
.groups = "drop") %>%
rename(idrssd = rssd_id)
# ── Merge and build DV ──
df <- df_base %>%
filter(!is.na(f_u_pp), total_asset > 0, is.finite(ln_assets_raw),
!is.na(uninsured_deposit), !is.na(insured_deposit), insured_deposit > 0) %>%
left_join(btfp_bank, by = "idrssd") %>%
left_join(dw_bank, by = "idrssd") %>%
mutate(
btfp_n = replace_na(btfp_n, 0L), btfp_amt = replace_na(btfp_amt, 0),
btfp_coll = replace_na(btfp_coll, 0),
dw_n = replace_na(dw_n, 0L), dw_amt = replace_na(dw_amt, 0),
dw_coll = replace_na(dw_coll, 0), dw_omo = replace_na(dw_omo, 0),
dw_non_omo = replace_na(dw_non_omo, 0),
is_btfp = as.integer(btfp_amt > 0),
is_dw = as.integer(dw_amt > 0),
is_fed = as.integer(is_btfp | is_dw),
borrower_type = case_when(
is_btfp == 1 & is_dw == 1 ~ "Both",
is_btfp == 1 ~ "BTFP Only",
is_dw == 1 ~ "DW Only",
TRUE ~ "Non-Borrower"),
total_borrowed = btfp_amt + dw_amt,
pledged_collateral = pmax(dw_coll, btfp_coll), # DW is superset
# ── THE DV ──
rho = safe_div(total_borrowed, pledged_collateral, NA_real_),
# Facility-specific
rho_btfp = safe_div(btfp_amt, btfp_coll, NA_real_),
rho_dw = safe_div(dw_amt, dw_coll, NA_real_),
# Normalized
borrowed_ta = total_borrowed / (total_asset * 1000),
collateral_ta = pledged_collateral / (total_asset * 1000),
total_n = btfp_n + dw_n,
multi_loan = as.integer(total_n > 1)
)
cat(sprintf("Full sample: %d | Fed borrowers: %d (%.1f%%)\n",
nrow(df), sum(df$is_fed), 100 * mean(df$is_fed)))
## Full sample: 4226 | Fed borrowers: 822 (19.5%)
SAMPLE
CONSTRUCTION
df_borr <- df %>% filter(is_fed == 1, !is.na(rho), rho > 0, is.finite(rho))
asset_breaks <- quantile(df$total_asset, probs = c(0, .25, .50, .75, 1), na.rm = TRUE)
df_borr <- df_borr %>%
mutate(size_bucket = cut(total_asset, breaks = asset_breaks,
labels = c("Q1 (Small)", "Q2", "Q3", "Q4 (Large)"),
include.lowest = TRUE))
med_rho <- median(df_borr$rho)
df_borr <- df_borr %>%
mutate(rho_group = ifelse(rho >= med_rho, "High ρ", "Low ρ"))
cat(sprintf("=== BORROWER SAMPLE (ρ > 0) ===\n"))
## === BORROWER SAMPLE (ρ > 0) ===
cat(sprintf(" N = %d | BTFP Only: %d | DW Only: %d | Both: %d\n",
nrow(df_borr), sum(df_borr$borrower_type == "BTFP Only"),
sum(df_borr$borrower_type == "DW Only"), sum(df_borr$borrower_type == "Both")))
## N = 822 | BTFP Only: 392 | DW Only: 326 | Both: 104
cat(sprintf(" Multi-loan: %d (%.1f%%)\n", sum(df_borr$multi_loan), 100*mean(df_borr$multi_loan)))
## Multi-loan: 406 (49.4%)
cat(sprintf(" ρ: mean=%.3f, med=%.3f, sd=%.3f, min=%.4f, max=%.4f\n",
mean(df_borr$rho), median(df_borr$rho), sd(df_borr$rho), min(df_borr$rho), max(df_borr$rho)))
## ρ: mean=1.089, med=0.714, sd=2.245, min=0.0000, max=26.7484
cat(sprintf(" ρ > 1: %d banks\n", sum(df_borr$rho > 1)))
## ρ > 1: 231 banks
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())
DESCRIPTIVE STATISTICS
4.1 DV
Distribution
rho_by_type <- df_borr %>%
group_by(borrower_type) %>%
summarise(N = n(), Mean = mean(rho), Median = median(rho), SD = sd(rho),
P25 = quantile(rho, .25), P75 = quantile(rho, .75), .groups = "drop") %>%
bind_rows(
df_borr %>% summarise(borrower_type = "All Borrowers", N = n(),
Mean = mean(rho), Median = median(rho), SD = sd(rho),
P25 = quantile(rho, .25), P75 = quantile(rho, .75))
) %>% mutate(across(where(is.numeric) & !matches("^N$"), ~ round(., 4)))
kbl(rho_by_type, format = "html", escape = FALSE,
col.names = c("Type", "N", "Mean", "Median", "SD", "P25", "P75"),
caption = "ρ = Amount Borrowed / Pledged Collateral by Facility Type") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "Collateral = pre-pledged pool (max across loans). Amount = total drawn (sum). Both in actual dollars.")
ρ = Amount Borrowed / Pledged Collateral by Facility Type
|
Type
|
N
|
Mean
|
Median
|
SD
|
P25
|
P75
|
|
BTFP Only
|
392
|
1.0761
|
0.9744
|
0.6684
|
0.7132
|
1.3965
|
|
Both
|
104
|
1.9211
|
0.9973
|
3.0590
|
0.1954
|
1.7588
|
|
DW Only
|
326
|
0.8392
|
0.0065
|
2.9899
|
0.0002
|
0.3231
|
|
All Borrowers
|
822
|
1.0891
|
0.7140
|
2.2446
|
0.0114
|
1.1332
|
|
Note:
|
|
Collateral = pre-pledged pool (max across loans). Amount =
total drawn (sum). Both in actual dollars.
|
save_kbl_latex(rho_by_type, "Table_Rho_ByType",
caption = "$\\rho$ = Amount / Pledged Collateral by Facility Type")
## Saved: Table_Rho_ByType.tex
4.2 High ρ vs Low ρ
(Median Split)
desc_vars <- c("rho", "borrowed_ta", "collateral_ta",
"ln_assets_raw", "mtm_total_raw", "mtm_sec_raw", "mtm_loan_raw",
"book_equity_ratio_raw", "cash_ratio_raw", "loan_to_deposit_raw",
"wholesale_raw", "roa_raw",
"uninsured_lev_raw", "uninsured_share_raw", "beta_u_clipped", "one_minus_beta",
"f_pp", "f_u_pp", "emv_pp", "v_pp")
desc_labels <- c("ρ (DV)", "Borrowed/TA", "Collateral/TA",
"Log(Assets)", "Total MTM (ℓ)", "Securities MTM (ℓ_S)", "Loan MTM (ℓ_L)",
"Book Equity (e)", "Cash/TA", "Loan/Deposit",
"Wholesale (%)", "ROA",
"Uninsured/TA (μ)", "D^U/D", "β^U", "1 − β^U",
"Franchise (f)", "Unins. Franchise (f^U)", "MV Equity (E^MV)", "Run Value (v)")
split_tbl <- map_dfr(seq_along(desc_vars), function(i) {
v <- desc_vars[i]
h <- df_borr[[v]][df_borr$rho_group == "High ρ"]
l <- df_borr[[v]][df_borr$rho_group == "Low ρ"]
tt <- tryCatch(t.test(h, l), error = function(e) NULL)
p_val <- if (!is.null(tt)) tt$p.value else NA_real_
tibble(Variable = desc_labels[i],
`High ρ` = sprintf("%.3f (%.3f)", mean(h, na.rm=T), sd(h, na.rm=T)),
`Low ρ` = sprintf("%.3f (%.3f)", mean(l, na.rm=T), sd(l, na.rm=T)),
Diff = mean(h, na.rm=T) - mean(l, na.rm=T),
p = p_val, Stars = format_pval(p_val))
}) %>% mutate(Difference = sprintf("%.3f%s", round(Diff, 3), Stars))
kbl(split_tbl %>% select(Variable, `High ρ`, `Low ρ`, Difference),
format = "html", escape = FALSE,
col.names = c("Variable",
sprintf("High ρ ≥ %.3f (N=%d)", med_rho, sum(df_borr$rho_group == "High ρ")),
sprintf("Low ρ < %.3f (N=%d)", med_rho, sum(df_borr$rho_group == "Low ρ")),
"Difference"),
caption = sprintf("Above vs Below Median ρ (median = %.4f)", med_rho)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
footnote(general = "*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).")
Above vs Below Median ρ (median = 0.7140)
|
Variable
|
High ρ ≥ 0.714 (N=411)
|
Low ρ < 0.714 (N=411)
|
Difference
|
|
ρ (DV)
|
2.022 (2.880)
|
0.156 (0.222)
|
1.867***
|
|
Borrowed/TA
|
0.155 (0.369)
|
0.011 (0.026)
|
0.144***
|
|
Collateral/TA
|
0.064 (0.066)
|
0.064 (0.077)
|
-0.000
|
|
Log(Assets)
|
13.598 (1.405)
|
13.944 (1.620)
|
-0.346***
|
|
Total MTM (ℓ)
|
6.142 (1.900)
|
5.729 (2.035)
|
0.412***
|
|
Securities MTM (ℓ_S)
|
2.608 (1.711)
|
2.185 (1.512)
|
0.423***
|
|
Loan MTM (ℓ_L)
|
3.534 (1.538)
|
3.545 (1.621)
|
-0.011
|
|
Book Equity (e)
|
8.220 (3.040)
|
8.949 (3.141)
|
-0.729***
|
|
Cash/TA
|
4.468 (4.640)
|
6.035 (6.186)
|
-1.566***
|
|
Loan/Deposit
|
73.246 (20.032)
|
75.187 (19.564)
|
-1.941
|
|
Wholesale (%)
|
1.789 (3.537)
|
1.269 (3.406)
|
0.520**
|
|
ROA
|
1.048 (0.569)
|
1.139 (0.600)
|
-0.091**
|
|
Uninsured/TA (μ)
|
26.887 (12.156)
|
27.379 (11.976)
|
-0.492
|
|
D^U/D
|
31.593 (14.171)
|
32.040 (14.245)
|
-0.447
|
|
β^U
|
0.347 (0.118)
|
0.338 (0.111)
|
0.009
|
|
1 − β^U
|
0.653 (0.118)
|
0.662 (0.111)
|
-0.009
|
|
Franchise (f)
|
2.897 (1.644)
|
3.008 (1.676)
|
-0.111
|
|
Unins. Franchise (f^U)
|
1.086 (1.102)
|
1.127 (1.104)
|
-0.041
|
|
MV Equity (E^MV)
|
4.976 (4.121)
|
6.228 (4.480)
|
-1.252***
|
|
Run Value (v)
|
3.890 (3.866)
|
5.101 (4.164)
|
-1.211***
|
|
Note:
|
|
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).
|
save_kbl_latex(split_tbl %>% select(Variable, `High ρ`, `Low ρ`, Difference),
"Table_Desc_RhoMedianSplit", caption = "Above vs Below Median $\\rho$")
## Saved: Table_Desc_RhoMedianSplit.tex
4.3 ρ by Size
Bucket
size_tbl <- df_borr %>%
group_by(size_bucket) %>%
summarise(N = n(), `ρ Mean` = round(mean(rho), 4), `ρ Median` = round(median(rho), 4),
`ρ SD` = round(sd(rho), 4),
`ℓ` = round(mean(mtm_total_raw, na.rm=T), 3), `ℓ_S` = round(mean(mtm_sec_raw, na.rm=T), 3),
`f^U` = round(mean(f_u_pp, na.rm=T), 3), `Cash/TA` = round(mean(cash_ratio_raw, na.rm=T), 3),
`v` = round(mean(v_pp, na.rm=T), 3), `Multi %` = round(100*mean(multi_loan), 1),
.groups = "drop")
kbl(size_tbl, format = "html", escape = FALSE,
caption = "ρ by Asset Size Quartile (from full sample)") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
ρ by Asset Size Quartile (from full sample)
|
size_bucket
|
N
|
ρ Mean
|
ρ Median
|
ρ SD
|
ℓ
|
ℓ_S
|
f^U
|
Cash/TA
|
v
|
Multi %
|
|
Q1 (Small)
|
61
|
1.0778
|
0.8425
|
1.4845
|
5.808
|
2.809
|
0.615
|
6.842
|
4.377
|
41.0
|
|
Q2
|
137
|
0.9146
|
0.8009
|
1.4356
|
5.979
|
2.738
|
0.856
|
6.834
|
3.786
|
48.2
|
|
Q3
|
243
|
1.0885
|
0.7143
|
1.8724
|
6.173
|
2.474
|
0.917
|
5.502
|
3.866
|
46.5
|
|
Q4 (Large)
|
381
|
1.1539
|
0.6153
|
2.7480
|
5.789
|
2.158
|
1.396
|
4.268
|
5.172
|
53.0
|
save_kbl_latex(size_tbl, "Table_Rho_SizeBuckets", caption = "$\\rho$ by Size Quartile")
## Saved: Table_Rho_SizeBuckets.tex
4.4 Single vs
Multi-Loan
multi_vars <- c("rho", "borrowed_ta", "collateral_ta", "ln_assets_raw",
"mtm_total_raw", "mtm_sec_raw", "f_u_pp", "cash_ratio_raw", "v_pp")
multi_labels <- c("ρ (DV)", "Borrowed/TA", "Collateral/TA", "Log(Assets)",
"MTM (ℓ)", "Securities MTM (ℓ_S)", "f^U", "Cash/TA", "Run Value (v)")
multi_tbl <- map_dfr(seq_along(multi_vars), function(i) {
v <- multi_vars[i]
m <- df_borr[[v]][df_borr$multi_loan == 1]
s <- df_borr[[v]][df_borr$multi_loan == 0]
tt <- tryCatch(t.test(m, s), error = function(e) NULL)
p_val <- if (!is.null(tt)) tt$p.value else NA_real_
tibble(Variable = multi_labels[i],
`Multi` = sprintf("%.3f (%.3f)", mean(m, na.rm=T), sd(m, na.rm=T)),
`Single` = sprintf("%.3f (%.3f)", mean(s, na.rm=T), sd(s, na.rm=T)),
Diff = mean(m, na.rm=T) - mean(s, na.rm=T),
p = p_val, Stars = format_pval(p_val))
}) %>% mutate(Difference = sprintf("%.3f%s", round(Diff, 3), Stars))
kbl(multi_tbl %>% select(Variable, Multi, Single, Difference),
format = "html", escape = FALSE,
col.names = c("Variable", sprintf("Multi (N=%d)", sum(df_borr$multi_loan)),
sprintf("Single (N=%d)", sum(!df_borr$multi_loan)), "Difference"),
caption = "Multi-Loan vs Single-Loan Borrowers") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Multi-Loan vs Single-Loan Borrowers
|
Variable
|
Multi (N=406)
|
Single (N=416)
|
Difference
|
|
ρ (DV)
|
1.867 (2.975)
|
0.330 (0.402)
|
1.537***
|
|
Borrowed/TA
|
0.156 (0.372)
|
0.013 (0.024)
|
0.143***
|
|
Collateral/TA
|
0.080 (0.076)
|
0.048 (0.064)
|
0.031***
|
|
Log(Assets)
|
13.856 (1.497)
|
13.689 (1.549)
|
0.167
|
|
MTM (ℓ)
|
6.025 (1.991)
|
5.848 (1.964)
|
0.177
|
|
Securities MTM (ℓ_S)
|
2.550 (1.685)
|
2.246 (1.555)
|
0.305***
|
|
f^U
|
1.176 (1.229)
|
1.038 (0.960)
|
0.139*
|
|
Cash/TA
|
4.551 (4.772)
|
5.935 (6.093)
|
-1.384***
|
|
Run Value (v)
|
4.300 (4.029)
|
4.686 (4.088)
|
-0.386
|
save_kbl_latex(multi_tbl %>% select(Variable, Multi, Single, Difference),
"Table_MultiVsSingle", caption = "Multi vs Single-Loan Borrowers")
## Saved: Table_MultiVsSingle.tex
4.5 Facility-Type
Summary
fac_tbl <- df_borr %>%
group_by(borrower_type) %>%
summarise(N = n(), `ρ` = round(mean(rho), 3),
`Borrowed/TA` = round(mean(borrowed_ta, na.rm=T), 4),
`Collateral/TA` = round(mean(collateral_ta, na.rm=T), 4),
`ℓ` = round(mean(mtm_total_raw, na.rm=T), 3),
`f^U` = round(mean(f_u_pp, na.rm=T), 3),
`Cash/TA` = round(mean(cash_ratio_raw, na.rm=T), 3),
`v` = round(mean(v_pp, na.rm=T), 3),
`μ` = round(mean(uninsured_lev_raw, na.rm=T), 3),
`1−β^U` = round(mean(one_minus_beta, na.rm=T), 3),
.groups = "drop")
kbl(fac_tbl, format = "html", escape = FALSE,
caption = "Characteristics by Facility Type") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Characteristics by Facility Type
|
borrower_type
|
N
|
ρ
|
Borrowed/TA
|
Collateral/TA
|
ℓ
|
f^U
|
Cash/TA
|
v
|
μ
|
1−β^U
|
|
BTFP Only
|
392
|
1.076
|
0.0673
|
0.0590
|
6.165
|
1.054
|
4.677
|
3.904
|
26.173
|
0.663
|
|
Both
|
104
|
1.921
|
0.2157
|
0.0845
|
5.779
|
1.413
|
4.549
|
4.342
|
31.989
|
0.635
|
|
DW Only
|
326
|
0.839
|
0.0605
|
0.0626
|
5.710
|
1.071
|
6.166
|
5.256
|
26.737
|
0.659
|
save_kbl_latex(fac_tbl, "Table_FacilityType", caption = "Characteristics by Facility Type")
## Saved: Table_FacilityType.tex
REGRESSIONS
DV: \(\rho = \text{Amount
Borrowed} / \text{Pledged Collateral}\)
Predictions: \(\ell \times
f^U > 0\); Cash/TA \(<
0\).
All RHS standardized within borrower sample.
df_reg <- df_borr %>%
mutate(
mtm_total_b = standardize_z(winsorize(mtm_total_raw)),
mtm_sec_b = standardize_z(winsorize(mtm_sec_raw)),
mtm_loan_b = standardize_z(winsorize(mtm_loan_raw)),
f_u_b = standardize_z(winsorize(f_u_pp)),
cash_b = standardize_z(winsorize(cash_ratio_raw)),
ln_assets_b = standardize_z(winsorize(ln_assets_raw)),
ltd_b = standardize_z(winsorize(loan_to_deposit_raw)),
equity_b = standardize_z(winsorize(book_equity_ratio_raw)),
wholesale_b = standardize_z(winsorize(wholesale_raw)),
roa_b = standardize_z(winsorize(roa_raw)),
unins_lev_b = standardize_z(winsorize(uninsured_lev_raw)),
one_minus_beta_b = standardize_z(winsorize(one_minus_beta)),
mtm_x_fu_b = mtm_total_b * f_u_b,
sec_x_fu_b = mtm_sec_b * f_u_b,
loan_x_fu_b = mtm_loan_b * f_u_b,
mtm_x_mu_b = mtm_total_b * unins_lev_b,
mtm_x_1mbeta_b = mtm_total_b * one_minus_beta_b,
mtm_x_mu_x_1mbeta_b = mtm_total_b * unins_lev_b * one_minus_beta_b,
ln_rho = log(rho)
)
ctrl <- c("ln_assets_b", "cash_b", "ltd_b", "equity_b", "wholesale_b", "roa_b")
ctrl_str <- paste(ctrl, collapse = " + ")
coef_map <- c(
"mtm_total_b" = "ℓ (MTM Loss)", "mtm_sec_b" = "ℓ_S (Securities)",
"mtm_loan_b" = "ℓ_L (Loans)", "f_u_b" = "f^U (Unins. Franchise)",
"mtm_x_fu_b" = "ℓ × f^U (expect > 0)",
"sec_x_fu_b" = "ℓ_S × f^U", "loan_x_fu_b" = "ℓ_L × f^U",
"unins_lev_b" = "μ", "one_minus_beta_b" = "1−β^U",
"mtm_x_mu_b" = "ℓ × μ", "mtm_x_1mbeta_b" = "ℓ × (1−β^U)",
"mtm_x_mu_x_1mbeta_b" = "ℓ × μ × (1−β^U)",
"cash_b" = "Cash/TA (expect < 0)", "ln_assets_b" = "Log(Assets)",
"ltd_b" = "Loan/Dep", "equity_b" = "Equity/TA",
"wholesale_b" = "Wholesale", "roa_b" = "ROA")
cat(sprintf("Regression sample: %d\n", nrow(df_reg)))
## Regression sample: 822
5.1 Main
fml <- as.formula(paste0("rho ~ mtm_total_b + f_u_b + mtm_x_fu_b + ", ctrl_str))
reg_main <- list(
"ρ: All" = feols(fml, data = df_reg, vcov = "hetero"),
"ρ: BTFP Only" = feols(fml, data = df_reg %>% filter(borrower_type == "BTFP Only"), vcov = "hetero"),
"ρ: DW Only" = feols(fml, data = df_reg %>% filter(borrower_type == "DW Only"), vcov = "hetero"),
"ρ: Both" = feols(fml, data = df_reg %>% filter(borrower_type == "Both"), vcov = "hetero"),
"ln(ρ): All" = feols(update(fml, ln_rho ~ .), data = df_reg %>% filter(is.finite(ln_rho)), vcov = "hetero")
)
msummary(reg_main, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
coef_rename = coef_map,
title = "ρ = Amount Borrowed / Pledged Collateral",
notes = "ℓ×f^U > 0: coordination amplifies drawdown. Cash < 0: liquid banks draw less.")
ρ = Amount Borrowed / Pledged Collateral
| |
ρ: All |
ρ: BTFP Only |
ρ: DW Only |
ρ: Both |
ln(ρ): All |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
| ℓ×f^U > 0: coordination amplifies drawdown. Cash < 0: liquid banks draw less. |
| (Intercept) |
1.107*** |
1.073*** |
0.972*** |
1.501*** |
-2.402*** |
|
(0.082) |
(0.037) |
(0.202) |
(0.255) |
(0.134) |
| ℓ (MTM Loss) |
0.036 |
-0.036 |
0.145 |
-0.244 |
0.024 |
|
(0.110) |
(0.038) |
(0.235) |
(0.340) |
(0.150) |
| f^U (Unins. Franchise) |
0.182 |
-0.035 |
0.245 |
0.514* |
0.412*** |
|
(0.126) |
(0.044) |
(0.296) |
(0.295) |
(0.150) |
| ℓ × f^U (expect > 0) |
0.181 |
0.018 |
0.198 |
0.794* |
0.126 |
|
(0.125) |
(0.037) |
(0.236) |
(0.424) |
(0.128) |
| Log(Assets) |
0.014 |
-0.025 |
-0.130 |
0.122 |
-1.083*** |
|
(0.076) |
(0.042) |
(0.096) |
(0.341) |
(0.189) |
| Cash/TA (expect < 0) |
-0.268*** |
-0.038 |
-0.333*** |
-0.549* |
-1.010*** |
|
(0.069) |
(0.054) |
(0.127) |
(0.288) |
(0.174) |
| Loan/Dep |
-0.102 |
0.020 |
-0.246 |
0.209 |
-0.193 |
|
(0.124) |
(0.046) |
(0.241) |
(0.429) |
(0.186) |
| Equity/TA |
-0.016 |
0.003 |
0.006 |
-0.320 |
-0.276* |
|
(0.104) |
(0.036) |
(0.215) |
(0.427) |
(0.165) |
| Wholesale |
0.133** |
0.041 |
0.093 |
0.438 |
0.310** |
|
(0.065) |
(0.034) |
(0.135) |
(0.321) |
(0.125) |
| ROA |
-0.100 |
-0.018 |
-0.062 |
-0.313 |
-0.051 |
|
(0.074) |
(0.041) |
(0.129) |
(0.267) |
(0.144) |
| Num.Obs. |
822 |
392 |
326 |
104 |
822 |
| R2 |
0.035 |
0.016 |
0.035 |
0.167 |
0.128 |
| R2 Adj. |
0.024 |
-0.007 |
0.007 |
0.087 |
0.118 |
| Std.Errors |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
save_reg_latex(reg_main, "Table_Rho_Main", coef_rename = coef_map,
title = "$\\rho$ = Amount / Pledged Collateral")
## Saved: Table_Rho_Main.tex
5.2 Single vs
Multi-Loan
reg_multi <- list(
"All" = feols(fml, data = df_reg, vcov = "hetero"),
"Single-Loan" = feols(fml, data = df_reg %>% filter(multi_loan == 0), vcov = "hetero"),
"Multi-Loan" = feols(fml, data = df_reg %>% filter(multi_loan == 1), vcov = "hetero")
)
msummary(reg_multi, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
coef_rename = coef_map, title = "ρ: Single vs Multi-Loan")
ρ: Single vs Multi-Loan
| |
All |
Single-Loan |
Multi-Loan |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
| (Intercept) |
1.107*** |
0.338*** |
1.810*** |
|
(0.082) |
(0.019) |
(0.140) |
| ℓ (MTM Loss) |
0.036 |
-0.022 |
0.092 |
|
(0.110) |
(0.022) |
(0.205) |
| f^U (Unins. Franchise) |
0.182 |
0.026 |
0.212 |
|
(0.126) |
(0.025) |
(0.183) |
| ℓ × f^U (expect > 0) |
0.181 |
0.011 |
0.288 |
|
(0.125) |
(0.019) |
(0.220) |
| Log(Assets) |
0.014 |
-0.109*** |
0.101 |
|
(0.076) |
(0.022) |
(0.141) |
| Cash/TA (expect < 0) |
-0.268*** |
-0.071*** |
-0.305** |
|
(0.069) |
(0.019) |
(0.140) |
| Loan/Dep |
-0.102 |
0.009 |
-0.133 |
|
(0.124) |
(0.026) |
(0.214) |
| Equity/TA |
-0.016 |
-0.069*** |
-0.007 |
|
(0.104) |
(0.022) |
(0.173) |
| Wholesale |
0.133** |
0.019 |
0.099 |
|
(0.065) |
(0.022) |
(0.104) |
| ROA |
-0.100 |
0.005 |
-0.181 |
|
(0.074) |
(0.021) |
(0.145) |
| Num.Obs. |
822 |
416 |
406 |
| R2 |
0.035 |
0.125 |
0.035 |
| R2 Adj. |
0.024 |
0.106 |
0.013 |
| Std.Errors |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
save_reg_latex(reg_multi, "Table_Rho_MultiVsSingle", coef_rename = coef_map)
## Saved: Table_Rho_MultiVsSingle.tex
5.3 Signal: ℓ_S vs
ℓ_L × f^U
fml_sig <- as.formula(paste0(
"rho ~ mtm_sec_b + mtm_loan_b + f_u_b + sec_x_fu_b + loan_x_fu_b + ", ctrl_str))
reg_sig <- list(
"ℓ × f^U" = feols(fml, data = df_reg, vcov = "hetero"),
"ℓ_S/ℓ_L × f^U" = feols(fml_sig, data = df_reg, vcov = "hetero"),
"BTFP+Both" = feols(fml_sig, data = df_reg %>% filter(borrower_type != "DW Only"), vcov = "hetero"),
"DW+Both" = feols(fml_sig, data = df_reg %>% filter(borrower_type != "BTFP Only"), vcov = "hetero")
)
msummary(reg_sig, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
coef_rename = coef_map, title = "ρ: Securities vs Loan Signal")
ρ: Securities vs Loan Signal
| |
ℓ × f^U |
ℓ_S/ℓ_L × f^U |
BTFP+Both |
DW+Both |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
| (Intercept) |
1.107*** |
1.139*** |
1.250*** |
1.222*** |
|
(0.082) |
(0.092) |
(0.075) |
(0.168) |
| ℓ (MTM Loss) |
0.036 |
|
|
|
|
(0.110) |
|
|
|
| f^U (Unins. Franchise) |
0.182 |
0.187 |
0.142 |
0.305 |
|
(0.126) |
(0.128) |
(0.111) |
(0.220) |
| ℓ × f^U (expect > 0) |
0.181 |
|
|
|
|
(0.125) |
|
|
|
| Log(Assets) |
0.014 |
0.043 |
0.090 |
0.067 |
|
(0.076) |
(0.080) |
(0.106) |
(0.133) |
| Cash/TA (expect < 0) |
-0.268*** |
-0.243*** |
-0.131 |
-0.323** |
|
(0.069) |
(0.078) |
(0.095) |
(0.143) |
| Loan/Dep |
-0.102 |
-0.071 |
0.123 |
-0.123 |
|
(0.124) |
(0.137) |
(0.136) |
(0.277) |
| Equity/TA |
-0.016 |
-0.004 |
-0.010 |
-0.032 |
|
(0.104) |
(0.108) |
(0.081) |
(0.187) |
| Wholesale |
0.133** |
0.125** |
0.127* |
0.191 |
|
(0.065) |
(0.063) |
(0.071) |
(0.129) |
| ROA |
-0.100 |
-0.102 |
-0.113 |
-0.125 |
|
(0.074) |
(0.076) |
(0.084) |
(0.129) |
| ℓ_S (Securities) |
|
0.075 |
0.079 |
0.213 |
|
|
(0.183) |
(0.116) |
(0.381) |
| ℓ_L (Loans) |
|
0.103 |
-0.061 |
0.126 |
|
|
(0.141) |
(0.088) |
(0.212) |
| ℓ_S × f^U |
|
-0.032 |
0.163 |
-0.020 |
|
|
(0.130) |
(0.161) |
(0.225) |
| ℓ_L × f^U |
|
0.373* |
0.180* |
0.570* |
|
|
(0.204) |
(0.097) |
(0.305) |
| Num.Obs. |
822 |
822 |
496 |
430 |
| R2 |
0.035 |
0.052 |
0.056 |
0.083 |
| R2 Adj. |
0.024 |
0.039 |
0.035 |
0.059 |
| Std.Errors |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
save_reg_latex(reg_sig, "Table_Rho_Signal", coef_rename = coef_map)
## Saved: Table_Rho_Signal.tex
5.4 Decomposition: ℓ
× μ × (1−β^U)
fml_d2 <- as.formula(paste0("rho ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
"mtm_x_mu_b + mtm_x_1mbeta_b + ", ctrl_str))
fml_d3 <- as.formula(paste0("rho ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
"mtm_x_mu_x_1mbeta_b + ", ctrl_str))
reg_decomp <- list(
"ℓ × f^U (baseline)" = feols(fml, data = df_reg, vcov = "hetero"),
"ℓ×μ + ℓ×(1−β^U)" = feols(fml_d2, data = df_reg, vcov = "hetero"),
"ℓ × μ × (1−β^U)" = feols(fml_d3, data = df_reg, vcov = "hetero")
)
msummary(reg_decomp, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
coef_rename = coef_map,
title = "Decomposition: ℓ × f^U → ℓ × μ × (1−β^U)",
notes = "Col 1: baseline. Col 2: separate interactions. Col 3: triple.")
Decomposition: ℓ × f^U → ℓ × μ × (1−β^U)
| |
ℓ × f^U (baseline) |
ℓ×μ + ℓ×(1−β^U) |
ℓ × μ × (1−β^U) |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
| Col 1: baseline. Col 2: separate interactions. Col 3: triple. |
| (Intercept) |
1.107*** |
1.102*** |
1.091*** |
|
(0.082) |
(0.082) |
(0.078) |
| ℓ (MTM Loss) |
0.036 |
0.049 |
0.031 |
|
(0.110) |
(0.108) |
(0.108) |
| f^U (Unins. Franchise) |
0.182 |
|
|
|
(0.126) |
|
|
| ℓ × f^U (expect > 0) |
0.181 |
|
|
|
(0.125) |
|
|
| Log(Assets) |
0.014 |
0.004 |
0.007 |
|
(0.076) |
(0.068) |
(0.069) |
| Cash/TA (expect < 0) |
-0.268*** |
-0.267*** |
-0.291*** |
|
(0.069) |
(0.071) |
(0.064) |
| Loan/Dep |
-0.102 |
-0.107 |
-0.132 |
|
(0.124) |
(0.123) |
(0.116) |
| Equity/TA |
-0.016 |
-0.009 |
-0.021 |
|
(0.104) |
(0.099) |
(0.109) |
| Wholesale |
0.133** |
0.137** |
0.144** |
|
(0.065) |
(0.062) |
(0.063) |
| ROA |
-0.100 |
-0.106 |
-0.092 |
|
(0.074) |
(0.076) |
(0.071) |
| μ |
|
0.169 |
0.162* |
|
|
(0.106) |
(0.092) |
| 1−β^U |
|
-0.006 |
-0.033 |
|
|
(0.100) |
(0.084) |
| ℓ × μ |
|
0.139 |
|
|
|
(0.102) |
|
| ℓ × (1−β^U) |
|
0.066 |
|
|
|
(0.087) |
|
| ℓ × μ × (1−β^U) |
|
|
-0.031 |
|
|
|
(0.032) |
| Num.Obs. |
822 |
822 |
822 |
| R2 |
0.035 |
0.034 |
0.029 |
| R2 Adj. |
0.024 |
0.020 |
0.017 |
| Std.Errors |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
Heteroskedasticity-robust |
save_reg_latex(reg_decomp, "Table_Rho_Decomposition", coef_rename = coef_map)
## Saved: Table_Rho_Decomposition.tex
PLOTS
6.1 ρ
Distribution
p1 <- ggplot(df_borr, aes(x = rho)) +
geom_histogram(aes(y = after_stat(density)), bins = 40, fill = "#1565C0", alpha = 0.6) +
geom_density(linewidth = 0.8, color = "#C62828") +
geom_vline(xintercept = med_rho, linetype = "dashed") +
annotate("text", x = med_rho + 0.03, y = Inf, vjust = 2,
label = sprintf("Median = %.3f", med_rho), size = 3.5) +
labs(title = "Distribution of ρ = Borrowed / Pledged Collateral",
x = "ρ", y = "Density") + theme_gp
p2 <- ggplot(df_borr, aes(x = rho, fill = borrower_type, color = borrower_type)) +
geom_density(alpha = 0.3, linewidth = 0.7) +
scale_fill_manual(values = c("BTFP Only"="#1565C0","DW Only"="#E53935","Both"="#6A1B9A")) +
scale_color_manual(values = c("BTFP Only"="#1565C0","DW Only"="#E53935","Both"="#6A1B9A")) +
labs(title = "ρ by Facility Type", x = "ρ", y = "Density") + theme_gp
print(p1 + p2)
save_figure(p1 + p2, "Fig_Rho_Distribution", width = 14, height = 6)
6.2 ρ by Size
ggplot(df_borr, aes(x = size_bucket, y = rho, fill = size_bucket)) +
geom_boxplot(alpha = 0.7, outlier.alpha = 0.3) +
labs(title = "ρ by Size Quartile", x = NULL, y = "ρ") +
theme_gp + theme(legend.position = "none")
6.3 ρ vs ℓ × f^U and
Cash
p4 <- ggplot(df_reg, aes(x = mtm_x_fu_b, y = rho)) +
geom_point(aes(color = borrower_type), alpha = 0.5, size = 2) +
geom_smooth(method = "lm", color = "black", se = TRUE, linewidth = 0.8) +
scale_color_manual(values = c("BTFP Only"="#1565C0","DW Only"="#E53935","Both"="#6A1B9A"), name = NULL) +
labs(title = "ρ vs ℓ × f^U", x = "ℓ × f^U (z-score)", y = "ρ") + theme_gp
p5 <- ggplot(df_reg, aes(x = cash_b, y = rho)) +
geom_point(aes(color = borrower_type), alpha = 0.5, size = 2) +
geom_smooth(method = "lm", color = "black", se = TRUE, linewidth = 0.8) +
scale_color_manual(values = c("BTFP Only"="#1565C0","DW Only"="#E53935","Both"="#6A1B9A"), name = NULL) +
labs(title = "ρ vs Cash/TA", x = "Cash/TA (z-score)", y = "ρ") + theme_gp
print(p4 + p5)
save_figure(p4 + p5, "Fig_Rho_Scatter", width = 14, height = 6)
6.4 ρ vs Run
Value
ggplot(df_reg, aes(x = v_pp, y = rho)) +
geom_point(aes(color = borrower_type), alpha = 0.4, size = 2) +
geom_smooth(method = "lm", color = "black", se = TRUE, linewidth = 0.8) +
geom_vline(xintercept = 0, linetype = "dashed") +
scale_color_manual(values = c("BTFP Only"="#1565C0","DW Only"="#E53935","Both"="#6A1B9A"), name = NULL) +
labs(title = "ρ vs Run Value (v = E^MV − F^U)",
subtitle = "v < 0: run equilibrium possible → expect higher ρ.",
x = "v (pp of TA)", y = "ρ") + theme_gp
Rpubs Link : [to be
updated]