1 SETUP

1.1 Packages

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)
cat("All packages loaded.\n")
## All packages loaded.

1.2 Helpers

winsorize <- function(x, probs = c(0.025, 0.975)) {
  if (all(is.na(x))) return(x)
  q <- quantile(x, probs = probs, na.rm = TRUE, names = FALSE)
  pmax(pmin(x, q[2]), q[1])
}

standardize_z <- function(x) {
  if (all(is.na(x))) return(x)
  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")
}

dv_summary_rows <- function(model_list) {
  stats <- lapply(model_list, function(m) {
    y <- fitted(m) + resid(m)
    c(N_DV1 = sum(round(y) == 1, na.rm = TRUE),
      Mean_DV = round(mean(y, na.rm = TRUE), 4))
  })
  df <- data.frame(term = c("N (DV = 1)", "Mean (DV)"), stringsAsFactors = FALSE)
  for (nm in names(stats)) df[[nm]] <- as.character(stats[[nm]])
  df
}

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))
}

# ── Reusable function: descriptive comparison table ──
make_desc_comparison <- function(df, group_var, group_high, group_low,
                                 vars, labels) {
  map_dfr(seq_along(vars), function(i) {
    v <- vars[i]
    h <- df[[v]][df[[group_var]] == group_high]
    l <- df[[v]][df[[group_var]] == group_low]
    n_h <- sum(!is.na(h)); n_l <- sum(!is.na(l))
    tt <- tryCatch(t.test(h, l), error = function(e) NULL)
    p_val <- if (!is.null(tt)) tt$p.value else NA_real_
    tibble(
      Variable  = labels[i],
      High      = sprintf("%.3f (%.3f)", mean(h, na.rm = TRUE), sd(h, na.rm = TRUE)),
      Low       = sprintf("%.3f (%.3f)", mean(l, na.rm = TRUE), sd(l, na.rm = TRUE)),
      Diff      = round(mean(h, na.rm = TRUE) - mean(l, na.rm = TRUE), 3),
      p         = p_val,
      Stars     = format_pval(p_val)
    )
  }) %>%
    mutate(Difference = sprintf("%.3f%s", Diff, Stars))
}

1.3 Paths & Dates

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"; BASELINE_ARB <- "2023Q3"
CRISIS_START <- as.Date("2023-03-08"); CRISIS_END <- as.Date("2023-05-04")
ARB_START <- as.Date("2023-11-15"); ARB_END <- as.Date("2024-01-24")
DW_DATA_END <- as.Date("2023-12-31")

2 DATA LOADING

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
}
cat("Call Report:", nrow(call_q), "obs |", n_distinct(call_q$idrssd), "banks\n")
## Call Report: 75989 obs | 5074 banks

2.1 Exclusions & Borrower Indicators

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)

create_borrower_indicator <- function(loans_df, date_col, id_col, amount_col,
                                      start_date, end_date, prefix) {
  loans_df %>%
    filter(!!sym(date_col) >= start_date, !!sym(date_col) <= end_date) %>%
    group_by(!!sym(id_col)) %>%
    summarise("{prefix}" := 1L, "{prefix}_amt" := sum(!!sym(amount_col), na.rm=TRUE),
              "{prefix}_first" := min(!!sym(date_col)), .groups = "drop") %>%
    rename(idrssd = !!sym(id_col))
}

btfp_crisis <- create_borrower_indicator(btfp_loans,"btfp_loan_date","rssd_id","btfp_loan_amount",CRISIS_START,CRISIS_END,"btfp_crisis")
btfp_arb    <- create_borrower_indicator(btfp_loans,"btfp_loan_date","rssd_id","btfp_loan_amount",ARB_START,ARB_END,"btfp_arb")
dw_crisis   <- create_borrower_indicator(dw_loans,"dw_loan_date","rssd_id","dw_loan_amount",CRISIS_START,min(CRISIS_END,DW_DATA_END),"dw_crisis")
dw_arb      <- create_borrower_indicator(dw_loans,"dw_loan_date","rssd_id","dw_loan_amount",ARB_START,DW_DATA_END,"dw_arb")
cat("BTFP Crisis:", nrow(btfp_crisis), "| DW Crisis:", nrow(dw_crisis), "\n")
## BTFP Crisis: 526 | DW Crisis: 459

3 CALIBRATION & VARIABLE CONSTRUCTION

3.1 Calibration [DSSW Eq. 20]

y_10yr      <- 0.0392
delta_decay <- 0.10
cap_factor  <- 1 / (y_10yr + delta_decay)

cat("=== CALIBRATION (DSSW Eq. 20) ===\n")
## === CALIBRATION (DSSW Eq. 20) ===
cat(sprintf("  y (10yr Treasury) = %.4f\n", y_10yr))
##   y (10yr Treasury) = 0.0392
cat(sprintf("  δ (decay rate)    = %.2f\n", delta_decay))
##   δ (decay rate)    = 0.10
cat(sprintf("  Cap factor        = 1/(y+δ) = 1/%.4f = %.2f\n", y_10yr + delta_decay, cap_factor))
##   Cap factor        = 1/(y+δ) = 1/0.1392 = 7.18

3.2 Variable Construction [Theory Eq. 1–7, 12, Table 1]

construct_analysis_vars <- function(baseline_data) {
  baseline_data %>%
    mutate(
      # ── Eq. 2: MTM loss components ──
      mtm_total_raw  = mtm_loss_to_total_asset,
      mtm_loan_raw   = mtm_loss_total_loan_to_total_asset,
      mtm_sec_raw    = mtm_loss_to_total_asset - mtm_loss_total_loan_to_total_asset,
      mtm_btfp_raw   = mtm_loss_omo_eligible_to_total_asset,
      mtm_other_raw  = mtm_loss_non_omo_eligible_to_total_asset, # non omo sec + total loan
      
      # Market value of asset by types
      mv_omo_eligble_raw = omo_eligible - mtm_loss_omo_eligible,
      mv_non_omo_securities = non_omo_securities - mtm_loss_non_omo_securities,
      mv_loan_raw  = total_loan - mtm_loss_total_loan,
      
      
      # ── Balance sheet ratios ──
      uninsured_lev_raw     = uninsured_deposit_to_total_asset,
      insured_lev_raw       = r_insured_deposit,
      uninsured_share_raw   = uninsured_to_deposit,
      ln_assets_raw         = log(total_asset),
      cash_ratio_raw        = cash_to_total_asset,
      securities_ratio_raw  = security_to_total_asset,
      loan_ratio_raw        = total_loan_to_total_asset,
      book_equity_ratio_raw = book_equity_to_total_asset,
      roa_raw               = roa,
      fhlb_ratio_raw        = fhlb_to_total_asset,
      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,

      uninsured_beta_raw = ifelse(!is.na(beta_uninsured), beta_uninsured, NA_real_),
      beta_u_clipped     = pmin(pmax(uninsured_beta_raw, 0), 1),
      cost_u_raw = ifelse(!is.na(deposit_cost_uninsured), deposit_cost_uninsured, 0),
      adjusted_equity_raw = book_equity_to_total_asset - mtm_loss_to_total_asset,

      mu_decimal        = uninsured_deposit / total_asset,
      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_),

      # ── Eq. 3 (DSSW Eq. 20) ──
      gross_rent = (1 - beta_u_clipped) * y_10yr,
      net_rent   = gross_rent - cost_u_raw,
      f_decimal  = ifelse(!is.na(beta_u_clipped),
        pmax(net_rent * cap_factor * mu_decimal, 0), NA_real_),
      f_pp = ifelse(!is.na(f_decimal), f_decimal * 100, NA_real_),
      emv_pp = ifelse(!is.na(f_pp),
        book_equity_to_total_asset - mtm_total_raw + f_pp, NA_real_),
      f_u_pp = ifelse(!is.na(f_pp) & !is.na(uninsured_share_d),
        uninsured_share_d * f_pp, NA_real_),
      v_pp = ifelse(!is.na(emv_pp) & !is.na(f_u_pp),
        emv_pp - f_u_pp, NA_real_),
      threshold_run = ifelse(!is.na(f_pp) & !is.na(insured_share),
        book_equity_to_total_asset + insured_share * f_pp, NA_real_),
      liquid_buffer_raw = cash_to_total_asset + security_to_total_asset - mtm_sec_raw,
      run_possible = as.integer(!is.na(v_pp) & v_pp < 0),
      collateral_capacity_raw = omo_eligible_to_total_asset,

      # ── Winsorized ──
      mtm_total_w=winsorize(mtm_total_raw), mtm_sec_w=winsorize(mtm_sec_raw),
      mtm_loan_w=winsorize(mtm_loan_raw),
      mtm_btfp_w=winsorize(mtm_btfp_raw), mtm_other_w=winsorize(mtm_other_raw),
      uninsured_lev_w=winsorize(uninsured_lev_raw),
      insured_lev_w=winsorize(r_insured_deposit), adjusted_equity_w=winsorize(adjusted_equity_raw),
      f_pp_w=winsorize(f_pp), f_u_pp_w=winsorize(f_u_pp), emv_pp_w=winsorize(emv_pp),
      uninsured_beta_w=winsorize(uninsured_beta_raw), ln_assets_w=winsorize(ln_assets_raw),
      cash_ratio_w=winsorize(cash_ratio_raw), book_equity_ratio_w=winsorize(book_equity_ratio_raw),
      roa_w=winsorize(roa_raw), loan_to_deposit_w=winsorize(loan_to_deposit_raw),
      wholesale_w=winsorize(wholesale_raw), deposit_cost_w=winsorize(cost_u_raw),

      # ── Z-standardized ──
      mtm_total=standardize_z(mtm_total_w), mtm_sec=standardize_z(mtm_sec_w),
      mtm_loan=standardize_z(mtm_loan_w),
      mtm_btfp=standardize_z(mtm_btfp_w), mtm_other=standardize_z(mtm_other_w),
      uninsured_lev=standardize_z(uninsured_lev_w),
      insured_lev=standardize_z(insured_lev_w), adjusted_equity=standardize_z(adjusted_equity_w),
      franchise_value=standardize_z(f_pp_w), uninsured_franchise=standardize_z(f_u_pp_w),
      emv=standardize_z(emv_pp_w),
      uninsured_beta=standardize_z(uninsured_beta_w), ln_assets=standardize_z(ln_assets_w),
      cash_ratio=standardize_z(cash_ratio_w), book_equity_ratio=standardize_z(book_equity_ratio_w),
      roa=standardize_z(roa_w), loan_to_deposit=standardize_z(loan_to_deposit_w),
      wholesale=standardize_z(wholesale_w),

      mtm_x_f_u = mtm_total * uninsured_franchise
    )
}

