1 Theory-to-Code Map

Every equation and prediction in theory_standalone.tex is mapped to a specific code section below. This document is organized to allow a reader to verify that every testable claim in the theory is executed.

Theory Reference Claim Code Section
Eq. 1 Balance sheet: \(C+S+L = D^I + D^U + E\) §3 Variable Construction
Eq. 2 \(\lambda = (1-\theta_S)S + (1-\theta_L)L\); decomposition \(\ell = \ell_S + \ell_L\) §3 Variable Construction
Eq. 3 \(f_i = \max\{[(1-\beta^U_i)y - c^U_i]/(y+\delta) \cdot \mu_i,\; 0\}\); DSSW Eq. 20 decaying perpetuity (\(\delta=10\%\)) §3 Calibration
Eq. 4 \(E^{MV} = E - \lambda + F\) §3 Variable Construction
Eq. 5 Panic width \(= (D^U/D)F\) §4 Sanity Checks
Eq. 6 Run threshold \(\lambda^* = \underline\lambda + \alpha(D^U/D)F\) Not directly testable (\(\alpha\) unobserved)
Eq. 7 \(\partial^2\Pr(\text{run})/\partial\lambda\partial D^U > 0\) §8 Prediction 2 (Goldstein)
Eq. 8 Liquidity gap \(g = w - (C+\theta_S S)\) §7 P1 (composition of borrowers)
Eq. 9 BTFP margin \(\Delta_{\text{BTFP}} = (1-\theta_S)S_{\text{el}}\) §9 Prediction 3 (par-value channel)
Eq. 10 Partial threshold \(\underline\ell(\phi)\) §12 Robustness: \(\phi\) sensitivity
Eq. 11 LPM: \(\Pr(\text{Borrow}_i) = \alpha + c_1\ell + c_2 f + c_3(\ell\times f) + \gamma'X + \varepsilon\) §8 Prediction 2
P1 Borrowers concentrated in panic zone, not fund. insolvency §7
P1 “Coordination: MTM losses and uninsured leverage jointly elevated” §7.3
P2 \(c_3>0\) in panic zone; \(c_3\approx 0\) in fund. insolvency §8.1–8.3
P2 Goldstein test: formal \(c_3^{PZ} \neq c_3^{FI}\) §8.4
P2 Decomposition: \(\ell\times\mu\) vs \(\ell\times(1-\beta^U)\) §8.5
P2 “Uninsured leverage channel should dominate” §8.5
P3 BTFP: \(\ell_S\) positive; DW: \(\ell_S \approx 0\) §9.1
P3 Cross-equation: \(\ell_S^{BTFP} > \ell_S^{DW}\) §9.2
P3 Observable vs unobservable signal: \(\ell_S\times f\) vs \(\ell_L\times f\) §9.3
P3 Facility choice among borrowers §9.4
Falsification FHLB: \(\ell\times f \approx 0\) §10.1
Falsification Arb period: \(c_3 \approx 0\) §10.2
Robustness Logit §11.1
Robustness \(\beta^U\) clipping §11.2
Robustness \(T\) sensitivity (\(T \in \{5,7,10,15,20,\infty\}\); perpetuity as upper bound) §11.4
Robustness \(\phi\) sensitivity (eq. 10) §11.3

2 SETUP

2.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.

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

create_size_category_3 <- function(assets_thousands) {
  assets_millions <- assets_thousands / 1000
  case_when(
    assets_millions >= 100000 ~ "Large (>$100B)",
    assets_millions >= 1000   ~ "Medium ($1B-$100B)",
    TRUE                      ~ "Small (<$1B)")
}
size_levels_3 <- c("Small (<$1B)", "Medium ($1B-$100B)", "Large (>$100B)")

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

# --- Dependent variable summary rows for modelsummary ---
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
}

# --- Desc stats helpers ---
build_desc_table <- function(df_a, df_b, label_a, label_b, vars, labels) {
  avail <- vars[vars %in% names(df_a) & vars %in% names(df_b)]
  avail_labels <- labels[vars %in% names(df_a) & vars %in% names(df_b)]
  results <- data.frame(Variable = avail_labels, stringsAsFactors = FALSE)
  results[[paste0("N_", label_a)]]      <- sapply(avail, function(v) sum(!is.na(df_a[[v]])))
  results[[paste0("Mean_", label_a)]]   <- sapply(avail, function(v) round(mean(df_a[[v]], na.rm=TRUE), 3))
  results[[paste0("SD_", label_a)]]     <- sapply(avail, function(v) round(sd(df_a[[v]], na.rm=TRUE), 3))
  results[[paste0("Median_", label_a)]] <- sapply(avail, function(v) round(median(df_a[[v]], na.rm=TRUE), 3))
  results[[paste0("N_", label_b)]]      <- sapply(avail, function(v) sum(!is.na(df_b[[v]])))
  results[[paste0("Mean_", label_b)]]   <- sapply(avail, function(v) round(mean(df_b[[v]], na.rm=TRUE), 3))
  results[[paste0("SD_", label_b)]]     <- sapply(avail, function(v) round(sd(df_b[[v]], na.rm=TRUE), 3))
  results[[paste0("Median_", label_b)]] <- sapply(avail, function(v) round(median(df_b[[v]], na.rm=TRUE), 3))
  results$Diff <- results[[paste0("Mean_", label_a)]] - results[[paste0("Mean_", label_b)]]
  results$t_stat <- sapply(avail, function(v) {
    tt <- tryCatch(t.test(df_a[[v]], df_b[[v]]), error = function(e) NULL)
    if (!is.null(tt)) round(tt$statistic, 2) else NA_real_
  })
  results$p_val <- sapply(avail, function(v) {
    tt <- tryCatch(t.test(df_a[[v]], df_b[[v]]), error = function(e) NULL)
    if (!is.null(tt)) round(tt$p.value, 4) else NA_real_
  })
  results$Stars <- sapply(results$p_val, format_pval)
  return(results)
}

display_desc_table <- function(desc_tbl, label_a, label_b, n_a, n_b, caption_text) {
  disp <- desc_tbl %>%
    mutate(
      !!paste0(label_a, " Mean (SD)") := sprintf("%.3f (%.3f)",
        .data[[paste0("Mean_", label_a)]], .data[[paste0("SD_", label_a)]]),
      !!paste0(label_b, " Mean (SD)") := sprintf("%.3f (%.3f)",
        .data[[paste0("Mean_", label_b)]], .data[[paste0("SD_", label_b)]]),
      Difference = sprintf("%.3f%s", Diff, Stars),
      `t-stat` = round(t_stat, 2)
    ) %>%
    select(Variable, all_of(paste0(label_a, " Mean (SD)")),
           all_of(paste0(label_b, " Mean (SD)")), Difference, `t-stat`)
  kbl(disp, format = "html", escape = FALSE,
      caption = sprintf("%s: %s (N=%d) vs. %s (N=%d)", caption_text, label_a, n_a, label_b, n_b)) %>%
    kable_styling(bootstrap_options = c("striped","hover","condensed"),
                  full_width = FALSE, position = "left") %>%
    footnote(general = "*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).", general_title = "")
}

save_desc_latex <- function(desc_tbl, label_a, label_b, n_a, n_b, caption_text, filename) {
  tex <- desc_tbl %>%
    mutate(col_a = sprintf("%.3f (%.3f)", .data[[paste0("Mean_",label_a)]], .data[[paste0("SD_",label_a)]]),
           col_b = sprintf("%.3f (%.3f)", .data[[paste0("Mean_",label_b)]], .data[[paste0("SD_",label_b)]]),
           diff_col = sprintf("%.3f%s", Diff, Stars)) %>%
    select(Variable, col_a, col_b, diff_col, t_stat)
  names(tex) <- c("Variable", paste0(label_a," Mean (SD)"), paste0(label_b," Mean (SD)"), "Difference", "t-stat")
  kbl_tex <- kbl(tex, format="latex", booktabs=TRUE, escape=FALSE,
    caption=sprintf("%s: %s (N=%d) vs. %s (N=%d)", caption_text, label_a, n_a, label_b, n_b)) %>%
    kable_styling(latex_options = c("hold_position","scale_down")) %>%
    footnote(general="*** p$<$0.01, ** p$<$0.05, * p$<$0.10.", escape=FALSE, general_title="")
  writeLines(kbl_tex, file.path(TABLE_PATH, paste0(filename, ".tex")))
  cat(sprintf("Saved: %s.tex\n", filename))
}

# --- Save kbl table as LaTeX ---
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")) %>%
    footnote(general = "", escape = FALSE, general_title = "")
  writeLines(tex, file.path(TABLE_PATH, paste0(filename, ".tex")))
  cat(sprintf("Saved: %s.tex\n", filename))
}

# --- Save modelsummary regression table as LaTeX ---
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))
}

2.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/run_Analysis_03232026")
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")

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

# ── Load deposit costs from DSSW hedonic estimation ──
# (Generated by deposit_cost_estimation.Rmd)
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)
  cat("Deposit costs loaded:", nrow(deposit_costs_2022q4), "banks at 2022Q4\n")
  HAS_DEPOSIT_COSTS <- TRUE
} else {
  cat("WARNING: dssw_deposit_costs.csv not found. Run deposit_cost_estimation.Rmd first.\n")
  cat("         Using c = 0 (deposit costs omitted from franchise value).\n")
  deposit_costs_2022q4 <- NULL
  HAS_DEPOSIT_COSTS <- FALSE
}
## Deposit costs loaded: 4685 banks at 2022Q4
cat("Call Report:", nrow(call_q), "obs |", n_distinct(call_q$idrssd), "banks\n")
## Call Report: 75989 obs | 5074 banks

3.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)
cat("Excluded:", length(excluded_banks), "banks (G-SIB + failed)\n")
## Excluded: 41 banks (G-SIB + failed)
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

4 CALIBRATION & VARIABLE CONSTRUCTION

4.1 Calibration [Theory Eq. 3]

# ==============================================================================
# DSSW Eq. (20): Decaying perpetuity (Gordon Growth Model)
#
# Deposits decay at rate δ per year. The franchise rent (1-β^U)y - c^U
# on each dollar of uninsured deposits is capitalized as a decaying
# perpetuity:
#
#   f_i = max{ [(1-β^U_i) y - c^U_i] / (y + δ) × μ_i , 0 }
#
# where:
#   y     = 10-year Treasury yield (the discount rate for a stream with
#           duration 1/δ = 10 years)
#   δ     = deposit decay rate (10% per year; DSSW baseline)
#   β^U_i = uninsured deposit beta (bank-level, DSSW)
#   c^U_i = uninsured deposit operating cost (bank-level, DSSW hedonic)
#   μ_i   = D^U_i / A_i (uninsured deposit leverage)
#
# The cap factor 1/(y+δ) = 7.18 is constant across banks.
# The pmax ensures f ≥ 0: if operating costs exceed franchise rents,
# the franchise is worthless (not negative).
# ==============================================================================
 
y_10yr      <- 0.0370     # 10-year Treasury yield (March 10, 2023) — from FRED DGS10
delta_decay <- 0.10      # Deposit decay rate (DSSW baseline: 10% per year)
cap_factor  <- 1 / (y_10yr + delta_decay)   # = 7.18
 
cat("=== CALIBRATION (DSSW Eq. 20: Decaying Perpetuity) ===\n")
## === CALIBRATION (DSSW Eq. 20: Decaying Perpetuity) ===
cat(sprintf("  y (10yr Treasury) = %.4f\n", y_10yr))
##   y (10yr Treasury) = 0.0370
cat(sprintf("  δ (decay rate)    = %.2f (deposit half-life ≈ %.1f years)\n",
    delta_decay, log(2)/delta_decay))
##   δ (decay rate)    = 0.10 (deposit half-life ≈ 6.9 years)
cat(sprintf("  Cap. factor       = 1/(y+δ) = 1/%.4f = %.2f\n",
    y_10yr + delta_decay, cap_factor))
##   Cap. factor       = 1/(y+δ) = 1/0.1370 = 7.30
cat(sprintf("  Duration match    = 1/δ = %.0f years → 10yr Treasury\n", 1/delta_decay))
##   Duration match    = 1/δ = 10 years → 10yr Treasury

4.2 Variable Construction [Theory Eq. 1–4, Table 1]

# ==============================================================================
# Maps EVERY variable in Theory Table 1 to data:
#   ℓ_S = (1-θ_S)S/A    → total securities MTM losses / TA
#   ℓ_L = (1-θ_L)L/A    → mtm_loss_total_loan_to_total_asset
#   ℓ   = ℓ_S + ℓ_L     → mtm_loss_to_total_asset
#   BTFP-eligible        → mtm_loss_omo_eligible_to_total_asset    [OMO securities]
#   non-BTFP             → mtm_loss_non_omo_eligible_to_total_asset [non-OMO sec + loans]
#   μ   = D^U/A          → uninsured_deposit_to_total_asset
#   β^U                  → beta_uninsured (DSSW)
#   c   = deposit cost   → deposit_cost_weighted (DSSW hedonic)
#   f   = (1-β^U)(r-c) μ × AF(T,δ)            [Franchise value / TA, finite-horizon annuity]
#   e   = E/A            → book_equity_to_total_asset
#   ℓ̄  = e + f           → solvency threshold
#   ℓ_  = e + (D^I/D)f   → liquidity threshold
#
# β^U is CLIPPED to [0,1] per theory assumption (β ∈ [0,1]).
# δ = 10yr Treasury yield; r = Fed funds rate; c = deposit cost.
# ==============================================================================

construct_analysis_vars <- function(baseline_data) {
  baseline_data %>%
    mutate(
      # ── Eq. 2: MTM loss components ──
      #    ℓ   = total MTM losses / TA
      #    ℓ_S = (1-θ_S)S/A = total securities losses / TA  (= ℓ - ℓ_L)
      #    ℓ_L = (1-θ_L)L/A = total loan losses / TA
      mtm_total_raw  = mtm_loss_to_total_asset,
      mtm_loan_raw   = mtm_loss_total_loan_to_total_asset,           # ℓ_L: Loan losses
      mtm_sec_raw    = mtm_loss_to_total_asset -                     # ℓ_S: Securities losses
                       mtm_loss_total_loan_to_total_asset,           #      = ℓ - ℓ_L
      # BTFP-eligible (OMO) vs non-BTFP decomposition (for P3 par-channel tests)
      mtm_btfp_raw   = mtm_loss_omo_eligible_to_total_asset,        # OMO-eligible securities
      mtm_other_raw  = mtm_loss_non_omo_eligible_to_total_asset,    # non-OMO sec + loans

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

      # ── Deposit beta: clip to [0,1] per theory ──
      uninsured_beta_raw    = ifelse(!is.na(beta_uninsured), beta_uninsured, NA_real_),
      beta_u_clipped        = pmin(pmax(uninsured_beta_raw, 0), 1),
      beta_was_clipped      = as.integer(!is.na(uninsured_beta_raw) &
        (uninsured_beta_raw < 0 | uninsured_beta_raw > 1)),

      # ── Uninsured deposit cost c^U (from DSSW hedonic estimation) ──
      # DSSW Eq. 20: cost is subtracted from the franchise rent, not the rate.
      # Use uninsured-specific cost (not weighted average across all deposits).
      cost_u_raw = ifelse(!is.na(deposit_cost_uninsured), deposit_cost_uninsured, 0),

      # ── Jiang AE (Framework A) ──
      adjusted_equity_raw = book_equity_to_total_asset - mtm_loss_to_total_asset,
      mtm_insolvent = as.integer(adjusted_equity_raw < 0),
      mtm_solvent   = as.integer(adjusted_equity_raw >= 0),

      # ── IDCR-100% (Framework B) ──
      mv_assets = mm_asset,
      idcr_100  = safe_div(mv_assets - uninsured_deposit - insured_deposit,
                            insured_deposit, NA_real_),
      insolvent_idcr_100 = as.integer(idcr_100 < 0),
      solvent_idcr_100   = as.integer(idcr_100 >= 0),
      
     # ── DSSW Eq. 20: Franchise value (decaying perpetuity) ──
      # f_i = pmax( ((1 - β^U_i) * y - c^U_i) / (y + δ) * μ_i, 0 )
      #
      # The numerator (1-β^U)*y is the gross franchise rent per dollar of
      # uninsured deposits: the spread between the market rate y and the
      # deposit rate β^U*y. Subtracting c^U gives the NET rent after
      # operating costs. Capitalizing at (y+δ) reflects both discounting
      # and deposit decay. Multiplying by μ scales to assets.
      #
      # NOTE: (1-β)*y - c ≠ (1-β)*(y-c). The cost is on the RENT, not the RATE.
      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_),
 
      # Gross franchise rent per $ of uninsured deposits
      gross_rent = (1 - beta_u_clipped) * y_10yr,
      # Net rent = gross rent - operating cost
      net_rent   = gross_rent - cost_u_raw,
 
      # f in decimal (fraction of total assets)
      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_), 
      

      # ── Eq. 4: E^MV = e - ℓ + f ──
      emv_pp = ifelse(!is.na(f_pp),
        book_equity_to_total_asset - mtm_loss_to_total_asset + f_pp, NA_real_),
      # Post-run equity = e - ℓ + (D^I/D)f
      e_postrun_pp = ifelse(!is.na(f_pp) & !is.na(insured_share),
        book_equity_to_total_asset - mtm_loss_to_total_asset + insured_share * f_pp, NA_real_),

      # ── Thresholds ──
      threshold_solvency  = ifelse(!is.na(f_pp), book_equity_to_total_asset + f_pp, NA_real_),
      threshold_liquidity = ifelse(!is.na(f_pp) & !is.na(insured_share),
        book_equity_to_total_asset + insured_share * f_pp, NA_real_),
      # ── Eq. 5: Panic width = (D^U/D)f ──
      panic_width = ifelse(!is.na(f_pp) & !is.na(uninsured_share_d),
        uninsured_share_d * f_pp, NA_real_),

      # ── Three-region classification ──
      model_region = case_when(
        is.na(threshold_solvency) | is.na(threshold_liquidity) ~ NA_character_,
        mtm_loss_to_total_asset <= threshold_liquidity ~ "No-Run Region",
        mtm_loss_to_total_asset <= threshold_solvency  ~ "Panic Zone",
        TRUE ~ "Fundamental Insolvency"),
      model_region = factor(model_region,
        levels = c("No-Run Region","Panic Zone","Fundamental Insolvency")),
      in_norun = as.integer(model_region == "No-Run Region"),
      in_panic = as.integer(model_region == "Panic Zone"),
      in_fund_ins = as.integer(model_region == "Fundamental Insolvency"),

      # ── Eq. 7: Liquidity gap proxy ──
      # g = w - (C + θ_S S). Market value of securities = book - ALL securities MTM losses.
      # liquid_buffer = C/A + (S/A - ℓ_S) = cash + market-value securities
      liquid_buffer_raw = cash_to_total_asset + security_to_total_asset - mtm_sec_raw,

      # ── 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),   # BTFP-eligible (OMO)
      mtm_other_w=winsorize(mtm_other_raw),  # non-BTFP (non-OMO sec + loans)
      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), 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 (full-sample z-scores) ──
      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),   # BTFP-eligible (OMO) z-score
      mtm_other=standardize_z(mtm_other_w),  # non-BTFP z-score
      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), 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),

      # ── Eq. 6 / Eq. 11: Interactions ──
      # NOTE: The theory's comparative static (Eq. 7) is ∂²Pr/∂λ∂D^U,
      # i.e. w.r.t. λ and D^U (uninsured deposits). The regression specification
      # (Eq. 11) uses ℓ × f instead, where f = (1-β^U)(r-c)μ/δ conflates
      # the leverage channel (ℓ × μ) and the stickiness channel (ℓ × (1-β^U)).
      # This is the paper's stated specification; the decomposition in §8.5
      # separates the two channels as a robustness check.
      mtm_x_franchise  = mtm_total * franchise_value,
      mtm_x_uninsured  = mtm_total * uninsured_lev,
      mtm_x_unins_beta = mtm_total * uninsured_beta,

      # ── Eq. 9: Par benefit & collateral ──
      collateral_capacity_raw = omo_eligible_to_total_asset,
      par_benefit_raw = mtm_loss_omo_eligible_to_omo_eligible,
      size_cat = factor(create_size_category_3(total_asset), levels = size_levels_3)
    ) %>%
    mutate(collateral_capacity_w = winsorize(collateral_capacity_raw),
           collateral_capacity = standardize_z(collateral_capacity_w),
           par_benefit_w = winsorize(par_benefit_raw),
           par_benefit = standardize_z(par_benefit_w))
}

5 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), "| Beta^U available:", sum(!is.na(df_2022q4$f_pp)),
    "| Beta clipped:", sum(df_2022q4$beta_was_clipped, na.rm=TRUE), "\n")
## 2022Q4: 4292 | Beta^U available: 4226 | Beta clipped: 8
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),
           user_group=factor(case_when(both_fed==1~"Both",!!sym(btfp_var)==1~"BTFP_Only",
             !!sym(dw_var)==1~"DW_Only",TRUE~"Neither"),
             levels=c("Neither","BTFP_Only","DW_Only","Both")),
           non_user=as.integer(any_fed==0&fhlb_user==0))
}

df_crisis <- join_all_borrowers(df_2022q4, btfp_crisis, dw_crisis, "btfp_crisis", "dw_crisis")
df_arb <- df_2023q3 %>%
  left_join(btfp_arb %>% select(idrssd,btfp_arb,btfp_arb_amt), by="idrssd") %>%
  left_join(dw_arb %>% select(idrssd,dw_arb), by="idrssd") %>%
  mutate(btfp_arb=replace_na(btfp_arb,0L), dw_arb=replace_na(dw_arb,0L),
         fhlb_user=as.integer(abnormal_fhlb_borrowing_10pct==1),
         any_fed=as.integer(btfp_arb==1|dw_arb==1),
         non_user=as.integer(any_fed==0&fhlb_user==0))

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

5.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","roa")

cleaning_log <- list()
log_step <- function(step, description, df) {
  cleaning_log[[length(cleaning_log) + 1]] <<- list(
    Step = step, Description = description, N = nrow(df),
    Borrowers = sum(df$any_fed, na.rm = TRUE))
  invisible(df)
}

log_step(1, "Call Report universe (all bank-quarters)", call_q %>% mutate(any_fed = NA_integer_))
log_step(2, sprintf("Filter to baseline period (%s)", BASELINE_MAIN),
         call_q %>% filter(period == BASELINE_MAIN) %>% mutate(any_fed = NA_integer_))
log_step(3, "Exclude G-SIB and failed banks",
         call_q %>% filter(period == BASELINE_MAIN, !idrssd %in% excluded_banks) %>% mutate(any_fed = NA_integer_))
log_step(4, "Require OMO-eligible securities > 0",
         call_q %>% filter(period == BASELINE_MAIN, !idrssd %in% excluded_banks,
                           !is.na(omo_eligible) & omo_eligible > 0) %>% mutate(any_fed = NA_integer_))
log_step(5, "Merge DSSW betas + borrower indicators", df_crisis)

df_tmp <- df_crisis
log_step(6, "Drop missing MTM losses", df_tmp <- df_tmp %>% filter(!is.na(mtm_loss_to_total_asset)))
log_step(7, "Drop missing core balance sheet",
         df_tmp <- df_tmp %>% filter(if_all(all_of(core_vars), ~!is.na(.))))
log_step(8, "Drop missing deposits",
         df_tmp <- df_tmp %>% filter(!is.na(uninsured_deposit) & !is.na(insured_deposit) &
                                      insured_deposit > 0 & !is.na(uninsured_deposit_to_total_asset)))
log_step(9, "Drop missing FHLB indicator",
         df_tmp <- df_tmp %>% filter(!is.na(abnormal_fhlb_borrowing_10pct)))
log_step(10, "Drop non-positive total assets",
         df_tmp <- df_tmp %>% filter(total_asset > 0 & is.finite(ln_assets_raw)))
log_step(11, "Drop missing adjusted equity / IDCR",
         df_tmp <- df_tmp %>% filter(!is.na(adjusted_equity_raw) & !is.na(idcr_100)))

df_crisis_clean <- df_tmp
df_crisis_model <- df_crisis_clean %>% filter(!is.na(model_region))
log_step(12, "Require DSSW beta^U -> theory model", df_crisis_model)

df_arb_clean <- df_arb %>%
  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) %>% filter(!is.na(adjusted_equity_raw) & !is.na(idcr_100))

cat(sprintf("Clean: %d | Theory model: %d | Arb: %d\n",
    nrow(df_crisis_clean), nrow(df_crisis_model), nrow(df_arb_clean)))
## Clean: 4251 | Theory model: 4226 | Arb: 4168
cl <- bind_rows(lapply(cleaning_log, as.data.frame))
cl$Dropped <- c(NA, -diff(cl$N)); cl$Dropped[1] <- 0
cl$Pct_of_Prev <- c(NA, round(100*cl$Dropped[-1]/cl$N[-nrow(cl)],1)); cl$Pct_of_Prev[1] <- 0
cl$Borrowers_disp <- ifelse(cl$Step >= 5, cl$Borrowers, "---")

disp_cl <- cl %>%
  mutate(N_fmt=formatC(N,format="d",big.mark=","),
         Drop_fmt=ifelse(Dropped==0,"---",formatC(Dropped,format="d",big.mark=",")),
         Pct_fmt=ifelse(is.na(Pct_of_Prev)|Pct_of_Prev==0,"---",paste0(Pct_of_Prev,"%")),
         Borr_fmt=Borrowers_disp) %>%
  select(Step, Description, N_fmt, Drop_fmt, Pct_fmt, Borr_fmt)

kbl(disp_cl, format="html", escape=FALSE,
    col.names=c("Step","Filter","N Remaining","Dropped","% Dropped","Fed Borrowers"),
    caption="Sample Construction") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(nrow(disp_cl), bold=TRUE, background="#e8f5e9")
Sample Construction
Step Filter N Remaining Dropped % Dropped Fed Borrowers
1 Call Report universe (all bank-quarters) 75,989 — — —
2 Filter to baseline period (2022Q4) 4,737 71,252 93.8% —
3 Exclude G-SIB and failed banks 4,696 41 0.9% —
4 Require OMO-eligible securities > 0 4,292 404 8.6% —
5 Merge DSSW betas + borrower indicators 4,292 — — 828
6 Drop missing MTM losses 4,282 10 0.2% 828
7 Drop missing core balance sheet 4,282 — — 828
8 Drop missing deposits 4,251 31 0.7% 828
9 Drop missing FHLB indicator 4,251 — — 828
10 Drop non-positive total assets 4,251 — — 828
11 Drop missing adjusted equity / IDCR 4,251 — — 828
12 Require DSSW beta^U -> theory model 4,226 25 0.6% 822 
# --- LaTeX export ---
save_kbl_latex(disp_cl, "Table_SampleConstruction",
  col.names=c("Step","Filter","N Remaining","Dropped","\\% Dropped","Fed Borrowers"),
  caption="Sample Construction")
## Saved: Table_SampleConstruction.tex

6 SANITY CHECKS [Theory Eq. 4–5]

df_check <- df_crisis_model

cat("=== SANITY CHECKS (Theory Equations 4-5) ===\n\n")
## === SANITY CHECKS (Theory Equations 4-5) ===
# Eq. 2: ℓ = ℓ_S + ℓ_L (securities + loans)
decomp_err <- max(abs(df_check$mtm_total_raw - (df_check$mtm_sec_raw + df_check$mtm_loan_raw)), na.rm=TRUE)
cat(sprintf("Eq. 2: max|ℓ - (ℓ_S + ℓ_L)| = %.6f → %s\n", decomp_err,
    ifelse(decomp_err < 0.01, "PASS", "FAIL")))
## Eq. 2: max|ℓ - (ℓ_S + ℓ_L)| = 0.000000 → PASS
# Eq. 9: ℓ_S is the coordination signal (observable); ℓ_L is the fundamental channel (unobservable)
cat(sprintf("Eq. 2/9: Securities MTM (ℓ_S): mean=%.2f | Loan MTM (ℓ_L): mean=%.2f | Sum check: max|ℓ-(ℓ_S+ℓ_L)|=%.6f → PASS\n",
    mean(df_check$mtm_sec_raw, na.rm=TRUE), mean(df_check$mtm_loan_raw, na.rm=TRUE), decomp_err))
## Eq. 2/9: Securities MTM (ℓ_S): mean=2.14 | Loan MTM (ℓ_L): mean=3.35 | Sum check: max|ℓ-(ℓ_S+ℓ_L)|=0.000000 → PASS
# Eq. 3 (DSSW): f >= 0 (guaranteed by pmax in formula)
stopifnot(all(df_check$f_pp >= 0, na.rm = TRUE))
cat("DSSW Eq. 20: f >= 0 for all banks (pmax in formula) → PASS\n")
## DSSW Eq. 20: f >= 0 for all banks (pmax in formula) → PASS
# Diagnostic: how many banks have negative net rent BEFORE the pmax floor?
n_neg_rent <- sum(!is.na(df_check$beta_u_clipped) &
  ((1 - df_check$beta_u_clipped) * y_10yr - df_check$cost_u_raw) < 0, na.rm = TRUE)
cat(sprintf("  Banks with (1-β^U)y < c^U (negative net rent, floored to f=0): %d (%.1f%%)\n",
    n_neg_rent, 100 * n_neg_rent / sum(!is.na(df_check$beta_u_clipped))))
##   Banks with (1-β^U)y < c^U (negative net rent, floored to f=0): 47 (1.1%)
# Eq. 4: E^MV = e - ℓ + f
emv_err <- max(abs(df_check$emv_pp - (df_check$book_equity_ratio_raw - df_check$mtm_total_raw + df_check$f_pp)), na.rm=TRUE)
cat(sprintf("Eq. 4: max|E^MV - (e-ℓ+f)| = %.6f → %s\n", emv_err,
    ifelse(emv_err < 0.001, "PASS", "CHECK")))
## Eq. 4: max|E^MV - (e-ℓ+f)| = 0.000000 → PASS
# Eq. 5: ℓ̄ >= ℓ_ (solvency >= liquidity threshold)
stopifnot(all(df_check$threshold_solvency >= df_check$threshold_liquidity - 1e-10, na.rm=TRUE))
cat("Eq. 5: Solvency threshold >= Liquidity threshold → PASS\n")
## Eq. 5: Solvency threshold >= Liquidity threshold → PASS
# Eq. 5: panic_width = (D^U/D)*f
pw_err <- max(abs(df_check$panic_width - df_check$uninsured_share_d*df_check$f_pp), na.rm=TRUE)
cat(sprintf("Eq. 5: max|panic_width - (D^U/D)f| = %.6f → %s\n", pw_err,
    ifelse(pw_err < 0.001, "PASS", "CHECK")))
## Eq. 5: max|panic_width - (D^U/D)f| = 0.000000 → PASS
# Region ordering
nr <- df_check %>% filter(model_region=="No-Run Region")
pz <- df_check %>% filter(model_region=="Panic Zone")
fi <- df_check %>% filter(model_region=="Fundamental Insolvency")
stopifnot(all(nr$mtm_total_raw <= nr$threshold_liquidity + 1e-10))
stopifnot(all(pz$mtm_total_raw >  pz$threshold_liquidity - 1e-10))
stopifnot(all(pz$mtm_total_raw <= pz$threshold_solvency  + 1e-10))
stopifnot(all(fi$mtm_total_raw >  fi$threshold_solvency  - 1e-10))
cat("Region assignments consistent with thresholds → PASS\n")
## Region assignments consistent with thresholds → PASS
cat(sprintf("\nBeta^U clipped: %d banks (%.1f%%)\n",
    sum(df_check$beta_was_clipped,na.rm=T), 100*mean(df_check$beta_was_clipped,na.rm=T)))
## 
## Beta^U clipped: 8 banks (0.2%)
cat("\n=== ALL SANITY CHECKS PASSED ===\n")
## 
## === ALL SANITY CHECKS PASSED ===

7 THREE-REGION CLASSIFICATION

7.1 Sensitivity to φ (Run Assumption) [Theory Eq. 10]

Theory (Eq. 10): \(\underline\ell(\phi) = e + [(D^I + (1-\phi)D^U)/D]\,f\). Baseline uses \(\phi = 1\) (full uninsured run). Lower \(\phi\) raises the liquidity threshold, shrinking the panic zone and moving banks toward no-run.

phi_grid_main <- c(0.25, 0.50, 0.75, 1.00)

phi_table <- map_dfr(phi_grid_main, function(phi) {
  df_phi <- df_crisis_model %>%
    mutate(
      # Eq. 10: generalised liquidity threshold
      th_liq_phi = book_equity_to_total_asset +
        safe_div(insured_deposit + (1 - phi) * uninsured_deposit,
                 insured_deposit + uninsured_deposit, NA_real_) * f_pp,
      region_phi = case_when(
        is.na(th_liq_phi) | is.na(threshold_solvency) ~ NA_character_,
        mtm_total_raw <= th_liq_phi ~ "No-Run",
        mtm_total_raw <= threshold_solvency ~ "Panic",
        TRUE ~ "Fund. Insolvency"
      )
    ) %>% filter(!is.na(region_phi))

  n_tot <- nrow(df_phi)
  n_nr  <- sum(df_phi$region_phi == "No-Run")
  n_pz  <- sum(df_phi$region_phi == "Panic")
  n_fi  <- sum(df_phi$region_phi == "Fund. Insolvency")

  # Borrowing rates by region
  br_nr <- if (n_nr > 0) mean(df_phi$any_fed[df_phi$region_phi == "No-Run"], na.rm = TRUE) else NA_real_
  br_pz <- if (n_pz > 0) mean(df_phi$any_fed[df_phi$region_phi == "Panic"], na.rm = TRUE) else NA_real_
  br_fi <- if (n_fi > 0) mean(df_phi$any_fed[df_phi$region_phi == "Fund. Insolvency"], na.rm = TRUE) else NA_real_

  # Mean panic width = (D^U/D)f (solvency threshold unchanged; only liquidity moves)
  mean_width <- mean(df_phi$threshold_solvency - df_phi$th_liq_phi, na.rm = TRUE)

  tibble(
    phi = phi, N = n_tot,
    NoRun = n_nr, Panic = n_pz, FundIns = n_fi,
    Borr_NoRun = br_nr, Borr_Panic = br_pz, Borr_FundIns = br_fi,
    PanicWidth = round(mean_width, 2)
  )
})

disp_phi <- phi_table %>%
  mutate(
    `φ` = sprintf("%.0f%%", phi * 100),
    `No-Run` = sprintf("%d (%.1f%%)", NoRun, 100 * NoRun / N),
    `Panic Zone` = sprintf("%d (%.1f%%)", Panic, 100 * Panic / N),
    `Fund. Insolvency` = sprintf("%d (%.1f%%)", FundIns, 100 * FundIns / N),
    `Borr. Rate (NR)` = ifelse(is.na(Borr_NoRun), "---", sprintf("%.1f%%", 100 * Borr_NoRun)),
    `Borr. Rate (PZ)` = ifelse(is.na(Borr_Panic), "---", sprintf("%.1f%%", 100 * Borr_Panic)),
    `Borr. Rate (FI)` = ifelse(is.na(Borr_FundIns), "---", sprintf("%.1f%%", 100 * Borr_FundIns)),
    `Width (pp)` = PanicWidth
  ) %>%
  select(`φ`, N, `No-Run`, `Panic Zone`, `Fund. Insolvency`,
         `Borr. Rate (NR)`, `Borr. Rate (PZ)`, `Borr. Rate (FI)`, `Width (pp)`)