4 BUILD DATASETS

df_2022q4 <- 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)) %>%
  construct_analysis_vars()

df_2023q3 <- call_q %>%
  filter(period == BASELINE_ARB, !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 == "2023Q3") %>% select(idrssd, is_public), by = "idrssd") %>%
  mutate(is_public = replace_na(is_public, 0L)) %>%
  construct_analysis_vars()

cat("2022Q4:", nrow(df_2022q4), "| β^U available:", sum(!is.na(df_2022q4$f_pp)), "\n")
## 2022Q4: 4292 | β^U available: 4226
join_all_borrowers <- function(df_base, btfp_df, dw_df, btfp_var, dw_var) {
  df_base %>%
    left_join(btfp_df %>% select(idrssd, starts_with(btfp_var)), by = "idrssd") %>%
    left_join(dw_df %>% select(idrssd, starts_with(dw_var)), by = "idrssd") %>%
    mutate("{btfp_var}" := replace_na(!!sym(btfp_var), 0L),
           "{dw_var}" := replace_na(!!sym(dw_var), 0L),
           fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
           any_fed = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1),
           both_fed = as.integer(!!sym(btfp_var) == 1 & !!sym(dw_var) == 1),
           fed_amt = replace_na(!!sym(paste0(btfp_var, "_amt")), 0) +
                     replace_na(!!sym(paste0(dw_var, "_amt")), 0))
}

df_crisis <- join_all_borrowers(df_2022q4, btfp_crisis, dw_crisis, "btfp_crisis", "dw_crisis")

cat("Crisis:", nrow(df_crisis), "| Any Fed:", sum(df_crisis$any_fed), "\n")
## Crisis: 4292 | Any Fed: 828

4.1 Sample Cleaning

core_vars <- c("book_equity_to_total_asset", "total_asset", "total_liability",
               "cash_to_total_asset", "security_to_total_asset",
               "total_loan_to_total_asset", "loan_to_deposit", "roa",
               "uninsured_deposit_to_total_asset", "wholesale_raw")

df_crisis_clean <- df_crisis %>%
  filter(!is.na(mtm_loss_to_total_asset)) %>%
  filter(if_all(all_of(core_vars), ~ !is.na(.))) %>%
  filter(!is.na(uninsured_deposit) & !is.na(insured_deposit) & insured_deposit > 0) %>%
  filter(!is.na(abnormal_fhlb_borrowing_10pct)) %>%
  filter(total_asset > 0 & is.finite(ln_assets_raw))

df_model <- df_crisis_clean %>% filter(!is.na(f_u_pp))

cat(sprintf("Clean: %d | Theory model (β^U available): %d\n",
    nrow(df_crisis_clean), nrow(df_model)))
## Clean: 4251 | Theory model (β^U available): 4226
cat(sprintf("Fed borrowers in model sample: %d (%.1f%%)\n",
    sum(df_model$any_fed), 100 * mean(df_model$any_fed)))
## Fed borrowers in model sample: 822 (19.5%)
borr_colors <- c("Fed Borrower" = "#C62828", "Non-Borrower" = "#1565C0")
fac_colors  <- c("BTFP" = "#1565C0", "DW" = "#E53935", "Both" = "#6A1B9A")
theme_gp <- theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold", size = 14),
        plot.subtitle = element_text(color = "grey40", size = 11),
        plot.caption = element_text(color = "grey50", size = 9, hjust = 0),
        legend.position = "bottom", panel.grid.minor = element_blank())

5 BORROWING / CAPACITY: DATA CONSTRUCTION

Key design decisions (all issues from prior review fixed):

  1. BTFP and DW analyzed separately — BTFP accepts collateral at face/par value (no MV adjustment, no haircut); DW values OMO-eligible at market value and non-OMO at market value minus haircut. Mixing them into a single ρ confounds facility choice with run severity.
  2. DW collateral: max() not sum() — DW uses a standing pre-pledged pool; multiple advances draw against the same pool. sum() double-counts. BTFP: sum() is correct because each transaction pledges separate securities.
  3. Loan amounts are in actual dollars; Call Report assets in thousands — normalizations use total_asset × 1000.
  4. ρ = 0 banks diagnosed and excluded from regressions — zero-amount draws are uninformative for revealed run expectations.
# ==============================================================================
# BTFP aggregation: SUM amounts, SUM collateral
#   Each BTFP loan pledges its own securities at FACE value.
#   ρ_BTFP = total_amount / total_face_value_of_pledged_securities
#
# DW aggregation: SUM amounts, MAX collateral
#   DW uses a standing pre-pledged pool (dw_total_collateral reports the
#   full pool at each draw). Multiple advances tap the same pool.
#   ρ_DW = total_amount / max(pool_size)
# ==============================================================================

# ── BTFP: per-loan collateral → sum both amount and collateral ──
btfp_bank <- btfp_loans %>%
  filter(btfp_loan_date >= CRISIS_START, btfp_loan_date <= CRISIS_END) %>%
  group_by(rssd_id) %>%
  summarise(
    btfp_n_loans    = n(),
    btfp_amt        = sum(btfp_loan_amount, na.rm = TRUE),
    btfp_collateral = sum(btfp_total_collateral, na.rm = TRUE),
    btfp_first_date = min(btfp_loan_date),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

# ── DW: standing pool → MAX collateral, SUM amounts ──
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_loans    = n(),
    dw_amt        = sum(dw_loan_amount, na.rm = TRUE),
    dw_collateral = 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),
    dw_first_date = min(dw_loan_date),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

# ── Merge onto model sample ──
df_cap <- df_model %>%
  left_join(btfp_bank, by = "idrssd") %>%
  left_join(dw_bank,   by = "idrssd") %>%
  mutate(
    # Explicit NA → 0 for safe math
    btfp_n_loans    = replace_na(btfp_n_loans, 0L),
    btfp_amt        = replace_na(btfp_amt, 0),
    btfp_collateral = replace_na(btfp_collateral, 0),
    dw_n_loans      = replace_na(dw_n_loans, 0L),
    dw_amt          = replace_na(dw_amt, 0),
    dw_collateral   = replace_na(dw_collateral, 0),
    dw_omo          = replace_na(dw_omo, 0),
    dw_non_omo      = replace_na(dw_non_omo, 0),
    
    # Identify Borrowers
    btfp_crisis = as.integer(btfp_amt > 0),
    dw_crisis   = as.integer(dw_amt > 0),
    any_fed     = as.integer(btfp_crisis == 1 | dw_crisis == 1)
  ) %>%
  filter(any_fed == 1) %>%
  mutate(
    # ── Facility-specific ρ ──
    rho_btfp        = safe_div(btfp_amt, btfp_collateral, NA_real_),
    rho_dw_omo      = safe_div(dw_amt,   dw_omo,          NA_real_),
    rho_dw_non_omo  = safe_div(dw_amt,   dw_non_omo,      NA_real_),
    rho_dw          = safe_div(dw_amt,   dw_collateral,   NA_real_),

    # ── Normalize by total assets (convert TA from thousands to actual dollars) ──
    btfp_amt_ta        = btfp_amt / (total_asset * 1000),
    btfp_collateral_ta = btfp_collateral / (total_asset * 1000),
    dw_amt_ta          = dw_amt / (total_asset * 1000),
    dw_collateral_ta   = dw_collateral / (total_asset * 1000),
    dw_omo_ta          = dw_omo / (total_asset * 1000),
    dw_non_omo_ta      = dw_non_omo / (total_asset * 1000),

    # ── Multi-loan flags ──
    btfp_multi = as.integer(btfp_n_loans > 1),
    dw_multi   = as.integer(dw_n_loans > 1),

    # ── Borrower-type classification ──
    borrower_type = case_when(
      btfp_crisis == 1 & dw_crisis == 1 ~ "Both",
      btfp_crisis == 1 & dw_crisis == 0 ~ "BTFP Only",
      dw_crisis == 1 & btfp_crisis == 0 ~ "DW Only",
      TRUE ~ "Other"
    ),

    # ── Decomposition ──
    one_minus_beta = 1 - beta_u_clipped
  )

# ── Size quartile breakpoints from FULL model sample (not just borrowers) ──
asset_breaks <- quantile(df_model$total_asset, probs = c(0, .25, .50, .75, 1), na.rm = TRUE)
df_cap <- df_cap %>%
  mutate(size_bucket = cut(total_asset, breaks = asset_breaks,
                           labels = c("Q1 (Small)", "Q2", "Q3", "Q4 (Large)"),
                           include.lowest = TRUE))

# ── Base BTFP- and DW-specific subsets ──
df_btfp <- df_cap %>% filter(btfp_n_loans > 0 & !is.na(rho_btfp))
df_dw   <- df_cap %>% filter(dw_n_loans   > 0 & !is.na(rho_dw))
df_cap <- df_cap %>%
  mutate(
    # 1. Convert balance sheet liquidity (thousands) to actual dollars
    cash_dollars = cash * 1000,
    
    # MV of Securities = (Book Ratio - MTM Loss Ratio) * Total Assets in Dollars
    # This precisely handles the market value adjustment for pledgeable collateral
    mv_sec_dollars = (security_to_total_asset - mtm_sec_raw) * (total_asset * 1000),
    
    # Uninsured deposits to actual dollars
    unins_dep_dollars = uninsured_deposit * 1000,
    
    # MV of Non-OMO Securities in dollars
    mv_non_omo_dollars = replace_na(mv_non_omo_securities, 0) * 1000,
    
    # 2A. REALISTIC ASSUMPTION: Run met via Cash + Actual Fed Borrowing
    w_realistic_btfp = btfp_amt + cash_dollars,
    w_realistic_dw   = dw_amt + cash_dollars,
    
    # 2B. STRICT ASSUMPTION: w = g + cash + mv_sec
    w_strict_btfp = btfp_amt + cash_dollars + mv_non_omo_dollars,
    w_strict_dw   = dw_amt + cash_dollars + mv_sec_dollars,
    
    # 3. Calculate Revealed Expected Run Rates
    run_rate_real_btfp = safe_div(w_realistic_btfp, unins_dep_dollars, NA_real_),
    run_rate_real_dw   = safe_div(w_realistic_dw, unins_dep_dollars, NA_real_),
    
    run_rate_strict_btfp = safe_div(w_strict_btfp, unins_dep_dollars, NA_real_),
    run_rate_strict_dw   = safe_div(w_strict_dw, unins_dep_dollars, NA_real_)
  )