kbl(disp_phi, format = "html", escape = FALSE,
    caption = sprintf("Three-Region Classification Under Alternative Run Assumptions (N=%d, δ=%.2f%%)",
                      phi_table$N[1], delta_decay * 100)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  row_spec(which(phi_table$phi == 1.00), bold = TRUE, background = "#e8f5e9") %>%
  add_header_above(c(" " = 2, "Region Counts" = 3, "Fed Borrowing Rate" = 3, " " = 1)) %>%
  footnote(general = c(
    "φ = fraction of uninsured depositors who run. φ=100% is the baseline (worst-case full run).",
    "Liquidity threshold: ℓ_(φ) = e + [(D^I + (1-φ)D^U)/D]f. Solvency threshold unchanged: ℓ̄ = e + f.",
    "Lower φ raises ℓ_(φ), shrinking the panic zone and reclassifying marginal banks as no-run."))
Three-Region Classification Under Alternative Run Assumptions (N=4226, δ=10.00%)
Region Counts
Fed Borrowing Rate
φ N No-Run Panic Zone Fund. Insolvency Borr. Rate (NR) Borr. Rate (PZ) Borr. Rate (FI) Width (pp)
25% 4226 3877 (91.7%) 14 (0.3%) 335 (7.9%) 18.9% 21.4% 26.3% 0.21
50% 4226 3852 (91.2%) 39 (0.9%) 335 (7.9%) 18.7% 33.3% 26.3% 0.42
75% 4226 3822 (90.4%) 69 (1.6%) 335 (7.9%) 18.7% 30.4% 26.3% 0.63
100% 4226 3789 (89.7%) 102 (2.4%) 335 (7.9%) 18.5% 32.4% 26.3% 0.84
Note:
φ = fraction of uninsured depositors who run. φ=100% is the baseline (worst-case full run).
Liquidity threshold: ℓ_(φ) = e + [(D^I + (1-φ)D^U)/D]f. Solvency threshold unchanged: ℓ̄ = e + f.
Lower φ raises ℓ_(φ), shrinking the panic zone and reclassifying marginal banks as no-run. 
# --- LaTeX export ---
tex_phi <- kbl(disp_phi, format="latex", booktabs=TRUE, escape=FALSE,
    caption=sprintf("Three-Region Classification Under Alternative Run Assumptions (N=%d, $\\delta$=%.2f\\%%)",
                    phi_table$N[1], delta_decay*100)) %>%
  kable_styling(latex_options=c("hold_position","scale_down")) %>%
  add_header_above(c(" "=2, "Region Counts"=3, "Fed Borrowing Rate"=3, " "=1)) %>%
  footnote(general=c("$\\phi$=1 (baseline): full uninsured-depositor run.",
    "Liquidity threshold: $\\underline{\\ell}(\\phi) = e + [(D^I + (1-\\phi)D^U)/D]f$."),
    escape=FALSE, general_title="")
writeLines(tex_phi, file.path(TABLE_PATH, "Table_Sensitivity_Phi.tex"))
cat("Saved: Table_Sensitivity_Phi.tex\n")
## Saved: Table_Sensitivity_Phi.tex

7.2 Sensitivity to δ (Discount Rate)

# DSSW uses δ=0.10. We test δ ∈ {0.05, 0.075, 0.10, 0.125, 0.15, 0.20}
# Lower δ = slower decay = longer-lived deposits = higher cap factor = higher f
sens <- map_dfr(c(0.05, 0.075, 0.10, 0.125, 0.15, 0.20), function(dd) {
  cf_dd <- 1 / (y_10yr + dd)
  df_s <- df_crisis_clean %>% filter(!is.na(beta_u_clipped)) %>%
    mutate(c_u = ifelse(!is.na(cost_u_raw), cost_u_raw, 0),
           f_s = pmax(((1 - beta_u_clipped) * y_10yr - c_u) * cf_dd * mu_decimal, 0) * 100,
           th_sol = book_equity_to_total_asset + f_s,
           th_liq = book_equity_to_total_asset + insured_share * f_s,
           reg = case_when(mtm_loss_to_total_asset <= th_liq ~ "NoRun",
                           mtm_loss_to_total_asset <= th_sol ~ "Panic", TRUE ~ "FundIns"))
  tibble(delta_pct = dd * 100, N = nrow(df_s), NoRun = sum(df_s$reg == "NoRun"),
         Panic = sum(df_s$reg == "Panic"), FundIns = sum(df_s$reg == "FundIns"),
         Cap_Factor = round(cf_dd, 2),
         Mean_f = round(mean(df_s$f_s, na.rm = TRUE), 2),
         Width = round(mean(df_s$th_sol - df_s$th_liq, na.rm = TRUE), 2))
})
disp_s <- sens %>% mutate(`No-Run`=sprintf("%d (%.1f%%)",NoRun,100*NoRun/N),
  `Panic`=sprintf("%d (%.1f%%)",Panic,100*Panic/N),
  `Fund.Ins.`=sprintf("%d (%.1f%%)",FundIns,100*FundIns/N)) %>%
  select(delta_pct, Cap_Factor, N, `No-Run`, Panic, `Fund.Ins.`, Mean_f, Width)
 
kbl(disp_s, format="html", escape=FALSE,
    col.names=c("δ (%)","1/(y+δ)","N","No-Run","Panic","Fund.Ins.","Mean f (pp)","Width (pp)"),
    caption=sprintf("Sensitivity to Deposit Decay Rate (y=%.2f%%, baseline δ=%.0f%%)",
                    y_10yr*100, delta_decay*100)) %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(which(abs(sens$delta_pct - delta_decay*100) < 0.01), bold=TRUE, background="#e8f5e9") %>%
  footnote(general=c(
    "δ = deposit decay rate (fraction of deposits that leave per year).",
    "Lower δ → slower decay → higher cap factor → higher f → fewer banks in Panic/FI.",
    "DSSW baseline: δ = 10% (duration = 10 years)."))
Sensitivity to Deposit Decay Rate (y=3.70%, baseline δ=10%)
δ (%) 1/(y+δ) N No-Run Panic Fund.Ins. Mean f (pp) Width (pp)
5.0 11.49 4226 3934 (93.1%) 96 (2.3%) 196 (4.6%) 3.85 1.32
7.5 8.93 4226 3853 (91.2%) 103 (2.4%) 270 (6.4%) 2.99 1.03
10.0 7.30 4226 3789 (89.7%) 102 (2.4%) 335 (7.9%) 2.44 0.84
12.5 6.17 4226 3754 (88.8%) 98 (2.3%) 374 (8.8%) 2.07 0.71
15.0 5.35 4226 3714 (87.9%) 96 (2.3%) 416 (9.8%) 1.79 0.62
20.0 4.22 4226 3662 (86.7%) 84 (2.0%) 480 (11.4%) 1.41 0.49
Note:
δ = deposit decay rate (fraction of deposits that leave per year).
Lower δ → slower decay → higher cap factor → higher f → fewer banks in Panic/FI.
DSSW baseline: δ = 10% (duration = 10 years). 
# --- LaTeX export ---
save_kbl_latex(disp_s, "Table_Sensitivity_Delta",
  col.names=c("$\\delta$ (\\%)","$1/(y+\\delta)$","N","No-Run","Panic","Fund.Ins.",
              "Mean $f$ (pp)","Width (pp)"),
  caption=sprintf("Sensitivity to Deposit Decay Rate ($y$=%.2f\\%%, baseline $\\delta$=%.0f\\%%)",
                  y_10yr*100, delta_decay*100))
## Saved: Table_Sensitivity_Delta.tex

7.3 Cross-Framework Comparison

n_all <- nrow(df_crisis_clean); nm <- nrow(df_crisis_model)
comp <- tribble(~Framework, ~`Solvent/NoRun`, ~Panic, ~`Insol/FundIns`)

ns <- sum(df_crisis_clean$mtm_solvent,na.rm=T)
comp <- comp %>% add_row(Framework="Jiang AE (e-l>=0)",
  `Solvent/NoRun`=sprintf("%d (%.1f%%)",ns,100*ns/n_all), Panic="---",
  `Insol/FundIns`=sprintf("%d (%.1f%%)",n_all-ns,100*(n_all-ns)/n_all))

for (phi in c(0.25, 0.50, 0.75, 1.00)) {
  ip <- safe_div(df_crisis_clean$mv_assets-phi*df_crisis_clean$uninsured_deposit-df_crisis_clean$insured_deposit,
                  df_crisis_clean$insured_deposit, NA_real_)
  ns <- sum(ip>=0,na.rm=T); ni <- sum(ip<0,na.rm=T); nt <- ns+ni
  comp <- comp %>% add_row(Framework=sprintf("IDCR (phi=%.0f%%)",phi*100),
    `Solvent/NoRun`=sprintf("%d (%.1f%%)",ns,100*ns/nt), Panic="---",
    `Insol/FundIns`=sprintf("%d (%.1f%%)",ni,100*ni/nt))
}

comp <- comp %>% add_row(
  Framework=sprintf("Theory Model (N=%d, r=%.1f%%, δ=%.2f%%)",nm,y_10yr*100,delta_decay*100),
  `Solvent/NoRun`=sprintf("%d (%.1f%%)",sum(df_crisis_model$in_norun),100*mean(df_crisis_model$in_norun)),
  Panic=sprintf("%d (%.1f%%)",sum(df_crisis_model$in_panic),100*mean(df_crisis_model$in_panic)),
  `Insol/FundIns`=sprintf("%d (%.1f%%)",sum(df_crisis_model$in_fund_ins),100*mean(df_crisis_model$in_fund_ins)))

kbl(comp, format="html", escape=FALSE,
    col.names=c("Framework","Solvent/No-Run","Panic Zone","Fund.Insolvency"),
    caption="Bank Classification (2022Q4)") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(nrow(comp), bold=TRUE, background="#e8f5e9")
Bank Classification (2022Q4)
Framework Solvent/No-Run Panic Zone Fund.Insolvency
Jiang AE (e-l>=0) 3426 (80.6%) — 825 (19.4%)
IDCR (phi=25%) 4157 (97.8%) — 94 (2.2%)
IDCR (phi=50%) 4072 (95.8%) — 179 (4.2%)
IDCR (phi=75%) 3809 (89.6%) — 442 (10.4%)
IDCR (phi=100%) 3041 (71.5%) — 1210 (28.5%)
Theory Model (N=4226, r=3.7%, δ=10.00%) 3789 (89.7%) 102 (2.4%) 335 (7.9%) 
# --- LaTeX export ---
save_kbl_latex(comp, "Table_CrossFramework",
  col.names=c("Framework","Solvent/No-Run","Panic Zone","Fund.Insolvency"),
  caption="Bank Classification: Cross-Framework Comparison (2022Q4)")
## Saved: Table_CrossFramework.tex

8 FRANCHISE VALUE DIAGNOSTICS

df_fv <- df_crisis_model
cat("================================================================\n")
## ================================================================
cat("  FRANCHISE VALUE DIAGNOSTICS [Theory Eq. 3]\n")
##   FRANCHISE VALUE DIAGNOSTICS [Theory Eq. 3]
cat("================================================================\n\n")
## ================================================================
cat(sprintf("Banks: %d | f: mean=%.2f, med=%.2f, sd=%.2f\n",
    nrow(df_fv), mean(df_fv$f_pp), median(df_fv$f_pp), sd(df_fv$f_pp)))
## Banks: 4226 | f: mean=2.44, med=2.18, sd=1.50
cat(sprintf("  P10=%.2f, P25=%.2f, P75=%.2f, P90=%.2f\n",
    quantile(df_fv$f_pp,.10), quantile(df_fv$f_pp,.25), quantile(df_fv$f_pp,.75), quantile(df_fv$f_pp,.90)))
##   P10=0.84, P25=1.45, P75=3.14, P90=4.28
cat(sprintf("\nInputs: beta^U (clipped): mean=%.3f | mu: mean=%.3f\n",
    mean(df_fv$beta_u_clipped,na.rm=T), mean(df_fv$mu_decimal,na.rm=T)))
## 
## Inputs: beta^U (clipped): mean=0.331 | mu: mean=0.238
cat(sprintf("  Uninsured cost (c^U): mean=%.4f | Net rent ((1-β^U)y - c^U): mean=%.4f\n",
    mean(df_fv$cost_u_raw, na.rm=T),
    mean((1 - df_fv$beta_u_clipped) * y_10yr - df_fv$cost_u_raw, na.rm=T)))
##   Uninsured cost (c^U): mean=0.0108 | Net rent ((1-β^U)y - c^U): mean=0.0139
cat(sprintf("  y = %.2f%% | δ (decay) = %.0f%% | Cap.factor = 1/(y+δ) = %.2f\n",
    y_10yr*100, delta_decay*100, cap_factor))
##   y = 3.70% | δ (decay) = 10% | Cap.factor = 1/(y+δ) = 7.30
cat(sprintf("\nThresholds: Solvency=%.2f | Liquidity=%.2f | Width=%.2f | Actual MTM=%.2f\n",
    mean(df_fv$threshold_solvency), mean(df_fv$threshold_liquidity),
    mean(df_fv$panic_width,na.rm=T), mean(df_fv$mtm_total_raw)))
## 
## Thresholds: Solvency=12.05 | Liquidity=11.21 | Width=0.84 | Actual MTM=5.49
cat(sprintf("E^MV: mean=%.2f | E^post-run: mean=%.2f\n",
    mean(df_fv$emv_pp), mean(df_fv$e_postrun_pp,na.rm=T)))
## E^MV: mean=6.55 | E^post-run: mean=5.72

9 DESCRIPTIVE STATISTICS

desc_vars_A <- c("ln_assets_raw","cash_ratio_raw","securities_ratio_raw","loan_ratio_raw",
  "book_equity_ratio_raw","roa_raw","fhlb_ratio_raw","wholesale_raw","loan_to_deposit_raw")
desc_labels_A <- c("Log(Assets)","Cash / TA","Securities / TA","Loans / TA",
  "Book Equity / TA (e)","ROA","FHLB / TA","Wholesale (%)","Loan / Deposit")

desc_vars_B <- c("mtm_total_raw","mtm_sec_raw","mtm_loan_raw","mtm_btfp_raw","mtm_other_raw",
  "cost_u_raw","net_rent",
  "uninsured_lev_raw","insured_lev_raw","uninsured_share_raw","uninsured_beta_raw",
  "f_pp","emv_pp","e_postrun_pp","threshold_solvency","threshold_liquidity","panic_width")
desc_labels_B <- c("Total MTM (l)","Securities MTM (l_S)","Loan MTM (l_L)",
  "BTFP-elig MTM (OMO)","Non-BTFP MTM","Deposit Cost (c)","Net Spread (r-c)",
  "Uninsured/TA (mu)","Insured/TA","D^U/D","Beta^U","Franchise (f)",
  "MV Equity (E^MV)","Post-Run Equity","Solvency Thres.","Liquidity Thres.","Panic Width")

desc_vars_C <- c("collateral_capacity_raw","par_benefit_raw")
desc_labels_C <- c("OMO Collateral/TA (%)","Par Benefit")

desc_vars_all <- c(desc_vars_A, desc_vars_B, desc_vars_C)
desc_labels_all <- c(desc_labels_A, desc_labels_B, desc_labels_C)

9.1 Panel: Borrower vs Non-Borrower by Region

for (reg in c("No-Run Region","Panic Zone","Fundamental Insolvency")) {
  df_reg <- df_crisis_model %>% filter(model_region==reg)
  df_b <- df_reg %>% filter(any_fed==1); df_n <- df_reg %>% filter(any_fed==0)
  if (nrow(df_b)>=5 & nrow(df_n)>=5) {
    d <- build_desc_table(df_b,df_n,"Borrower","NonBorrower",desc_vars_all,desc_labels_all)
    cat(sprintf("\n### %s (B:%d, NB:%d)\n\n", reg, nrow(df_b), nrow(df_n)))
    print(display_desc_table(d,"Borrower","NonBorrower",nrow(df_b),nrow(df_n),reg))
    save_desc_latex(d,"Borrower","NonBorrower",nrow(df_b),nrow(df_n),reg,
                    sprintf("Table_Desc_%s",gsub("[^A-Za-z]","",reg)))
    cat("\n")
  }
}

9.1.1 No-Run Region (B:701, NB:3088)

No-Run Region: Borrower (N=701) vs. NonBorrower (N=3088)
Variable Borrower Mean (SD) NonBorrower Mean (SD) Difference t-stat
Log(Assets) 13.846 (1.551) 12.710 (1.383) 1.136*** 17.85
Cash / TA 5.477 (5.748) 8.959 (9.442) -3.482*** -12.63
Securities / TA 24.099 (12.820) 23.841 (14.820) 0.258 0.47
Loans / TA 64.502 (13.570) 61.076 (16.915) 3.426*** 5.75
Book Equity / TA (e) 9.252 (2.792) 10.355 (6.154) -1.103*** -7.21
ROA 1.123 (0.609) 1.081 (2.006) 0.042 0.97
FHLB / TA 3.703 (4.806) 2.396 (4.019) 1.307*** 6.69
Wholesale (%) 1.443 (3.367) 0.868 (3.087) 0.575*** 4.15
Loan / Deposit 76.824 (18.608) 72.087 (24.244) 4.737*** 5.73
Total MTM (l) 5.535 (1.794) 5.081 (2.058) 0.454*** 5.88
Securities MTM (l_S) 2.043 (1.360) 1.837 (1.523) 0.206*** 3.53
Loan MTM (l_L) 3.492 (1.526) 3.244 (1.744) 0.248*** 3.79
BTFP-elig MTM (OMO) 0.729 (0.735) 0.612 (0.775) 0.117*** 3.78
Non-BTFP MTM 4.740 (1.730) 4.304 (1.926) 0.436*** 5.90
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.013 (0.004) 0.014 (0.004) -0.001*** -3.23
Uninsured/TA (mu) 27.553 (12.330) 23.081 (11.822) 4.472*** 8.74
Insured/TA 57.612 (12.895) 62.568 (13.089) -4.956*** -9.16
D^U/D 32.538 (14.554) 27.066 (13.902) 5.472*** 9.06
Beta^U 0.345 (0.119) 0.329 (0.105) 0.016*** 3.19
Franchise (f) 2.741 (1.589) 2.389 (1.490) 0.352*** 5.36
MV Equity (E^MV) 6.458 (3.621) 7.662 (6.619) -1.204*** -6.64
Post-Run Equity 5.409 (3.359) 6.854 (6.512) -1.445*** -8.37
Solvency Thres. 11.993 (2.980) 12.743 (6.063) -0.750*** -4.79
Liquidity Thres. 10.944 (2.704) 11.935 (5.990) -0.991*** -6.67
Panic Width 1.049 (1.066) 0.808 (0.956) 0.241*** 5.50
OMO Collateral/TA (%) 10.243 (9.419) 10.645 (10.265) -0.402 -1.00
Par Benefit 8.294 (11.284) 10.869 (224.740) -2.575 -0.63
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).

Saved: Table_Desc_NoRunRegion.tex

9.1.2 Panic Zone (B:33, NB:69)

Panic Zone: Borrower (N=33) vs. NonBorrower (N=69)
Variable Borrower Mean (SD) NonBorrower Mean (SD) Difference t-stat
Log(Assets) 13.757 (1.367) 12.732 (1.038) 1.025*** 3.81
Cash / TA 3.566 (2.837) 5.819 (4.350) -2.253*** -3.13
Securities / TA 35.560 (12.510) 39.289 (17.205) -3.729 -1.24
Loans / TA 55.722 (13.006) 49.192 (18.838) 6.530** 2.04
Book Equity / TA (e) 5.545 (1.420) 5.293 (1.575) 0.252 0.81
ROA 0.950 (0.364) 0.947 (0.478) 0.003 0.03
FHLB / TA 2.865 (3.705) 2.222 (3.356) 0.643 0.85
Wholesale (%) 1.818 (3.753) 0.668 (1.600) 1.150* 1.69
Loan / Deposit 63.623 (18.243) 54.280 (21.847) 9.343** 2.27
Total MTM (l) 8.414 (1.314) 7.786 (1.415) 0.628** 2.20
Securities MTM (l_S) 4.117 (1.424) 4.213 (1.716) -0.096 -0.30
Loan MTM (l_L) 4.297 (1.821) 3.574 (2.226) 0.723* 1.74
BTFP-elig MTM (OMO) 1.379 (1.266) 0.818 (0.888) 0.561** 2.29
Non-BTFP MTM 6.531 (2.064) 6.197 (2.001) 0.334 0.77
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.016 (0.002) 0.015 (0.003) 0.001 0.92
Uninsured/TA (mu) 32.427 (8.349) 30.845 (15.312) 1.582 0.67
Insured/TA 56.382 (8.774) 60.625 (14.607) -4.243* -1.82
D^U/D 36.452 (9.416) 33.589 (16.118) 2.863 1.13
Beta^U 0.287 (0.059) 0.300 (0.073) -0.013 -0.92
Franchise (f) 3.685 (1.091) 3.365 (1.684) 0.320 1.15
MV Equity (E^MV) 0.816 (0.508) 0.871 (1.522) -0.055 -0.27
Post-Run Equity -0.611 (0.510) -0.499 (0.591) -0.112 -0.98
Solvency Thres. 9.230 (1.252) 8.657 (1.802) 0.573* 1.86
Liquidity Thres. 7.803 (1.281) 7.287 (1.536) 0.516* 1.78
Panic Width 1.426 (0.688) 1.370 (1.693) 0.056 0.24
OMO Collateral/TA (%) 12.423 (10.694) 10.295 (9.468) 2.128 0.98
Par Benefit 13.620 (14.948) 8.473 (4.743) 5.147* 1.93
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).

Saved: Table_Desc_PanicZone.tex

9.1.3 Fundamental Insolvency (B:88, NB:247)

Fundamental Insolvency: Borrower (N=88) vs. NonBorrower (N=247)
Variable Borrower Mean (SD) NonBorrower Mean (SD) Difference t-stat
Log(Assets) 13.185 (1.234) 12.581 (1.230) 0.604*** 3.95
Cash / TA 4.083 (3.999) 5.143 (4.587) -1.060** -2.05
Securities / TA 40.077 (14.801) 38.366 (16.736) 1.711 0.90
Loans / TA 50.590 (16.501) 51.140 (16.997) -0.550 -0.27
Book Equity / TA (e) 4.408 (1.765) 4.824 (1.965) -0.416* -1.84
ROA 0.918 (0.405) 0.827 (0.560) 0.091 1.62
FHLB / TA 3.498 (4.068) 3.052 (4.854) 0.446 0.84
Wholesale (%) 2.103 (4.180) 0.932 (2.133) 1.171** 2.51
Loan / Deposit 57.418 (20.311) 57.180 (20.796) 0.238 0.09
Total MTM (l) 8.198 (1.263) 8.510 (1.428) -0.312* -1.92
Securities MTM (l_S) 4.566 (1.569) 4.562 (2.064) 0.004 0.01
Loan MTM (l_L) 3.633 (1.830) 3.948 (2.309) -0.315 -1.29
BTFP-elig MTM (OMO) 1.257 (1.431) 1.066 (1.157) 0.191 1.12
Non-BTFP MTM 6.349 (1.807) 7.049 (2.016) -0.700*** -3.02
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.013 (0.003) 0.014 (0.003) -0.001 -1.32
Uninsured/TA (mu) 21.799 (9.123) 19.024 (9.012) 2.775** 2.46
Insured/TA 67.639 (9.537) 71.756 (9.426) -4.117*** -3.49
D^U/D 24.330 (9.860) 20.900 (9.522) 3.430*** 2.83
Beta^U 0.345 (0.093) 0.330 (0.092) 0.015 1.32
Franchise (f) 2.127 (1.067) 1.950 (1.053) 0.177 1.34
MV Equity (E^MV) -1.663 (1.470) -1.736 (1.466) 0.073 0.40
Post-Run Equity -2.263 (1.490) -2.227 (1.468) -0.036 -0.20
Solvency Thres. 6.536 (1.750) 6.774 (1.711) -0.238 -1.11
Liquidity Thres. 5.935 (1.696) 6.283 (1.735) -0.348 -1.64
Panic Width 0.601 (0.534) 0.491 (0.476) 0.110* 1.69
OMO Collateral/TA (%) 12.376 (11.671) 10.673 (10.432) 1.703 1.21
Par Benefit 10.214 (4.805) 10.223 (5.176) -0.009 -0.01
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).

Saved: Table_Desc_FundamentalInsolvency.tex

9.2 Full Sample

df_fb <- df_crisis_clean %>% filter(any_fed==1); df_fn <- df_crisis_clean %>% filter(any_fed==0)
d <- build_desc_table(df_fb,df_fn,"FedBorrower","NonBorrower",desc_vars_all,desc_labels_all)
display_desc_table(d,"FedBorrower","NonBorrower",nrow(df_fb),nrow(df_fn),"Full Sample")
Full Sample: FedBorrower (N=828) vs. NonBorrower (N=3423)
Variable FedBorrower Mean (SD) NonBorrower Mean (SD) Difference t-stat
Log(Assets) 13.763 (1.524) 12.698 (1.371) 1.065*** 18.39
Cash / TA 5.256 (5.513) 8.623 (9.154) -3.367*** -13.61
Securities / TA 26.472 (14.267) 25.260 (15.707) 1.212** 2.15
Loans / TA 62.470 (14.766) 60.027 (17.318) 2.443*** 4.12
Book Equity / TA (e) 8.540 (3.158) 9.854 (6.136) -1.314*** -8.65
ROA 1.092 (0.585) 1.058 (1.915) 0.034 0.89
FHLB / TA 3.624 (4.684) 2.441 (4.077) 1.183*** 6.68
Wholesale (%) 1.530 (3.473) 0.872 (3.013) 0.658*** 5.01
Loan / Deposit 73.960 (20.022) 70.558 (24.465) 3.402*** 4.19
Total MTM (l) 5.951 (1.985) 5.386 (2.230) 0.565*** 7.16
Securities MTM (l_S) 2.424 (1.666) 2.092 (1.774) 0.332*** 5.08
Loan MTM (l_L) 3.526 (1.583) 3.294 (1.810) 0.232*** 3.68
BTFP-elig MTM (OMO) 0.824 (0.932) 0.649 (0.822) 0.175*** 4.93
Non-BTFP MTM 4.975 (1.852) 4.541 (2.074) 0.434*** 5.90
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.014 (0.004) 0.014 (0.004) 0.000*** -3.19
Uninsured/TA (mu) 27.149 (12.037) 22.956 (11.878) 4.193*** 9.02
Insured/TA 58.687 (12.795) 63.165 (13.167) -4.478*** -8.99
D^U/D 31.809 (14.167) 26.757 (13.839) 5.052*** 9.25
Beta^U 0.342 (0.115) 0.329 (0.104) 0.013*** 3.15
Franchise (f) 2.713 (1.547) 2.377 (1.478) 0.336*** 5.64
MV Equity (E^MV) 5.362 (4.309) 6.843 (6.827) -1.481*** -7.77
Post-Run Equity 4.346 (4.062) 6.046 (6.712) -1.700*** -9.32
Solvency Thres. 11.298 (3.313) 12.227 (6.023) -0.929*** -6.00
Liquidity Thres. 10.281 (3.041) 11.430 (5.943) -1.149*** -7.81
Panic Width 1.016 (1.022) 0.797 (0.957) 0.219*** 5.59
OMO Collateral/TA (%) 10.639 (9.933) 10.633 (10.254) 0.006 0.02
Par Benefit 8.706 (10.971) 10.758 (213.462) -2.052 -0.56
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test). 
save_desc_latex(d,"FedBorrower","NonBorrower",nrow(df_fb),nrow(df_fn),"Full Sample","Table_Desc_FullSample")
## Saved: Table_Desc_FullSample.tex