# Propagate calculations to working subsets
df_btfp <- df_cap %>% filter(btfp_n_loans > 0 & !is.na(rho_btfp))
df_dw   <- df_cap %>% filter(dw_n_loans   > 0 & !is.na(rho_dw))
# ── Implied Run Rate by Size Bucket (BTFP) ──
run_size_btfp <- df_btfp %>%
  group_by(size_bucket) %>%
  summarise(
    N = n(),
    `Mean Borrowing/TA` = round(mean(btfp_amt_ta, na.rm=T), 4),
    `Mean Cash/TA` = round(mean(cash_ratio_raw, na.rm=T), 4),
    `Realistic Run % (Cash+Borrowing)` = round(mean(run_rate_real_btfp, na.rm=T) * 100, 2),
    `Strict Run % (Cash+Borrowing+MV Sec)` = round(mean(run_rate_strict_btfp, na.rm=T) * 100, 2),
    .groups = "drop"
  )

kbl(run_size_btfp, format = "html", escape = FALSE,
    caption = "BTFP Borrowers: Revealed Run Expectations by Size") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
BTFP Borrowers: Revealed Run Expectations by Size
size_bucket N Mean Borrowing/TA Mean Cash/TA Realistic Run % (Cash+Borrowing) Strict Run % (Cash+Borrowing+MV Sec)
Q1 (Small) 39 0.0752 7.0580 84.94 190.86
Q2 89 0.0632 5.9035 56.33 133.70
Q3 143 0.0587 4.3116 51.44 148.36
Q4 (Large) 225 0.0710 3.9528 53.05 100.25 
# ── Implied Run Rate by Size Bucket (DW) ──
run_size_dw <- df_dw %>%
  group_by(size_bucket) %>%
  summarise(
    N = n(),
    `Mean Borrowing/TA` = round(mean(dw_amt_ta, na.rm=T), 4),
    `Mean Cash/TA` = round(mean(cash_ratio_raw, na.rm=T), 4),
    `Realistic Run % (Cash+Borrowing)` = round(mean(run_rate_real_dw, na.rm=T) * 100, 2),
    `Strict Run % (Cash+Borrowing+MV Sec)` = round(mean(run_rate_strict_dw, na.rm=T) * 100, 2),
    .groups = "drop"
  )

kbl(run_size_dw, format = "html", escape = FALSE,
    caption = "DW Borrowers: Revealed Run Expectations by Size") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
DW Borrowers: Revealed Run Expectations by Size
size_bucket N Mean Borrowing/TA Mean Cash/TA Realistic Run % (Cash+Borrowing) Strict Run % (Cash+Borrowing+MV Sec)
Q1 (Small) 25 0.0690 6.8591 87.53 17978.60
Q2 59 0.0562 8.2433 68.49 13064.16
Q3 120 0.0464 6.4866 51.51 12217.55
Q4 (Large) 226 0.1105 4.6321 109.63 11657.09 
# ── Implied Run Rate: High vs Low ρ (BTFP) ──
df_btfp_valid <- df_btfp %>% filter(rho_btfp > 0 & is.finite(rho_btfp))
med_btfp <- median(df_btfp_valid$rho_btfp)
df_btfp_valid <- df_btfp_valid %>% mutate(rho_grp = ifelse(rho_btfp >= med_btfp, "High ρ", "Low ρ"))

run_rho_btfp <- df_btfp_valid %>%
  group_by(rho_grp) %>%
  summarise(
    N = n(),
    `Mean ρ` = round(mean(rho_btfp, na.rm=T), 3),
    `Realistic Run % (Cash+Borrowing)` = round(mean(run_rate_real_btfp, na.rm=T) * 100, 2),
    `Uninsured Dep / TA` = round(mean(uninsured_lev_raw, na.rm=T), 3),
    .groups = "drop"
  )