9.3 By Facility

for (pair in list(
  list("BTFP_Only", quote(btfp_crisis==1 & dw_crisis==0), "Non_Borrower", quote(any_fed==0)),
  list("DW_Only", quote(dw_crisis==1 & btfp_crisis==0), "Non_Borrower", quote(any_fed==0)),
  list("Both", quote(btfp_crisis==1 & dw_crisis==1), "Non_Borrower", quote(any_fed==0))
)) {
  df_a <- df_crisis_model %>% filter(!!pair[[2]]); df_b <- df_crisis_model %>% filter(!!pair[[4]])
  if (nrow(df_a)>=5 & nrow(df_b)>=5) {
    d <- build_desc_table(df_a,df_b,pair[[1]],pair[[3]],desc_vars_all,desc_labels_all)
    cat(sprintf("\n### %s vs %s\n\n", pair[[1]], pair[[3]]))
    print(display_desc_table(d,pair[[1]],pair[[3]],nrow(df_a),nrow(df_b),pair[[1]]))
    save_desc_latex(d,pair[[1]],pair[[3]],nrow(df_a),nrow(df_b),pair[[1]],
                    sprintf("Table_Desc_%s",pair[[1]]))
    cat("\n")
  }
}

9.3.1 BTFP_Only vs Non_Borrower

BTFP_Only: BTFP_Only (N=392) vs. Non_Borrower (N=3404)
Variable BTFP_Only Mean (SD) Non_Borrower Mean (SD) Difference t-stat
Log(Assets) 13.497 (1.414) 12.701 (1.367) 0.796*** 10.59
Cash / TA 4.677 (4.539) 8.619 (9.161) -3.942*** -14.18
Securities / TA 28.259 (13.597) 25.208 (15.611) 3.051*** 4.14
Loans / TA 61.356 (13.961) 60.114 (17.223) 1.242 1.63
Book Equity / TA (e) 8.218 (3.138) 9.851 (6.096) -1.633*** -8.60
ROA 1.060 (0.541) 1.060 (1.919) 0.000 0.00
FHLB / TA 3.860 (4.600) 2.440 (4.076) 1.420*** 5.85
Wholesale (%) 1.497 (3.327) 0.868 (3.004) 0.629*** 3.58
Loan / Deposit 72.385 (18.978) 70.645 (24.382) 1.740* 1.66
Total MTM (l) 6.165 (1.955) 5.384 (2.223) 0.781*** 7.37
Securities MTM (l_S) 2.608 (1.665) 2.083 (1.750) 0.525*** 5.88
Loan MTM (l_L) 3.557 (1.561) 3.301 (1.811) 0.256*** 3.02
BTFP-elig MTM (OMO) 0.850 (0.903) 0.649 (0.819) 0.201*** 4.21
Non-BTFP MTM 5.063 (1.835) 4.542 (2.074) 0.521*** 5.25
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.014 (0.004) 0.014 (0.004) 0.000 -1.55
Uninsured/TA (mu) 26.173 (11.526) 22.944 (11.821) 3.229*** 5.24
Insured/TA 59.850 (12.078) 63.195 (13.111) -3.345*** -5.15
D^U/D 30.539 (13.375) 26.750 (13.805) 3.789*** 5.29
Beta^U 0.337 (0.105) 0.329 (0.104) 0.008 1.52
Franchise (f) 2.670 (1.540) 2.377 (1.478) 0.293*** 3.59
MV Equity (E^MV) 4.724 (4.302) 6.843 (6.827) -2.119*** -8.59
Post-Run Equity 3.754 (4.044) 6.046 (6.712) -2.292*** -9.78
Solvency Thres. 10.888 (3.311) 12.227 (6.023) -1.339*** -6.81
Liquidity Thres. 9.919 (3.057) 11.430 (5.943) -1.511*** -8.17
Panic Width 0.969 (1.019) 0.797 (0.957) 0.172*** 3.20
OMO Collateral/TA (%) 11.437 (10.334) 10.640 (10.259) 0.797 1.45
Par Benefit 8.913 (14.824) 10.774 (214.057) -1.861 -0.50
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).

Saved: Table_Desc_BTFP_Only.tex

9.3.2 DW_Only vs Non_Borrower

DW_Only: DW_Only (N=326) vs. Non_Borrower (N=3404)
Variable DW_Only Mean (SD) Non_Borrower Mean (SD) Difference t-stat
Log(Assets) 13.832 (1.464) 12.701 (1.367) 1.131*** 13.41
Cash / TA 6.166 (6.530) 8.619 (9.161) -2.453*** -6.22
Securities / TA 23.558 (14.063) 25.208 (15.611) -1.650** -2.00
Loans / TA 64.314 (15.204) 60.114 (17.223) 4.200*** 4.71
Book Equity / TA (e) 9.124 (3.158) 9.851 (6.096) -0.727*** -3.57
ROA 1.134 (0.649) 1.060 (1.919) 0.074 1.51
FHLB / TA 3.244 (4.362) 2.440 (4.076) 0.804*** 3.20
Wholesale (%) 1.489 (3.829) 0.868 (3.004) 0.621*** 2.85
Loan / Deposit 76.302 (20.748) 70.645 (24.382) 5.657*** 4.63
Total MTM (l) 5.710 (2.015) 5.384 (2.223) 0.326*** 2.76
Securities MTM (l_S) 2.112 (1.543) 2.083 (1.750) 0.029 0.32
Loan MTM (l_L) 3.599 (1.646) 3.301 (1.811) 0.298*** 3.09
BTFP-elig MTM (OMO) 0.728 (0.829) 0.649 (0.819) 0.079 1.64
Non-BTFP MTM 4.926 (1.891) 4.542 (2.074) 0.384*** 3.48
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.014 (0.004) 0.014 (0.004) 0.000** -1.99
Uninsured/TA (mu) 26.737 (11.748) 22.944 (11.821) 3.793*** 5.57
Insured/TA 59.006 (12.709) 63.195 (13.111) -4.189*** -5.67
D^U/D 31.457 (13.973) 26.750 (13.805) 4.707*** 5.82
Beta^U 0.341 (0.113) 0.329 (0.104) 0.012* 1.96
Franchise (f) 2.677 (1.495) 2.377 (1.478) 0.300*** 3.46
MV Equity (E^MV) 6.090 (4.341) 6.843 (6.827) -0.753*** -2.81
Post-Run Equity 5.107 (4.101) 6.046 (6.712) -0.939*** -3.69
Solvency Thres. 11.801 (3.386) 12.227 (6.023) -0.426** -1.99
Liquidity Thres. 10.817 (3.108) 11.430 (5.943) -0.613*** -3.07
Panic Width 0.984 (0.946) 0.797 (0.957) 0.187*** 3.40
OMO Collateral/TA (%) 9.271 (8.943) 10.640 (10.259) -1.369*** -2.60
Par Benefit 8.545 (5.954) 10.774 (214.057) -2.229 -0.61
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).

Saved: Table_Desc_DW_Only.tex

9.3.3 Both vs Non_Borrower

Both: Both (N=104) vs. Non_Borrower (N=3404)
Variable Both Mean (SD) Non_Borrower Mean (SD) Difference t-stat
Log(Assets) 14.615 (1.781) 12.701 (1.367) 1.914*** 10.87
Cash / TA 4.549 (5.080) 8.619 (9.161) -4.070*** -7.79
Securities / TA 27.273 (14.419) 25.208 (15.611) 2.065 1.43
Loans / TA 62.394 (14.576) 60.114 (17.223) 2.280 1.56
Book Equity / TA (e) 8.276 (2.597) 9.851 (6.096) -1.575*** -5.72
ROA 1.098 (0.539) 1.060 (1.919) 0.038 0.61
FHLB / TA 4.112 (5.851) 2.440 (4.076) 1.672*** 2.89
Wholesale (%) 1.774 (2.859) 0.868 (3.004) 0.906*** 3.18
Loan / Deposit 74.584 (19.397) 70.645 (24.382) 3.939** 2.02
Total MTM (l) 5.779 (1.864) 5.384 (2.223) 0.395** 2.12
Securities MTM (l_S) 2.491 (1.623) 2.083 (1.750) 0.408** 2.52
Loan MTM (l_L) 3.289 (1.418) 3.301 (1.811) -0.012 -0.09
BTFP-elig MTM (OMO) 0.931 (0.956) 0.649 (0.819) 0.282*** 2.97
Non-BTFP MTM 4.870 (1.750) 4.542 (2.074) 0.328* 1.87
Deposit Cost (c) 0.011 (0.000) 0.011 (0.000) 0.000 NA
Net Spread (r-c) 0.013 (0.005) 0.014 (0.004) -0.001** -2.55
Uninsured/TA (mu) 31.989 (13.857) 22.944 (11.821) 9.045*** 6.58
Insured/TA 52.903 (14.357) 63.195 (13.111) -10.292*** -7.22
D^U/D 37.760 (16.435) 26.750 (13.805) 11.010*** 6.76
Beta^U 0.366 (0.148) 0.329 (0.104) 0.037** 2.54
Franchise (f) 2.988 (1.713) 2.377 (1.478) 0.611*** 3.60
MV Equity (E^MV) 5.485 (3.874) 6.843 (6.827) -1.358*** -3.41
Post-Run Equity 4.190 (3.631) 6.046 (6.712) -1.856*** -4.96
Solvency Thres. 11.265 (2.869) 12.227 (6.023) -0.962*** -3.21
Liquidity Thres. 9.969 (2.502) 11.430 (5.943) -1.461*** -5.50
Panic Width 1.295 (1.214) 0.797 (0.957) 0.498*** 4.15
OMO Collateral/TA (%) 11.284 (9.575) 10.640 (10.259) 0.644 0.67
Par Benefit 8.484 (4.345) 10.774 (214.057) -2.290 -0.62
*** p<0.01, ** p<0.05, * p<0.10 (Welch t-test).

Saved: Table_Desc_Both.tex

10 PREDICTION 1: FUNDAMENTAL VS. PANIC

Theory claim: “If runs were driven by coordination failure, borrowers should be disproportionately panic-zone banks. […] Under the coordination interpretation, MTM losses and uninsured leverage are jointly elevated among borrowers.”

10.1 7.1 Borrowing Rates by Region

region_borrow <- df_crisis_model %>%
  group_by(model_region) %>%
  summarise(N=n(),
    AnyFed_N=sum(any_fed), AnyFed_pct=round(100*mean(any_fed),2),
    BTFP_N=sum(btfp_crisis), BTFP_pct=round(100*mean(btfp_crisis),2),
    DW_N=sum(dw_crisis), DW_pct=round(100*mean(dw_crisis),2),
    FHLB_N=sum(fhlb_user), FHLB_pct=round(100*mean(fhlb_user),2), .groups="drop")

p1_rates_disp <- region_borrow %>%
  mutate(AnyFed=sprintf("%d (%.1f%%)",AnyFed_N,AnyFed_pct),
         BTFP=sprintf("%d (%.1f%%)",BTFP_N,BTFP_pct),
         DW=sprintf("%d (%.1f%%)",DW_N,DW_pct),
         FHLB=sprintf("%d (%.1f%%)",FHLB_N,FHLB_pct)) %>%
  select(model_region,N,AnyFed,BTFP,DW,FHLB)

kbl(p1_rates_disp, format="html", col.names=c("Region","N","Any Fed","BTFP","DW","FHLB"),
      caption="P1: Borrowing Rates by Theory Region") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE)
P1: Borrowing Rates by Theory Region
Region N Any Fed BTFP DW FHLB
No-Run Region 3789 701 (18.5%) 408 (10.8%) 383 (10.1%) 274 (7.2%)
Panic Zone 102 33 (32.4%) 24 (23.5%) 12 (11.8%) 6 (5.9%)
Fundamental Insolvency 335 88 (26.3%) 64 (19.1%) 35 (10.4%) 19 (5.7%) 
# --- LaTeX export ---
save_kbl_latex(p1_rates_disp, "Table_P1_BorrowRates",
  col.names=c("Region","N","Any Fed","BTFP","DW","FHLB"),
  caption="Borrowing Rates by Theory Region")
## Saved: Table_P1_BorrowRates.tex

10.2 7.2 Formal Proportion Tests

cat("=== P1: PROPORTION TESTS ===\n\n")
## === P1: PROPORTION TESTS ===
# Chi-squared across all three regions
tbl_chi <- table(df_crisis_model$model_region, df_crisis_model$any_fed)
chi <- chisq.test(tbl_chi, correct=FALSE)
cat(sprintf("Chi-squared (3 regions): X2=%.2f, df=%d, p=%.6f\n", chi$statistic, chi$parameter, chi$p.value))
## Chi-squared (3 regions): X2=22.96, df=2, p=0.000010
# Pairwise: Panic vs Fund.Ins (the KEY P1 comparison)
pz_d <- df_crisis_model %>% filter(model_region=="Panic Zone")
fi_d <- df_crisis_model %>% filter(model_region=="Fundamental Insolvency")
nr_d <- df_crisis_model %>% filter(model_region=="No-Run Region")

pz_rate <- mean(pz_d$any_fed); fi_rate <- mean(fi_d$any_fed); nr_rate <- mean(nr_d$any_fed)
cat(sprintf("\nBorrowing rates: No-Run=%.2f%%, Panic=%.2f%%, Fund.Ins.=%.2f%%\n",
    nr_rate*100, pz_rate*100, fi_rate*100))
## 
## Borrowing rates: No-Run=18.50%, Panic=32.35%, Fund.Ins.=26.27%
# Two-sample proportion test: Panic > Fund.Ins.?
pt_pf <- prop.test(x=c(sum(pz_d$any_fed), sum(fi_d$any_fed)),
                    n=c(nrow(pz_d), nrow(fi_d)), alternative="greater")
cat(sprintf("Panic > Fund.Ins.: p=%.4f %s\n", pt_pf$p.value,
    ifelse(pt_pf$p.value<0.05, "(SIGNIFICANT: panic zone dominates)","(not significant)")))
## Panic > Fund.Ins.: p=0.1410 (not significant)
# Fisher exact: Panic vs Fund.Ins.
tbl_pf <- table(
  df_crisis_model$model_region[df_crisis_model$model_region %in% c("Panic Zone","Fundamental Insolvency")],
  df_crisis_model$any_fed[df_crisis_model$model_region %in% c("Panic Zone","Fundamental Insolvency")])
if (nrow(tbl_pf)==2 & ncol(tbl_pf)==2) {
  ft <- fisher.test(tbl_pf)
  cat(sprintf("Fisher exact (Panic vs FI): OR=%.2f, p=%.4f\n", ft$estimate, ft$p.value))
}

# Panic > No-Run?
pt_pn <- prop.test(x=c(sum(pz_d$any_fed), sum(nr_d$any_fed)),
                    n=c(nrow(pz_d), nrow(nr_d)), alternative="greater")
cat(sprintf("Panic > No-Run: p=%.4f\n", pt_pn$p.value))
## Panic > No-Run: p=0.0003

10.3 7.3 Joint Elevation Test

Theory: “Under the coordination interpretation, MTM losses and uninsured leverage are jointly elevated among borrowers, because it is the combination that places a bank in the panic zone.”

cat("=== P1: JOINT ELEVATION OF l AND mu AMONG BORROWERS ===\n\n")
## === P1: JOINT ELEVATION OF l AND mu AMONG BORROWERS ===
# Bivariate test: borrowers have higher (ℓ, μ) jointly
cat("--- Univariate comparisons ---\n")
## --- Univariate comparisons ---
for (v in c("mtm_total_raw","uninsured_lev_raw","f_pp")) {
  b_m <- mean(df_crisis_model[[v]][df_crisis_model$any_fed==1], na.rm=T)
  n_m <- mean(df_crisis_model[[v]][df_crisis_model$any_fed==0], na.rm=T)
  tt <- t.test(df_crisis_model[[v]][df_crisis_model$any_fed==1],
               df_crisis_model[[v]][df_crisis_model$any_fed==0])
  cat(sprintf("  %-20s Borrower=%.3f  Non=%.3f  Diff=%.3f (p=%.4f)\n",
      v, b_m, n_m, b_m-n_m, tt$p.value))
}
##   mtm_total_raw        Borrower=5.936  Non=5.384  Diff=0.551 (p=0.0000)
##   uninsured_lev_raw    Borrower=27.133  Non=22.944  Diff=4.189 (p=0.0000)
##   f_pp                 Borrower=2.713  Non=2.377  Diff=0.336 (p=0.0000)
# Regression P1: fundamental vs coordination cross-sectional signatures
# Col 1: losses alone (fundamental channel)
# Col 2: + uninsured leverage (coordination starts)
# Col 3: + interaction (full coordination)
controls <- c("ln_assets","cash_ratio","loan_to_deposit","book_equity_ratio","wholesale","roa")
ctrl_str <- paste(controls, collapse=" + ")

cat("\n--- P1 Progressive Regression: Fundamental vs Coordination Signatures ---\n")
## 
## --- P1 Progressive Regression: Fundamental vs Coordination Signatures ---
reg_p1 <- list(
  "Fundamental"    = feols(as.formula(paste0("any_fed ~ mtm_total + ", ctrl_str)),
                           data=df_crisis_model, vcov="hetero"),
  "+Leverage"      = feols(as.formula(paste0("any_fed ~ mtm_total + uninsured_lev + ", ctrl_str)),
                           data=df_crisis_model, vcov="hetero"),
  "+Interaction"   = feols(as.formula(paste0("any_fed ~ mtm_total + uninsured_lev + mtm_x_uninsured + ", ctrl_str)),
                           data=df_crisis_model, vcov="hetero"),
  "Eq.11 (f spec)" = feols(as.formula(paste0("any_fed ~ mtm_total + franchise_value + mtm_x_franchise + ", ctrl_str)),
                            data=df_crisis_model, vcov="hetero")
)

msummary(reg_p1, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_p1),
  coef_rename=c("mtm_total"="l (MTM)","uninsured_lev"="mu (Uninsured/TA)",
    "mtm_x_uninsured"="l x mu","franchise_value"="f (Franchise)",
    "mtm_x_franchise"="l x f","ln_assets"="Log(Assets)","cash_ratio"="Cash/TA",
    "loan_to_deposit"="Loan/Dep","book_equity_ratio"="Equity/TA",
    "wholesale"="Wholesale","roa"="ROA"),
  title="P1: Fundamental (losses alone) vs Coordination (losses + leverage + interaction)")
P1: Fundamental (losses alone) vs Coordination (losses + leverage + interaction)
Fundamental +Leverage +Interaction Eq.11 (f spec)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 0.192*** 0.192*** 0.194*** 0.193***
(0.006) (0.006) (0.006) (0.006)
l (MTM) 0.022*** 0.025*** 0.029*** 0.027***
(0.006) (0.006) (0.007) (0.006)
Log(Assets) 0.109*** 0.102*** 0.102*** 0.105***
(0.007) (0.008) (0.008) (0.007)
Cash/TA -0.022*** -0.023*** -0.021*** -0.021***
(0.006) (0.006) (0.006) (0.006)
Loan/Dep -0.010 -0.008 -0.005 -0.005
(0.007) (0.007) (0.007) (0.007)
Equity/TA -0.021*** -0.019*** -0.016*** -0.018***
(0.006) (0.006) (0.006) (0.006)
Wholesale 0.028*** 0.029*** 0.029*** 0.029***
(0.007) (0.007) (0.007) (0.007)
ROA 0.000 -0.001 -0.002 -0.002
(0.006) (0.006) (0.006) (0.006)
mu (Uninsured/TA) 0.015** 0.018**
(0.007) (0.007)
l x mu 0.019***
(0.006)
f (Franchise) 0.014**
(0.007)
l x f 0.017***
(0.006)
Num.Obs. 4226 4226 4226 4226
R2 0.107 0.108 0.110 0.109
R2 Adj. 0.105 0.106 0.108 0.108
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 822 822 822
Mean (DV) 0.1945 0.1945 0.1945 0.1945 
# --- LaTeX export ---
save_reg_latex(reg_p1, "Table_P1_Progressive",
  add_rows=dv_summary_rows(reg_p1),
  coef_rename=c("mtm_total"="$\\ell$","uninsured_lev"="$\\mu$",
    "mtm_x_uninsured"="$\\ell \\times \\mu$","franchise_value"="$f$",
    "mtm_x_franchise"="$\\ell \\times f$","ln_assets"="Log(Assets)","cash_ratio"="Cash/TA",
    "loan_to_deposit"="Loan/Dep","book_equity_ratio"="Equity/TA",
    "wholesale"="Wholesale","roa"="ROA"),
  title="Fundamental vs.\\ Coordination Signatures")
## Saved: Table_P1_Progressive.tex

10.4 7.4 Region Indicator Regressions

# Which region predicts borrowing? Panic zone should dominate.
reg_p1r <- list(
  "Indicators"      = feols(as.formula(paste0("any_fed ~ in_panic + in_fund_ins + ", ctrl_str)),
                             data=df_crisis_model, vcov="hetero"),
  "Indicators+BTFP" = feols(as.formula(paste0("btfp_crisis ~ in_panic + in_fund_ins + ", ctrl_str)),
                             data=df_crisis_model, vcov="hetero"),
  "Indicators+DW"   = feols(as.formula(paste0("dw_crisis ~ in_panic + in_fund_ins + ", ctrl_str)),
                             data=df_crisis_model, vcov="hetero")
)

msummary(reg_p1r, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_p1r),
  coef_rename=c("in_panic"="Panic Zone (indicator)","in_fund_ins"="Fund. Insolvency (indicator)"),
  title="P1: Region Indicators Predicting Borrowing (No-Run = reference)",
  notes="Theory predicts: Panic Zone > 0, Fund. Insolvency smaller or zero (coordination, not fundamentals).")
P1: Region Indicators Predicting Borrowing (No-Run = reference)
Indicators Indicators+BTFP Indicators+DW
* p < 0.1, ** p < 0.05, *** p < 0.01
Theory predicts: Panic Zone > 0, Fund. Insolvency smaller or zero (coordination, not fundamentals).
(Intercept) 0.186*** 0.110*** 0.100***
(0.006) (0.005) (0.005)
Panic Zone (indicator) 0.085* 0.080* -0.002
(0.045) (0.042) (0.031)
Fund. Insolvency (indicator) 0.045* 0.045** 0.002
(0.025) (0.023) (0.018)
ln_assets 0.110*** 0.061*** 0.078***
(0.007) (0.006) (0.006)
cash_ratio -0.030*** -0.030*** -0.003
(0.006) (0.004) (0.005)
loan_to_deposit -0.011* -0.014** -0.004
(0.007) (0.005) (0.005)
book_equity_ratio -0.018*** -0.016*** -0.005
(0.006) (0.005) (0.004)
wholesale 0.028*** 0.021*** 0.015***
(0.007) (0.006) (0.005)
roa -0.003 -0.005 -0.001
(0.006) (0.005) (0.005)
Num.Obs. 4226 4226 4226
R2 0.106 0.066 0.071
R2 Adj. 0.104 0.064 0.069
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 496 430
Mean (DV) 0.1945 0.1174 0.1018 
# --- LaTeX export ---
save_reg_latex(reg_p1r, "Table_P1_RegionIndicators",
  add_rows=dv_summary_rows(reg_p1r),
  coef_rename=c("in_panic"="Panic Zone","in_fund_ins"="Fund.\\ Insolvency"),
  title="Region Indicators Predicting Borrowing",
  notes="No-Run Region is the omitted category.")
## Saved: Table_P1_RegionIndicators.tex

11 PREDICTION 2: STRATEGIC COMPLEMENTARITIES (GOLDSTEIN TEST)

Theory claim (Eq. 6/11): “\(c_3 > 0\) estimated within the panic zone; the same interaction should be absent or substantially weaker among fundamentally insolvent banks, where withdrawal is dominant regardless of beliefs and the funding structure adds nothing to the prediction.”

11.1 8.1 Main Table: Eq. (11) Full & By DV

fml_main <- as.formula(paste0("any_fed ~ mtm_total + franchise_value + mtm_x_franchise + ", ctrl_str))

coef_map <- c("mtm_total"="l (MTM)","franchise_value"="f (Franchise)",
  "mtm_x_franchise"="l x f","uninsured_lev"="mu (Uninsured/TA)",
  "ln_assets"="Log(Assets)","cash_ratio"="Cash/TA",
  "loan_to_deposit"="Loan/Dep","book_equity_ratio"="Equity/TA",
  "wholesale"="Wholesale","roa"="ROA")

reg_main <- list(
  "Any Fed"  = feols(fml_main, data=df_crisis_model, vcov="hetero"),
  "BTFP"     = feols(update(fml_main,btfp_crisis~.), data=df_crisis_model, vcov="hetero"),
  "DW"       = feols(update(fml_main,dw_crisis~.),   data=df_crisis_model, vcov="hetero")
)

msummary(reg_main, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_main), coef_rename=coef_map,
  title="P2: Eq. (11) — Full Sample, by Dependent Variable")
P2: Eq. (11) — Full Sample, by Dependent Variable
Any Fed BTFP DW
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 0.193*** 0.116*** 0.101***
(0.006) (0.005) (0.004)
l (MTM) 0.027*** 0.017*** 0.010*
(0.006) (0.005) (0.005)
f (Franchise) 0.014** 0.011* 0.006
(0.007) (0.006) (0.006)
l x f 0.017*** 0.009* 0.014***
(0.006) (0.005) (0.004)
Log(Assets) 0.105*** 0.056*** 0.076***
(0.007) (0.006) (0.006)
Cash/TA -0.021*** -0.025*** 0.001
(0.006) (0.005) (0.005)
Loan/Dep -0.005 -0.010* 0.001
(0.007) (0.006) (0.006)
Equity/TA -0.018*** -0.017*** -0.002
(0.006) (0.005) (0.004)
Wholesale 0.029*** 0.022*** 0.015***
(0.007) (0.006) (0.005)
ROA -0.002 -0.005 -0.002
(0.006) (0.005) (0.005)
Num.Obs. 4226 4226 4226
R2 0.109 0.067 0.074
R2 Adj. 0.108 0.065 0.072
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 496 430
Mean (DV) 0.1945 0.1174 0.1018 
# --- LaTeX export ---
save_reg_latex(reg_main, "Table_P2_MainEq11",
  add_rows=dv_summary_rows(reg_main), coef_rename=coef_map,
  title="Eq.\\ (11): Full Sample, by Dependent Variable")
## Saved: Table_P2_MainEq11.tex

11.2 8.2 Within-Region: Panic Zone vs Fund. Insolvency

This is THE Goldstein test. \(c_3\) should be positive and significant in the panic zone (coordination lives there), and absent or weaker in the fund. insolvency region (withdrawal is dominant regardless of beliefs).

df_pz <- df_crisis_model %>% filter(model_region=="Panic Zone")
df_fi <- df_crisis_model %>% filter(model_region=="Fundamental Insolvency")
df_nr <- df_crisis_model %>% filter(model_region=="No-Run Region")

# --- Panel A: Full-sample z-scores (for comparability with full-sample column) ---
reg_goldstein <- list()
reg_goldstein[["Full"]] <- feols(fml_main, data=df_crisis_model, vcov="hetero")

if (sum(df_pz$any_fed)>=10 & sum(df_pz$any_fed==0)>=10)
  reg_goldstein[["Panic Zone"]] <- feols(fml_main, data=df_pz, vcov="hetero")
if (sum(df_fi$any_fed)>=10 & sum(df_fi$any_fed==0)>=10)
  reg_goldstein[["Fund. Insolvency"]] <- feols(fml_main, data=df_fi, vcov="hetero")
if (sum(df_nr$any_fed)>=10 & sum(df_nr$any_fed==0)>=10)
  reg_goldstein[["No-Run"]] <- feols(fml_main, data=df_nr, vcov="hetero")

msummary(reg_goldstein, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_goldstein), coef_rename=coef_map,
  title="P2 Goldstein Test: Eq. (11) Within Each Region (full-sample z-scores)",
  notes="Theory: c3(l x f) > 0 in Panic Zone; c3 ≈ 0 in Fund. Insolvency. Uses full-sample z-scores.")
P2 Goldstein Test: Eq. (11) Within Each Region (full-sample z-scores)
Full Panic Zone Fund. Insolvency No-Run
* p < 0.1, ** p < 0.05, *** p < 0.01
Theory: c3(l x f) > 0 in Panic Zone; c3 ≈ 0 in Fund. Insolvency. Uses full-sample z-scores.
(Intercept) 0.193*** 0.269 0.233 0.189***
(0.006) (0.450) (0.144) (0.006)
l (MTM) 0.027*** -0.005 -0.044 0.025***
(0.006) (0.180) (0.061) (0.007)
f (Franchise) 0.014** 0.051 -0.073 0.014*
(0.007) (0.068) (0.095) (0.007)
l x f 0.017*** 0.044 0.073 0.015**
(0.006) (0.061) (0.064) (0.006)
Log(Assets) 0.105*** 0.159** 0.114*** 0.103***
(0.007) (0.065) (0.032) (0.008)
Cash/TA -0.021*** -0.181** -0.065 -0.020***
(0.006) (0.086) (0.040) (0.006)
Loan/Dep -0.005 0.030 0.004 -0.005
(0.007) (0.064) (0.034) (0.007)
Equity/TA -0.018*** 0.086 -0.062 -0.014**
(0.006) (0.290) (0.076) (0.006)
Wholesale 0.029*** 0.022 0.045* 0.025***
(0.007) (0.046) (0.024) (0.007)
ROA -0.002 -0.052 -0.023 -0.000
(0.006) (0.063) (0.027) (0.006)
Num.Obs. 4226 102 335 3789
R2 0.109 0.235 0.100 0.107
R2 Adj. 0.108 0.160 0.075 0.104
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 33 88 701
Mean (DV) 0.1945 0.3235 0.2627 0.185 
# --- LaTeX export ---
save_reg_latex(reg_goldstein, "Table_P2_Goldstein",
  add_rows=dv_summary_rows(reg_goldstein), coef_rename=coef_map,
  title="Goldstein Test: Eq.\\ (11) Within Each Region",
  notes="$c_3(\\ell \\times f) > 0$ in Panic Zone; $c_3 \\approx 0$ in Fund.\\ Insolvency.")
## Saved: Table_P2_Goldstein.tex
# --- Panel B: Within-region restandardized z-scores ---
# Full-sample z-scores have shifted means within subsamples, which can distort
# the interaction coefficient. We restandardize within each region so that
# main effects are evaluated at within-region means.
restd_within <- function(df_sub) {
  df_sub %>% mutate(
    mtm_total_r   = standardize_z(winsorize(mtm_total_raw)),
    fv_r          = standardize_z(winsorize(f_pp)),
    mtm_x_fv_r   = mtm_total_r * fv_r,
    uninsured_lev_r = standardize_z(winsorize(uninsured_lev_raw)),
    ln_assets_r   = standardize_z(winsorize(ln_assets_raw)),
    cash_ratio_r  = standardize_z(winsorize(cash_ratio_raw)),
    loan_to_deposit_r = standardize_z(winsorize(loan_to_deposit_raw)),
    book_equity_ratio_r = standardize_z(winsorize(book_equity_ratio_raw)),
    wholesale_r   = standardize_z(winsorize(wholesale_raw)),
    roa_r         = standardize_z(winsorize(roa_raw))
  )
}

fml_restd <- any_fed ~ mtm_total_r + fv_r + mtm_x_fv_r +
  ln_assets_r + cash_ratio_r + loan_to_deposit_r + book_equity_ratio_r + wholesale_r + roa_r

reg_goldstein_restd <- list()

df_pz_r <- restd_within(df_pz)
df_fi_r <- restd_within(df_fi)
df_nr_r <- restd_within(df_nr)

if (sum(df_pz_r$any_fed)>=10 & sum(df_pz_r$any_fed==0)>=10)
  reg_goldstein_restd[["PZ (restd)"]] <- feols(fml_restd, data=df_pz_r, vcov="hetero")
if (sum(df_fi_r$any_fed)>=10 & sum(df_fi_r$any_fed==0)>=10)
  reg_goldstein_restd[["FI (restd)"]] <- feols(fml_restd, data=df_fi_r, vcov="hetero")
if (sum(df_nr_r$any_fed)>=10 & sum(df_nr_r$any_fed==0)>=10)
  reg_goldstein_restd[["NR (restd)"]] <- feols(fml_restd, data=df_nr_r, vcov="hetero")

restd_map <- c("mtm_total_r"="l (MTM)","fv_r"="f (Franchise)","mtm_x_fv_r"="l x f",
  "ln_assets_r"="Log(Assets)","cash_ratio_r"="Cash/TA","loan_to_deposit_r"="Loan/Dep",
  "book_equity_ratio_r"="Equity/TA","wholesale_r"="Wholesale","roa_r"="ROA")

msummary(reg_goldstein_restd, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_goldstein_restd), coef_rename=restd_map,
  title="P2 Goldstein (within-region restandardized z-scores)",
  notes=c("Variables z-standardized WITHIN each region so main effects are evaluated at within-region means.",
    "This ensures l x f is not confounded by level differences in regressors across regions."))
P2 Goldstein (within-region restandardized z-scores)
PZ (restd) FI (restd) NR (restd)
* p < 0.1, ** p < 0.05, *** p < 0.01
Variables z-standardized WITHIN each region so main effects are evaluated at within-region means.
This ensures l x f is not confounded by level differences in regressors across regions.
(Intercept) 0.323*** 0.264*** 0.186***
(0.043) (0.023) (0.006)
l (MTM) 0.058 -0.035 0.023***
(0.095) (0.029) (0.006)
f (Franchise) 0.064 0.017 0.012*
(0.076) (0.028) (0.007)
l x f 0.020 0.030 0.013**
(0.036) (0.024) (0.006)
Log(Assets) 0.135** 0.097*** 0.104***
(0.061) (0.025) (0.008)
Cash/TA -0.091* -0.043* -0.020***
(0.049) (0.026) (0.006)
Loan/Dep 0.019 0.004 -0.004
(0.056) (0.033) (0.007)
Equity/TA -0.014 -0.031 -0.013**
(0.093) (0.036) (0.006)
Wholesale 0.025 0.053* 0.024***
(0.051) (0.028) (0.007)
ROA -0.039 -0.022 -0.001
(0.051) (0.022) (0.006)
Num.Obs. 102 335 3789
R2 0.224 0.106 0.107
R2 Adj. 0.148 0.081 0.105
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 33 88 701
Mean (DV) 0.3235 0.2627 0.185 
# --- LaTeX export ---
save_reg_latex(reg_goldstein_restd, "Table_P2_Goldstein_Restandardized",
  add_rows=dv_summary_rows(reg_goldstein_restd), coef_rename=restd_map,
  title="Goldstein Test: Within-Region Restandardized Z-Scores",
  notes="Variables restandardized within each region.")
## Saved: Table_P2_Goldstein_Restandardized.tex

11.3 8.3 Within-Region: BTFP and DW Separately

reg_region_fac <- list()
if (sum(df_pz$any_fed)>=10)   reg_region_fac[["PZ_AnyFed"]] <- feols(fml_main, data=df_pz, vcov="hetero")
if (sum(df_pz$btfp_crisis)>=10) reg_region_fac[["PZ_BTFP"]] <- feols(update(fml_main,btfp_crisis~.), data=df_pz, vcov="hetero")
if (sum(df_pz$dw_crisis)>=10)   reg_region_fac[["PZ_DW"]]   <- feols(update(fml_main,dw_crisis~.), data=df_pz, vcov="hetero")
if (sum(df_fi$any_fed)>=10)   reg_region_fac[["FI_AnyFed"]] <- feols(fml_main, data=df_fi, vcov="hetero")
if (sum(df_fi$btfp_crisis)>=10) reg_region_fac[["FI_BTFP"]] <- feols(update(fml_main,btfp_crisis~.), data=df_fi, vcov="hetero")
if (sum(df_fi$dw_crisis)>=10)   reg_region_fac[["FI_DW"]]   <- feols(update(fml_main,dw_crisis~.), data=df_fi, vcov="hetero")

if (length(reg_region_fac)>0) {
  msummary(reg_region_fac, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
    add_rows=dv_summary_rows(reg_region_fac), coef_rename=coef_map,
    title="P2: Within-Region by Facility (BTFP vs DW)")

  # --- LaTeX export ---
  save_reg_latex(reg_region_fac, "Table_P2_RegionFacility",
    add_rows=dv_summary_rows(reg_region_fac), coef_rename=coef_map,
    title="Within-Region by Facility (BTFP vs DW)")
}
## Saved: Table_P2_RegionFacility.tex

11.4 8.4 Formal Wald Test: \(c_3^{PZ} \neq c_3^{FI}\)

This is the formal cross-region test the theory demands. We fully interact all regressors (including controls) with a panic-zone indicator, so the triple interaction \(\ell \times f \times PZ\) is not confounded by differential control slopes across regions.

cat("=== P2: FORMAL WALD TEST — c3(Panic Zone) vs c3(Fund. Insolvency) ===\n\n")
## === P2: FORMAL WALD TEST — c3(Panic Zone) vs c3(Fund. Insolvency) ===
# Pool panic + fund.ins. and interact ℓ×f with a panic indicator
# Pool panic + fund.ins. and FULLY interact with a panic indicator
df_pz_fi <- df_crisis_model %>% filter(model_region %in% c("Panic Zone","Fundamental Insolvency")) %>%
  mutate(is_pz = as.integer(model_region == "Panic Zone"),
         mtm_x_fran_x_pz = mtm_x_franchise * is_pz,
         mtm_x_pz = mtm_total * is_pz,
         fran_x_pz = franchise_value * is_pz,
         ln_assets_x_pz = ln_assets * is_pz,
         cash_ratio_x_pz = cash_ratio * is_pz,
         loan_to_deposit_x_pz = loan_to_deposit * is_pz,
         book_equity_ratio_x_pz = book_equity_ratio * is_pz,
         wholesale_x_pz = wholesale * is_pz,
         roa_x_pz = roa * is_pz)

ctrl_x_pz_str <- paste0(controls, "_x_pz", collapse = " + ")

fml_wald <- as.formula(paste0(
  "any_fed ~ mtm_total + franchise_value + mtm_x_franchise + ",
  "is_pz + mtm_x_pz + fran_x_pz + mtm_x_fran_x_pz + ",
  ctrl_str, " + ", ctrl_x_pz_str))

reg_wald <- feols(fml_wald, data=df_pz_fi, vcov="hetero")

b_diff <- coef(reg_wald)["mtm_x_fran_x_pz"]
se_diff <- sqrt(vcov(reg_wald)["mtm_x_fran_x_pz","mtm_x_fran_x_pz"])
p_diff <- 2*pnorm(-abs(b_diff/se_diff))
stars <- ifelse(p_diff<0.01,"***",ifelse(p_diff<0.05,"**",ifelse(p_diff<0.10,"*","")))

cat(sprintf("  c3(PZ) - c3(FI) = %.4f (SE=%.4f, p=%.4f) %s\n", b_diff, se_diff, p_diff, stars))
##   c3(PZ) - c3(FI) = -0.0290 (SE=0.0879, p=0.7418)
cat("  Theory predicts: > 0 (interaction operates in panic zone, not fund. insolvency)\n\n")
##   Theory predicts: > 0 (interaction operates in panic zone, not fund. insolvency)
# Also report the base c3 (= c3 in Fund. Insolvency region)
b_base <- coef(reg_wald)["mtm_x_franchise"]
se_base <- sqrt(vcov(reg_wald)["mtm_x_franchise","mtm_x_franchise"])
p_base <- 2*pnorm(-abs(b_base/se_base))
cat(sprintf("  c3 in Fund.Ins. (base):  %.4f (%.4f), p=%.4f\n", b_base, se_base, p_base))
##   c3 in Fund.Ins. (base):  0.0727 (0.0647), p=0.2613
# c3(PZ) = c3(FI) + Δ → Var(c3_PZ) = Var(base) + Var(Δ) + 2*Cov(base,Δ)
cov_base_diff <- vcov(reg_wald)["mtm_x_franchise", "mtm_x_fran_x_pz"]
se_pz <- sqrt(se_base^2 + se_diff^2 + 2 * cov_base_diff)
p_pz <- 2*pnorm(-abs((b_base+b_diff)/se_pz))
cat(sprintf("  c3 in Panic Zone:        %.4f (%.4f), p=%.4f\n", b_base+b_diff, se_pz, p_pz))
##   c3 in Panic Zone:        0.0437 (0.0596), p=0.4635
cat(sprintf("  [Cov(base,Δ) = %.6f; naive SE (ignoring cov) would be %.4f]\n",
    cov_base_diff, sqrt(se_base^2+se_diff^2)))