kbl(run_rho_btfp, format = "html", escape = FALSE,
    caption = "BTFP: Revealed Run Rate by High/Low Borrowing Utilization (ρ)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
BTFP: Revealed Run Rate by High/Low Borrowing Utilization (ρ)
rho_grp N Mean ρ Realistic Run % (Cash+Borrowing) Uninsured Dep / TA
High ρ 248 0.856 54.47 26.792
Low ρ 248 0.289 56.77 27.994 
cat("=== SAMPLE OVERVIEW ===\n")
## === SAMPLE OVERVIEW ===
cat(sprintf("  Total borrowers in model: %d\n", nrow(df_cap)))
##   Total borrowers in model: 822
cat(sprintf("  BTFP borrowers: %d (multi-loan: %d, %.1f%%)\n",
    nrow(df_btfp), sum(df_btfp$btfp_multi), 100 * mean(df_btfp$btfp_multi)))
##   BTFP borrowers: 496 (multi-loan: 276, 55.6%)
cat(sprintf("  DW borrowers:   %d (multi-loan: %d, %.1f%%)\n",
    nrow(df_dw), sum(df_dw$dw_multi), 100 * mean(df_dw$dw_multi)))
##   DW borrowers:   430 (multi-loan: 121, 28.1%)
cat(sprintf("  Both facilities: %d\n", sum(df_cap$borrower_type == "Both")))
##   Both facilities: 104
cat("\n=== ρ DIAGNOSTICS (before any filtering) ===\n")
## 
## === ρ DIAGNOSTICS (before any filtering) ===
cat(sprintf("  ρ_BTFP:         mean=%.3f, med=%.3f, sd=%.3f, min=%.4f, max=%.4f [N=%d]\n",
    mean(df_btfp$rho_btfp, na.rm = TRUE), median(df_btfp$rho_btfp, na.rm = TRUE), sd(df_btfp$rho_btfp, na.rm = TRUE),
    min(df_btfp$rho_btfp, na.rm = TRUE), max(df_btfp$rho_btfp, na.rm = TRUE), sum(!is.na(df_btfp$rho_btfp))))
##   ρ_BTFP:         mean=0.572, med=0.570, sd=0.325, min=0.0000, max=1.0000 [N=496]
cat(sprintf("  ρ_DW (Overall): mean=%.3f, med=%.3f, sd=%.3f, min=%.4f, max=%.4f [N=%d]\n",
    mean(df_dw$rho_dw, na.rm = TRUE), median(df_dw$rho_dw, na.rm = TRUE), sd(df_dw$rho_dw, na.rm = TRUE),
    min(df_dw$rho_dw, na.rm = TRUE), max(df_dw$rho_dw, na.rm = TRUE), sum(!is.na(df_dw$rho_dw))))
##   ρ_DW (Overall): mean=0.969, med=0.013, sd=3.134, min=0.0000, max=26.7484 [N=430]
cat(sprintf("  ρ_DW (OMO):     mean=%.3f, med=%.3f, sd=%.3f, min=%.4f, max=%.4f [N=%d]\n",
    mean(df_dw$rho_dw_omo, na.rm = TRUE), median(df_dw$rho_dw_omo, na.rm = TRUE), sd(df_dw$rho_dw_omo, na.rm = TRUE),
    min(df_dw$rho_dw_omo, na.rm = TRUE), max(df_dw$rho_dw_omo, na.rm = TRUE), sum(!is.na(df_dw$rho_dw_omo))))
##   ρ_DW (OMO):     mean=886.363, med=0.130, sd=11713.504, min=0.0000, max=160585.5484 [N=188]
cat(sprintf("  ρ_DW (Non-OMO): mean=%.3f, med=%.3f, sd=%.3f, min=%.4f, max=%.4f [N=%d]\n",
    mean(df_dw$rho_dw_non_omo, na.rm = TRUE), median(df_dw$rho_dw_non_omo, na.rm = TRUE), sd(df_dw$rho_dw_non_omo, na.rm = TRUE),
    min(df_dw$rho_dw_non_omo, na.rm = TRUE), max(df_dw$rho_dw_non_omo, na.rm = TRUE), sum(!is.na(df_dw$rho_dw_non_omo))))
##   ρ_DW (Non-OMO): mean=7.225, med=0.007, sd=69.960, min=0.0000, max=1074.3770 [N=313]
cat("\n=== EDGE-CASE DIAGNOSTICS ===\n")
## 
## === EDGE-CASE DIAGNOSTICS ===
cat(sprintf("  BTFP: amt=0: %d | collateral=0: %d | ρ>1: %d\n",
    sum(df_btfp$btfp_amt == 0), sum(df_btfp$btfp_collateral == 0),
    sum(df_btfp$rho_btfp > 1, na.rm = TRUE)))
##   BTFP: amt=0: 0 | collateral=0: 0 | ρ>1: 0
cat(sprintf("  DW:   amt=0: %d | collateral=0: %d | ρ>1: %d\n",
    sum(df_dw$dw_amt == 0), sum(df_dw$dw_collateral == 0),
    sum(df_dw$rho_dw > 1, na.rm = TRUE)))
##   DW:   amt=0: 0 | collateral=0: 0 | ρ>1: 63
cat("\n=== COLLATERAL AGGREGATION CHECK (DW multi-loan) ===\n")
## 
## === COLLATERAL AGGREGATION CHECK (DW multi-loan) ===
dw_multi_check <- df_dw %>% filter(dw_multi == 1)
dw_single_check <- df_dw %>% filter(dw_multi == 0)
cat(sprintf("  DW single-loan: mean collateral/TA = %.4f [N=%d]\n",
    mean(dw_single_check$dw_collateral_ta), nrow(dw_single_check)))
##   DW single-loan: mean collateral/TA = 0.0498 [N=309]
cat(sprintf("  DW multi-loan:  mean collateral/TA = %.4f [N=%d]\n",
    mean(dw_multi_check$dw_collateral_ta), nrow(dw_multi_check)))
##   DW multi-loan:  mean collateral/TA = 0.1001 [N=121]
cat("  (Using max() — ratio should be comparable across groups.)\n")
##   (Using max() — ratio should be comparable across groups.)

6 DESCRIPTIVE STATISTICS

6.1 5.1 ρ Distribution by Facility

rho_summary_fn <- function(x, label) {
  tibble(Facility = label, N = sum(!is.na(x)),
         Mean = mean(x, na.rm=T), Median = median(x, na.rm=T),
         SD = sd(x, na.rm=T), P25 = quantile(x, .25, na.rm=T),
         P75 = quantile(x, .75, na.rm=T),
         Min = min(x, na.rm=T), Max = max(x, na.rm=T))
}

rho_stats <- bind_rows(
  rho_summary_fn(df_btfp$rho_btfp, "BTFP (Face-Value Collateral)"),
  rho_summary_fn(df_dw$rho_dw, "DW (Overall Pool)"),
  rho_summary_fn(df_dw$rho_dw_omo, "DW (OMO: Market-Value Adjusted)"),
  rho_summary_fn(df_dw$rho_dw_non_omo, "DW (Non-OMO: MV Minus Haircut)")
)

kbl(rho_stats %>% mutate(across(where(is.numeric) & !matches("^N$"), ~ round(., 4))),
    format = "html", escape = FALSE,
    caption = "Distribution of ρ by Facility") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  footnote(general = "BTFP: Collateral accepted at par/face value without MTM loss. DW: Applies MTM loss. DW OMO avoids haircut, Non-OMO applies both MTM loss and haircut.")
Distribution of ρ by Facility
Facility N Mean Median SD P25 P75 Min Max
BTFP (Face-Value Collateral) 496 0.5722 0.5699 0.3247 0.3098 0.8931 0 1.0000
DW (Overall Pool) 430 0.9691 0.0129 3.1337 0.0002 0.4124 0 26.7484
DW (OMO: Market-Value Adjusted) 188 886.3634 0.1302 11713.5038 0.0012 1.1659 0 160585.5484
DW (Non-OMO: MV Minus Haircut) 313 7.2248 0.0066 69.9605 0.0001 0.3848 0 1074.3770
Note:
BTFP: Collateral accepted at par/face value without MTM loss. DW: Applies MTM loss. DW OMO avoids haircut, Non-OMO applies both MTM loss and haircut. 
save_kbl_latex(rho_stats %>% mutate(across(where(is.numeric) & !matches("^N$"), ~ round(., 4))),
  "Table_Rho_Summary",
  caption = "Distribution of $\\rho$ by Facility")
## Saved: Table_Rho_Summary.tex

6.2 5.2 BTFP: Above vs Below Median ρ

# ── Filter to valid BTFP ρ > 0 ──
df_btfp_valid <- df_btfp %>% filter(rho_btfp > 0 & is.finite(rho_btfp))
med_btfp <- median(df_btfp_valid$rho_btfp)
df_btfp_valid <- df_btfp_valid %>%
  mutate(rho_grp = ifelse(rho_btfp >= med_btfp, "High", "Low"))

cat(sprintf("BTFP valid: %d | Median ρ_BTFP = %.4f | High: %d | Low: %d\n",
    nrow(df_btfp_valid), med_btfp,
    sum(df_btfp_valid$rho_grp == "High"), sum(df_btfp_valid$rho_grp == "Low")))
## BTFP valid: 496 | Median ρ_BTFP = 0.5699 | High: 248 | Low: 248
desc_vars <- c("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", "uninsured_beta_raw",
  "f_pp", "f_u_pp", "emv_pp", "v_pp",
  "btfp_amt_ta", "btfp_collateral_ta")
desc_labels <- c("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",
  "Franchise (f)", "Unins. Franchise (f^U)", "MV Equity (E^MV)", "Run Value (v)",
  "BTFP Amount/TA", "BTFP Collateral/TA")

btfp_split <- make_desc_comparison(df_btfp_valid, "rho_grp", "High", "Low",
                                    desc_vars, desc_labels)

kbl(btfp_split %>% select(Variable, High, Low, Difference, p),
    format = "html", escape = FALSE,
    col.names = c("Variable", sprintf("High ρ_BTFP (≥%.3f)", med_btfp),
                  sprintf("Low ρ_BTFP (<%.3f)", med_btfp), "Difference", "p-value"),
    caption = sprintf("BTFP: Above vs Below Median ρ (median = %.4f)", med_btfp)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  footnote(general = "*** p<0.01, ** p<0.05, * p<0.10. BTFP calculates ρ as Loan Amount / Face Value.")
BTFP: Above vs Below Median ρ (median = 0.5699)
Variable High ρ_BTFP (≥0.570) Low ρ_BTFP (<0.570) Difference p-value
Log(Assets) 13.576 (1.482) 13.887 (1.630) -0.311** 0.0266046
Total MTM (ℓ) 6.045 (1.844) 6.123 (2.036) -0.078 0.6545887
Securities MTM (ℓ_S) 2.496 (1.565) 2.671 (1.739) -0.175 0.2398733
Loan MTM (ℓ_L) 3.549 (1.467) 3.452 (1.601) 0.097 0.4833117
Book Equity (e) 8.095 (2.639) 8.366 (3.376) -0.271 0.3205222
Cash/TA 4.429 (4.733) 4.872 (4.570) -0.442 0.2903532
Loan/Deposit 74.526 (18.705) 71.166 (19.317) 3.361** 0.0495913
Wholesale (%) 1.788 (3.900) 1.322 (2.375) 0.466 0.1085192
ROA 1.053 (0.545) 1.083 (0.536) -0.030 0.5367721
Uninsured/TA (μ) 26.792 (11.624) 27.994 (12.876) -1.202 0.2755607
D^U/D 31.557 (13.670) 32.549 (15.026) -0.992 0.4420942
β^U 0.358 (0.127) 0.328 (0.102) 0.030*** 0.0044275
Franchise (f) 2.784 (1.519) 3.174 (1.839) -0.390** 0.0103753
Unins. Franchise (f^U) 1.012 (0.946) 1.247 (1.321) -0.236** 0.0228475
MV Equity (E^MV) 4.834 (3.901) 5.417 (4.590) -0.582 0.1285328
Run Value (v) 3.823 (3.618) 4.169 (4.276) -0.347 0.3302570
BTFP Amount/TA 0.069 (0.086) 0.064 (0.114) 0.005 0.5572068
BTFP Collateral/TA 0.087 (0.127) 0.210 (0.326) -0.122*** 0.0000001
Note:
*** p<0.01, ** p<0.05, * p<0.10. BTFP calculates ρ as Loan Amount / Face Value. 
save_kbl_latex(btfp_split %>% select(Variable, High, Low, Difference, p),
  "Table_Desc_BTFP_MedianSplit",
  col.names = c("Variable", "High $\\rho$", "Low $\\rho$", "Difference", "p-value"),
  caption = "BTFP: Above vs Below Median $\\rho_{\\text{BTFP}}$")
## Saved: Table_Desc_BTFP_MedianSplit.tex

6.3 5.3 DW: Above vs Below Median ρ

df_dw_valid <- df_dw %>% filter(rho_dw > 0 & is.finite(rho_dw))
med_dw <- median(df_dw_valid$rho_dw)
df_dw_valid <- df_dw_valid %>%
  mutate(rho_grp = ifelse(rho_dw >= med_dw, "High", "Low"))

cat(sprintf("DW valid: %d | Median ρ_DW = %.4f | High: %d | Low: %d\n",
    nrow(df_dw_valid), med_dw,
    sum(df_dw_valid$rho_grp == "High"), sum(df_dw_valid$rho_grp == "Low")))
## DW valid: 430 | Median ρ_DW = 0.0129 | High: 215 | Low: 215
desc_vars_dw <- c("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", "uninsured_beta_raw",
  "f_pp", "f_u_pp", "emv_pp", "v_pp",
  "dw_amt_ta", "dw_collateral_ta")
desc_labels_dw <- c("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",
  "Franchise (f)", "Unins. Franchise (f^U)", "MV Equity (E^MV)", "Run Value (v)",
  "DW Amount/TA", "DW Collateral/TA")

dw_split <- make_desc_comparison(df_dw_valid, "rho_grp", "High", "Low",
                                  desc_vars_dw, desc_labels_dw)

kbl(dw_split %>% select(Variable, High, Low, Difference, p),
    format = "html", escape = FALSE,
    col.names = c("Variable", sprintf("High ρ_DW (≥%.3f)", med_dw),
                  sprintf("Low ρ_DW (<%.3f)", med_dw), "Difference", "p-value"),
    caption = sprintf("DW: Above vs Below Median ρ (median = %.4f)", med_dw)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  footnote(general = "*** p<0.01, ** p<0.05, * p<0.10. DW adjusts collateral for Market Value and Haircuts. DW multi-loans utilize max(pool) capacity.")
DW: Above vs Below Median ρ (median = 0.0129)
Variable High ρ_DW (≥0.013) Low ρ_DW (<0.013) Difference p-value
Log(Assets) 13.910 (1.463) 14.133 (1.685) -0.224 0.1425810
Total MTM (ℓ) 5.797 (2.009) 5.657 (1.948) 0.140 0.4626079
Securities MTM (ℓ_S) 2.389 (1.657) 2.018 (1.457) 0.372** 0.0139135
Loan MTM (ℓ_L) 3.408 (1.529) 3.639 (1.659) -0.231 0.1334865
Book Equity (e) 8.602 (3.238) 9.236 (2.823) -0.634** 0.0311344
Cash/TA 4.920 (5.918) 6.629 (6.453) -1.708*** 0.0044340
Loan/Deposit 75.684 (20.368) 76.089 (20.518) -0.405 0.8375330
Wholesale (%) 1.960 (4.009) 1.156 (3.135) 0.804** 0.0210250
ROA 1.146 (0.727) 1.104 (0.501) 0.042 0.4897857
Uninsured/TA (μ) 29.014 (13.066) 27.001 (11.808) 2.013* 0.0945391
D^U/D 34.407 (15.625) 31.555 (13.889) 2.853** 0.0460617
β^U 0.353 (0.130) 0.342 (0.116) 0.011 0.3435537
Franchise (f) 3.068 (1.779) 2.925 (1.550) 0.144 0.3725513
Unins. Franchise (f^U) 1.237 (1.204) 1.070 (0.996) 0.167 0.1177921
MV Equity (E^MV) 5.873 (4.362) 6.504 (4.169) -0.630 0.1263336
Run Value (v) 4.636 (4.115) 5.434 (3.861) -0.797** 0.0388968
DW Amount/TA 0.165 (0.480) 0.000 (0.000) 0.165*** 0.0000009
DW Collateral/TA 0.073 (0.088) 0.055 (0.072) 0.019** 0.0170413
Note:
*** p<0.01, ** p<0.05, * p<0.10. DW adjusts collateral for Market Value and Haircuts. DW multi-loans utilize max(pool) capacity. 
save_kbl_latex(dw_split %>% select(Variable, High, Low, Difference, p),
  "Table_Desc_DW_MedianSplit",
  col.names = c("Variable", "High $\\rho$", "Low $\\rho$", "Difference", "p-value"),
  caption = "DW: Above vs Below Median $\\rho_{\\text{DW}}$")
## Saved: Table_Desc_DW_MedianSplit.tex

6.4 5.4 ρ by Size Bucket

# ── BTFP by size ──
btfp_size <- df_btfp_valid %>%
  group_by(size_bucket) %>%
  summarise(
    N = n(), 
    `ρ Mean` = round(mean(rho_btfp), 4), `ρ Median` = round(median(rho_btfp), 4),
    `ρ SD` = round(sd(rho_btfp), 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(btfp_multi), 1), .groups = "drop")

kbl(btfp_size, format = "html", escape = FALSE,
    caption = "BTFP: ρ by Asset Size Quartile (Par/Face Value)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
BTFP: ρ by Asset Size Quartile (Par/Face Value)
size_bucket N ρ Mean ρ Median ρ SD ℓ ℓ_S f^U Cash/TA v Multi %
Q1 (Small) 39 0.6340 0.6919 0.3288 5.674 2.889 0.670 7.058 3.829 38.5
Q2 89 0.5797 0.5714 0.3275 6.266 2.939 0.950 5.903 3.415 52.8
Q3 143 0.6109 0.5991 0.3030 6.347 2.711 0.892 4.312 3.535 57.3
Q4 (Large) 225 0.5339 0.5168 0.3335 5.916 2.308 1.431 3.953 4.548 58.7 
# ── DW by size (Added OMO & Non-OMO columns) ──
dw_size <- df_dw_valid %>%
  group_by(size_bucket) %>%
  summarise(
    N = n(), 
    `ρ Overall Mean` = round(mean(rho_dw), 4), 
    `ρ OMO Mean` = round(mean(rho_dw_omo, na.rm=T), 4), 
    `ρ Non-OMO Mean` = round(mean(rho_dw_non_omo, na.rm=T), 4),
    `ρ Median` = round(median(rho_dw), 4),
    `ρ SD` = round(sd(rho_dw), 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),
    `Multi %` = round(100 * mean(dw_multi), 1), .groups = "drop")

kbl(dw_size, format = "html", escape = FALSE,
    caption = "DW: ρ by Asset Size Quartile (MV & Haircut Adjusted)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  footnote(general = "Size quartiles from full model sample. Multi % = banks with >1 loan at that facility.")
DW: ρ by Asset Size Quartile (MV & Haircut Adjusted)
size_bucket N ρ Overall Mean ρ OMO Mean ρ Non-OMO Mean ρ Median ρ SD ℓ f^U Cash/TA v Multi %
Q1 (Small) 25 1.2446 1.7555 1.2074 0.1246 2.1934 5.851 0.540 6.859 5.391 40.0
Q2 59 0.6294 16.7918 0.7140 0.0096 1.8447 5.634 0.821 8.243 4.135 25.4
Q3 120 0.9749 13.2611 0.7417 0.0336 2.6688 5.949 0.926 6.487 4.214 22.5
Q4 (Large) 226 1.0243 1968.0989 11.6831 0.0068 3.6775 5.620 1.429 4.632 5.666 30.5
Note:
Size quartiles from full model sample. Multi % = banks with >1 loan at that facility. 
save_kbl_latex(btfp_size, "Table_Rho_BTFP_SizeBuckets", caption = "BTFP $\\rho$ by Size")
## Saved: Table_Rho_BTFP_SizeBuckets.tex
save_kbl_latex(dw_size, "Table_Rho_DW_SizeBuckets", caption = "DW $\\rho$ by Size")
## Saved: Table_Rho_DW_SizeBuckets.tex

6.5 5.5 Multi-Loan vs Single-Loan

# ── BTFP: single vs multi ──
btfp_multi_vars <- c("rho_btfp", "btfp_amt_ta", "btfp_collateral_ta",
                      "ln_assets_raw", "mtm_total_raw", "mtm_sec_raw",
                      "f_u_pp", "cash_ratio_raw", "v_pp")
btfp_multi_labs <- c("ρ_BTFP", "Amount/TA", "Collateral/TA",
                     "Log(Assets)", "MTM (ℓ)", "Securities MTM (ℓ_S)",
                     "f^U", "Cash/TA", "Run Value (v)")

df_btfp_valid <- df_btfp_valid %>%
  mutate(multi_grp = ifelse(btfp_multi == 1, "Multi", "Single"))
btfp_multi_tbl <- make_desc_comparison(df_btfp_valid, "multi_grp", "Multi", "Single",
                                        btfp_multi_vars, btfp_multi_labs)

kbl(btfp_multi_tbl %>% select(Variable, High, Low, Difference, p),
    format = "html", escape = FALSE,
    col.names = c("Variable", "Multi-Loan", "Single-Loan", "Difference", "p-value"),
    caption = sprintf("BTFP: Multi-Loan (%d) vs Single-Loan (%d)",
      sum(df_btfp_valid$btfp_multi), sum(!df_btfp_valid$btfp_multi))) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
BTFP: Multi-Loan (276) vs Single-Loan (220)
Variable Multi-Loan Single-Loan Difference p-value
ρ_BTFP 0.531 (0.262) 0.624 (0.384) -0.093*** 0.0022886
Amount/TA 0.100 (0.123) 0.025 (0.029) 0.075*** 0.0000000
Collateral/TA 0.234 (0.315) 0.042 (0.042) 0.192*** 0.0000000
Log(Assets) 13.790 (1.403) 13.659 (1.746) 0.131 0.3664627
MTM (ℓ) 6.198 (1.967) 5.941 (1.903) 0.257 0.1418132
Securities MTM (ℓ_S) 2.676 (1.703) 2.467 (1.589) 0.209 0.1600984
f^U 1.153 (1.286) 1.100 (0.965) 0.053 0.6027277
Cash/TA 4.379 (4.810) 4.991 (4.435) -0.612 0.1420094
Run Value (v) 4.002 (3.984) 3.988 (3.940) 0.014 0.9691570 
# ── DW: single vs multi ──
dw_multi_vars <- c("rho_dw", "dw_amt_ta", "dw_collateral_ta",
                    "ln_assets_raw", "mtm_total_raw",
                    "f_u_pp", "cash_ratio_raw", "v_pp")
dw_multi_labs <- c("ρ_DW", "Amount/TA", "Collateral/TA",
                   "Log(Assets)", "MTM (ℓ)",
                   "f^U", "Cash/TA", "Run Value (v)")

df_dw_valid <- df_dw_valid %>%
  mutate(multi_grp = ifelse(dw_multi == 1, "Multi", "Single"))
dw_multi_tbl <- make_desc_comparison(df_dw_valid, "multi_grp", "Multi", "Single",
                                      dw_multi_vars, dw_multi_labs)

kbl(dw_multi_tbl %>% select(Variable, High, Low, Difference, p),
    format = "html", escape = FALSE,
    col.names = c("Variable", "Multi-Loan", "Single-Loan", "Difference", "p-value"),
    caption = sprintf("DW: Multi-Loan (%d) vs Single-Loan (%d)",
      sum(df_dw_valid$dw_multi), sum(!df_dw_valid$dw_multi))) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
DW: Multi-Loan (121) vs Single-Loan (309)
Variable Multi-Loan Single-Loan Difference p-value
ρ_DW 3.222 (5.279) 0.087 (0.207) 3.136*** 0.0000000
Amount/TA 0.288 (0.613) 0.002 (0.008) 0.286*** 0.0000011
Collateral/TA 0.100 (0.094) 0.050 (0.071) 0.050*** 0.0000003
Log(Assets) 14.040 (1.548) 14.014 (1.595) 0.025 0.8800942
MTM (ℓ) 5.894 (2.025) 5.662 (1.958) 0.232 0.2817347
f^U 1.330 (1.281) 1.084 (1.024) 0.246* 0.0605775
Cash/TA 4.295 (4.646) 6.354 (6.684) -2.059*** 0.0003389
Run Value (v) 4.490 (4.101) 5.249 (3.953) -0.759* 0.0827915 
save_kbl_latex(btfp_multi_tbl %>% select(Variable, High, Low, Difference, p),
  "Table_BTFP_MultiVsSingle",
  col.names = c("Variable", "Multi", "Single", "Diff", "p-value"),
  caption = "BTFP: Multi-Loan vs Single-Loan")
## Saved: Table_BTFP_MultiVsSingle.tex
save_kbl_latex(dw_multi_tbl %>% select(Variable, High, Low, Difference, p),
  "Table_DW_MultiVsSingle",
  col.names = c("Variable", "Multi", "Single", "Diff", "p-value"),
  caption = "DW: Multi-Loan vs Single-Loan")
## Saved: Table_DW_MultiVsSingle.tex

6.6 5.6 Facility-Type Comparison

fac_summary <- df_cap %>%
  group_by(borrower_type) %>%
  summarise(
    N = n(),
    `ℓ` = 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),
    `Unins/TA` = round(mean(uninsured_lev_raw, na.rm=T), 3),
    `β^U` = round(mean(beta_u_clipped, na.rm=T), 3),
    `Log(TA)` = round(mean(ln_assets_raw, na.rm=T), 2),
    .groups = "drop"
  )

kbl(fac_summary, 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 ℓ ℓ_S f^U Cash/TA v Unins/TA β^U Log(TA)
BTFP Only 392 6.165 2.608 1.054 4.677 3.904 26.173 0.337 13.50
Both 104 5.779 2.491 1.413 4.549 4.342 31.989 0.365 14.62
DW Only 326 5.710 2.112 1.071 6.166 5.256 26.737 0.341 13.83 
save_kbl_latex(fac_summary, "Table_FacilityType_Chars",
  caption = "Characteristics by Facility Type")
## Saved: Table_FacilityType_Chars.tex

7 PLOTS: ρ DISTRIBUTIONS

p_btfp_hist <- ggplot(df_btfp_valid, aes(x = rho_btfp)) +
  geom_histogram(aes(y = after_stat(density)), bins = 35, fill = "#1565C0", alpha = 0.6) +
  geom_density(linewidth = 0.8, color = "#C62828") +
  geom_vline(xintercept = med_btfp, linetype = "dashed", linewidth = 0.8) +
  annotate("text", x = med_btfp + 0.03, y = Inf, vjust = 2,
           label = sprintf("Median = %.3f", med_btfp), size = 3.5) +
  labs(title = "BTFP: ρ = Amount / Face-Value Collateral",
       subtitle = "BTFP lends at par; collateral at face value. ρ = how much of par capacity drawn.",
       x = "ρ_BTFP", y = "Density") + theme_gp

p_dw_hist <- ggplot(df_dw_valid, aes(x = rho_dw)) +
  geom_histogram(aes(y = after_stat(density)), bins = 35, fill = "#E53935", alpha = 0.6) +
  geom_density(linewidth = 0.8, color = "#1565C0") +
  geom_vline(xintercept = med_dw, linetype = "dashed", linewidth = 0.8) +
  annotate("text", x = med_dw + 0.03, y = Inf, vjust = 2,
           label = sprintf("Median = %.3f", med_dw), size = 3.5) +
  labs(title = "DW: ρ = Amount / MV-Adjusted Collateral Pool",
       subtitle = "DW standing pool (max). OMO at MV; non-OMO at MV−haircut.",
       x = "ρ_DW", y = "Density") + theme_gp

print(p_btfp_hist + p_dw_hist)

save_figure(p_btfp_hist + p_dw_hist, "Fig_Rho_Distributions", width = 14, height = 6)
p_btfp_box <- ggplot(df_btfp_valid, aes(x = size_bucket, y = rho_btfp, fill = size_bucket)) +
  geom_boxplot(alpha = 0.7, outlier.alpha = 0.3) +
  labs(title = "BTFP: ρ by Size Quartile", x = NULL, y = "ρ_BTFP") +
  theme_gp + theme(legend.position = "none")

p_dw_box <- ggplot(df_dw_valid, aes(x = size_bucket, y = rho_dw, fill = size_bucket)) +
  geom_boxplot(alpha = 0.7, outlier.alpha = 0.3) +
  labs(title = "DW: ρ by Size Quartile", x = NULL, y = "ρ_DW") +
  theme_gp + theme(legend.position = "none")

print(p_btfp_box + p_dw_box)

save_figure(p_btfp_box + p_dw_box, "Fig_Rho_SizeBoxplots", width = 14, height = 6)

8 REGRESSIONS: BTFP

BTFP: \(\rho_{\text{BTFP}} = \text{Amount} / \text{Face-Value Collateral}\)

BTFP offers par → recapitalization channel. Securities losses \(\ell_S\) determine capacity. Banks with higher \(\ell \times f^U\) should draw a larger share (expect worse runs). Cash \(< 0\) (buffer offsets need).

8.1 7.1 Main Table

# ── Prepare BTFP regression sample ──
df_btfp_reg <- df_btfp_valid %>%
  mutate(
    # Re-standardize within BTFP borrower sample
    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)),

    # Interactions
    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,

    # LHS: Revealed Run Rate (Percentage Points)
    run_pct_btfp = run_rate_real_btfp * 100
  )

cat(sprintf("BTFP regression sample: %d (after removing ρ=0)\n", nrow(df_btfp_reg)))
## BTFP regression sample: 496 (after removing ρ=0)
ctrl_b <- c("ln_assets_b", "cash_b", "ltd_b", "equity_b", "wholesale_b", "roa_b")
ctrl_b_str <- paste(ctrl_b, collapse = " + ")

coef_map_btfp <- c(
  "mtm_total_b"  = "ℓ (MTM Loss)", "mtm_sec_b" = "ℓ_S (Securities)",
  "mtm_loan_b"   = "ℓ_L (Loans)", "f_u_b" = "f^U (Uninsured Franchise)",
  "mtm_x_fu_b"   = "ℓ × f^U (expect > 0)",
  "sec_x_fu_b"   = "ℓ_S × f^U (expect > 0)",
  "loan_x_fu_b"  = "ℓ_L × f^U (expect ≈ 0)",
  "cash_b" = "Cash/TA", "ln_assets_b" = "Log(Assets)",
  "ltd_b" = "Loan/Dep", "equity_b" = "Equity/TA",
  "wholesale_b" = "Wholesale", "roa_b" = "ROA")

# Updated formula using Implied Run %
fml_btfp <- as.formula(paste0("run_pct_btfp ~ mtm_total_b + f_u_b + mtm_x_fu_b + ", ctrl_b_str))

reg_btfp_main <- list(
  "Run %: Full"    = feols(fml_btfp, data = df_btfp_reg, vcov = "hetero"),
  "Run %: Single"  = feols(fml_btfp, data = df_btfp_reg %>% filter(btfp_multi == 0), vcov = "hetero"),
  "Run %: Multi"   = feols(fml_btfp, data = df_btfp_reg %>% filter(btfp_multi == 1), vcov = "hetero")
)

msummary(reg_btfp_main, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
  coef_rename = coef_map_btfp,
  title = "BTFP: Revealed Run Expectation (%)",
  notes = "LHS = (BTFP Draw + Cash) / Uninsured Deposits. Tests if fundamental vulnerability drives internal run expectations.")
BTFP: Revealed Run Expectation (%)
Run %: Full Run %: Single Run %: Multi
* p < 0.1, ** p < 0.05, *** p < 0.01
LHS = (BTFP Draw + Cash) / Uninsured Deposits. Tests if fundamental vulnerability drives internal run expectations.
(Intercept) 56.357*** 31.468*** 75.401***
(5.786) (2.025) (9.454)
ℓ (MTM Loss) -3.037 4.147 -11.159
(6.840) (3.223) (12.305)
f^U (Uninsured Franchise) -35.928*** -16.475*** -45.797**
(13.468) (4.178) (18.637)
ℓ × f^U (expect > 0) 4.079 -2.496 6.949
(5.894) (4.695) (8.436)
Log(Assets) 21.633 -2.378 39.314
(16.504) (2.746) (27.225)
Cash/TA 27.729*** 20.799*** 41.494**
(7.985) (4.148) (16.355)
Loan/Dep -31.377 -1.089 -48.461
(20.127) (4.803) (29.893)
Equity/TA 16.816 2.404 19.276
(10.523) (4.235) (14.117)
Wholesale 4.105 0.879 1.267
(3.228) (1.502) (5.933)
ROA 5.850 1.962 8.307
(8.530) (2.571) (13.490)
Num.Obs. 495 219 276
R2 0.166 0.412 0.221
R2 Adj. 0.151 0.386 0.195
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
save_reg_latex(reg_btfp_main, "Table_RunExp_BTFP_Main",
  coef_rename = c("mtm_total_b"="$\\ell$", "f_u_b"="$f^U$",
    "mtm_x_fu_b"="$\\ell \\times f^U$", "cash_b"="Cash/TA",
    "ln_assets_b"="Log(Assets)", "ltd_b"="Loan/Dep",
    "equity_b"="Equity/TA", "wholesale_b"="Wholesale", "roa_b"="ROA"),
  title = "BTFP: Revealed Run Expectation (\\%)")
## Saved: Table_RunExp_BTFP_Main.tex

8.2 7.2 Signal Decomposition: ℓ_S vs ℓ_L

fml_d1 <- as.formula(paste0("run_pct_btfp ~ mtm_total_b + f_u_b + mtm_x_fu_b + ", ctrl_b_str))
fml_d2 <- as.formula(paste0("run_pct_btfp ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
                              "mtm_x_mu_b + mtm_x_1mbeta_b + ", ctrl_b_str))
fml_d3 <- as.formula(paste0("run_pct_btfp ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
                              "mtm_x_mu_x_1mbeta_b + ", ctrl_b_str))

reg_btfp_decomp <- list(
  "ℓ × f^U"               = feols(fml_d1, data = df_btfp_reg, vcov = "hetero"),
  "ℓ×μ + ℓ×(1−β^U)"       = feols(fml_d2, data = df_btfp_reg, vcov = "hetero"),
  "ℓ × μ × (1−β^U)"       = feols(fml_d3, data = df_btfp_reg, vcov = "hetero")
)

decomp_map <- c(
  "mtm_total_b" = "ℓ", "f_u_b" = "f^U",
  "unins_lev_b" = "μ (Uninsured Leverage)",
  "one_minus_beta_b" = "1−β^U (Deposit Sensitivity)",
  "mtm_x_fu_b" = "ℓ × f^U",
  "mtm_x_mu_b" = "ℓ × μ", "mtm_x_1mbeta_b" = "ℓ × (1−β^U)",
  "mtm_x_mu_x_1mbeta_b" = "ℓ × μ × (1−β^U)",
  "cash_b" = "Cash/TA", "ln_assets_b" = "Log(Assets)", "ltd_b" = "Loan/Dep",
  "equity_b" = "Equity/TA", "wholesale_b" = "Wholesale", "roa_b" = "ROA")

msummary(reg_btfp_decomp, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
  coef_rename = decomp_map,
  title = "BTFP Run Exp: Decomposition ℓ × f^U → ℓ × μ × (1−β^U)")
BTFP Run Exp: Decomposition ℓ × f^U → ℓ × μ × (1−β^U)
ℓ × f^U ℓ×μ + ℓ×(1−β^U) ℓ × μ × (1−β^U)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 56.357*** 53.883*** 57.234***
(5.786) (4.501) (5.220)
ℓ -3.037 -7.484 -0.970
(6.840) (7.219) (5.039)
f^U -35.928***
(13.468)
ℓ × f^U 4.079
(5.894)
Log(Assets) 21.633 22.992* 20.854*
(16.504) (13.901) (11.481)
Cash/TA 27.729*** 27.129*** 25.132***
(7.985) (6.874) (6.011)
Loan/Dep -31.377 -34.043* -40.772*
(20.127) (19.027) (21.109)
Equity/TA 16.816 12.995 17.007*
(10.523) (8.486) (9.315)
Wholesale 4.105 1.033 3.070
(3.228) (3.127) (3.009)
ROA 5.850 6.944 4.420
(8.530) (7.600) (6.102)
μ (Uninsured Leverage) -49.021*** -36.555***
(15.434) (8.663)
1−β^U (Deposit Sensitivity) -14.987* -30.376**
(8.570) (15.267)
ℓ × μ 6.707
(7.793)
ℓ × (1−β^U) 20.347*
(11.275)
ℓ × μ × (1−β^U) -28.872*
(15.894)
Num.Obs. 495 495 495
R2 0.166 0.288 0.349
R2 Adj. 0.151 0.272 0.336
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
save_reg_latex(reg_btfp_decomp, "Table_RunExp_BTFP_Decomp",
  coef_rename = c("mtm_total_b"="$\\ell$", "f_u_b"="$f^U$",
    "unins_lev_b"="$\\mu$", "one_minus_beta_b"="$1-\\beta^U$",
    "mtm_x_fu_b"="$\\ell \\times f^U$",
    "mtm_x_mu_b"="$\\ell \\times \\mu$",
    "mtm_x_1mbeta_b"="$\\ell \\times (1-\\beta^U)$",
    "mtm_x_mu_x_1mbeta_b"="$\\ell \\times \\mu \\times (1-\\beta^U)$"),
  title = "BTFP Run Expectation: Decomposition")
## Saved: Table_RunExp_BTFP_Decomp.tex

8.3 7.3 Decomposition: ℓ × μ × (1 − β^U)

fml_d1 <- as.formula(paste0("rho_btfp ~ mtm_total_b + f_u_b + mtm_x_fu_b + ", ctrl_b_str))
fml_d2 <- as.formula(paste0("rho_btfp ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
                              "mtm_x_mu_b + mtm_x_1mbeta_b + ", ctrl_b_str))
fml_d3 <- as.formula(paste0("rho_btfp ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
                              "mtm_x_mu_x_1mbeta_b + ", ctrl_b_str))

reg_btfp_decomp <- list(
  "ℓ × f^U"               = feols(fml_d1, data = df_btfp_reg, vcov = "hetero"),
  "ℓ×μ + ℓ×(1−β^U)"       = feols(fml_d2, data = df_btfp_reg, vcov = "hetero"),
  "ℓ × μ × (1−β^U)"       = feols(fml_d3, data = df_btfp_reg, vcov = "hetero")
)

decomp_map <- c(
  "mtm_total_b" = "ℓ", "f_u_b" = "f^U",
  "unins_lev_b" = "μ (Uninsured Leverage)",
  "one_minus_beta_b" = "1−β^U (Deposit Sensitivity)",
  "mtm_x_fu_b" = "ℓ × f^U",
  "mtm_x_mu_b" = "ℓ × μ", "mtm_x_1mbeta_b" = "ℓ × (1−β^U)",
  "mtm_x_mu_x_1mbeta_b" = "ℓ × μ × (1−β^U)",
  "cash_b" = "Cash/TA", "ln_assets_b" = "Log(Assets)", "ltd_b" = "Loan/Dep",
  "equity_b" = "Equity/TA", "wholesale_b" = "Wholesale", "roa_b" = "ROA")

msummary(reg_btfp_decomp, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
  coef_rename = decomp_map,
  title = "BTFP: Decomposition ℓ × f^U → ℓ × μ × (1−β^U)",
  notes = "Col 1: baseline. Col 2: separate interactions. Col 3: triple interaction.")
BTFP: Decomposition ℓ × f^U → ℓ × μ × (1−β^U)
ℓ × f^U ℓ×μ + ℓ×(1−β^U) ℓ × μ × (1−β^U)
* p < 0.1, ** p < 0.05, *** p < 0.01
Col 1: baseline. Col 2: separate interactions. Col 3: triple interaction.
(Intercept) 0.573*** 0.573*** 0.572***
(0.014) (0.015) (0.014)
ℓ -0.015 -0.012 -0.012
(0.016) (0.017) (0.016)
f^U -0.010
(0.016)
ℓ × f^U 0.010
(0.015)
Log(Assets) -0.066*** -0.082*** -0.083***
(0.018) (0.018) (0.018)
Cash/TA -0.033* -0.042** -0.043**
(0.019) (0.019) (0.019)
Loan/Dep 0.050*** 0.035* 0.034*
(0.018) (0.019) (0.018)
Equity/TA -0.031* -0.028* -0.029*
(0.016) (0.016) (0.016)
Wholesale 0.010 0.010 0.011
(0.014) (0.014) (0.014)
ROA 0.010 0.007 0.007
(0.016) (0.016) (0.016)
μ (Uninsured Leverage) 0.014 0.014
(0.017) (0.018)
1−β^U (Deposit Sensitivity) -0.047*** -0.048***
(0.017) (0.016)
ℓ × μ 0.006
(0.015)
ℓ × (1−β^U) 0.000
(0.015)
ℓ × μ × (1−β^U) -0.002
(0.012)
Num.Obs. 496 496 496
R2 0.067 0.083 0.082
R2 Adj. 0.050 0.062 0.063
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
save_reg_latex(reg_btfp_decomp, "Table_Rho_BTFP_Decomp",
  coef_rename = c("mtm_total_b"="$\\ell$", "f_u_b"="$f^U$",
    "unins_lev_b"="$\\mu$", "one_minus_beta_b"="$1-\\beta^U$",
    "mtm_x_fu_b"="$\\ell \\times f^U$",
    "mtm_x_mu_b"="$\\ell \\times \\mu$",
    "mtm_x_1mbeta_b"="$\\ell \\times (1-\\beta^U)$",
    "mtm_x_mu_x_1mbeta_b"="$\\ell \\times \\mu \\times (1-\\beta^U)$"),
  title = "BTFP: Decomposition")
## Saved: Table_Rho_BTFP_Decomp.tex

9 REGRESSIONS: DW

DW: \(\rho_{\text{DW}} = \text{Amount} / \text{MV-Adjusted Pool}\)

DW accepts broad collateral (OMO at MV, non-OMO at MV−haircut). Banks borrow for immediate cash needs. Cash should be strongly negative.

9.1 8.1 Main Table

df_dw_reg <- df_dw_valid %>%
  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_dw = log(rho_dw)
  )

cat(sprintf("DW regression sample: %d (after removing ρ=0)\n", nrow(df_dw_reg)))
## DW regression sample: 430 (after removing ρ=0)
fml_dw <- as.formula(paste0("rho_dw ~ mtm_total_b + f_u_b + mtm_x_fu_b + ", ctrl_b_str))

reg_dw_main <- list(
  "ρ_DW: Full"    = feols(fml_dw, data = df_dw_reg, vcov = "hetero"),
  "ρ_DW: Single"  = feols(fml_dw, data = df_dw_reg %>% filter(dw_multi == 0), vcov = "hetero"),
  "ρ_DW: Multi"   = feols(fml_dw, data = df_dw_reg %>% filter(dw_multi == 1), vcov = "hetero"),
  "ln(ρ_DW): Full" = feols(update(fml_dw, ln_rho_dw ~ .),
                            data = df_dw_reg %>% filter(is.finite(ln_rho_dw)), vcov = "hetero")
)

msummary(reg_dw_main, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
  coef_rename = coef_map_btfp,
  title = "DW: ρ = Amount / MV-Adjusted Collateral Pool",
  notes = "DW: standing pool (max). OMO at MV, non-OMO at MV−haircut.")
DW: ρ = Amount / MV-Adjusted Collateral Pool
ρ_DW: Full ρ_DW: Single ρ_DW: Multi ln(ρ_DW): Full
* p < 0.1, ** p < 0.05, *** p < 0.01
DW: standing pool (max). OMO at MV, non-OMO at MV−haircut.
(Intercept) 0.982*** 0.092*** 3.210*** -4.830***
(0.153) (0.013) (0.509) (0.209)
ℓ (MTM Loss) 0.100 -0.001 0.349 -0.039
(0.197) (0.016) (0.567) (0.235)
f^U (Uninsured Franchise) 0.219 0.012 -0.034 0.803***
(0.199) (0.017) (0.394) (0.235)
ℓ × f^U (expect > 0) 0.304 0.010 0.531 0.395*
(0.209) (0.013) (0.485) (0.203)
Log(Assets) 0.056 -0.032*** 0.490 -1.394***
(0.154) (0.011) (0.557) (0.268)
Cash/TA -0.348*** -0.032*** -0.519 -1.025***
(0.130) (0.011) (0.434) (0.256)
Loan/Dep -0.186 -0.008 -0.654 -0.207
(0.225) (0.017) (0.558) (0.285)
Equity/TA 0.000 -0.012 0.400 -0.376
(0.190) (0.014) (0.511) (0.266)
Wholesale 0.137 -0.003 -0.240 0.474**
(0.115) (0.010) (0.244) (0.212)
ROA -0.109 0.018 -0.710** 0.164
(0.118) (0.014) (0.333) (0.220)
Num.Obs. 430 309 121 430
R2 0.036 0.047 0.067 0.139
R2 Adj. 0.016 0.019 -0.009 0.121
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
save_reg_latex(reg_dw_main, "Table_Rho_DW_Main",
  coef_rename = c("mtm_total_b"="$\\ell$", "f_u_b"="$f^U$",
    "mtm_x_fu_b"="$\\ell \\times f^U$", "cash_b"="Cash/TA",
    "ln_assets_b"="Log(Assets)"),
  title = "DW: $\\rho$ = Amount / MV-Adjusted Collateral Pool")
## Saved: Table_Rho_DW_Main.tex

9.2 8.2 Signal Decomposition

fml_dw_sig <- as.formula(paste0(
  "rho_dw ~ mtm_sec_b + mtm_loan_b + f_u_b + sec_x_fu_b + loan_x_fu_b + ", ctrl_b_str))

reg_dw_sig <- list(
  "ρ_DW: ℓ × f^U"        = feols(fml_dw, data = df_dw_reg, vcov = "hetero"),
  "ρ_DW: ℓ_S/ℓ_L × f^U" = feols(fml_dw_sig, data = df_dw_reg, vcov = "hetero")
)

msummary(reg_dw_sig, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
  coef_rename = coef_map_btfp,
  title = "DW: Securities vs Loan Signal",
  notes = "DW accepts broad collateral; signal decomposition may differ from BTFP.")
DW: Securities vs Loan Signal
ρ_DW: ℓ × f^U ρ_DW: ℓ_S/ℓ_L × f^U
* p < 0.1, ** p < 0.05, *** p < 0.01
DW accepts broad collateral; signal decomposition may differ from BTFP.
(Intercept) 0.982*** 1.042***
(0.153) (0.169)
ℓ (MTM Loss) 0.100
(0.197)
f^U (Uninsured Franchise) 0.219 0.224
(0.199) (0.204)
ℓ × f^U (expect > 0) 0.304
(0.209)
Log(Assets) 0.056 0.104
(0.154) (0.158)
Cash/TA -0.348*** -0.281*
(0.130) (0.160)
Loan/Dep -0.186 -0.107
(0.225) (0.289)
Equity/TA 0.000 0.006
(0.190) (0.187)
Wholesale 0.137 0.142
(0.115) (0.110)
ROA -0.109 -0.096
(0.118) (0.122)
ℓ_S (Securities) 0.191
(0.373)
ℓ_L (Loans) 0.170
(0.228)
ℓ_S × f^U (expect > 0) -0.089
(0.198)
ℓ_L × f^U (expect ≈ 0) 0.600*
(0.316)
Num.Obs. 430 430
R2 0.036 0.064
R2 Adj. 0.016 0.039
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust 
save_reg_latex(reg_dw_sig, "Table_Rho_DW_Signal",
  coef_rename = c("mtm_sec_b"="$\\ell_S$", "mtm_loan_b"="$\\ell_L$",
    "f_u_b"="$f^U$", "sec_x_fu_b"="$\\ell_S \\times f^U$",
    "loan_x_fu_b"="$\\ell_L \\times f^U$"),
  title = "DW: Securities vs Loan Signal")
## Saved: Table_Rho_DW_Signal.tex

9.3 8.3 Decomposition: ℓ × μ × (1 − β^U)

fml_dw_d1 <- as.formula(paste0("rho_dw ~ mtm_total_b + f_u_b + mtm_x_fu_b + ", ctrl_b_str))
fml_dw_d2 <- as.formula(paste0("rho_dw ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
                                 "mtm_x_mu_b + mtm_x_1mbeta_b + ", ctrl_b_str))
fml_dw_d3 <- as.formula(paste0("rho_dw ~ mtm_total_b + unins_lev_b + one_minus_beta_b + ",
                                 "mtm_x_mu_x_1mbeta_b + ", ctrl_b_str))

reg_dw_decomp <- list(
  "ℓ × f^U"               = feols(fml_dw_d1, data = df_dw_reg, vcov = "hetero"),
  "ℓ×μ + ℓ×(1−β^U)"       = feols(fml_dw_d2, data = df_dw_reg, vcov = "hetero"),
  "ℓ × μ × (1−β^U)"       = feols(fml_dw_d3, data = df_dw_reg, vcov = "hetero")
)

msummary(reg_dw_decomp, stars = c("*"=.10, "**"=.05, "***"=.01), gof_omit = "AIC|BIC|Log|RMSE",
  coef_rename = decomp_map,
  title = "DW: Decomposition ℓ × f^U → ℓ × μ × (1−β^U)")
DW: Decomposition ℓ × f^U → ℓ × μ × (1−β^U)
ℓ × f^U ℓ×μ + ℓ×(1−β^U) ℓ × μ × (1−β^U)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 0.982*** 0.971*** 0.971***
(0.153) (0.153) (0.151)
ℓ 0.100 0.109 0.072
(0.197) (0.195) (0.193)
f^U 0.219
(0.199)
ℓ × f^U 0.304
(0.209)
Log(Assets) 0.056 0.023 0.029
(0.154) (0.119) (0.118)
Cash/TA -0.348*** -0.355** -0.400***
(0.130) (0.140) (0.123)
Loan/Dep -0.186 -0.182 -0.188
(0.225) (0.224) (0.225)
Equity/TA 0.000 0.013 -0.036
(0.190) (0.189) (0.206)
Wholesale 0.137 0.146 0.156
(0.115) (0.106) (0.111)
ROA -0.109 -0.122 -0.093
(0.118) (0.123) (0.114)
μ (Uninsured Leverage) 0.254 0.239
(0.190) (0.169)
1−β^U (Deposit Sensitivity) 0.040 0.002
(0.214) (0.178)
ℓ × μ 0.237
(0.176)
ℓ × (1−β^U) 0.141
(0.168)
ℓ × μ × (1−β^U) -0.019
(0.054)
Num.Obs. 430 430 430
R2 0.036 0.036 0.029
R2 Adj. 0.016 0.011 0.006
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
save_reg_latex(reg_dw_decomp, "Table_Rho_DW_Decomp",
  coef_rename = c("mtm_total_b"="$\\ell$", "f_u_b"="$f^U$",
    "unins_lev_b"="$\\mu$", "one_minus_beta_b"="$1-\\beta^U$",
    "mtm_x_fu_b"="$\\ell \\times f^U$",
    "mtm_x_mu_b"="$\\ell \\times \\mu$",
    "mtm_x_1mbeta_b"="$\\ell \\times (1-\\beta^U)$",
    "mtm_x_mu_x_1mbeta_b"="$\\ell \\times \\mu \\times (1-\\beta^U)$"),
  title = "DW: Decomposition")
## Saved: Table_Rho_DW_Decomp.tex

10 SCATTER PLOTS

10.1 10.1 ρ vs ℓ × f^U

p_btfp_sc <- ggplot(df_btfp_reg, aes(x = mtm_x_fu_b, y = rho_btfp)) +
  geom_point(aes(color = ifelse(btfp_multi == 1, "Multi-Loan", "Single-Loan")),
             alpha = 0.5, size = 2) +
  geom_smooth(method = "lm", color = "#C62828", se = TRUE, linewidth = 0.8) +
  scale_color_manual(values = c("Multi-Loan" = "#E53935", "Single-Loan" = "#1565C0"), name = NULL) +
  labs(title = "BTFP: ρ vs ℓ × f^U",
       subtitle = "Positive slope = coordination amplifies drawdown of par capacity.",
       x = "ℓ × f^U (z-score)", y = "ρ_BTFP") + theme_gp

p_dw_sc <- ggplot(df_dw_reg, aes(x = mtm_x_fu_b, y = rho_dw)) +
  geom_point(aes(color = ifelse(dw_multi == 1, "Multi-Loan", "Single-Loan")),
             alpha = 0.5, size = 2) +
  geom_smooth(method = "lm", color = "#C62828", se = TRUE, linewidth = 0.8) +
  scale_color_manual(values = c("Multi-Loan" = "#E53935", "Single-Loan" = "#1565C0"), name = NULL) +
  labs(title = "DW: ρ vs ℓ × f^U",
       x = "ℓ × f^U (z-score)", y = "ρ_DW") + theme_gp

print(p_btfp_sc + p_dw_sc)

save_figure(p_btfp_sc + p_dw_sc, "Fig_Rho_vs_Interaction", width = 14, height = 6)

10.2 10.2 ρ vs Cash

p_btfp_cash <- ggplot(df_btfp_reg, aes(x = cash_b, y = rho_btfp)) +
  geom_point(alpha = 0.4, size = 2, color = "#1565C0") +
  geom_smooth(method = "lm", color = "#C62828", se = TRUE, linewidth = 0.8) +
  labs(title = "BTFP: ρ vs Cash/TA",
       subtitle = "Negative slope = liquid banks draw less capacity.",
       x = "Cash/TA (z-score)", y = "ρ_BTFP") + theme_gp

p_dw_cash <- ggplot(df_dw_reg, aes(x = cash_b, y = rho_dw)) +
  geom_point(alpha = 0.4, size = 2, color = "#E53935") +
  geom_smooth(method = "lm", color = "#1565C0", se = TRUE, linewidth = 0.8) +
  labs(title = "DW: ρ vs Cash/TA",
       x = "Cash/TA (z-score)", y = "ρ_DW") + theme_gp

print(p_btfp_cash + p_dw_cash)

save_figure(p_btfp_cash + p_dw_cash, "Fig_Rho_vs_Cash", width = 14, height = 6)

10.3 10.3 ρ vs Run Value v

p_btfp_v <- ggplot(df_btfp_reg, aes(x = v_pp, y = rho_btfp)) +
  geom_point(alpha = 0.4, size = 2, color = "#37474F") +
  geom_smooth(method = "lm", color = "#C62828", se = TRUE, linewidth = 0.8) +
  geom_vline(xintercept = 0, linetype = "dashed", linewidth = 0.6) +
  labs(title = "BTFP: ρ vs Run Value v",
       subtitle = "v < 0 ⟹ run equilibrium possible; expect higher ρ (negative slope).",
       x = "Run Value v (pp of TA)", y = "ρ_BTFP") + theme_gp

p_dw_v <- ggplot(df_dw_reg, aes(x = v_pp, y = rho_dw)) +
  geom_point(alpha = 0.4, size = 2, color = "#37474F") +
  geom_smooth(method = "lm", color = "#C62828", se = TRUE, linewidth = 0.8) +
  geom_vline(xintercept = 0, linetype = "dashed", linewidth = 0.6) +
  labs(title = "DW: ρ vs Run Value v",
       x = "Run Value v (pp of TA)", y = "ρ_DW") + theme_gp

print(p_btfp_v + p_dw_v)

save_figure(p_btfp_v + p_dw_v, "Fig_Rho_vs_RunValue", width = 14, height = 6)