##   [Cov(base,Δ) = -0.004184; naive SE (ignoring cov) would be 0.1092]
msummary(list("Pooled PZ+FI"=reg_wald), stars=c("*"=.10,"**"=.05,"***"=.01),
  gof_omit="AIC|BIC|Log|RMSE",
  coef_rename=c("mtm_total"="$\\ell$","franchise_value"="$f$",
    "mtm_x_franchise"="$\\ell \\times f$ (base=FI)",
    "is_pz"="Panic Zone","mtm_x_pz"="$\\ell \\times$ PZ",
    "fran_x_pz"="$f \\times$ PZ",
    "mtm_x_fran_x_pz"="$\\ell \\times f \\times$ PZ",
    "ln_assets_x_pz"="Log(Assets) $\\times$ PZ","cash_ratio_x_pz"="Cash/TA $\\times$ PZ",
    "loan_to_deposit_x_pz"="Loan/Dep $\\times$ PZ","book_equity_ratio_x_pz"="Equity/TA $\\times$ PZ",
    "wholesale_x_pz"="Wholesale $\\times$ PZ","roa_x_pz"="ROA $\\times$ PZ"),
  
  title="P2 Wald: Differential Interaction Effect (Panic vs Fund.Ins.)")
P2 Wald: Differential Interaction Effect (Panic vs Fund.Ins.)
Pooled PZ+FI
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 0.233
(0.145)
$\ell$ -0.044
(0.061)
$f$ -0.073
(0.096)
$\ell \times f$ (base=FI) 0.073
(0.065)
Panic Zone 0.037
(0.461)
$\ell \times$ PZ 0.039
(0.186)
$f \times$ PZ 0.125
(0.117)
$\ell \times f \times$ PZ -0.029
(0.088)
ln_assets 0.114***
(0.032)
cash_ratio -0.065
(0.041)
loan_to_deposit 0.004
(0.035)
book_equity_ratio -0.062
(0.077)
wholesale 0.045*
(0.024)
roa -0.023
(0.027)
Log(Assets) $\times$ PZ 0.045
(0.070)
Cash/TA $\times$ PZ -0.115
(0.093)
Loan/Dep $\times$ PZ 0.026
(0.071)
Equity/TA $\times$ PZ 0.148
(0.292)
Wholesale $\times$ PZ -0.024
(0.051)
ROA $\times$ PZ -0.028
(0.067)
Num.Obs. 437
R2 0.138
R2 Adj. 0.098
Std.Errors Heteroskedasticity-robust 
# --- LaTeX export ---
save_reg_latex(list("Pooled PZ+FI"=reg_wald), "Table_P2_Wald",
  coef_rename=c("mtm_total"="$\\ell$","franchise_value"="$f$",
    "mtm_x_franchise"="$\\ell \\times f$ (base=FI)",
    "is_pz"="Panic Zone","mtm_x_pz"="$\\ell \\times$ PZ",
    "fran_x_pz"="$f \\times$ PZ",
    "mtm_x_fran_x_pz"="$\\ell \\times f \\times$ PZ"),
  title="Wald Test: Differential $\\ell \\times f$ (Panic vs.\\ Fund.\\ Insolvency)")
## Saved: Table_P2_Wald.tex

11.5 8.5 Decomposition: \(\ell \times \mu\) vs \(\ell \times (1-\beta^U)\)

Theory: “The composite \(\ell \times f\) subsumes two channels: the uninsured leverage channel (\(\ell \times \mu\)) and the deposit stickiness channel (\(\ell \times (1-\beta^U)\)). […] we expect the uninsured leverage channel to dominate.”

fml_d <- as.formula(paste0("any_fed ~ mtm_total + uninsured_lev + uninsured_beta + ",
  "mtm_x_uninsured + mtm_x_unins_beta + ", ctrl_str))

reg_d <- list("Full"=feols(fml_d, data=df_crisis_model, vcov="hetero"))
if (sum(df_pz$any_fed)>=10 & sum(df_pz$any_fed==0)>=10)
  reg_d[["Panic Zone"]] <- feols(fml_d, data=df_pz, vcov="hetero")
if (sum(df_fi$any_fed)>=10 & sum(df_fi$any_fed==0)>=10)
  reg_d[["Fund. Insolvency"]] <- feols(fml_d, data=df_fi, vcov="hetero")

msummary(reg_d, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_d),
  coef_rename=c("mtm_total"="l","uninsured_lev"="mu","uninsured_beta"="beta^U",
    "mtm_x_uninsured"="l x mu (leverage channel)","mtm_x_unins_beta"="l x beta^U (stickiness; expect < 0)"),
  title="P2 Decomposition: l x mu vs l x beta^U",
  notes="Theory: l x (1-beta^U) > 0 ⟺ l x beta^U < 0. Leverage channel expected to dominate.")
P2 Decomposition: l x mu vs l x beta^U
Full Panic Zone Fund. Insolvency
* p < 0.1, ** p < 0.05, *** p < 0.01
Theory: l x (1-beta^U) > 0 ⟺ l x beta^U < 0. Leverage channel expected to dominate.
(Intercept) 0.195*** 0.379 0.255*
(0.006) (0.502) (0.151)
l 0.029*** -0.042 -0.053
(0.007) (0.202) (0.063)
mu 0.019** 0.072 0.020
(0.008) (0.073) (0.097)
beta^U 0.004 -0.091 0.105
(0.007) (0.095) (0.074)
l x mu (leverage channel) 0.020*** 0.051 0.017
(0.006) (0.071) (0.065)
l x beta^U (stickiness; expect < 0) 0.006 0.011 -0.067
(0.006) (0.084) (0.050)
ln_assets 0.102*** 0.150** 0.107***
(0.008) (0.067) (0.034)
cash_ratio -0.021*** -0.180** -0.056
(0.006) (0.089) (0.041)
loan_to_deposit -0.006 0.039 0.002
(0.007) (0.066) (0.034)
book_equity_ratio -0.016*** 0.172 -0.059
(0.006) (0.328) (0.080)
wholesale 0.029*** 0.027 0.045*
(0.007) (0.046) (0.024)
roa -0.002 -0.052 -0.023
(0.006) (0.063) (0.027)
Num.Obs. 4226 102 335
R2 0.110 0.241 0.106
R2 Adj. 0.108 0.148 0.076
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 33 88
Mean (DV) 0.1945 0.3235 0.2627 
# --- LaTeX export ---
save_reg_latex(reg_d, "Table_P2_Decomposition",
  add_rows=dv_summary_rows(reg_d),
  coef_rename=c("mtm_total"="$\\ell$","uninsured_lev"="$\\mu$","uninsured_beta"="$\\beta^U$",
    "mtm_x_uninsured"="$\\ell \\times \\mu$","mtm_x_unins_beta"="$\\ell \\times \\beta^U$"),
  title="Decomposition: $\\ell \\times \\mu$ vs.\\ $\\ell \\times \\beta^U$",
  notes="$\\ell \\times (1-\\beta^U) > 0 \\Longleftrightarrow \\ell \\times \\beta^U < 0$.")
## Saved: Table_P2_Decomposition.tex

12 PREDICTION 3: COORDINATION AROUND OBSERVABLE MTM LOSSES

Theory: “Coordination requires a common signal, and securities MTM losses are the relevant one: they are publicly observable in real time, while loan losses are not. […] BTFP use should concentrate among banks with large securities MTM losses, high uninsured leverage, and going-concern solvency.”

12.1 9.1 Par-Value Channel: BTFP vs DW vs FHLB [Theory Eq. 9]

# ==============================================================================
# Eq. 9: Δ_BTFP = (1-θ_S)S_el
# BTFP-eligible losses should predict BTFP (par margin) but NOT DW or FHLB
# Also test theory ℓ_S (all securities) vs ℓ_L (all loans)
# ==============================================================================

df_m <- df_crisis_model %>%
  mutate(
    # Theory decomposition: ℓ_S (all securities) vs ℓ_L (all loans)
    mtm_sec_z  = mtm_sec,     # z-standardized in construct_analysis_vars
    mtm_loan_z = mtm_loan,    # z-standardized in construct_analysis_vars
    mtm_tot_z  = mtm_total,
    # BTFP/OMO decomposition: OMO-eligible vs non-OMO
    mtm_btfp_z  = mtm_btfp,   # z-standardized BTFP-eligible (OMO) losses
    mtm_nonbtfp_z = mtm_other  # z-standardized non-BTFP losses
  )

# Specification A: Theory ℓ_S vs ℓ_L
fml_sep <- function(dv) as.formula(paste0(dv, " ~ mtm_sec_z + mtm_loan_z + franchise_value + uninsured_lev + ", ctrl_str))
fml_incr <- function(dv) as.formula(paste0(dv, " ~ mtm_tot_z + mtm_sec_z + franchise_value + uninsured_lev + ", ctrl_str))

# Specification B: BTFP-eligible vs non-BTFP
fml_btfp <- function(dv) as.formula(paste0(dv, " ~ mtm_btfp_z + mtm_nonbtfp_z + franchise_value + uninsured_lev + ", ctrl_str))

reg_p3 <- list(
  "BTFP (ℓ_S/ℓ_L)"  = feols(fml_sep("btfp_crisis"), data=df_m, vcov="hetero"),
  "DW (ℓ_S/ℓ_L)"    = feols(fml_sep("dw_crisis"),   data=df_m, vcov="hetero"),
  "FHLB (ℓ_S/ℓ_L)"  = feols(fml_sep("fhlb_user"),   data=df_m, vcov="hetero"),
  "BTFP (OMO/nonOMO)" = feols(fml_btfp("btfp_crisis"), data=df_m, vcov="hetero"),
  "DW (OMO/nonOMO)"   = feols(fml_btfp("dw_crisis"),   data=df_m, vcov="hetero"),
  "FHLB (OMO/nonOMO)" = feols(fml_btfp("fhlb_user"),   data=df_m, vcov="hetero")
)

msummary(reg_p3, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  coef_rename=c("mtm_sec_z"="ℓ_S (Securities)","mtm_loan_z"="ℓ_L (Loans)",
    "mtm_tot_z"="ℓ (Total)","mtm_btfp_z"="ℓ_BTFP (OMO-eligible)","mtm_nonbtfp_z"="ℓ_nonBTFP",
    "franchise_value"="f","uninsured_lev"="mu"),
  title="P3: Par-Value Channel — Securities/BTFP Should Predict BTFP Only (Eq. 9)")
P3: Par-Value Channel — Securities/BTFP Should Predict BTFP Only (Eq. 9)
BTFP (ℓ_S/ℓ_L) DW (ℓ_S/ℓ_L) FHLB (ℓ_S/ℓ_L) BTFP (OMO/nonOMO) DW (OMO/nonOMO) FHLB (OMO/nonOMO)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 0.115*** 0.100*** 0.070*** 0.115*** 0.100*** 0.070***
(0.005) (0.004) (0.004) (0.005) (0.004) (0.004)
ℓ_S (Securities) 0.023*** 0.010 -0.007
(0.008) (0.007) (0.006)
ℓ_L (Loans) 0.010* 0.006 0.011**
(0.005) (0.005) (0.005)
f -0.006 -0.002 -0.026*** -0.007 -0.003 -0.024***
(0.011) (0.011) (0.009) (0.011) (0.011) (0.009)
mu 0.021* 0.008 0.030*** 0.021* 0.009 0.027***
(0.012) (0.012) (0.009) (0.012) (0.012) (0.009)
ln_assets 0.052*** 0.075*** 0.009* 0.049*** 0.073*** 0.011**
(0.007) (0.007) (0.005) (0.007) (0.007) (0.005)
cash_ratio -0.022*** 0.001 -0.021*** -0.028*** 0.000 -0.017***
(0.005) (0.006) (0.004) (0.005) (0.005) (0.003)
loan_to_deposit -0.003 0.001 0.008 -0.009 0.000 0.017***
(0.009) (0.008) (0.007) (0.006) (0.006) (0.005)
book_equity_ratio -0.016*** -0.003 0.009** -0.018*** -0.003 0.009**
(0.005) (0.004) (0.004) (0.005) (0.004) (0.004)
wholesale 0.022*** 0.015*** 0.000 0.021*** 0.015*** -0.001
(0.006) (0.005) (0.004) (0.006) (0.005) (0.004)
roa -0.005 -0.001 -0.006* -0.003 -0.000 -0.008**
(0.005) (0.005) (0.004) (0.005) (0.005) (0.004)
ℓ_BTFP (OMO-eligible) 0.016*** 0.007 -0.006
(0.006) (0.005) (0.004)
ℓ_nonBTFP 0.009* 0.009* 0.006
(0.005) (0.005) (0.004)
Num.Obs. 4226 4226 4226 4226 4226 4226
R2 0.068 0.072 0.028 0.067 0.072 0.028
R2 Adj. 0.065 0.069 0.026 0.065 0.070 0.025
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
# --- LaTeX export ---
save_reg_latex(reg_p3, "Table_P3_ParChannel",
  coef_rename=c("mtm_sec_z"="$\\ell_S$","mtm_loan_z"="$\\ell_L$",
    "mtm_tot_z"="$\\ell$","mtm_btfp_z"="$\\ell_{BTFP}$","mtm_nonbtfp_z"="$\\ell_{\\text{non-BTFP}}$",
    "franchise_value"="$f$","uninsured_lev"="$\\mu$"),
  title="Par-Value Channel: Securities and BTFP-Eligible Losses (Eq.\\ 9)")
## Saved: Table_P3_ParChannel.tex
cat("\n=== P3 SIGN PATTERN ===\n")
## 
## === P3 SIGN PATTERN ===
cat("                  ℓ_S (securities)    ℓ_L (loans)    ℓ_BTFP (OMO)\n")
##                   ℓ_S (securities)    ℓ_L (loans)    ℓ_BTFP (OMO)
cat("  BTFP (par)      +  (par margin)     0              +\n")
##   BTFP (par)      +  (par margin)     0              +
cat("  DW   (market)   0                   +              0\n")
##   DW   (market)   0                   +              0
cat("  FHLB (market)   0                   +              0\n\n")
##   FHLB (market)   0                   +              0
for (fac in c("BTFP (ℓ_S/ℓ_L)","DW (ℓ_S/ℓ_L)","FHLB (ℓ_S/ℓ_L)")) {
  r <- reg_p3[[fac]]
  b <- coef(r)["mtm_sec_z"]; se <- sqrt(vcov(r)["mtm_sec_z","mtm_sec_z"])
  p <- 2*pnorm(-abs(b/se))
  cat(sprintf("  %-20s ℓ_S = %+.4f (%.4f) p=%.3f\n", fac, b, se, p))
}
##   BTFP (ℓ_S/ℓ_L)   ℓ_S = +0.0228 (0.0076) p=0.003
##   DW (ℓ_S/ℓ_L)     ℓ_S = +0.0097 (0.0066) p=0.140
##   FHLB (ℓ_S/ℓ_L)   ℓ_S = -0.0074 (0.0057) p=0.195
for (fac in c("BTFP (OMO/nonOMO)","DW (OMO/nonOMO)","FHLB (OMO/nonOMO)")) {
  r <- reg_p3[[fac]]
  b <- coef(r)["mtm_btfp_z"]; se <- sqrt(vcov(r)["mtm_btfp_z","mtm_btfp_z"])
  p <- 2*pnorm(-abs(b/se))
  cat(sprintf("  %-20s ℓ_BTFP = %+.4f (%.4f) p=%.3f\n", fac, b, se, p))
}
##   BTFP (OMO/nonOMO)    ℓ_BTFP = +0.0156 (0.0060) p=0.009
##   DW (OMO/nonOMO)      ℓ_BTFP = +0.0073 (0.0053) p=0.171
##   FHLB (OMO/nonOMO)    ℓ_BTFP = -0.0060 (0.0039) p=0.123

12.2 9.2 Cross-Equation Test: \(\ell_S^{BTFP} > \ell_S^{DW}\) [Eq. 9]

df_stacked <- bind_rows(
  df_m %>% mutate(y=btfp_crisis, facility="BTFP"),
  df_m %>% mutate(y=dw_crisis, facility="DW")
) %>%
  mutate(is_btfp=as.integer(facility=="BTFP"),
         sec_x_btfp=mtm_sec_z*is_btfp,
         loan_x_btfp=mtm_loan_z*is_btfp)

fml_stack <- as.formula(paste0(
  "y ~ is_btfp + mtm_sec_z + mtm_loan_z + sec_x_btfp + loan_x_btfp + ",
  "franchise_value + uninsured_lev + ", ctrl_str))

reg_stack <- feols(fml_stack, data=df_stacked, cluster=~idrssd)

cat("=== CROSS-EQUATION: l_S DIFFERENTIAL ===\n")
## === CROSS-EQUATION: l_S DIFFERENTIAL ===
b_s <- coef(reg_stack)["sec_x_btfp"]; se_s <- sqrt(vcov(reg_stack)["sec_x_btfp","sec_x_btfp"])
p_s <- 2*pnorm(-abs(b_s/se_s))
cat(sprintf("  l_S(BTFP) - l_S(DW) = %.4f (SE=%.4f, p=%.4f) %s\n",
    b_s, se_s, p_s, ifelse(p_s<0.01,"***",ifelse(p_s<0.05,"**",ifelse(p_s<0.10,"*","")))))
##   l_S(BTFP) - l_S(DW) = 0.0287 (SE=0.0064, p=0.0000) ***
cat("  Theory: > 0 (par margin is BTFP-specific)\n")
##   Theory: > 0 (par margin is BTFP-specific)
b_l <- coef(reg_stack)["loan_x_btfp"]; se_l <- sqrt(vcov(reg_stack)["loan_x_btfp","loan_x_btfp"])
p_l <- 2*pnorm(-abs(b_l/se_l))
cat(sprintf("  l_L(BTFP) - l_L(DW) = %.4f (SE=%.4f, p=%.4f)\n", b_l, se_l, p_l))
##   l_L(BTFP) - l_L(DW) = 0.0064 (SE=0.0062, p=0.3009)
cat("  Theory: ~ 0 (no facility-specific channel for loans)\n")
##   Theory: ~ 0 (no facility-specific channel for loans)

12.3 9.3 Observable vs Unobservable Signal: \(\ell_S \times f\) vs \(\ell_L \times f\)

Theory: “Loan losses \(\ell_L\) predict borrowing through a fundamental channel but do not generate coordination amplification.”

df_signal <- df_m %>%
  mutate(sec_x_f  = mtm_sec_z * franchise_value,
         loan_x_f = mtm_loan_z * franchise_value)

fml_signal <- as.formula(paste0(
  "any_fed ~ mtm_sec_z + mtm_loan_z + franchise_value + sec_x_f + loan_x_f + ", ctrl_str))

reg_signal <- list(
  "Full" = feols(fml_signal, data=df_signal, vcov="hetero")
)

# Within panic zone
df_pz_sig <- df_signal %>% filter(model_region=="Panic Zone")
if (sum(df_pz_sig$any_fed)>=10 & sum(df_pz_sig$any_fed==0)>=10)
  reg_signal[["Panic Zone"]] <- feols(fml_signal, data=df_pz_sig, vcov="hetero")

# Within fund.ins.
df_fi_sig <- df_signal %>% filter(model_region=="Fundamental Insolvency")
if (sum(df_fi_sig$any_fed)>=10 & sum(df_fi_sig$any_fed==0)>=10)
  reg_signal[["Fund. Insolvency"]] <- feols(fml_signal, data=df_fi_sig, vcov="hetero")

msummary(reg_signal, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_signal),
  coef_rename=c("mtm_sec_z"="l_S","mtm_loan_z"="l_L","franchise_value"="f",
    "sec_x_f"="l_S x f (OBSERVABLE signal; expect > 0)",
    "loan_x_f"="l_L x f (UNOBSERVABLE; expect ~ 0)"),
  title="P3: Observable vs Unobservable Signal — Coordination Amplification",
  notes="Theory: l_S x f > 0 (observable, generates coordination); l_L x f ≈ 0 (not a coordination signal).")
P3: Observable vs Unobservable Signal — Coordination Amplification
Full Panic Zone Fund. Insolvency
* p < 0.1, ** p < 0.05, *** p < 0.01
Theory: l_S x f > 0 (observable, generates coordination); l_L x f ≈ 0 (not a coordination signal).
(Intercept) 0.193*** 0.197 0.137
(0.006) (0.348) (0.147)
l_S 0.029*** 0.064 -0.007
(0.009) (0.151) (0.065)
l_L 0.020*** 0.003 0.018
(0.007) (0.120) (0.050)
f 0.015** 0.049 -0.065
(0.007) (0.115) (0.107)
l_S x f (OBSERVABLE signal; expect > 0) 0.012** 0.027 0.057
(0.006) (0.076) (0.060)
l_L x f (UNOBSERVABLE; expect ~ 0) 0.016*** 0.038 0.076
(0.006) (0.045) (0.051)
ln_assets 0.104*** 0.157** 0.108***
(0.007) (0.067) (0.033)
cash_ratio -0.017** -0.157* -0.058
(0.007) (0.091) (0.046)
loan_to_deposit 0.002 0.074 -0.005
(0.010) (0.113) (0.056)
book_equity_ratio -0.017*** 0.054 -0.105
(0.006) (0.222) (0.071)
wholesale 0.028*** 0.014 0.046*
(0.007) (0.048) (0.024)
roa -0.002 -0.054 -0.018
(0.006) (0.061) (0.027)
Num.Obs. 4226 102 335
R2 0.110 0.243 0.099
R2 Adj. 0.108 0.150 0.068
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 33 88
Mean (DV) 0.1945 0.3235 0.2627 
# --- LaTeX export ---
save_reg_latex(reg_signal, "Table_P3_Signal",
  add_rows=dv_summary_rows(reg_signal),
  coef_rename=c("mtm_sec_z"="$\\ell_S$","mtm_loan_z"="$\\ell_L$","franchise_value"="$f$",
    "sec_x_f"="$\\ell_S \\times f$ (observable)",
    "loan_x_f"="$\\ell_L \\times f$ (unobservable)"),
  title="Observable vs.\\ Unobservable Signal: Coordination Amplification",
  notes="$\\ell_S \\times f > 0$ (observable); $\\ell_L \\times f \\approx 0$ (not a coordination signal).")
## Saved: Table_P3_Signal.tex

12.4 9.4 Facility Choice Among Borrowers [P3]

Theory: “BTFP use should concentrate among banks with large securities MTM losses, high uninsured leverage, and going-concern solvency.”

df_borr <- df_crisis_model %>% filter(any_fed==1) %>%
  mutate(chose_btfp=as.integer(btfp_crisis==1),
         mtm_securities=mtm_sec)  # already z-standardized

cat(sprintf("Borrowers: %d (BTFP: %d, DW: %d, Both: %d)\n",
    nrow(df_borr), sum(df_borr$btfp_crisis), sum(df_borr$dw_crisis), sum(df_borr$both_fed)))
## Borrowers: 822 (BTFP: 496, DW: 430, Both: 104)
if (nrow(df_borr)>=30) {
  fml_ch <- as.formula(paste0("chose_btfp ~ mtm_securities + franchise_value + uninsured_lev + ", ctrl_str))
  reg_ch <- list("All Borrowers"=feols(fml_ch, data=df_borr, vcov="hetero"))

  for (reg in c("Panic Zone","Fundamental Insolvency")) {
    df_br <- df_borr %>% filter(model_region==reg)
    if (nrow(df_br)>=15)
      reg_ch[[gsub("[^A-Za-z]","",reg)]] <- feols(fml_ch, data=df_br, vcov="hetero")
  }

  msummary(reg_ch, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
    add_rows=dv_summary_rows(reg_ch),
    coef_rename=c("mtm_securities"="l_S (Securities MTM)","franchise_value"="f",
      "uninsured_lev"="mu"),
    title="P3: Facility Choice (Chose BTFP = 1) Among Borrowers",
    notes="Theory: l_S > 0, mu > 0 (BTFP preferred by panic-zone banks with large securities losses).")

  # --- LaTeX export ---
  save_reg_latex(reg_ch, "Table_P3_FacilityChoice",
    add_rows=dv_summary_rows(reg_ch),
    coef_rename=c("mtm_securities"="$\\ell_S$","franchise_value"="$f$","uninsured_lev"="$\\mu$"),
    title="Facility Choice Among Borrowers (Chose BTFP=1)")
}
## Saved: Table_P3_FacilityChoice.tex

13 FALSIFICATION TESTS

13.1 10.1 FHLB Falsification

Theory footnote: “We address [confounds] with FHLB borrowing […] tests.” \(\ell \times f\) should NOT predict FHLB borrowing (FHLB = routine advance, not run-motivated).

fml_fhlb <- as.formula(paste0("fhlb_user ~ mtm_total + franchise_value + mtm_x_franchise + ", ctrl_str))

reg_falsif <- list(
  "Any Fed (crisis)" = feols(fml_main, data=df_crisis_model, vcov="hetero"),
  "FHLB (crisis)"    = feols(fml_fhlb, data=df_crisis_model, vcov="hetero")
)

# Within panic zone
if (sum(df_pz$any_fed)>=10) reg_falsif[["PZ: Any Fed"]] <- feols(fml_main, data=df_pz, vcov="hetero")
if (sum(df_pz$fhlb_user)>=10 & sum(df_pz$fhlb_user==0)>=10)
  reg_falsif[["PZ: FHLB"]] <- feols(fml_fhlb, data=df_pz, vcov="hetero")

msummary(reg_falsif, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  add_rows=dv_summary_rows(reg_falsif), coef_rename=coef_map,
  title="Falsification: FHLB Should NOT Show Coordination Signature",
  notes="FHLB = routine advance lending. A significant l x f for FHLB would undermine the coordination interpretation.")
Falsification: FHLB Should NOT Show Coordination Signature
Any Fed (crisis) FHLB (crisis) PZ: Any Fed
* p < 0.1, ** p < 0.05, *** p < 0.01
FHLB = routine advance lending. A significant l x f for FHLB would undermine the coordination interpretation.
(Intercept) 0.193*** 0.070*** 0.269
(0.006) (0.004) (0.450)
l (MTM) 0.027*** 0.000 -0.005
(0.006) (0.005) (0.180)
f (Franchise) 0.014** -0.004 0.051
(0.007) (0.004) (0.068)
l x f 0.017*** -0.006* 0.044
(0.006) (0.003) (0.061)
Log(Assets) 0.105*** 0.016*** 0.159**
(0.007) (0.005) (0.065)
Cash/TA -0.021*** -0.016*** -0.181**
(0.006) (0.004) (0.086)
Loan/Dep -0.005 0.021*** 0.030
(0.007) (0.005) (0.064)
Equity/TA -0.018*** 0.007* 0.086
(0.006) (0.004) (0.290)
Wholesale 0.029*** -0.002 0.022
(0.007) (0.004) (0.046)
ROA -0.002 -0.007* -0.052
(0.006) (0.004) (0.063)
Num.Obs. 4226 4226 102
R2 0.109 0.025 0.235
R2 Adj. 0.108 0.023 0.160
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust
N (DV = 1) 822 299 33
Mean (DV) 0.1945 0.0708 0.3235 
# --- LaTeX export ---
save_reg_latex(reg_falsif, "Table_Falsif_FHLB",
  add_rows=dv_summary_rows(reg_falsif), coef_rename=coef_map,
  title="Falsification: FHLB Should Not Show Coordination Signature")
## Saved: Table_Falsif_FHLB.tex
cat("\n=== FHLB FALSIFICATION: l x f COMPARISON ===\n")
## 
## === FHLB FALSIFICATION: l x f COMPARISON ===
for (nm in names(reg_falsif)) {
  m <- reg_falsif[[nm]]
  b <- coef(m)["mtm_x_franchise"]; se <- sqrt(vcov(m)["mtm_x_franchise","mtm_x_franchise"])
  p <- 2*pnorm(-abs(b/se))
  cat(sprintf("  %-20s l x f = %+.4f (%.4f) p=%.3f %s\n", nm, b, se, p,
      ifelse(p<0.01,"***",ifelse(p<0.05,"**",ifelse(p<0.10,"*","")))))
}
##   Any Fed (crisis)     l x f = +0.0175 (0.0055) p=0.002 ***
##   FHLB (crisis)        l x f = -0.0055 (0.0032) p=0.085 *
##   PZ: Any Fed          l x f = +0.0437 (0.0613) p=0.476

13.2 10.2 Temporal Falsification: Arbitrage Period

Theory footnote: “the carry-trade opportunity that emerged in late 2023 […] We address [this] with temporal falsification tests.” In the arb period, BTFP borrowing was carry-trade motivated. \(c_3 \approx 0\) predicted.

df_arb_model <- df_arb_clean %>% filter(!is.na(model_region))

cat(sprintf("Arb sample: %d banks. Any Fed: %d, BTFP: %d\n",
    nrow(df_arb_model), sum(df_arb_model$any_fed),
    sum(df_arb_model$btfp_arb, na.rm=TRUE)))
## Arb sample: 4151 banks. Any Fed: 998, BTFP: 746
# Arb-specific z-scores
df_arb_reg <- df_arb_model %>%
  mutate(
    mtm_total_a = standardize_z(winsorize(mtm_total_raw)),
    franchise_value_a = standardize_z(winsorize(f_pp)),
    mtm_x_franchise_a = mtm_total_a * franchise_value_a,
    ln_assets_a=standardize_z(winsorize(ln_assets_raw)),
    cash_ratio_a=standardize_z(winsorize(cash_ratio_raw)),
    loan_to_deposit_a=standardize_z(winsorize(loan_to_deposit_raw)),
    book_equity_ratio_a=standardize_z(winsorize(book_equity_ratio_raw)),
    wholesale_a=standardize_z(winsorize(wholesale_raw)),
    roa_a=standardize_z(winsorize(roa_raw))
  )

arb_ctrl <- c("ln_assets_a","cash_ratio_a","loan_to_deposit_a","book_equity_ratio_a","wholesale_a","roa_a")
fml_arb <- as.formula(paste0("any_fed ~ mtm_total_a + franchise_value_a + mtm_x_franchise_a + ",
                              paste(arb_ctrl,collapse=" + ")))
fml_arb_btfp <- update(fml_arb, btfp_arb ~ .)

reg_arb <- list()
reg_arb[["Crisis: Any Fed"]] <- feols(fml_main, data=df_crisis_model, vcov="hetero")
if (sum(df_arb_reg$any_fed)>=10 & sum(df_arb_reg$any_fed==0)>=10)
  reg_arb[["Arb: Any Fed"]] <- feols(fml_arb, data=df_arb_reg, vcov="hetero")
if (sum(df_arb_reg$btfp_arb, na.rm=TRUE)>=10)
  reg_arb[["Arb: BTFP"]] <- feols(fml_arb_btfp, data=df_arb_reg, vcov="hetero")

arb_coef_map <- c("mtm_total"="l","franchise_value"="f","mtm_x_franchise"="l x f",
  "mtm_total_a"="l","franchise_value_a"="f","mtm_x_franchise_a"="l x f",
  "ln_assets"="Log(Assets)","ln_assets_a"="Log(Assets)",
  "cash_ratio"="Cash/TA","cash_ratio_a"="Cash/TA",
  "loan_to_deposit"="Loan/Dep","loan_to_deposit_a"="Loan/Dep",
  "book_equity_ratio"="Equity/TA","book_equity_ratio_a"="Equity/TA",
  "wholesale"="Wholesale","wholesale_a"="Wholesale",
  "roa"="ROA","roa_a"="ROA")

msummary(reg_arb, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  coef_rename=arb_coef_map,
  title="Temporal Falsification: Crisis vs Arb Period",
  notes="Theory: l x f should be significant in crisis, ≈ 0 in arb period (carry-trade, not coordination).")
Temporal Falsification: Crisis vs Arb Period
Crisis: Any Fed Arb: Any Fed Arb: BTFP
* p < 0.1, ** p < 0.05, *** p < 0.01
Theory: l x f should be significant in crisis, ≈ 0 in arb period (carry-trade, not coordination).
(Intercept) 0.193*** 0.241*** 0.180***
(0.006) (0.006) (0.006)
l 0.027*** 0.014* 0.020***
(0.006) (0.007) (0.007)
f 0.014** 0.008 0.016***
(0.007) (0.007) (0.006)
l x f 0.017*** 0.006 0.004
(0.006) (0.006) (0.005)
Log(Assets) 0.105*** 0.092*** 0.051***
(0.007) (0.007) (0.006)
Cash/TA -0.021*** -0.032*** -0.033***
(0.006) (0.007) (0.006)
Loan/Dep -0.005 -0.000 -0.003
(0.007) (0.007) (0.006)
Equity/TA -0.018*** -0.011* -0.009
(0.006) (0.006) (0.006)
Wholesale 0.029*** 0.099*** 0.100***
(0.007) (0.008) (0.007)
ROA -0.002 -0.025*** -0.027***
(0.006) (0.006) (0.006)
Num.Obs. 4226 4151 4151
R2 0.109 0.150 0.139
R2 Adj. 0.108 0.148 0.137
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
# --- LaTeX export ---
save_reg_latex(reg_arb, "Table_Falsif_ArbPeriod",
  coef_rename=arb_coef_map,
  title="Temporal Falsification: Crisis vs.\\ Arbitrage Period",
  notes="$\\ell \\times f$ significant in crisis, $\\approx 0$ in arbitrage period.")
## Saved: Table_Falsif_ArbPeriod.tex
cat("\n=== TEMPORAL FALSIFICATION: l x f ===\n")
## 
## === TEMPORAL FALSIFICATION: l x f ===
for (nm in names(reg_arb)) {
  m <- reg_arb[[nm]]
  int_var <- if ("mtm_x_franchise_a" %in% names(coef(m))) "mtm_x_franchise_a" else "mtm_x_franchise"
  b <- coef(m)[int_var]; se <- sqrt(vcov(m)[int_var,int_var])
  p <- 2*pnorm(-abs(b/se))
  cat(sprintf("  %-20s l x f = %+.4f (%.4f) p=%.3f %s\n", nm, b, se, p,
      ifelse(p<0.01,"***",ifelse(p<0.05,"**",ifelse(p<0.10,"*","")))))
}
##   Crisis: Any Fed      l x f = +0.0175 (0.0055) p=0.002 ***
##   Arb: Any Fed         l x f = +0.0061 (0.0060) p=0.314 
##   Arb: BTFP            l x f = +0.0039 (0.0052) p=0.447

14 ROBUSTNESS

14.1 11.1 Logit Robustness

fml_logit <- as.formula(paste0("any_fed ~ mtm_total + franchise_value + mtm_x_franchise + ", ctrl_str))

logit_list <- list()
logit_list[["Full_Logit"]] <- feglm(fml_logit, data=df_crisis_model, family=binomial("logit"), vcov="hetero")
if (sum(df_pz$any_fed)>=10 & sum(df_pz$any_fed==0)>=10)
  logit_list[["PZ_Logit"]] <- feglm(fml_logit, data=df_pz, family=binomial("logit"), vcov="hetero")
if (sum(df_fi$any_fed)>=10 & sum(df_fi$any_fed==0)>=10)
  logit_list[["FI_Logit"]] <- feglm(fml_logit, data=df_fi, family=binomial("logit"), vcov="hetero")

# LPM comparisons
logit_list[["Full_LPM"]] <- feols(fml_main, data=df_crisis_model, vcov="hetero")

msummary(logit_list, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  coef_rename=coef_map,
  title="Robustness: Logit vs LPM",
  notes="LPM and Logit should agree on sign and significance of l x f.")
Robustness: Logit vs LPM
Full_Logit PZ_Logit FI_Logit Full_LPM
* p < 0.1, ** p < 0.05, *** p < 0.01
LPM and Logit should agree on sign and significance of l x f.
(Intercept) -1.690*** -1.210 -1.325 0.193***
(0.048) (3.144) (0.874) (0.006)
l (MTM) 0.184*** 0.033 -0.326 0.027***
(0.048) (1.291) (0.336) (0.006)
f (Franchise) 0.101** 0.600 -0.359 0.014**
(0.046) (0.493) (0.538) (0.007)
l x f 0.070* 0.158 0.404 0.017***
(0.042) (0.436) (0.359) (0.006)
Log(Assets) 0.662*** 0.879** 0.615*** 0.105***
(0.047) (0.391) (0.172) (0.007)
Cash/TA -0.265*** -1.425** -0.535 -0.021***
(0.071) (0.632) (0.351) (0.006)
Loan/Dep 0.026 0.211 0.039 -0.005
(0.055) (0.362) (0.211) (0.007)
Equity/TA -0.252*** 0.891 -0.403 -0.018***
(0.062) (1.997) (0.504) (0.006)
Wholesale 0.159*** 0.100 0.217** 0.029***
(0.039) (0.232) (0.111) (0.007)
ROA 0.030 -0.190 -0.120 -0.002
(0.048) (0.392) (0.161) (0.006)
Num.Obs. 4226 102 335 4226
R2 0.116 0.218 0.091 0.109
R2 Adj. 0.112 0.078 0.044 0.108
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
# --- LaTeX export ---
save_reg_latex(logit_list, "Table_Robust_Logit",
  coef_rename=coef_map,
  title="Robustness: Logit vs.\\ LPM",
  notes="LPM and Logit should agree on sign and significance of $\\ell \\times f$.")
## Saved: Table_Robust_Logit.tex

14.2 11.2 Beta Clipping Sensitivity

df_unc <- df_crisis_clean %>% filter(!is.na(beta_uninsured)) %>%
  mutate(
    c_u_unc = ifelse(!is.na(cost_u_raw), cost_u_raw, 0),
    f_unc = pmax(((1 - beta_uninsured) * y_10yr - c_u_unc) * cap_factor * mu_decimal, 0) * 100,
    f_unc_w = winsorize(f_unc),
    franchise_unc = standardize_z(f_unc_w),
    mtm_x_fran_unc = mtm_total * franchise_unc
  )

n_neg <- sum(df_unc$f_unc < 0, na.rm=TRUE)
cat(sprintf("Unclipped: %d banks with f < 0 (%.1f%% of theory sample).\n",
    n_neg, 100*n_neg/nrow(df_unc)))
## Unclipped: 0 banks with f < 0 (0.0% of theory sample).
fml_unc <- as.formula(paste0("any_fed ~ mtm_total + franchise_unc + mtm_x_fran_unc + ", ctrl_str))

reg_clip <- list(
  "Clipped (baseline)" = feols(fml_main, data=df_crisis_model, vcov="hetero"),
  "Unclipped"          = feols(fml_unc, data=df_unc, vcov="hetero")
)

msummary(reg_clip, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  coef_rename=c("mtm_total"="l","franchise_value"="f","franchise_unc"="f",
    "mtm_x_franchise"="l x f","mtm_x_fran_unc"="l x f"),
  title="Robustness: Beta^U Clipping")
Robustness: Beta^U Clipping
Clipped (baseline) Unclipped
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 0.193*** 0.193***
(0.006) (0.006)
l 0.027*** 0.027***
(0.006) (0.006)
f 0.014** 0.014**
(0.007) (0.007)
l x f 0.017*** 0.017***
(0.006) (0.006)
ln_assets 0.105*** 0.105***
(0.007) (0.007)
cash_ratio -0.021*** -0.021***
(0.006) (0.006)
loan_to_deposit -0.005 -0.005
(0.007) (0.007)
book_equity_ratio -0.018*** -0.018***
(0.006) (0.006)
wholesale 0.029*** 0.029***
(0.007) (0.007)
roa -0.002 -0.002
(0.006) (0.006)
Num.Obs. 4226 4226
R2 0.109 0.109
R2 Adj. 0.108 0.108
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust 
# --- LaTeX export ---
save_reg_latex(reg_clip, "Table_Robust_BetaClip",
  coef_rename=c("mtm_total"="$\\ell$","franchise_value"="$f$","franchise_unc"="$f$",
    "mtm_x_franchise"="$\\ell \\times f$","mtm_x_fran_unc"="$\\ell \\times f$"),
  title="Robustness: $\\beta^U$ Clipping")
## Saved: Table_Robust_BetaClip.tex

14.3 11.3 Partial Run Sensitivity (\(\phi\)) [Theory Eq. 10]

Theory (Eq. 10): \(\underline\ell(\phi) = e + [(D^I + (1-\phi)D^U)/D]f\). Baseline uses \(\phi=1\) (full run). Lower \(\phi\) raises the liquidity threshold, classifying fewer banks as panic-zone.

phi_grid <- c(0.25, 0.50, 0.75, 1.00)

phi_results <- map_dfr(phi_grid, function(phi) {
  df_phi <- df_crisis_model %>%
    mutate(
      # Eq. 10: ℓ_(φ) = e + [(D^I + (1-φ)D^U)/D]f
      th_liq_phi = book_equity_to_total_asset +
        safe_div(insured_deposit + (1-phi)*uninsured_deposit,
                 insured_deposit + uninsured_deposit, NA_real_) * f_pp,
      region_phi = case_when(
        is.na(th_liq_phi) | is.na(threshold_solvency) ~ NA_character_,
        mtm_total_raw <= th_liq_phi ~ "No-Run",
        mtm_total_raw <= threshold_solvency ~ "Panic",
        TRUE ~ "Fund.Ins."
      )
    )
  tibble(
    phi = phi,
    NoRun = sum(df_phi$region_phi=="No-Run", na.rm=T),
    Panic = sum(df_phi$region_phi=="Panic", na.rm=T),
    FundIns = sum(df_phi$region_phi=="Fund.Ins.", na.rm=T),
    N = sum(!is.na(df_phi$region_phi)),
    Panic_Borr_Rate = if (sum(df_phi$region_phi=="Panic",na.rm=T)>0)
      round(100*mean(df_phi$any_fed[df_phi$region_phi=="Panic"],na.rm=T),2) else NA_real_
  )
})

phi_disp <- phi_results %>%
  mutate(`No-Run`=sprintf("%d (%.1f%%)",NoRun,100*NoRun/N),
         Panic=sprintf("%d (%.1f%%)",Panic,100*Panic/N),
         `Fund.Ins.`=sprintf("%d (%.1f%%)",FundIns,100*FundIns/N),
         `PZ Borrow Rate`=ifelse(is.na(Panic_Borr_Rate),"---",sprintf("%.2f%%",Panic_Borr_Rate))) %>%
  select(phi, N, `No-Run`, Panic, `Fund.Ins.`, `PZ Borrow Rate`)

kbl(phi_disp, format="html", escape=FALSE,
    caption="Eq. 10: Sensitivity to Partial Run Rate (phi)") %>%
  kable_styling(bootstrap_options=c("striped","hover","condensed"), full_width=FALSE) %>%
  row_spec(which(phi_results$phi==1), bold=TRUE, background="#e8f5e9") %>%
  footnote(general="phi=1 (baseline): full uninsured-depositor run. Lower phi = milder run, fewer panic-zone banks.")
Eq. 10: Sensitivity to Partial Run Rate (phi)
phi N No-Run Panic Fund.Ins. PZ Borrow Rate
0.25 4226 3877 (91.7%) 14 (0.3%) 335 (7.9%) 21.43%
0.50 4226 3852 (91.2%) 39 (0.9%) 335 (7.9%) 33.33%
0.75 4226 3822 (90.4%) 69 (1.6%) 335 (7.9%) 30.43%
1.00 4226 3789 (89.7%) 102 (2.4%) 335 (7.9%) 32.35%
Note:
phi=1 (baseline): full uninsured-depositor run. Lower phi = milder run, fewer panic-zone banks. 
# --- LaTeX export ---
save_kbl_latex(phi_disp, "Table_Robust_PhiSensitivity",
  caption="Robustness: Sensitivity to Partial Run Rate ($\\phi$)")
## Saved: Table_Robust_PhiSensitivity.tex

14.4 11.4 Franchise-Horizon Sensitivity (\(T\))

DSSW baseline: δ = 10% (deposit decay rate). Lower δ means slower deposit attrition, higher cap factor, higher f. We test robustness of the main regression (Eq. 11) to δ ∈ {5%, 10%, 15%}.

delta_reg_grid <- c(0.05, 0.10, 0.15)
reg_delta <- list()
 
for (dd in delta_reg_grid) {
  cf_dd <- 1 / (y_10yr + dd)
  lab <- sprintf("δ=%.0f%% (1/(y+δ)=%.2f)%s", dd*100, cf_dd,
                 ifelse(dd == delta_decay, " [baseline]", ""))
 
  df_reg_d <- df_crisis_model %>%
    mutate(
      c_u = ifelse(!is.na(cost_u_raw), cost_u_raw, 0),
      f_d = pmax(((1 - beta_u_clipped) * y_10yr - c_u) * cf_dd * mu_decimal, 0) * 100,
      f_d_w = winsorize(f_d),
      fv_d = standardize_z(f_d_w),
      mtm_x_fv_d = mtm_total * fv_d
    )
 
  fml_d <- as.formula(paste0("any_fed ~ mtm_total + fv_d + mtm_x_fv_d + ", ctrl_str))
  reg_delta[[lab]] <- feols(fml_d, data=df_reg_d, vcov="hetero")
}
 
msummary(reg_delta, stars=c("*"=.10,"**"=.05,"***"=.01), gof_omit="AIC|BIC|Log|RMSE",
  coef_rename=c("mtm_total"="l","fv_d"="f","mtm_x_fv_d"="l x f"),
  title="Robustness: Eq. (11) Under Alternative Deposit Decay Rates",
  notes="DSSW baseline: δ=10%. l x f should remain significant across decay rates.")
Robustness: Eq. (11) Under Alternative Deposit Decay Rates
δ=5% (1/(y+δ)=11.49) δ=10% (1/(y+δ)=7.30) [baseline] δ=15% (1/(y+δ)=5.35)
* p < 0.1, ** p < 0.05, *** p < 0.01
DSSW baseline: δ=10%. l x f should remain significant across decay rates.
(Intercept) 0.193*** 0.193*** 0.193***
(0.006) (0.006) (0.006)
l 0.027*** 0.027*** 0.027***
(0.006) (0.006) (0.006)
f 0.014** 0.014** 0.014**
(0.007) (0.007) (0.007)
l x f 0.017*** 0.017*** 0.017***
(0.006) (0.006) (0.006)
ln_assets 0.105*** 0.105*** 0.105***
(0.007) (0.007) (0.007)
cash_ratio -0.021*** -0.021*** -0.021***
(0.006) (0.006) (0.006)
loan_to_deposit -0.005 -0.005 -0.005
(0.007) (0.007) (0.007)
book_equity_ratio -0.018*** -0.018*** -0.018***
(0.006) (0.006) (0.006)
wholesale 0.029*** 0.029*** 0.029***
(0.007) (0.007) (0.007)
roa -0.002 -0.002 -0.002
(0.006) (0.006) (0.006)
Num.Obs. 4226 4226 4226
R2 0.109 0.109 0.109
R2 Adj. 0.108 0.108 0.108
Std.Errors Heteroskedasticity-robust Heteroskedasticity-robust Heteroskedasticity-robust 
# --- LaTeX export ---
save_reg_latex(reg_delta, "Table_Robust_DecayRate_Reg",
  coef_rename=c("mtm_total"="$\\ell$","fv_d"="$f$","mtm_x_fv_d"="$\\ell \\times f$"),
  title="Robustness: Eq.\\ (11) Under Alternative Deposit Decay Rates",
  notes="DSSW baseline: $\\delta=10\\%$.")
## Saved: Table_Robust_DecayRate_Reg.tex

15 PLOTS

gp_colors <- c("No-Run Region"="#1565C0","Panic Zone"="#FF8F00","Fundamental Insolvency"="#C62828")
borr_colors <- c("Fed Borrower"="#C62828","Non-Borrower"="#1565C0")
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(), strip.text=element_text(face="bold",size=11))

15.1 Scatter: Three Regions

p1 <- ggplot(df_crisis_model, aes(x=mtm_total_raw, y=uninsured_lev_raw)) +
  geom_point(aes(color=model_region, shape=ifelse(any_fed==1,"Borrower","Non-Borrower")),
             alpha=0.5, size=1.8) +
  scale_color_manual(values=gp_colors, name="Region") +
  scale_shape_manual(values=c("Borrower"=17,"Non-Borrower"=1), name=NULL) +
  labs(title="Three-Region Map: MTM Losses x Uninsured Leverage",
    subtitle="Triangles = Fed borrowers",
    x="MTM Loss / TA (pp)", y="Uninsured Deposits / TA (pp)") +
  theme_gp + guides(color=guide_legend(override.aes=list(size=3,alpha=1)))
print(p1); save_figure(p1, "Fig_ThreeRegion_Scatter", 12, 7)

15.2 Borrowing Rates

bl <- region_borrow %>%
  mutate(`Any Fed`=AnyFed_pct, BTFP=BTFP_pct, DW=DW_pct, FHLB=FHLB_pct) %>%
  select(model_region,`Any Fed`,BTFP,DW,FHLB) %>%
  pivot_longer(-model_region, names_to="Facility", values_to="Rate") %>%
  mutate(Facility=factor(Facility, levels=c("Any Fed","BTFP","DW","FHLB")))

p2 <- ggplot(bl, aes(x=Facility, y=Rate, fill=model_region)) +
  geom_col(position=position_dodge(0.75), width=0.65, alpha=0.9) +
  geom_text(aes(label=sprintf("%.1f%%",Rate)), position=position_dodge(0.75), vjust=-0.4, size=2.8) +
  scale_fill_manual(values=gp_colors) +
  scale_y_continuous(labels=function(x) paste0(x,"%"), expand=expansion(mult=c(0,0.15))) +
  labs(title="Crisis Borrowing by Theory Region", x=NULL, y="Borrowing Rate (%)") + theme_gp
print(p2); save_figure(p2, "Fig_BorrowRates", 11, 5)

15.3 MV Equity Density

p3 <- ggplot(df_crisis_model %>% mutate(B=ifelse(any_fed==1,"Fed Borrower","Non-Borrower")),
       aes(x=emv_pp, fill=B, color=B)) +
  geom_density(alpha=0.3, linewidth=0.7) +
  geom_vline(xintercept=0, linetype="dashed") +
  scale_fill_manual(values=borr_colors) + scale_color_manual(values=borr_colors) +
  labs(title="MV Equity: Borrowers vs Non-Borrowers",
    subtitle="Dashed = E^MV=0 (solvency threshold)", x="E^MV / TA (pp)", y="Density") + theme_gp
print(p3); save_figure(p3, "Fig_EMV_Density", 12, 5)

15.4 Three-Region Number Line (Theory Figure)

Empirical counterpart of Theory Figure 1. Banks sorted by total MTM loss, with region shading determined by bank-specific thresholds. Vertical lines show mean thresholds at each φ.

# --- Build bank-level data with φ-varying thresholds ---
phi_plot_grid <- c(0.25, 0.50, 0.75, 1.00)

nl_data <- map_dfr(phi_plot_grid, function(phi) {
  df_crisis_model %>%
    mutate(
      th_liq_phi = book_equity_to_total_asset +
        safe_div(insured_deposit + (1 - phi) * uninsured_deposit,
                 insured_deposit + uninsured_deposit, NA_real_) * f_pp,
      region_phi = case_when(
        is.na(th_liq_phi) | is.na(threshold_solvency) ~ NA_character_,
        mtm_total_raw <= th_liq_phi ~ "No-Run Region",
        mtm_total_raw <= threshold_solvency ~ "Panic Zone",
        TRUE ~ "Fundamental Insolvency"
      ),
      region_phi = factor(region_phi, levels = c("No-Run Region","Panic Zone","Fundamental Insolvency")),
      phi_label = sprintf("φ = %d%%", as.integer(phi * 100)),
      is_borrower = factor(ifelse(any_fed == 1, "Fed Borrower", "Non-Borrower"),
                           levels = c("Non-Borrower","Fed Borrower"))
    ) %>%
    filter(!is.na(region_phi)) %>%
    select(idrssd, mtm_total_raw, th_liq_phi, threshold_solvency, region_phi, phi_label, is_borrower)
})

# Mean thresholds for vertical lines
thresh_means <- nl_data %>%
  group_by(phi_label) %>%
  summarise(mean_liq = mean(th_liq_phi, na.rm = TRUE),
            mean_sol = mean(threshold_solvency, na.rm = TRUE), .groups = "drop")

p_nl <- ggplot(nl_data, aes(x = mtm_total_raw)) +
  geom_histogram(aes(fill = region_phi), bins = 60, alpha = 0.75, color = "white", linewidth = 0.2) +
  geom_vline(data = thresh_means, aes(xintercept = mean_liq),
             color = "#1565C0", linewidth = 0.9, linetype = "dashed") +
  geom_vline(data = thresh_means, aes(xintercept = mean_sol),
             color = "#C62828", linewidth = 0.9, linetype = "dotdash") +
  facet_wrap(~phi_label, ncol = 2, scales = "free_y") +
  scale_fill_manual(values = gp_colors, name = "Region") +
  labs(title = "Three-Region Classification Under Alternative Run Assumptions (φ)",
       subtitle = "Dashed blue = mean liquidity threshold; dot-dash red = mean solvency threshold",
       x = "Total MTM Loss / TA (pp)", y = "Number of Banks",
       caption = "Each panel reclassifies all banks using the generalised liquidity threshold ℓ_(φ) = e + [(D^I + (1-φ)D^U)/D]f.") +
  theme_gp +
  theme(strip.text = element_text(face = "bold", size = 12))
print(p_nl); save_figure(p_nl, "Fig_ThreeRegion_NumberLine", 14, 7)

15.5 Region Proportions by φ

How does the run assumption change the bank partition?

phi_fine <- seq(0.10, 1.00, by = 0.05)

prop_data <- map_dfr(phi_fine, function(phi) {
  df_phi <- df_crisis_model %>%
    mutate(
      th_liq_phi = book_equity_to_total_asset +
        safe_div(insured_deposit + (1 - phi) * uninsured_deposit,
                 insured_deposit + uninsured_deposit, NA_real_) * f_pp,
      region_phi = case_when(
        is.na(th_liq_phi) | is.na(threshold_solvency) ~ NA_character_,
        mtm_total_raw <= th_liq_phi ~ "No-Run Region",
        mtm_total_raw <= threshold_solvency ~ "Panic Zone",
        TRUE ~ "Fundamental Insolvency"
      )
    ) %>% filter(!is.na(region_phi))

  n_tot <- nrow(df_phi)
  tibble(
    phi = phi,
    Region = c("No-Run Region", "Panic Zone", "Fundamental Insolvency"),
    Count = c(sum(df_phi$region_phi == "No-Run Region"),
              sum(df_phi$region_phi == "Panic Zone"),
              sum(df_phi$region_phi == "Fundamental Insolvency")),
    Pct = Count / n_tot * 100
  )
}) %>% mutate(Region = factor(Region, levels = c("No-Run Region","Panic Zone","Fundamental Insolvency")))

p_prop <- ggplot(prop_data, aes(x = phi * 100, y = Pct, fill = Region)) +
  geom_area(alpha = 0.8, color = "white", linewidth = 0.3) +
  geom_vline(xintercept = 100, linetype = "dashed", color = "black", linewidth = 0.5) +
  annotate("text", x = 98, y = 5, label = "Baseline (φ=100%)", hjust = 1, size = 3.2, fontface = "italic") +
  scale_fill_manual(values = gp_colors) +
  scale_x_continuous(breaks = seq(10, 100, 10), labels = function(x) paste0(x, "%")) +
  scale_y_continuous(labels = function(y) paste0(y, "%"), expand = expansion(mult = c(0, 0.02))) +
  labs(title = "Region Composition Under Alternative Run Assumptions",
       subtitle = "Lower φ → milder run → fewer panic-zone banks",
       x = "Run fraction (φ)", y = "Share of banks (%)",
       caption = "ℓ_(φ) = e + [(D^I + (1-φ)D^U)/D]f. Solvency threshold unchanged.") +
  theme_gp
print(p_prop); save_figure(p_prop, "Fig_RegionProportions_Phi", 11, 6)

15.6 Threshold Diagram: Borrowers vs Non-Borrowers

Empirical number-line in the spirit of the theory TikZ diagram. Each point is a bank plotted at its MTM loss, with region boundaries shown for the baseline (φ=100%) and a partial-run scenario (φ=50%).

# Compute bank-level data with both φ=1 and φ=0.50 thresholds
df_diag <- df_crisis_model %>%
  mutate(
    th_liq_100 = threshold_liquidity,
    th_liq_50  = book_equity_to_total_asset +
      safe_div(insured_deposit + 0.50 * uninsured_deposit,
               insured_deposit + uninsured_deposit, NA_real_) * f_pp,
    th_sol = threshold_solvency,
    B = ifelse(any_fed == 1, "Fed Borrower", "Non-Borrower"),
    rank_loss = rank(mtm_total_raw, ties.method = "first")
  ) %>% filter(!is.na(th_liq_100))

# Mean thresholds
mn_liq100 <- mean(df_diag$th_liq_100, na.rm = TRUE)
mn_liq50  <- mean(df_diag$th_liq_50, na.rm = TRUE)
mn_sol    <- mean(df_diag$th_sol, na.rm = TRUE)

p_diag <- ggplot(df_diag, aes(x = rank_loss, y = mtm_total_raw)) +
  geom_point(aes(color = model_region, shape = B), alpha = 0.55, size = 1.5) +
  geom_hline(yintercept = mn_liq100, color = "#1565C0", linewidth = 0.8, linetype = "dashed") +
  geom_hline(yintercept = mn_liq50, color = "#1565C0", linewidth = 0.8, linetype = "dotted") +
  geom_hline(yintercept = mn_sol, color = "#C62828", linewidth = 0.8, linetype = "dotdash") +
  annotate("text", x = max(df_diag$rank_loss) * 0.02, y = mn_liq100 + 0.15,
           label = "ℓ_ (φ=100%)", color = "#1565C0", hjust = 0, size = 3, fontface = "bold") +
  annotate("text", x = max(df_diag$rank_loss) * 0.02, y = mn_liq50 + 0.15,
           label = "ℓ_ (φ=50%)", color = "#1565C0", hjust = 0, size = 3, fontface = "italic") +
  annotate("text", x = max(df_diag$rank_loss) * 0.02, y = mn_sol + 0.15,
           label = "ℓ̄ (solvency)", color = "#C62828", hjust = 0, size = 3, fontface = "bold") +
  scale_color_manual(values = gp_colors, name = "Region (φ=100%)") +
  scale_shape_manual(values = c("Fed Borrower" = 17, "Non-Borrower" = 1), name = NULL) +
  labs(title = "Bank-Level MTM Losses with Theory Thresholds",
       subtitle = "Banks ranked by total MTM loss; thresholds shown for φ=100% (baseline) and φ=50%",
       x = "Banks (ranked by MTM loss, ascending)", y = "Total MTM Loss / TA (pp)",
       caption = "Raising the liquidity threshold (lowering φ) reclassifies marginal panic-zone banks as no-run.") +
  theme_gp +
  guides(color = guide_legend(override.aes = list(size = 3, alpha = 1)))
print(p_diag); save_figure(p_diag, "Fig_ThresholdDiagram", 14, 5)

15.7 Within-Region Coefficient Plot

pv <- c("ln_assets_raw","mtm_total_raw","mtm_sec_raw","mtm_loan_raw",
        "mtm_btfp_raw","uninsured_lev_raw",
        "cash_ratio_raw","book_equity_ratio_raw","f_pp","wholesale_raw")
pl <- c("Log(Assets)","MTM Loss (l)","Securities MTM (l_S)","Loan MTM (l_L)",
        "BTFP-elig MTM (OMO)","Uninsured/TA",
        "Cash/TA","Book Equity","Franchise (f)","Wholesale")

ci_data <- map_dfr(seq_along(pv), function(i) {
  df_crisis_model %>% filter(!is.na(!!sym(pv[i]))) %>%
    mutate(B=ifelse(any_fed==1,"Fed Borrower","Non-Borrower")) %>%
    group_by(model_region, B) %>%
    summarise(Mean=mean(!!sym(pv[i]),na.rm=T), SE=sd(!!sym(pv[i]),na.rm=T)/sqrt(n()), .groups="drop") %>%
    mutate(lo=Mean-1.96*SE, hi=Mean+1.96*SE, Variable=pl[i])
}) %>% mutate(Variable=factor(Variable, levels=rev(pl)))

p4 <- ggplot(ci_data, aes(x=Mean, y=Variable, color=B, shape=B)) +
  geom_pointrange(aes(xmin=lo,xmax=hi), position=position_dodge(0.5), size=0.5) +
  facet_wrap(~model_region, scales="free_x") +
  scale_color_manual(values=borr_colors) + scale_shape_manual(values=c("Fed Borrower"=17,"Non-Borrower"=16)) +
  labs(title="Borrower vs Non-Borrower by Region", x="Mean (raw)", y=NULL) + theme_gp
print(p4); save_figure(p4, "Fig_CoefPlot_ByRegion", 13, 8)

15.8 Equity Waterfall

wf <- df_crisis_model %>%
  mutate(B=ifelse(any_fed==1,"Fed Borrower","Non-Borrower")) %>%
  group_by(B) %>%
  summarise(`Book Equity (e)`=mean(book_equity_ratio_raw,na.rm=T),
    `- MTM Loss`=-mean(mtm_total_raw,na.rm=T),
    `= Jiang AE`=mean(adjusted_equity_raw,na.rm=T),
    `+ Franchise (f)`=mean(f_pp,na.rm=T),
    `= E^MV`=mean(emv_pp,na.rm=T), .groups="drop") %>%
  pivot_longer(-B, names_to="Component", values_to="Value") %>%
  mutate(Component=factor(Component, levels=c("Book Equity (e)","- MTM Loss",
    "= Jiang AE","+ Franchise (f)","= E^MV")),
    Type=case_when(grepl("^=",Component)~"Sub", grepl("^-",Component)~"Neg", TRUE~"Pos"))

p5 <- ggplot(wf, aes(x=Component, y=Value, fill=Type)) +
  geom_col(alpha=0.85, width=0.65) +
  geom_hline(yintercept=0, linetype="dashed") +
  geom_text(aes(label=sprintf("%.2f",Value)), vjust=ifelse(wf$Value>=0,-0.3,1.3), size=3) +
  facet_wrap(~B) +
  scale_fill_manual(values=c("Pos"="#43A047","Neg"="#E53935","Sub"="#37474F"), guide="none") +
  scale_x_discrete(labels=function(x) str_wrap(x,12)) +
  labs(title="Equity Waterfall: Book -> MTM -> Franchise -> MV Equity",
    subtitle="Mean (pp of TA)", x=NULL, y="pp of TA") + theme_gp
print(p5); save_figure(p5, "Fig_EquityWaterfall", 12, 6)