Summary

This analysis examines bank borrowing behavior across Federal Reserve emergency facilities (BTFP and Discount Window) during the March 2023 banking crisis. We exploit the institutional differences between facilities – particularly BTFP’s par valuation of eligible collateral – to test whether banks strategically selected facilities based on balance sheet vulnerabilities.

Research Questions

  1. Extensive Margin: Did BTFP’s par valuation generate systematic selection, with banks sorting into facilities based on MTM losses?
  2. Temporal Dynamics: Did borrowing determinants differ across crisis phases (acute crisis vs. post-acute vs. arbitrage)?
  3. Intensive Margin: Conditional on borrowing, did banks with larger MTM losses borrow more?
  4. Collateral Constraints: Did banks “max out” BTFP-eligible collateral and turn to DW for additional needs?

Empirical Strategy Overview

Step Analysis Question Answered
1 Extensive margin (full period) Did MTM losses drive BTFP selection?
2 Temporal analysis Did determinants differ across phases?
3 Intensive margin Did distressed banks borrow more?
4 “Both” banks Did collateral constraints bind?

Variable Definitions

Variable Definitions

Dependent Variables

Variable Definition Formula
BTFP_i Binary: Bank i borrowed from BTFP 1[Bank i borrowed from BTFP]
DW_i Binary: Bank i borrowed from DW 1[Bank i borrowed from DW]
BTFPAmount_i BTFP borrowing scaled by assets BTFP Borrowing_i / Assets_i
BTFP_Acute_i First BTFP borrow <= May 1, 2023 1[First BTFP date <= May 1]
BTFP_PostAcute_i First BTFP borrow in (May 1, Oct 31] 1[First BTFP date in (May 1, Oct 31]]
BTFP_Arb_i First BTFP borrow in (Nov 1, Jan 24] 1[First BTFP date in (Nov 1, Jan 24]]

Key Explanatory Variables

Variable Definition Formula
MTM_BTFP_i MTM loss on BTFP-eligible securities / Assets MTM Loss on OMO-Eligible_i / Total Assets_i
MTM_Other_i MTM loss on non-eligible assets / Assets MTM Loss on Non-OMO_i / Total Assets_i
UninsuredLev_i Uninsured deposits / Assets Uninsured Deposits_i / Total Assets_i
EligibleCollateral_i BTFP-eligible securities / Assets OMO-Eligible Securities_i / Total Assets_i
BorrowingSubsidy_i MTM loss rate on eligible collateral MTM Loss on OMO-Eligible_i / OMO-Eligible_i

Run Risk Measures

Variable Definition Formula
RunRisk1_i Continuous: Uninsured x MTM %Uninsured_i x %MTM Loss_i
RunRisk2_i Continuous: Runable x MTM %Runable_i x %MTM Loss_i
RunRisk1Dummy_i Binary: Both above median 1[%Uninsured > p50 AND %MTM > p50]
RunRisk2Dummy_i Binary: Both above median 1[%Runable > p50 AND %MTM > p50]

Jiang et al. Insolvency Measures

Insured Deposit Coverage Ratio (IDCR)

IDCR_i(s) = (MV_Assets_i - s x UninsuredDeposits_i - InsuredDeposits_i) / InsuredDeposits_i

where s in {0.5, 1.0} represents the fraction of uninsured deposits that run.

Variable Run Scenario Interpretation
IDCR_1 s = 0.5 (50% run) Coverage ratio under moderate run
IDCR_2 s = 1.0 (100% run) Coverage ratio under complete run

Insolvency: Bank is insolvent if IDCR < 0

Capital Ratio Metric

Insolvency_i(s) = [(TotalAssets_i - TotalLiabilities_i) - s x UninsuredDeposits_i x MV_Adjustment_i] / TotalAssets_i

where: MV_Adjustment_i = (TotalAssets_i / MV_Assets_i) - 1

Variable Run Scenario Interpretation
Insolvency_1 s = 0.5 Capital metric under 50% run
Insolvency_2 s = 1.0 Capital metric under 100% run

Adjusted Equity (Jiang-Style)

AdjustedEquity_i = EquityRatio_i - MTMLoss_i

MTM_Insolvent_i = 1[AdjustedEquity_i < 0]

Control Variables

Variable Definition Formula
ln_assets Log of total assets ln(Total Assets_i)
cash_ratio Cash / Assets Cash_i / Total Assets_i
securities_ratio Securities / Assets Securities_i / Total Assets_i
roa Return on assets Net Income_i / Avg Assets_i
loan_to_deposit Loans / Deposits Total Loans_i / Total Deposits_i
book_equity_ratio Book equity / Assets Total Equity_i / Total Assets_i
pct_wholesale_liability Wholesale funding / Liabilities (Fed Funds + Repo + Other Borr)_i / Total Liabilities_i
pct_runable_liability Runable liabilities / Liabilities (Uninsured + Wholesale)_i / Total Liabilities_i
pct_liquidity_available Liquid assets / Assets (Cash + Rerepo + FF Sold)_i / Total Assets_i
fhlb_ratio FHLB advances / Assets FHLB Advances_i / Total Assets_i

Facility Choice Variables

Variable Definition
btfp Binary: Used BTFP during full program
dw Binary: Used DW during full program (post-BTFP)
dw_pre_btfp Binary: Used DW in pre-BTFP period (Jan 1 - Mar 12, 2023)
both Binary: Used both BTFP and DW
btfp_only Binary: Used BTFP but not DW
dw_only Binary: Used DW but not BTFP
any_fed Binary: Used either facility
facility Categorical: None / BTFP Only / DW Only / Both

Period-Specific Variables

Variable Period Date Range
btfp_acute / dw_acute Acute Crisis Mar 13 - May 1, 2023
btfp_post / dw_post Post-Acute May 2 - Oct 31, 2023
btfp_arb / dw_arb Arbitrage Nov 1, 2023 - Jan 24, 2024
dw_pre Pre-BTFP (Baseline) Jan 1 - Mar 12, 2023

Intensive Margin Variables

Variable Definition Formula
btfp_amount_pct BTFP borrowing as % of assets (BTFP Amount / Assets) x 100
dw_amount_pct DW borrowing as % of assets (DW Amount / Assets) x 100
total_borrowed_pct Total Fed borrowing as % of assets (BTFP + DW Amount) / Assets x 100
btfp_share BTFP share of total Fed borrowing BTFP Amount / (BTFP + DW) x 100
btfp_utilization Collateral utilization rate BTFP Amount / Collateral Capacity
maxed_out_btfp Binary: Utilization > 90% 1[btfp_utilization > 0.90]

Step 1: Extensive Margin (Full Period)

\[BTFP_i = \alpha + \beta_1 \cdot MTM^{BTFP}_i + \beta_2 \cdot MTM^{Other}_i + \beta_3 \cdot UninsuredLev_i + \beta_4 \cdot (MTM^{BTFP}_i \times UninsuredLev_i) + \beta_5 \cdot EligibleCollateral_i + \gamma'Z_i + \varepsilon_i\]

Run separately for BTFP and DW as dependent variables.

Step 2: Temporal Analysis

For each period \(p \in \{Acute, PostAcute, Arbitrage\}\):

\[BTFP^p_i = \alpha + \beta^p_1 \cdot MTM^{BTFP}_i + \beta^p_2 \cdot MTM^{Other}_i + \beta^p_3 \cdot UninsuredLev_i + \gamma'Z_i + \varepsilon_i\]

Step 3: Intensive Margin

Among BTFP users:

\[\frac{BTFPAmount_i}{Assets_i} = \alpha + \beta_1 \cdot MTM^{BTFP}_i + \beta_2 \cdot MTM^{Other}_i + \beta_3 \cdot UninsuredLev_i + \gamma'Z_i + \varepsilon_i\]

Step 4: Both Banks and Collateral Constraints

\[DW_i = \alpha + \beta_1 \cdot MTM^{BTFP}_i + \beta_2 \cdot MTM^{Other}_i + \beta_3 \cdot EligibleCollateral_i + \gamma'Z_i + \varepsilon_i \quad | \quad BTFP_i = 1\]

# SETUP AND PACKAGES

BASE_PATH <- "C:/Users/mohua/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025"
knitr::opts_knit$set(root.dir = BASE_PATH)

options(repos = c(CRAN = "https://cloud.r-project.org"))
options(scipen = 999)
set.seed(20230313)

required_packages <- c(
  "data.table", "dplyr", "tidyr", "tibble", "lubridate", "stringr", "readr",

"fixest", "sandwich", "lmtest", "broom",
  "ggplot2", "ggthemes", "scales", "patchwork", "gridExtra",
  "knitr", "kableExtra", "modelsummary", "htmltools", "fastmap",
  "bslib", "sass", "jquerylib", "rlang",
  "DescTools", "moments", "psych"
)

check_and_install <- function(pkg, min_version = NULL) {
  needs_install <- FALSE
  if (!requireNamespace(pkg, quietly = TRUE)) {
    needs_install <- TRUE
  } else if (!is.null(min_version)) {
    if (packageVersion(pkg) < min_version) {
      needs_install <- TRUE
    }
  }
  if (needs_install) {
    message(paste("Installing/Updating", pkg))
    tryCatch(
      install.packages(pkg, quiet = TRUE),
      error = function(e) warning(paste("Could not install", pkg))
    )
  }
}

check_and_install("fastmap", "1.2.0")
check_and_install("htmltools", "0.5.8")
check_and_install("bslib")

missing <- required_packages[!required_packages %in% installed.packages()[,"Package"]]
if(length(missing) > 0) install.packages(missing)

suppressPackageStartupMessages({
  library(data.table)
  library(dplyr)
  library(tidyr)
  library(tibble)
  library(lubridate)
  library(stringr)
  library(readr)
  library(fixest)
  library(sandwich)
  library(lmtest)
  library(broom)
  library(ggplot2)
  library(ggthemes)
  library(scales)
  library(patchwork)
  library(gridExtra)
  library(knitr)
  library(kableExtra)
  library(modelsummary)
  library(DescTools)
  library(moments)
  library(psych)
  library(tidyverse)
})

theme_journal <- function(base_size = 12) {
  theme_classic(base_size = base_size) +
    theme(
      plot.title = element_text(face = "bold"),
      legend.position = "bottom",
      panel.grid = element_blank()
    )
}
# CONFIGURE PATHS

DATA_RAW    <- file.path(BASE_PATH, "01_data/raw")
DATA_PROC   <- file.path(BASE_PATH, "01_data/processed")
DOC_PATH    <- file.path(BASE_PATH, "03_documentation")
TABLE_PATH  <- file.path(DOC_PATH, "regression_tables/btfp_analysis_new")
FIG_PATH    <- file.path(DOC_PATH, "figures/btfp_analysis_new")

dir.create(TABLE_PATH, recursive = TRUE, showWarnings = FALSE)
dir.create(FIG_PATH, recursive = TRUE, showWarnings = FALSE)

Crisis Timeline

# CRISIS PARAMETERS

CRISIS_START      <- as.Date("2023-03-13")
SVB_FAIL          <- as.Date("2023-03-10")
FRC_FAIL          <- as.Date("2023-05-01")
DW_HAIRCUT_RETURN <- as.Date("2023-10-31")
ARB_OPEN          <- as.Date("2023-11-06")
ARB_CLOSE         <- as.Date("2024-01-24")
BTFP_CLOSE        <- as.Date("2024-03-11")

PRE_BTFP_START    <- as.Date("2023-01-01")
PRE_BTFP_END      <- as.Date("2023-03-12")
PERIOD_1_END      <- as.Date("2023-05-01")
PERIOD_2_END      <- as.Date("2023-10-31")
PERIOD_3_END      <- as.Date("2024-01-24")

BASELINE_DATE     <- "2022Q4"

cat("================================================================\n")
#> ================================================================
cat("CRISIS TIMELINE\n")
#> CRISIS TIMELINE
cat("================================================================\n")
#> ================================================================
cat("Pre-BTFP (DW Only):    Jan 1 - Mar 12, 2023\n")
#> Pre-BTFP (DW Only):    Jan 1 - Mar 12, 2023
cat("Period 1 (Acute):      Mar 13 - May 1, 2023\n")
#> Period 1 (Acute):      Mar 13 - May 1, 2023
cat("Period 2 (Post-Acute): May 2 - Oct 31, 2023\n")
#> Period 2 (Post-Acute): May 2 - Oct 31, 2023
cat("Period 3 (Arbitrage):  Nov 1 - Jan 24, 2024\n")
#> Period 3 (Arbitrage):  Nov 1 - Jan 24, 2024
cat("================================================================\n")
#> ================================================================

Helper Functions

# HELPER FUNCTIONS

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

safe_div <- function(num, denom) {
  ifelse(is.na(denom) | denom == 0, NA_real_, num / denom)
}

parse_date_safe <- function(x) {
  if (inherits(x, "Date")) return(x)
  x_char <- as.character(x)
  result <- suppressWarnings(mdy(x_char))
  if (all(is.na(result))) result <- suppressWarnings(ymd(x_char))
  if (all(is.na(result))) result <- suppressWarnings(dmy(x_char))
  return(result)
}

theme_pub <- function(base_size = 11) {
  theme_minimal(base_size = base_size) +
    theme(
      plot.title = element_text(face = "bold", size = rel(1.2), hjust = 0),
      plot.subtitle = element_text(size = rel(0.9), hjust = 0, color = "gray40"),
      plot.caption = element_text(size = rel(0.7), hjust = 1, color = "gray50"),
      panel.grid.minor = element_blank(),
      panel.grid.major = element_line(color = "gray90", linewidth = 0.3),
      axis.title = element_text(face = "bold", size = rel(0.9)),
      legend.position = "bottom",
      strip.text = element_text(face = "bold"),
      plot.margin = margin(10, 10, 10, 10)
    )
}

crisis_colors <- c("Pre-BTFP" = "#636363", "Acute" = "#d73027",
                   "Post-Acute" = "#fc8d59", "Arbitrage" = "#4575b4")
facility_colors <- c("BTFP" = "#2166ac", "DW" = "#b2182b", "Both" = "#762a83", "None" = "#d9d9d9")

Data Loading

Load Data

# LOAD DATA

cat("\n=== LOADING DATA ===\n")
#> 
#> === LOADING DATA ===
call_q <- read_csv(file.path(DATA_PROC, "final_call_gsib.csv"), show_col_types = FALSE) %>%
  mutate(idrssd = as.character(idrssd))
cat("Call reports:", nrow(call_q), "obs\n")
#> Call reports: 61002 obs
btfp_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 = parse_date_safe(btfp_loan_date),
    btfp_maturity_date = parse_date_safe(btfp_maturity_date),
    btfp_repayment_date = parse_date_safe(btfp_repayment_date)
  )
cat("BTFP loans:", nrow(btfp_raw), "records\n")
#> BTFP loans: 6734 records
dw_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 = parse_date_safe(dw_loan_date),
    dw_maturity_date = parse_date_safe(dw_maturity_date),
    dw_repayment_date = parse_date_safe(dw_repayment_date)
  )
cat("DW loans:", nrow(dw_raw), "records\n")
#> DW loans: 20219 records

Assign Periods

# ASSIGN CRISIS PERIODS

assign_period <- function(date) {
  case_when(
    date >= PRE_BTFP_START & date <= PRE_BTFP_END ~ "Pre-BTFP",
    date >= CRISIS_START & date <= PERIOD_1_END ~ "Acute",
    date > PERIOD_1_END & date <= PERIOD_2_END ~ "Post-Acute",
    date > PERIOD_2_END & date <= PERIOD_3_END ~ "Arbitrage",
    TRUE ~ NA_character_
  )
}

btfp_loans <- btfp_raw %>%
  mutate(
    period = assign_period(btfp_loan_date),
    period = factor(period, levels = c("Pre-BTFP", "Acute", "Post-Acute", "Arbitrage"))
  ) %>%
  filter(!is.na(period))

dw_loans <- dw_raw %>%
  mutate(
    period = assign_period(dw_loan_date),
    period = factor(period, levels = c("Pre-BTFP", "Acute", "Post-Acute", "Arbitrage"))
  ) %>%
  filter(!is.na(period))

cat("\nLoans by period:\n")
#> 
#> Loans by period:
cat("BTFP:", table(btfp_loans$period), "\n")
#> BTFP: 0 1087 1972 3279
cat("DW:", table(dw_loans$period), "\n")
#> DW: 1871 1619 4237 0

Loan-Level Summary Tables

Table 1: Loan Characteristics by Period

Total ($B) represents the sum for amounts; ‘Cumulative’ row shows issuance to date. Mean, Median, Min, and Max statistics are reported in $Millions for monetary variables. Data includes observations up to September 30.

library(tidyverse)
library(lubridate)
library(kableExtra)

# --- 1. PRE-CALCULATION ---
dw_loans <- dw_loans %>%
  arrange(dw_loan_date) %>%
  mutate(dw_cumulative_global = cumsum(dw_loan_amount))

btfp_loans <- btfp_loans %>%
  arrange(btfp_loan_date) %>%
  mutate(btfp_cumulative_global = cumsum(btfp_loan_amount))

# --- 2. CONFIGURATION ---
# IMPORTANT: Avoid $ signs - they break HTML rendering
vars_dw <- list(
  "dw_loan_amount"      = "Loan Amount (Millions)",
  "dw_interest_rate"    = "Interest Rate (%)",
  "dw_term"             = "Term (Days)",
  "dw_total_collateral" = "Collateral Pledged (Millions)",
  "utilization"         = "Utilization (%)",
  "pct_omo"             = "BTFP Eligible Share (%)"
)

vars_btfp <- list(
  "btfp_loan_amount"      = "Loan Amount (Millions)",
  "btfp_interest_rate"    = "Interest Rate (%)",
  "btfp_term"             = "Term (Days)",
  "btfp_total_collateral" = "Collateral Pledged (Millions)",
  "utilization"           = "Utilization (%)",
  "pct_tsy"               = "Treasury Share (%)"
)

# --- 3. HELPER FUNCTION ---
get_period_stats <- function(data, period_name, var_list, facility_type = "DW") {
  
  df_period <- data %>% filter(period == period_name)
  n_banks <- n_distinct(df_period$rssd_id)
  
  cum_col <- if(facility_type == "DW") "dw_cumulative_global" else "btfp_cumulative_global"
  cum_val <- max(df_period[[cum_col]], na.rm = TRUE) / 1e9
  
  row_unique <- tibble(
    Variable = "Unique Borrowers (Count)",
    N = n_banks, Total_B = NA, Mean = NA, Median = NA, SD = NA, Min = NA, Max = NA
  )
  
  row_cumulative <- tibble(
    Variable = "Cumulative Issuance (Billions)",
    N = NA, Total_B = cum_val, Mean = NA, Median = NA, SD = NA, Min = NA, Max = NA
  )
  
  stats_rows <- map_dfr(names(var_list), function(v_col) {
    vals <- df_period[[v_col]]
    is_money <- str_detect(v_col, "amount|collateral")
    total_val <- if(is_money) sum(vals, na.rm = TRUE) / 1e9 else NA
    calc_vals <- if(is_money) vals / 1e6 else vals
    
    tibble(
      Variable = var_list[[v_col]],
      N      = sum(!is.na(vals)),
      Total_B = total_val,
      Mean   = mean(calc_vals, na.rm = TRUE),
      Median = median(calc_vals, na.rm = TRUE),
      SD     = sd(calc_vals, na.rm = TRUE),
      Min    = min(calc_vals, na.rm = TRUE),
      Max    = max(calc_vals, na.rm = TRUE)
    )
  })
  
  bind_rows(row_unique, row_cumulative, stats_rows)
}

# --- 4. PREPARE DATA ---
dw_ready <- dw_loans %>%
  mutate(
    utilization = (dw_loan_amount / dw_total_collateral) * 100,
    pct_omo = (dw_omo_eligible / dw_total_collateral) * 100
  )

btfp_ready <- btfp_loans %>%
  mutate(
    utilization = (btfp_loan_amount / btfp_total_collateral) * 100,
    pct_tsy = (btfp_treasury_sec / btfp_total_collateral) * 100
  )

# --- 5. GENERATE TABLE 1 (DW) ---
d1 <- get_period_stats(dw_ready, "Pre-BTFP", vars_dw, "DW")
d2 <- get_period_stats(dw_ready, "Acute", vars_dw, "DW")
d3 <- get_period_stats(dw_ready, "Post-Acute", vars_dw, "DW")
d4 <- get_period_stats(dw_ready, "Arbitrage", vars_dw, "DW")

tab1_data <- bind_rows(d1, d2, d3, d4)

kbl(tab1_data, 
    format = "html",
    caption = "Table 1: Discount Window (DW) Detailed Statistics by Period",
    digits = 2,
    col.names = c("Variable", "N", "Total (B)", "Mean", "Median", "SD", "Min", "Max"),
    escape = FALSE) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  ) %>%
  pack_rows("Panel A: Pre-BTFP", 1, nrow(d1)) %>%
  pack_rows("Panel B: Acute Crisis", nrow(d1) + 1, nrow(d1) + nrow(d2)) %>%
  pack_rows("Panel C: Post-Acute", nrow(d1) + nrow(d2) + 1, nrow(d1) + nrow(d2) + nrow(d3)) %>%
  pack_rows("Panel D: Arbitrage Period", nrow(tab1_data) - nrow(d4) + 1, nrow(tab1_data))
Table 1: Discount Window (DW) Detailed Statistics by Period
Variable N Total (B) Mean Median SD Min Max
Panel A: Pre-BTFP
Unique Borrowers (Count) 292 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 123.59 NA NA NA NA NA
Loan Amount (Millions) 1871 123.59 66.06 12.40 585.43 0.00 20377.61
Interest Rate (%) 1871 NA 4.63 4.75 0.13 4.50 4.75
Term (Days) 1871 NA 4.54 1.00 11.98 1.00 90.00
Collateral Pledged (Millions) 1871 892.23 476.87 85.79 6322.08 0.01 268687.26
Utilization (%) 1871 NA 23.95 14.98 23.75 0.00 100.00
BTFP Eligible Share (%) 1871 NA 32.64 0.00 45.69 0.00 100.00
Panel B: Acute Crisis
Unique Borrowers (Count) 424 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 3257.07 NA NA NA NA NA
Loan Amount (Millions) 1619 3133.48 1935.44 10.00 12075.23 0.00 127500.00
Interest Rate (%) 1619 NA 4.92 5.00 0.12 4.75 5.00
Term (Days) 1619 NA 4.51 1.00 12.73 1.00 91.00
Collateral Pledged (Millions) 1619 4745.72 2931.27 81.90 15706.74 0.00 272872.11
Utilization (%) 1619 NA 28.78 17.78 30.12 0.00 242.97
BTFP Eligible Share (%) 1619 NA 36.74 0.00 46.28 0.00 100.00
Panel C: Post-Acute
Unique Borrowers (Count) 846 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 3368.62 NA NA NA NA NA
Loan Amount (Millions) 4237 111.55 26.33 5.40 99.01 0.00 5600.00
Interest Rate (%) 4237 NA 5.35 5.25 0.13 4.95 6.00
Term (Days) 4237 NA 5.44 1.00 13.58 1.00 92.00
Collateral Pledged (Millions) 4237 2457.74 580.07 59.93 7515.33 0.00 309683.66
Utilization (%) 4237 NA 22.57 14.39 23.61 0.00 100.00
BTFP Eligible Share (%) 4237 NA 34.35 0.00 45.70 0.00 100.00
Panel D: Arbitrage Period
Unique Borrowers (Count) 0 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA -Inf NA NA NA NA NA
Loan Amount (Millions) 0 0.00 NaN NA NA Inf -Inf
Interest Rate (%) 0 NA NaN NA NA Inf -Inf
Term (Days) 0 NA NaN NA NA Inf -Inf
Collateral Pledged (Millions) 0 0.00 NaN NA NA Inf -Inf
Utilization (%) 0 NA NaN NA NA Inf -Inf
BTFP Eligible Share (%) 0 NA NaN NA NA Inf -Inf 
# BTFP Table
b1 <- get_period_stats(btfp_ready, "Acute", vars_btfp, "BTFP")
b2 <- get_period_stats(btfp_ready, "Post-Acute", vars_btfp, "BTFP")
b3 <- get_period_stats(btfp_ready, "Arbitrage", vars_btfp, "BTFP")

tab2_data <- bind_rows(b1, b2, b3)

kbl(tab2_data, 
    format = "html",
    caption = "Table 2: BTFP Detailed Statistics by Period",
    digits = 2,
    col.names = c("Variable", "N", "Total (B)", "Mean", "Median", "SD", "Min", "Max")) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  ) %>%
  pack_rows("Panel A: Acute Crisis", 1, nrow(b1)) %>%
  pack_rows("Panel B: Post-Acute", nrow(b1) + 1, nrow(b1) + nrow(b2)) %>%
  pack_rows("Panel C: Arbitrage Period", nrow(tab2_data) - nrow(b3) + 1, nrow(tab2_data))
Table 2: BTFP Detailed Statistics by Period
Variable N Total (B) Mean Median SD Min Max
Panel A: Acute Crisis
Unique Borrowers (Count) 492 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 145.33 NA NA NA NA NA
Loan Amount (Millions) 1087 145.33 133.70 14.00 658.38 0.00 8900.00
Interest Rate (%) 1087 NA 4.69 4.70 0.20 4.37 5.03
Term (Days) 1087 NA 311.66 365.00 125.27 1.00 369.00
Collateral Pledged (Millions) 1087 390.33 359.09 34.00 1626.91 0.01 17598.44
Utilization (%) 1087 NA 52.45 49.78 35.05 0.00 100.00
Treasury Share (%) 1087 NA 25.43 0.00 38.15 0.00 100.00
Panel B: Post-Acute
Unique Borrowers (Count) 816 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 196.71 NA NA NA NA NA
Loan Amount (Millions) 1972 51.38 26.06 5.00 103.68 0.00 3500.00
Interest Rate (%) 1972 NA 5.20 5.35 0.31 4.37 5.59
Term (Days) 1972 NA 272.37 365.00 154.72 1.00 369.00
Collateral Pledged (Millions) 1972 556.95 282.43 26.11 2763.23 0.00 53797.57
Utilization (%) 1972 NA 34.72 22.72 32.35 0.00 100.00
Treasury Share (%) 1972 NA 24.08 0.00 36.61 0.00 100.00
Panel C: Arbitrage Period
Unique Borrowers (Count) 801 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 426.52 NA NA NA NA NA
Loan Amount (Millions) 3279 229.81 70.09 15.00 259.09 0.00 3900.00
Interest Rate (%) 3279 NA 4.97 4.89 0.19 4.76 5.49
Term (Days) 3279 NA 334.63 365.00 97.12 1.00 369.00
Collateral Pledged (Millions) 3279 744.68 227.11 41.10 1470.39 0.01 52925.81
Utilization (%) 3279 NA 49.62 42.81 33.64 0.00 100.00
Treasury Share (%) 3279 NA 19.79 0.00 31.43 0.00 100.00

Table 2: Loan Characteristics by Period EXCLUDE (failed banks and GSIBs)

# Get list of banks to EXCLUDE (failed banks and GSIBs)
excluded_banks <- call_q %>%
  filter(quarter == "2022Q4") %>%
  filter(failed_bank == 1 | gsib == 1) %>%
  pull(idrssd) %>%
  as.character()

# Filter loan data to exclude failed and GSIB banks
dw_loans_filtered <- dw_loans %>%
  filter(!rssd_id %in% excluded_banks)

btfp_loans_filtered <- btfp_loans %>%
  filter(!rssd_id %in% excluded_banks)

cat("Excluded", length(excluded_banks), "banks (failed + GSIB)\n")
#> Excluded 41 banks (failed + GSIB)
cat("DW loans: Original =", nrow(dw_loans), "| Filtered =", nrow(dw_loans_filtered), "\n")
#> DW loans: Original = 7727 | Filtered = 7668
cat("BTFP loans: Original =", nrow(btfp_loans), "| Filtered =", nrow(btfp_loans_filtered), "\n")
#> BTFP loans: Original = 6338 | Filtered = 6304
# --- PRE-CALCULATION ---
dw_loans_filtered <- dw_loans_filtered %>%
  arrange(dw_loan_date) %>%
  mutate(dw_cumulative_global = cumsum(dw_loan_amount))

btfp_loans_filtered <- btfp_loans_filtered %>%
  arrange(btfp_loan_date) %>%
  mutate(btfp_cumulative_global = cumsum(btfp_loan_amount))

# --- CONFIGURATION ---
vars_dw <- list(
  "dw_loan_amount"      = "Loan Amount (Millions)",
  "dw_interest_rate"    = "Interest Rate (%)",
  "dw_term"             = "Term (Days)",
  "dw_total_collateral" = "Collateral Pledged (Millions)",
  "utilization"         = "Utilization (%)",
  "pct_omo"             = "BTFP Eligible Share (%)"
)

vars_btfp <- list(
  "btfp_loan_amount"      = "Loan Amount (Millions)",
  "btfp_interest_rate"    = "Interest Rate (%)",
  "btfp_term"             = "Term (Days)",
  "btfp_total_collateral" = "Collateral Pledged (Millions)",
  "utilization"           = "Utilization (%)",
  "pct_tsy"               = "Treasury Share (%)"
)

# --- HELPER FUNCTION ---
get_period_stats <- function(data, period_name, var_list, facility_type = "DW") {
  
  df_period <- data %>% filter(period == period_name)
  n_banks <- n_distinct(df_period$rssd_id)
  
  cum_col <- if(facility_type == "DW") "dw_cumulative_global" else "btfp_cumulative_global"
  cum_val <- max(df_period[[cum_col]], na.rm = TRUE) / 1e9
  
  row_unique <- tibble(
    Variable = "Unique Borrowers (Count)",
    N = n_banks, Total_B = NA, Mean = NA, Median = NA, SD = NA, Min = NA, Max = NA
  )
  
  row_cumulative <- tibble(
    Variable = "Cumulative Issuance (Billions)",
    N = NA, Total_B = cum_val, Mean = NA, Median = NA, SD = NA, Min = NA, Max = NA
  )
  
  stats_rows <- map_dfr(names(var_list), function(v_col) {
    vals <- df_period[[v_col]]
    is_money <- str_detect(v_col, "amount|collateral")
    total_val <- if(is_money) sum(vals, na.rm = TRUE) / 1e9 else NA
    calc_vals <- if(is_money) vals / 1e6 else vals
    
    tibble(
      Variable = var_list[[v_col]],
      N      = sum(!is.na(vals)),
      Total_B = total_val,
      Mean   = mean(calc_vals, na.rm = TRUE),
      Median = median(calc_vals, na.rm = TRUE),
      SD     = sd(calc_vals, na.rm = TRUE),
      Min    = min(calc_vals, na.rm = TRUE),
      Max    = max(calc_vals, na.rm = TRUE)
    )
  })
  
  bind_rows(row_unique, row_cumulative, stats_rows)
}

# --- PREPARE DATA ---
dw_ready_filtered <- dw_loans_filtered %>%
  mutate(
    utilization = (dw_loan_amount / dw_total_collateral) * 100,
    pct_omo = (dw_omo_eligible / dw_total_collateral) * 100
  )

btfp_ready_filtered <- btfp_loans_filtered %>%
  mutate(
    utilization = (btfp_loan_amount / btfp_total_collateral) * 100,
    pct_tsy = (btfp_treasury_sec / btfp_total_collateral) * 100
  )
# --- DW TABLE (Excluding Failed & GSIB) ---
d1_f <- get_period_stats(dw_ready_filtered, "Pre-BTFP", vars_dw, "DW")
d2_f <- get_period_stats(dw_ready_filtered, "Acute", vars_dw, "DW")
d3_f <- get_period_stats(dw_ready_filtered, "Post-Acute", vars_dw, "DW")
d4_f <- get_period_stats(dw_ready_filtered, "Arbitrage", vars_dw, "DW")

tab1_filtered <- bind_rows(d1_f, d2_f, d3_f, d4_f)

kbl(tab1_filtered, 
    format = "html",
    caption = "Table 1: Discount Window (DW) Statistics by Period (Excluding Failed & GSIB Banks)",
    digits = 2,
    col.names = c("Variable", "N", "Total (B)", "Mean", "Median", "SD", "Min", "Max")) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  ) %>%
  pack_rows("Panel A: Pre-BTFP (Baseline)", 1, nrow(d1_f)) %>%
  pack_rows("Panel B: Acute Crisis", nrow(d1_f) + 1, nrow(d1_f) + nrow(d2_f)) %>%
  pack_rows("Panel C: Post-Acute", nrow(d1_f) + nrow(d2_f) + 1, nrow(d1_f) + nrow(d2_f) + nrow(d3_f)) %>%
  pack_rows("Panel D: Arbitrage Period", nrow(tab1_filtered) - nrow(d4_f) + 1, nrow(tab1_filtered))
Table 1: Discount Window (DW) Statistics by Period (Excluding Failed & GSIB Banks)
Variable N Total (B) Mean Median SD Min Max
Panel A: Pre-BTFP (Baseline)
Unique Borrowers (Count) 287 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 84.35 NA NA NA NA NA
Loan Amount (Millions) 1866 84.35 45.20 12.25 96.73 0.00 2000.00
Interest Rate (%) 1866 NA 4.63 4.75 0.13 4.50 4.75
Term (Days) 1866 NA 4.54 1.00 12.00 1.00 90.00
Collateral Pledged (Millions) 1866 564.44 302.49 85.79 978.93 0.01 35354.76
Utilization (%) 1866 NA 23.85 14.94 23.58 0.00 100.00
BTFP Eligible Share (%) 1866 NA 32.69 0.00 45.74 0.00 100.00
Panel B: Acute Crisis
Unique Borrowers (Count) 417 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 607.62 NA NA NA NA NA
Loan Amount (Millions) 1581 523.28 330.98 9.70 2102.86 0.00 25000.00
Interest Rate (%) 1581 NA 4.92 5.00 0.11 4.75 5.00
Term (Days) 1581 NA 4.51 1.00 12.67 1.00 91.00
Collateral Pledged (Millions) 1581 1327.46 839.63 74.95 3630.20 0.00 63919.59
Utilization (%) 1581 NA 27.50 17.20 28.20 0.00 100.00
BTFP Eligible Share (%) 1581 NA 37.18 0.00 46.62 0.00 100.00
Panel C: Post-Acute
Unique Borrowers (Count) 836 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 719.15 NA NA NA NA NA
Loan Amount (Millions) 4221 111.53 26.42 5.50 99.19 0.00 5600.00
Interest Rate (%) 4221 NA 5.35 5.25 0.13 4.95 6.00
Term (Days) 4221 NA 5.46 1.00 13.60 1.00 92.00
Collateral Pledged (Millions) 4221 1426.42 337.93 59.88 2054.04 0.00 53658.43
Utilization (%) 4221 NA 22.65 14.41 23.62 0.00 100.00
BTFP Eligible Share (%) 4221 NA 34.36 0.00 45.72 0.00 100.00
Panel D: Arbitrage Period
Unique Borrowers (Count) 0 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA -Inf NA NA NA NA NA
Loan Amount (Millions) 0 0.00 NaN NA NA Inf -Inf
Interest Rate (%) 0 NA NaN NA NA Inf -Inf
Term (Days) 0 NA NaN NA NA Inf -Inf
Collateral Pledged (Millions) 0 0.00 NaN NA NA Inf -Inf
Utilization (%) 0 NA NaN NA NA Inf -Inf
BTFP Eligible Share (%) 0 NA NaN NA NA Inf -Inf 
# --- BTFP TABLE (Excluding Failed & GSIB) ---
b1_f <- get_period_stats(btfp_ready_filtered, "Acute", vars_btfp, "BTFP")
b2_f <- get_period_stats(btfp_ready_filtered, "Post-Acute", vars_btfp, "BTFP")
b3_f <- get_period_stats(btfp_ready_filtered, "Arbitrage", vars_btfp, "BTFP")

tab2_filtered <- bind_rows(b1_f, b2_f, b3_f)

kbl(tab2_filtered, 
    format = "html",
    caption = "Table 2: BTFP Statistics by Period (Excluding Failed & GSIB Banks)",
    digits = 2,
    col.names = c("Variable", "N", "Total (B)", "Mean", "Median", "SD", "Min", "Max")) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  ) %>%
  pack_rows("Panel A: Acute Crisis", 1, nrow(b1_f)) %>%
  pack_rows("Panel B: Post-Acute", nrow(b1_f) + 1, nrow(b1_f) + nrow(b2_f)) %>%
  pack_rows("Panel C: Arbitrage Period", nrow(tab2_filtered) - nrow(b3_f) + 1, nrow(tab2_filtered))
Table 2: BTFP Statistics by Period (Excluding Failed & GSIB Banks)
Variable N Total (B) Mean Median SD Min Max
Panel A: Acute Crisis
Unique Borrowers (Count) 485 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 121.13 NA NA NA NA NA
Loan Amount (Millions) 1071 121.13 113.10 14.00 571.28 0.00 8900.00
Interest Rate (%) 1071 NA 4.69 4.71 0.20 4.37 5.03
Term (Days) 1071 NA 312.75 365.00 124.31 1.00 369.00
Collateral Pledged (Millions) 1071 287.97 268.88 34.00 1278.72 0.01 17598.44
Utilization (%) 1071 NA 52.56 49.81 34.93 0.00 100.00
Treasury Share (%) 1071 NA 25.53 0.00 38.13 0.00 100.00
Panel B: Post-Acute
Unique Borrowers (Count) 811 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 172.43 NA NA NA NA NA
Loan Amount (Millions) 1961 51.30 26.16 5.00 103.95 0.00 3500.00
Interest Rate (%) 1961 NA 5.20 5.35 0.31 4.37 5.59
Term (Days) 1961 NA 273.71 365.00 153.93 1.00 369.00
Collateral Pledged (Millions) 1961 290.38 148.08 26.09 700.99 0.00 19173.96
Utilization (%) 1961 NA 34.78 22.73 32.35 0.00 100.00
Treasury Share (%) 1961 NA 23.91 0.00 36.54 0.00 100.00
Panel C: Arbitrage Period
Unique Borrowers (Count) 797 NA NA NA NA NA NA
Cumulative Issuance (Billions) NA 397.24 NA NA NA NA NA
Loan Amount (Millions) 3272 224.81 68.71 15.00 253.20 0.00 3900.00
Interest Rate (%) 3272 NA 4.97 4.89 0.19 4.76 5.49
Term (Days) 3272 NA 335.01 365.00 96.52 1.00 369.00
Collateral Pledged (Millions) 3272 632.76 193.39 41.05 692.18 0.01 18788.69
Utilization (%) 3272 NA 49.62 42.73 33.63 0.00 100.00
Treasury Share (%) 3272 NA 19.75 0.00 31.39 0.00 100.00

Visualizations

Figure 1: Daily Borrowing Volume

# FIGURE 1: DAILY BORROWING VOLUME

daily_combined <- bind_rows(
  btfp_loans %>%
    group_by(d = btfp_loan_date) %>%
    summarise(v = sum(btfp_loan_amount, na.rm = TRUE), .groups = "drop") %>%
    mutate(Fac = "BTFP"),
  dw_loans %>%
    group_by(d = dw_loan_date) %>%
    summarise(v = sum(dw_loan_amount, na.rm = TRUE), .groups = "drop") %>%
    mutate(Fac = "DW")
)

p1 <- ggplot(daily_combined, aes(x = d, y = v / 1e9, color = Fac)) +
  geom_line(linewidth = 0.8) +
  scale_color_manual(values = c("BTFP" = "#2b8cbe", "DW" = "#e34a33")) +
  labs(
    title = "Figure 1: Daily Borrowing Volume",
    subtitle = "Discount Window spikes early; BTFP builds gradually",
    y = "Volume ($ Billions)",
    x = NULL,
    color = NULL
  ) +
  theme_journal() +
  theme(legend.position = c(0.8, 0.8))

print(p1)

btfp_daily <- btfp_loans %>%
  group_by(btfp_loan_date) %>%
  summarise(volume = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "BTFP") %>%
  rename(date = btfp_loan_date)

dw_daily <- dw_loans %>%
  group_by(dw_loan_date) %>%
  summarise(volume = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "DW") %>%
  rename(date = dw_loan_date)

daily_combined <- bind_rows(btfp_daily, dw_daily)

Figure 1.b: Daily Borrowing Volume

# FIGURE 1: DAILY BORROWING VOLUME (With and Without Failed/GSIB Banks)

# --- Get excluded banks list ---
excluded_banks <- call_q %>%
  filter(quarter == "2022Q4") %>%
  filter(failed_bank == 1 | gsib == 1) %>%
  pull(idrssd) %>%
  as.character()

# --- ALL BANKS (Original) ---
daily_all <- bind_rows(
  btfp_loans %>%
    group_by(d = btfp_loan_date) %>%
    summarise(v = sum(btfp_loan_amount, na.rm = TRUE), .groups = "drop") %>%
    mutate(Facility = "BTFP", Sample = "All Banks"),
  dw_loans %>%
    group_by(d = dw_loan_date) %>%
    summarise(v = sum(dw_loan_amount, na.rm = TRUE), .groups = "drop") %>%
    mutate(Facility = "DW", Sample = "All Banks")
)

# --- EXCLUDING FAILED & GSIB ---
daily_filtered <- bind_rows(
  btfp_loans %>%
    filter(!rssd_id %in% excluded_banks) %>%
    group_by(d = btfp_loan_date) %>%
    summarise(v = sum(btfp_loan_amount, na.rm = TRUE), .groups = "drop") %>%
    mutate(Facility = "BTFP", Sample = "Excl. Failed/GSIB"),
  dw_loans %>%
    filter(!rssd_id %in% excluded_banks) %>%
    group_by(d = dw_loan_date) %>%
    summarise(v = sum(dw_loan_amount, na.rm = TRUE), .groups = "drop") %>%
    mutate(Facility = "DW", Sample = "Excl. Failed/GSIB")
)

# --- COMBINE ---
daily_combined <- bind_rows(daily_all, daily_filtered) %>%
  mutate(
    Group = paste(Facility, Sample, sep = " - "),
    Sample = factor(Sample, levels = c("All Banks", "Excl. Failed/GSIB"))
  )

# --- PLOT ---
p1_b <- ggplot(daily_combined, aes(x = d, y = v / 1e9, color = Facility, linetype = Sample)) +
  geom_line(linewidth = 0.8) +
  scale_color_manual(values = c("BTFP" = "#2b8cbe", "DW" = "#e34a33")) +
  scale_linetype_manual(values = c("All Banks" = "solid", "Excl. Failed/GSIB" = "dashed")) +
  labs(
    title = "Figure 1: Daily Borrowing Volume",
    subtitle = "Solid = All Banks | Dashed = Excluding Failed & GSIB Banks",
    y = "Volume ($ Billions)",
    x = NULL,
    color = "Facility",
    linetype = "Sample"
  ) +
  theme_journal() +
  theme(
    legend.position = "bottom",
    legend.box = "horizontal"
  ) +
  guides(
    color = guide_legend(order = 1),
    linetype = guide_legend(order = 2)
  )

print(p1_b)

# --- Create daily data for later use ---
btfp_daily <- btfp_loans %>%
  group_by(btfp_loan_date) %>%
  summarise(volume = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "BTFP") %>%
  rename(date = btfp_loan_date)

dw_daily <- dw_loans %>%
  group_by(dw_loan_date) %>%
  summarise(volume = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "DW") %>%
  rename(date = dw_loan_date)

daily_combined_simple <- bind_rows(btfp_daily, dw_daily)

Figure 2: Cumulative Borrowing

# FIGURE 2: CUMULATIVE BORROWING

btfp_cumul <- btfp_daily %>% arrange(date) %>% mutate(cumulative = cumsum(volume))
dw_cumul <- dw_daily %>% arrange(date) %>% mutate(cumulative = cumsum(volume))
cumul_combined <- bind_rows(btfp_cumul, dw_cumul)

p2 <- ggplot(cumul_combined, aes(x = date, y = cumulative, color = facility)) +
  geom_line(linewidth = 1.2) +
  geom_vline(xintercept = c(SVB_FAIL, FRC_FAIL, ARB_OPEN),
             linetype = "dashed", color = "gray50", linewidth = 0.5) +
  scale_color_manual(values = facility_colors, name = "Facility") +
  scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y") +
  scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
  labs(
    title = "Figure 2: Cumulative Emergency Lending",
    x = NULL,
    y = "Cumulative ($B)"
  ) +
  theme_pub()

print(p2)

Figure 2: Cumulative Borrowing With and Without Failed/GSIB Banks

# FIGURE 2: CUMULATIVE BORROWING (With and Without Failed/GSIB Banks)

# --- Get excluded banks list (if not already defined) ---
excluded_banks <- call_q %>%
  filter(quarter == "2022Q4") %>%
  filter(failed_bank == 1 | gsib == 1) %>%
  pull(idrssd) %>%
  as.character()

# --- ALL BANKS ---
btfp_daily_all <- btfp_loans %>%
  group_by(date = btfp_loan_date) %>%
  summarise(volume = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "BTFP", sample = "All Banks")

dw_daily_all <- dw_loans %>%
  group_by(date = dw_loan_date) %>%
  summarise(volume = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "DW", sample = "All Banks")

# --- EXCLUDING FAILED & GSIB ---
btfp_daily_filtered <- btfp_loans %>%
  filter(!rssd_id %in% excluded_banks) %>%
  group_by(date = btfp_loan_date) %>%
  summarise(volume = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "BTFP", sample = "Excl. Failed/GSIB")

dw_daily_filtered <- dw_loans %>%
  filter(!rssd_id %in% excluded_banks) %>%
  group_by(date = dw_loan_date) %>%
  summarise(volume = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
  mutate(facility = "DW", sample = "Excl. Failed/GSIB")

# --- CALCULATE CUMULATIVE ---
btfp_cumul_all <- btfp_daily_all %>% arrange(date) %>% mutate(cumulative = cumsum(volume))
dw_cumul_all <- dw_daily_all %>% arrange(date) %>% mutate(cumulative = cumsum(volume))

btfp_cumul_filtered <- btfp_daily_filtered %>% arrange(date) %>% mutate(cumulative = cumsum(volume))
dw_cumul_filtered <- dw_daily_filtered %>% arrange(date) %>% mutate(cumulative = cumsum(volume))

# --- COMBINE ---
cumul_combined <- bind_rows(
  btfp_cumul_all, 
  dw_cumul_all, 
  btfp_cumul_filtered, 
  dw_cumul_filtered
) %>%
  mutate(sample = factor(sample, levels = c("All Banks", "Excl. Failed/GSIB")))

# --- PLOT ---
p2_b <- ggplot(cumul_combined, aes(x = date, y = cumulative, color = facility, linetype = sample)) +
  geom_line(linewidth = 1.2) +
  geom_vline(xintercept = c(SVB_FAIL, FRC_FAIL, ARB_OPEN),
             linetype = "dashed", color = "gray50", linewidth = 0.5) +
  annotate("text", x = SVB_FAIL, y = Inf, label = "SVB Fail", vjust = 2, hjust = -0.1, size = 3, color = "gray40") +
  annotate("text", x = FRC_FAIL, y = Inf, label = "FRC Fail", vjust = 2, hjust = -0.1, size = 3, color = "gray40") +
  annotate("text", x = ARB_OPEN, y = Inf, label = "Arb Open", vjust = 2, hjust = -0.1, size = 3, color = "gray40") +
  scale_color_manual(values = c("BTFP" = "#2b8cbe", "DW" = "#e34a33"), name = "Facility") +
  scale_linetype_manual(values = c("All Banks" = "solid", "Excl. Failed/GSIB" = "dashed"), name = "Sample") +
  scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y") +
  scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
  labs(
    title = "Figure 2: Cumulative Emergency Lending",
    subtitle = "Solid = All Banks | Dashed = Excluding Failed & GSIB Banks",
    x = NULL,
    y = "Cumulative ($B)"
  ) +
  theme_pub() +
  theme(
    legend.position = "bottom",
    legend.box = "horizontal"
  ) +
  guides(
    color = guide_legend(order = 1),
    linetype = guide_legend(order = 2)
  )

print(p2_b)

Figure 3: Interest Rate Evolution

# FIGURE 3: INTEREST RATES

btfp_weekly <- btfp_loans %>%
  mutate(week = floor_date(btfp_loan_date, "week")) %>%
  group_by(week) %>%
  summarise(
    rate = weighted.mean(btfp_interest_rate, btfp_loan_amount, na.rm = TRUE),
    n = n(),
    .groups = "drop"
  ) %>%
  mutate(facility = "BTFP")

dw_weekly <- dw_loans %>%
  mutate(week = floor_date(dw_loan_date, "week")) %>%
  group_by(week) %>%
  summarise(
    rate = weighted.mean(dw_interest_rate, dw_loan_amount, na.rm = TRUE),
    n = n(),
    .groups = "drop"
  ) %>%
  mutate(facility = "DW")

weekly_rates <- bind_rows(btfp_weekly, dw_weekly)

p3 <- ggplot(weekly_rates, aes(x = week, y = rate, color = facility)) +
  geom_line(linewidth = 1) +
  geom_point(aes(size = n), alpha = 0.5) +
  annotate("rect", xmin = ARB_OPEN, xmax = ARB_CLOSE,
           ymin = -Inf, ymax = Inf, fill = "blue", alpha = 0.1) +
  scale_color_manual(values = facility_colors, name = "Facility") +
  scale_size_continuous(name = "N Loans", range = c(1, 4)) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y") +
  scale_y_continuous(labels = scales::percent_format(scale = 1)) +
  labs(
    title = "Figure 3: Weekly Average Interest Rates",
    subtitle = "Blue shading = Arbitrage window (BTFP rate < IORB)",
    x = NULL,
    y = "Interest Rate (%)"
  ) +
  theme_pub()

print(p3)

Figure 4: Term Distribution

# FIGURE 4: TERM DISTRIBUTION

all_loans <- bind_rows(
  btfp_loans %>%
    filter(period %in% c("Acute", "Post-Acute", "Arbitrage")) %>%
    transmute(period, facility = "BTFP", term = btfp_term),
  dw_loans %>%
    filter(period %in% c("Acute", "Post-Acute", "Arbitrage")) %>%
    transmute(period, facility = "DW", term = dw_term)
)

p4 <- ggplot(all_loans, aes(x = term, fill = facility)) +
  geom_histogram(alpha = 0.6, position = "identity", bins = 40) +
  facet_wrap(~period, ncol = 3, scales = "free_y") +
  scale_fill_manual(values = facility_colors, name = "Facility") +
  scale_x_continuous(limits = c(0, 400)) +
  labs(
    title = "Figure 4: Loan Term Distribution",
    subtitle = "BTFP offers 1-year terms (365 days); DW terms typically shorter",
    x = "Term (Days)",
    y = "Count"
  ) +
  theme_pub()

print(p4)

Figure 5: DW Collateral Composition

# FIGURE 5: DW COLLATERAL COMPOSITION OVER TIME

dw_monthly_collat <- dw_loans %>%
  mutate(month = floor_date(dw_loan_date, "month")) %>%
  group_by(month) %>%
  summarise(
    `BTFP-eligible`    = sum(dw_omo_eligible, na.rm = TRUE) / 1e9,
    `DW eligible only` = sum(dw_non_omo_eligible, na.rm = TRUE) / 1e9,
    .groups = "drop"
  ) %>%
  pivot_longer(
    cols = c(`BTFP-eligible`, `DW eligible only`),
    names_to = "type",
    values_to = "value"
  )

p5_levels <- ggplot(dw_monthly_collat, aes(month, value, color = type)) +
  geom_line(linewidth = 1) +
  geom_vline(xintercept = c(CRISIS_START, FRC_FAIL, ARB_OPEN),
             linetype = "dashed", color = "gray40", linewidth = 0.4) +
  scale_color_manual(values = c(`BTFP-eligible` = "#4575b4",
                                `DW eligible only` = "#d73027")) +
  scale_x_date(date_breaks = "2 months", date_labels = "%b\n%Y") +
  scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
  labs(
    title = "Figure 5: DW Collateral Amounts Over Time",
    subtitle = "BTFP-eligible vs. DW-only eligible collateral posted at the Discount Window",
    x = NULL,
    y = "Collateral ($B)",
    color = "Collateral Type"
  ) +
  theme_classic(base_size = 11) +
  theme(legend.position = "bottom")

print(p5_levels)

## Figure 5: DW Collateral Composition With and Without Failed/GSIB Banks

# FIGURE 5: DW COLLATERAL COMPOSITION OVER TIME (With and Without Failed/GSIB Banks)

# --- Get excluded banks list (if not already defined) ---
excluded_banks <- call_q %>%
  filter(quarter == "2022Q4") %>%
  filter(failed_bank == 1 | gsib == 1) %>%
  pull(idrssd) %>%
  as.character()

# --- ALL BANKS ---
dw_monthly_collat_all <- dw_loans %>%
  mutate(month = floor_date(dw_loan_date, "month")) %>%
  group_by(month) %>%
  summarise(
    BTFP_eligible    = sum(dw_omo_eligible, na.rm = TRUE) / 1e9,
    DW_eligible_only = sum(dw_non_omo_eligible, na.rm = TRUE) / 1e9,
    .groups = "drop"
  ) %>%
  pivot_longer(
    cols = c(BTFP_eligible, DW_eligible_only),
    names_to = "type",
    values_to = "value"
  ) %>%
  mutate(sample = "All Banks")

# --- EXCLUDING FAILED & GSIB ---
dw_monthly_collat_filtered <- dw_loans %>%
  filter(!rssd_id %in% excluded_banks) %>%
  mutate(month = floor_date(dw_loan_date, "month")) %>%
  group_by(month) %>%
  summarise(
    BTFP_eligible    = sum(dw_omo_eligible, na.rm = TRUE) / 1e9,
    DW_eligible_only = sum(dw_non_omo_eligible, na.rm = TRUE) / 1e9,
    .groups = "drop"
  ) %>%
  pivot_longer(
    cols = c(BTFP_eligible, DW_eligible_only),
    names_to = "type",
    values_to = "value"
  ) %>%
  mutate(sample = "Excl. Failed/GSIB")

# --- COMBINE ---
dw_monthly_collat_combined <- bind_rows(dw_monthly_collat_all, dw_monthly_collat_filtered) %>%
  mutate(
    type = recode(type, 
                  "BTFP_eligible" = "BTFP-eligible", 
                  "DW_eligible_only" = "DW eligible only"),
    sample = factor(sample, levels = c("All Banks", "Excl. Failed/GSIB"))
  )

# --- PLOT ---
p5_levels_b <- ggplot(dw_monthly_collat_combined, aes(x = month, y = value, color = type, linetype = sample)) +
  geom_line(linewidth = 1) +
  geom_vline(xintercept = c(CRISIS_START, FRC_FAIL, ARB_OPEN),
             linetype = "dashed", color = "gray40", linewidth = 0.4) +
  annotate("text", x = CRISIS_START, y = Inf, label = "Crisis Start", vjust = 2, hjust = -0.1, size = 3, color = "gray40") +
  annotate("text", x = FRC_FAIL, y = Inf, label = "FRC Fail", vjust = 2, hjust = -0.1, size = 3, color = "gray40") +
  annotate("text", x = ARB_OPEN, y = Inf, label = "Arb Open", vjust = 2, hjust = -0.1, size = 3, color = "gray40") +
  scale_color_manual(values = c("BTFP-eligible" = "#4575b4", "DW eligible only" = "#d73027"), name = "Collateral Type") +
  scale_linetype_manual(values = c("All Banks" = "solid", "Excl. Failed/GSIB" = "dashed"), name = "Sample") +
  scale_x_date(date_breaks = "2 months", date_labels = "%b\n%Y") +
  scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
  labs(
    title = "Figure 5: DW Collateral Amounts Over Time",
    subtitle = "Solid = All Banks | Dashed = Excluding Failed & GSIB Banks",
    x = NULL,
    y = "Collateral ($B)"
  ) +
  theme_classic(base_size = 11) +
  theme(
    legend.position = "bottom",
    legend.box = "horizontal"
  ) +
  guides(
    color = guide_legend(order = 1),
    linetype = guide_legend(order = 2)
  )

print(p5_levels_b)

# FIGURE 6: EFFECTIVE MATURITY VS CONTRACTUAL TERM

btfp_mat <- btfp_loans %>%
  filter(period %in% c("Acute", "Post-Acute", "Arbitrage")) %>%
  transmute(
    period,
    facility = "BTFP",
    term = btfp_term,
    eff_mat = btfp_effective_maturity_days
  )

dw_mat <- dw_loans %>%
  filter(period %in% c("Acute", "Post-Acute", "Arbitrage")) %>%
  transmute(
    period,
    facility = "DW",
    term = dw_term,
    eff_mat = dw_effective_maturity_days
  )

mat_data <- bind_rows(btfp_mat, dw_mat) %>%
  mutate(early_repay = term - eff_mat)

p6b <- ggplot(mat_data, aes(x = term, y = term - eff_mat, color = facility)) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
  geom_point(alpha = 0.3, size = 1) +
  facet_wrap(~period, ncol = 3) +
  scale_color_manual(values = facility_colors, name = "Facility") +
  labs(
    title = "Figure 6: Early Repayment by Contractual Term",
    subtitle = "0 = held to term; higher = repaid earlier",
    x = "Contractual Term (Days)",
    y = "Days Repaid Early"
  ) +
  theme_classic(base_size = 11)

print(p6b)

Bank-Level Analysis Dataset Construction

# AGGREGATE FULL PROGRAM FACILITY USAGE

btfp_full <- btfp_raw %>%
  filter(btfp_loan_date >= CRISIS_START, btfp_loan_date <= BTFP_CLOSE) %>%
  group_by(rssd_id) %>%
  summarise(
    btfp = 1L,
    btfp_amount = sum(btfp_loan_amount, na.rm = TRUE),
    btfp_first_date = min(btfp_loan_date),
    btfp_n_loans = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

dw_full <- dw_raw %>%
  filter(dw_loan_date >= CRISIS_START, dw_loan_date <= BTFP_CLOSE) %>%
  group_by(rssd_id) %>%
  summarise(
    dw = 1L,
    dw_amount = sum(dw_loan_amount, na.rm = TRUE),
    dw_first_date = min(dw_loan_date),
    dw_n_loans = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

dw_pre_btfp <- dw_raw %>%
  filter(dw_loan_date >= PRE_BTFP_START, dw_loan_date <= PRE_BTFP_END) %>%
  group_by(rssd_id) %>%
  summarise(
    dw_pre_btfp = 1L,
    dw_pre_btfp_amount = sum(dw_loan_amount, na.rm = TRUE),
    dw_pre_btfp_first = min(dw_loan_date),
    dw_pre_btfp_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

cat("Full program usage: BTFP =", nrow(btfp_full), "banks, DW (post-BTFP) =", nrow(dw_full), "banks\n")
#> Full program usage: BTFP = 1327 banks, DW (post-BTFP) = 1092 banks
cat("Pre-BTFP DW usage:", nrow(dw_pre_btfp), "banks\n")
#> Pre-BTFP DW usage: 292 banks
# CREATE 2022Q4 BASELINE

has_failed_bank <- "failed_bank" %in% names(call_q)
has_gsib <- "gsib" %in% names(call_q)
has_mv_asset <- "mm_asset" %in% names(call_q)

baseline <- call_q %>%
  filter(quarter == BASELINE_DATE) %>%
  transmute(
    idrssd = as.character(idrssd),
    failed_bank = if (has_failed_bank) failed_bank else 0L,
    gsib = if (has_gsib) gsib else 0L,
    size_bin = if ("size_bin" %in% names(call_q)) size_bin else NA_character_,
    total_asset, total_liability, total_equity, total_deposit, uninsured_deposit_to_total_asset,
    insured_deposit = pmax(insured_deposit, 1),
    uninsured_deposit = pmax(uninsured_deposit, 0),
    ln_assets = log(pmax(total_asset, 1)),
    assets = total_asset,
    cash, fed_fund_sold, rerepo,
    security, omo_eligible, non_omo_eligible, omo_eligible_to_total_asset, non_omo_eligible_to_total_asset,
    total_loan, roa,
    mv_asset = mm_asset,
    mtm_total_loss, mtm_loss_to_total_asset, equity_after_mtm,
    mtm_loss_omo_eligible, mtm_loss_omo_eligible_to_total_asset, mtm_loss_omo_eligible_to_omo_eligible,
    mtm_loss_non_omo_eligible, mtm_loss_non_omo_eligible_to_total_asset,
    repo, fed_fund_purchase, other_borr, other_borrowed_less_than_1yr,
    fhlb_adv, fhlb_to_total_asset,
    cash_to_total_asset, security_to_total_asset, book_equity_to_total_asset, loan_to_deposit
  ) %>%
  filter(
    gsib == 0 | is.na(gsib),
    failed_bank == 0 | is.na(failed_bank),
    !is.na(omo_eligible) & omo_eligible > 0
  )

cat("Baseline sample:", nrow(baseline), "banks\n")
#> Baseline sample: 4292 banks
# CONSTRUCT ALL VARIABLES

baseline <- baseline %>%
  mutate(
    mtm_btfp = mtm_loss_omo_eligible_to_total_asset,
    mtm_other = mtm_loss_non_omo_eligible_to_total_asset,
    uninsured_lev = uninsured_deposit_to_total_asset,
    eligible_collateral = omo_eligible_to_total_asset,
    borrowing_subsidy = mtm_loss_omo_eligible_to_omo_eligible,
    pct_uninsured = safe_div(uninsured_deposit, total_deposit) * 100,
    pct_wholesale_liability = safe_div(fed_fund_purchase + repo + other_borrowed_less_than_1yr, total_liability) * 100,
    pct_runable_liability = safe_div(uninsured_deposit + fed_fund_purchase + repo + other_borrowed_less_than_1yr, total_liability) * 100,
    pct_liquidity_available = safe_div(cash + rerepo + fed_fund_sold, total_asset) * 100,
    pct_mtm_loss = mtm_loss_to_total_asset * 100,
    cash_ratio = cash_to_total_asset,
    securities_ratio = security_to_total_asset,
    equity_ratio = safe_div(total_equity, total_asset) * 100,
    book_equity_ratio = book_equity_to_total_asset,
    fhlb_ratio = fhlb_to_total_asset,
    loan_to_deposit = loan_to_deposit,
    run_risk_1 = pct_uninsured * pct_mtm_loss,
    run_risk_2 = pct_runable_liability * pct_mtm_loss
  )

baseline <- baseline %>%
  mutate(
    median_pct_uninsured = median(pct_uninsured, na.rm = TRUE),
    median_pct_mtm_loss = median(pct_mtm_loss, na.rm = TRUE),
    median_pct_runable = median(pct_runable_liability, na.rm = TRUE),
    run_risk_1_dummy = as.integer(pct_uninsured > median_pct_uninsured & pct_mtm_loss > median_pct_mtm_loss),
    run_risk_2_dummy = as.integer(pct_runable_liability > median_pct_runable & pct_mtm_loss > median_pct_mtm_loss)
  )

# JIANG INSOLVENCY MEASURES
baseline <- baseline %>%
  mutate(
    mv_adjustment = if_else(mv_asset == 0 | is.na(mv_asset), NA_real_, (total_asset / mv_asset) - 1),
    idcr_1 = safe_div(mv_asset - 0.5 * uninsured_deposit - insured_deposit, insured_deposit),
    idcr_2 = safe_div(mv_asset - 1.0 * uninsured_deposit - insured_deposit, insured_deposit),
    insolvency_1 = safe_div((total_asset - total_liability) - 0.5 * uninsured_deposit * mv_adjustment, total_asset),
    insolvency_2 = safe_div((total_asset - total_liability) - 1.0 * uninsured_deposit * mv_adjustment, total_asset),
    adjusted_equity = equity_ratio - mtm_loss_to_total_asset,
    mtm_insolvent = as.integer(adjusted_equity < 0) * 100,
    insolvent_idcr_s50 = as.integer(idcr_1 < 0),
    insolvent_idcr_s100 = as.integer(idcr_2 < 0),
    insolvent_cap_s50 = as.integer(insolvency_1 < 0),
    insolvent_cap_s100 = as.integer(insolvency_2 < 0)
  )

baseline <- baseline %>%
  mutate(
    mtm_btfp_x_uninsured = mtm_btfp * uninsured_lev,
    adj_equity_x_uninsured = adjusted_equity * uninsured_lev
  )

cat("All variables constructed\n")
#> All variables constructed
# AGGREGATE FACILITY USAGE BY PERIOD

btfp_acute <- btfp_raw %>%
  filter(btfp_loan_date >= CRISIS_START, btfp_loan_date <= PERIOD_1_END) %>%
  group_by(rssd_id) %>%
  summarise(
    btfp_acute = 1L,
    btfp_acute_amount = sum(btfp_loan_amount, na.rm = TRUE),
    btfp_acute_first = min(btfp_loan_date),
    btfp_acute_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

btfp_post <- btfp_raw %>%
  filter(btfp_loan_date > PERIOD_1_END, btfp_loan_date <= PERIOD_2_END) %>%
  group_by(rssd_id) %>%
  summarise(
    btfp_post = 1L,
    btfp_post_amount = sum(btfp_loan_amount, na.rm = TRUE),
    btfp_post_first = min(btfp_loan_date),
    btfp_post_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

btfp_arb <- btfp_raw %>%
  filter(btfp_loan_date > PERIOD_2_END, btfp_loan_date <= PERIOD_3_END) %>%
  group_by(rssd_id) %>%
  summarise(
    btfp_arb = 1L,
    btfp_arb_amount = sum(btfp_loan_amount, na.rm = TRUE),
    btfp_arb_first = min(btfp_loan_date),
    btfp_arb_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

dw_pre <- dw_raw %>%
  filter(dw_loan_date >= PRE_BTFP_START, dw_loan_date <= PRE_BTFP_END) %>%
  group_by(rssd_id) %>%
  summarise(
    dw_pre = 1L,
    dw_pre_amount = sum(dw_loan_amount, na.rm = TRUE),
    dw_pre_first = min(dw_loan_date, na.rm = TRUE),
    dw_pre_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

dw_acute <- dw_raw %>%
  filter(dw_loan_date >= CRISIS_START, dw_loan_date <= PERIOD_1_END) %>%
  group_by(rssd_id) %>%
  summarise(
    dw_acute = 1L,
    dw_acute_amount = sum(dw_loan_amount, na.rm = TRUE),
    dw_acute_first = min(dw_loan_date),
    dw_acute_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

dw_post <- dw_raw %>%
  filter(dw_loan_date > PERIOD_1_END, dw_loan_date <= PERIOD_2_END) %>%
  group_by(rssd_id) %>%
  summarise(
    dw_post = 1L,
    dw_post_amount = sum(dw_loan_amount, na.rm = TRUE),
    dw_post_first = min(dw_loan_date),
    dw_post_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

dw_arb <- dw_raw %>%
  filter(dw_loan_date > PERIOD_2_END, dw_loan_date <= PERIOD_3_END) %>%
  group_by(rssd_id) %>%
  summarise(
    dw_arb = 1L,
    dw_arb_amount = sum(dw_loan_amount, na.rm = TRUE),
    dw_arb_first = min(dw_loan_date),
    dw_arb_n = n(),
    .groups = "drop"
  ) %>%
  rename(idrssd = rssd_id)

cat("Period-specific facility usage aggregated\n\n")
#> Period-specific facility usage aggregated
cat("BTFP Usage by Period:\n")
#> BTFP Usage by Period:
cat("  Acute (Mar 13 - May 1):     ", nrow(btfp_acute), "banks\n")
#>   Acute (Mar 13 - May 1):      492 banks
cat("  Post-Acute (May 2 - Oct 31):", nrow(btfp_post), "banks\n")
#>   Post-Acute (May 2 - Oct 31): 816 banks
cat("  Arbitrage (Nov 1 - Jan 24): ", nrow(btfp_arb), "banks\n")
#>   Arbitrage (Nov 1 - Jan 24):  801 banks
cat("\nDW Usage by Period:\n")
#> 
#> DW Usage by Period:
cat("  Pre-BTFP (January 1 - March 12):     ", nrow(dw_pre), "banks\n")
#>   Pre-BTFP (January 1 - March 12):      292 banks
cat("  Acute (Mar 13 - May 1):     ", nrow(dw_acute), "banks\n")
#>   Acute (Mar 13 - May 1):      424 banks
cat("  Post-Acute (May 2 - Oct 31):", nrow(dw_post), "banks\n")
#>   Post-Acute (May 2 - Oct 31): 846 banks
cat("  Arbitrage (Nov 1 - Jan 24): ", nrow(dw_arb), "banks\n")
#>   Arbitrage (Nov 1 - Jan 24):  0 banks
# MERGE ALL BORROWING DATA

df <- baseline %>%
  left_join(btfp_full, by = "idrssd") %>%
  left_join(dw_full, by = "idrssd") %>%
  left_join(dw_pre_btfp, by = "idrssd") %>%
  left_join(btfp_acute, by = "idrssd") %>%
  left_join(btfp_post, by = "idrssd") %>%
  left_join(btfp_arb, by = "idrssd") %>%
  left_join(dw_pre, by = "idrssd") %>%
  left_join(dw_acute, by = "idrssd") %>%
  left_join(dw_post, by = "idrssd") %>%
  left_join(dw_arb, by = "idrssd") %>%
  mutate(
    btfp = coalesce(btfp, 0L),
    dw = coalesce(dw, 0L),
    btfp_amount = coalesce(btfp_amount, 0),
    dw_amount = coalesce(dw_amount, 0),
    dw_pre_btfp = coalesce(dw_pre_btfp, 0L),
    dw_pre_btfp_amount = coalesce(dw_pre_btfp_amount, 0),
    btfp_acute = coalesce(btfp_acute, 0L),
    btfp_post = coalesce(btfp_post, 0L),
    btfp_arb = coalesce(btfp_arb, 0L),
    btfp_acute_amount = coalesce(btfp_acute_amount, 0),
    btfp_post_amount = coalesce(btfp_post_amount, 0),
    btfp_arb_amount = coalesce(btfp_arb_amount, 0),
    dw_acute = coalesce(dw_acute, 0L),
    dw_post = coalesce(dw_post, 0L),
    dw_arb = coalesce(dw_arb, 0L),
    dw_acute_amount = coalesce(dw_acute_amount, 0),
    dw_post_amount = coalesce(dw_post_amount, 0),
    dw_arb_amount = coalesce(dw_arb_amount, 0),
    both = as.integer(btfp == 1 & dw == 1),
    btfp_only = as.integer(btfp == 1 & dw == 0),
    dw_only = as.integer(btfp == 0 & dw == 1),
    any_fed = as.integer(btfp == 1 | dw == 1),
    dw_pre_only = as.integer(dw_pre_btfp == 1),
    any_fed_pre = as.integer(dw_pre_btfp == 1),
    both_acute = as.integer(btfp_acute == 1 & dw_acute == 1),
    btfp_only_acute = as.integer(btfp_acute == 1 & dw_acute == 0),
    dw_only_acute = as.integer(btfp_acute == 0 & dw_acute == 1),
    any_fed_acute = as.integer(btfp_acute == 1 | dw_acute == 1),
    both_post = as.integer(btfp_post == 1 & dw_post == 1),
    btfp_only_post = as.integer(btfp_post == 1 & dw_post == 0),
    dw_only_post = as.integer(btfp_post == 0 & dw_post == 1),
    any_fed_post = as.integer(btfp_post == 1 | dw_post == 1),
    both_arb = as.integer(btfp_arb == 1 & dw_arb == 1),
    btfp_only_arb = as.integer(btfp_arb == 1 & dw_arb == 0),
    dw_only_arb = as.integer(btfp_arb == 0 & dw_arb == 1),
    any_fed_arb = as.integer(btfp_arb == 1 | dw_arb == 1),
    d_assets = assets * 1000,
    btfp_amount_pct = safe_div(btfp_amount, d_assets) * 100,
    dw_amount_pct = safe_div(dw_amount, d_assets) * 100,
    total_borrowed = btfp_amount + dw_amount,
    total_borrowed_pct = safe_div(total_borrowed, d_assets) * 100,
    btfp_acute_amount_pct = safe_div(btfp_acute_amount, d_assets) * 100,
    btfp_post_amount_pct = safe_div(btfp_post_amount, d_assets) * 100,
    btfp_arb_amount_pct = safe_div(btfp_arb_amount, d_assets) * 100,
    dw_acute_amount_pct = safe_div(dw_acute_amount, d_assets) * 100,
    dw_post_amount_pct = safe_div(dw_post_amount, d_assets) * 100,
    dw_arb_amount_pct = safe_div(dw_arb_amount, d_assets) * 100,
    dw_pre_btfp_amount_pct = safe_div(dw_pre_btfp_amount, d_assets) * 100,
    btfp_share = ifelse(both == 1, safe_div(btfp_amount, total_borrowed) * 100, NA_real_),
    btfp_share_acute = ifelse(both_acute == 1,
                              safe_div(btfp_acute_amount, btfp_acute_amount + dw_acute_amount) * 100,
                              NA_real_),
    btfp_share_post = ifelse(both_post == 1,
                             safe_div(btfp_post_amount, btfp_post_amount + dw_post_amount) * 100,
                             NA_real_),
    btfp_share_arb = ifelse(both_arb == 1,
                            safe_div(btfp_arb_amount, btfp_arb_amount + dw_arb_amount) * 100,
                            NA_real_),
    collateral_capacity = (eligible_collateral / 100) * d_assets,
    btfp_utilization = safe_div(btfp_amount, collateral_capacity),
    maxed_out_btfp = as.integer(btfp_utilization > 0.90),
    btfp_util_acute = safe_div(btfp_acute_amount, collateral_capacity),
    btfp_util_post = safe_div(btfp_post_amount, collateral_capacity),
    btfp_util_arb = safe_div(btfp_arb_amount, collateral_capacity),
    btfp_period = case_when(
      btfp == 0 ~ NA_character_,
      btfp_first_date <= PERIOD_1_END ~ "Acute",
      btfp_first_date <= PERIOD_2_END ~ "PostAcute",
      btfp_first_date <= PERIOD_3_END ~ "Arbitrage",
      TRUE ~ "Winddown"
    ),
    facility = factor(case_when(
      btfp == 0 & dw == 0 ~ "None",
      btfp == 1 & dw == 0 ~ "BTFP Only",
      btfp == 0 & dw == 1 ~ "DW Only",
      TRUE ~ "Both"
    ), levels = c("None", "BTFP Only", "DW Only", "Both")),
    facility_pre = factor(case_when(
      dw_pre_btfp == 1 ~ "DW Only",
      TRUE ~ "None"
    ), levels = c("None", "DW Only")),
    facility_acute = factor(case_when(
      btfp_acute == 0 & dw_acute == 0 ~ "None",
      btfp_acute == 1 & dw_acute == 0 ~ "BTFP Only",
      btfp_acute == 0 & dw_acute == 1 ~ "DW Only",
      TRUE ~ "Both"
    ), levels = c("None", "BTFP Only", "DW Only", "Both")),
    facility_post = factor(case_when(
      btfp_post == 0 & dw_post == 0 ~ "None",
      btfp_post == 1 & dw_post == 0 ~ "BTFP Only",
      btfp_post == 0 & dw_post == 1 ~ "DW Only",
      TRUE ~ "Both"
    ), levels = c("None", "BTFP Only", "DW Only", "Both")),
    facility_arb = factor(case_when(
      btfp_arb == 0 & dw_arb == 0 ~ "None",
      btfp_arb == 1 & dw_arb == 0 ~ "BTFP Only",
      btfp_arb == 0 & dw_arb == 1 ~ "DW Only",
      TRUE ~ "Both"
    ), levels = c("None", "BTFP Only", "DW Only", "Both"))
  )

cat("\n")
cat(strrep("=", 70), "\n")
#> ======================================================================
cat("FACILITY USAGE SUMMARY BY PERIOD\n")
#> FACILITY USAGE SUMMARY BY PERIOD
cat(strrep("=", 70), "\n")
#> ======================================================================
cat("\n--- PRE-BTFP (Jan 1 - Mar 12, 2023) DW ONLY ---\n")
#> 
#> --- PRE-BTFP (Jan 1 - Mar 12, 2023) DW ONLY ---
cat("  DW only:      ", sum(df$dw_pre_only), sprintf("(%.1f%%)", 100 * mean(df$dw_pre_only)), "\n")
#>   DW only:       266 (6.2%)
cat("  Any Fed:      ", sum(df$any_fed_pre), sprintf("(%.1f%%)", 100 * mean(df$any_fed_pre)), "\n")
#>   Any Fed:       266 (6.2%)
cat("\n--- FULL PROGRAM (Mar 13, 2023 - Mar 11, 2024) ---\n")
#> 
#> --- FULL PROGRAM (Mar 13, 2023 - Mar 11, 2024) ---
cat("  BTFP only:    ", sum(df$btfp_only), sprintf("(%.1f%%)", 100 * mean(df$btfp_only)), "\n")
#>   BTFP only:     846 (19.7%)
cat("  DW only:      ", sum(df$dw_only), sprintf("(%.1f%%)", 100 * mean(df$dw_only)), "\n")
#>   DW only:       591 (13.8%)
cat("  Both:         ", sum(df$both), sprintf("(%.1f%%)", 100 * mean(df$both)), "\n")
#>   Both:          413 (9.6%)
cat("  Any Fed:      ", sum(df$any_fed), sprintf("(%.1f%%)", 100 * mean(df$any_fed)), "\n")
#>   Any Fed:       1850 (43.1%)
cat(strrep("=", 70), "\n")
#> ======================================================================
# WINSORIZE

vars_to_winsorize <- c("mtm_btfp", "mtm_other", "uninsured_lev", "eligible_collateral",
                       "borrowing_subsidy", "pct_uninsured", "pct_mtm_loss",
                       "cash_ratio", "securities_ratio", "ln_assets", "roa",
                       "idcr_1", "idcr_2", "insolvency_1", "insolvency_2", "adjusted_equity")

df <- df %>%
  mutate(across(any_of(vars_to_winsorize), ~winsorize(.x, c(0.01, 0.99)))) %>%
  mutate(
    mtm_btfp_x_uninsured = mtm_btfp * uninsured_lev,
    adj_equity_x_uninsured = adjusted_equity * uninsured_lev
  )

cat("Variables winsorized\n")
#> Variables winsorized

Summary Statistics

Table: Summary by Facility Choice (Full Program)

desc_stats <- df %>%
  group_by(facility) %>%
  summarize(
    N = n(),
    `Assets ($B)` = mean(assets, na.rm = TRUE) / 1e6,
    `MTM BTFP (%)` = mean(mtm_btfp, na.rm = TRUE),
    `MTM Other (%)` = mean(mtm_other, na.rm = TRUE),
    `Uninsured (%)` = mean(uninsured_lev, na.rm = TRUE),
    `% Insolvent` = mean(mtm_insolvent, na.rm = TRUE),
    `Eligible (%)` = mean(eligible_collateral, na.rm = TRUE),
    .groups = "drop"
  )

desc_stats %>%
  kbl(
    caption = "Descriptive Statistics by Facility Choice (January 2023 - March 2024)",
    digits = 3
  ) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Descriptive Statistics by Facility Choice (January 2023 - March 2024)
facility N Assets ($B) MTM BTFP (%) MTM Other (%) Uninsured (%) % Insolvent Eligible (%)
None 2442 1.172 0.602 4.389 21.806 16.242 10.953
BTFP Only 846 2.529 0.809 4.977 24.382 29.669 11.143
DW Only 591 4.366 0.610 4.635 25.880 14.044 8.687
Both 413 8.841 0.849 4.941 28.517 23.245 10.717

Insolvency Summary

cat("\n=== INSOLVENCY MEASURES ===\n")
#> 
#> === INSOLVENCY MEASURES ===
cat("% MTM Insolvent:", sprintf("%.1f%%", mean(df$mtm_insolvent, na.rm = TRUE) * 100), "\n")
#> % MTM Insolvent: 1926.7%
cat("% IDCR (s=0.5) < 0:", sprintf("%.1f%%", mean(df$insolvent_idcr_s50, na.rm = TRUE) * 100), "\n")
#> % IDCR (s=0.5) < 0: 4.2%
cat("% IDCR (s=1.0) < 0:", sprintf("%.1f%%", mean(df$insolvent_idcr_s100, na.rm = TRUE) * 100), "\n")
#> % IDCR (s=1.0) < 0: 28.3%
cat("% Capital (s=0.5) < 0:", sprintf("%.1f%%", mean(df$insolvent_cap_s50, na.rm = TRUE) * 100), "\n")
#> % Capital (s=0.5) < 0: 2.2%
cat("% Capital (s=1.0) < 0:", sprintf("%.1f%%", mean(df$insolvent_cap_s100, na.rm = TRUE) * 100), "\n")
#> % Capital (s=1.0) < 0: 7.6%

Step 1: Extensive Margin Analysis

# STEP 1: EXTENSIVE MARGIN

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

lpm_btfp <- feols(as.formula(paste("btfp ~", rhs)),
                  data = df, vcov = "hetero")

lpm_dw <- feols(as.formula(paste("dw ~", rhs)),
                data = df, vcov = "hetero")

modelsummary(
  list("BTFP" = lpm_btfp, "DW" = lpm_dw),
  stars = c('*' = .1, '**' = .05, '***' = .01),
  coef_map = c(
    "mtm_btfp" = "MTM (BTFP)",
    "mtm_other" = "MTM (Other)",
    "uninsured_lev" = "Uninsured Leverage",
    "I(mtm_btfp * uninsured_lev)" = "MTM_btfp x Uninsured Leverage",
    "pct_wholesale_liability" = "% Wholesale Liabilities",
    "fhlb_ratio" = "FHLB Ratio",
    "cash_ratio" = "Cash Ratio",
    "ln_assets" = "Log(Assets)",
    "securities_ratio" = "Securities Ratio",
    "loan_to_deposit" = "Loan-to-Deposit Ratio",
    "book_equity_ratio" = "Book Equity Ratio",
    "roa" = "ROA",
    "(Intercept)" = "Constant"
  ),
  gof_map = c("nobs", "r.squared"),
  title = "Extensive Margin - BTFP vs DW"
)
Extensive Margin - BTFP vs DW
BTFP DW
* p < 0.1, ** p < 0.05, *** p < 0.01
MTM (BTFP) 0.063*** 0.009
(0.020) (0.017)
MTM (Other) 0.010*** 0.001
(0.004) (0.003)
Uninsured Leverage 0.003*** 0.001
(0.001) (0.001)
MTM_btfp x Uninsured Leverage -0.001 0.000
(0.001) (0.001)
% Wholesale Liabilities 0.003 0.002
(0.002) (0.002)
FHLB Ratio 0.007*** 0.002
(0.002) (0.002)
Cash Ratio -0.005*** -0.001
(0.001) (0.001)
Log(Assets) 0.055*** 0.093***
(0.006) (0.006)
Securities Ratio 0.003*** -0.001
(0.001) (0.001)
Loan-to-Deposit Ratio 0.000 -0.000
(0.000) (0.000)
Book Equity Ratio -0.002*** 0.000
(0.001) (0.001)
ROA -0.002 -0.001
(0.010) (0.009)
Constant -0.589*** -0.962***
(0.082) (0.081)
Num.Obs. 4282 4282
R2 0.100 0.120

Run Risk Specifications

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

rhs_cont <- paste(base_rhs, "run_risk_1", sep = " + ")
lpm_run_cont <- feols(as.formula(paste("btfp ~", rhs_cont)),
                      data = df, vcov = "hetero")

rhs_dummy <- paste(base_rhs, "run_risk_1_dummy", sep = " + ")
lpm_run <- feols(as.formula(paste("btfp ~", rhs_dummy)),
                 data = df, vcov = "hetero")

modelsummary(
  list("Run Risk (Cont)" = lpm_run_cont, "Run Risk (Dummy)" = lpm_run),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  gof_map = c("nobs", "r.squared"),
  title = "Run Risk Specifications"
)
Run Risk Specifications
Run Risk (Cont) Run Risk (Dummy)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) -0.544*** -0.564***
(0.082) (0.081)
mtm_btfp 0.071*** 0.069***
(0.021) (0.021)
mtm_other -0.014** 0.005
(0.006) (0.004)
uninsured_lev -0.002* 0.002**
(0.001) (0.001)
I(mtm_btfp * uninsured_lev) -0.002*** -0.001*
(0.001) (0.001)
ln_assets 0.057*** 0.055***
(0.006) (0.006)
cash_ratio -0.004*** -0.005***
(0.001) (0.001)
securities_ratio 0.003*** 0.003***
(0.001) (0.001)
loan_to_deposit 0.001*** 0.000
(0.000) (0.000)
book_equity_ratio -0.007*** -0.002***
(0.001) (0.001)
pct_wholesale_liability 0.001 0.003
(0.002) (0.002)
fhlb_ratio 0.004** 0.007***
(0.002) (0.002)
roa -0.013 -0.003
(0.011) (0.010)
run_risk_1 0.000***
(0.000)
run_risk_1_dummy 0.064***
(0.021)
Num.Obs. 4251 4279
R2 0.107 0.102

Insolvency Specifications

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

rhs_jiang <- paste(base_rhs, "adjusted_equity", sep = " + ")
lpm_jiang <- feols(as.formula(paste("btfp ~", rhs_jiang)),
                   data = df, vcov = "hetero")

rhs_idcr <- paste(base_rhs, "idcr_2", sep = " + ")
lpm_idcr <- feols(as.formula(paste("btfp ~", rhs_idcr)),
                  data = df, vcov = "hetero")

rhs_cap <- paste(base_rhs, "insolvency_2", sep = " + ")
lpm_cap <- feols(as.formula(paste("btfp ~", rhs_cap)),
                 data = df, vcov = "hetero")

modelsummary(
  list(
    "Adj. Equity" = lpm_jiang,
    "IDCR (s = 1.0)" = lpm_idcr,
    "Capital (s = 1.0)" = lpm_cap
  ),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  gof_map = c("nobs", "r.squared"),
  title = "Insolvency Specifications (Jiang Integration)"
)
Insolvency Specifications (Jiang Integration)
Adj. Equity IDCR (s = 1.0) Capital (s = 1.0)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) -0.593*** -0.588*** -0.575***
(0.090) (0.079) (0.079)
mtm_btfp 0.048** 0.063*** 0.061***
(0.020) (0.020) (0.020)
mtm_other -0.012*** 0.010*** 0.011***
(0.005) (0.004) (0.004)
uninsured_lev 0.003*** 0.003*** 0.002*
(0.001) (0.001) (0.001)
I(mtm_btfp * uninsured_lev) -0.001 -0.001 -0.001
(0.001) (0.001) (0.001)
ln_assets 0.057*** 0.055*** 0.053***
(0.006) (0.006) (0.006)
cash_ratio -0.004*** -0.005*** -0.004***
(0.001) (0.001) (0.001)
securities_ratio 0.003*** 0.003*** 0.003***
(0.001) (0.001) (0.001)
loan_to_deposit 0.001 0.000 0.000
(0.001) (0.000) (0.000)
book_equity_ratio 0.013*** -0.004*** 0.002*
(0.002) (0.001) (0.001)
pct_wholesale_liability 0.003 0.003 0.003
(0.002) (0.002) (0.002)
fhlb_ratio 0.006*** 0.007*** 0.006***
(0.002) (0.002) (0.002)
roa -0.010 -0.007 0.001
(0.010) (0.010) (0.010)
adjusted_equity -0.023***
(0.003)
idcr_2 0.006*
(0.003)
insolvency_2 -0.650***
(0.164)
Num.Obs. 4282 4282 4282
R2 0.108 0.101 0.103

Step 2: Temporal Analysis

BTFP by Period

# STEP 2: TEMPORAL ANALYSIS - BTFP BY PERIOD

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

lpm_btfp_acute <- feols(as.formula(paste("btfp_acute ~", base_rhs)),
                        data = df, vcov = "hetero")

lpm_btfp_post <- feols(as.formula(paste("btfp_post ~", base_rhs)),
                       data = df, vcov = "hetero")

lpm_btfp_arb <- feols(as.formula(paste("btfp_arb ~", base_rhs)),
                      data = df, vcov = "hetero")

modelsummary(
  list(
    "BTFP Acute" = lpm_btfp_acute,
    "BTFP Post-Acute" = lpm_btfp_post,
    "BTFP Arbitrage" = lpm_btfp_arb
  ),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  coef_map = c(
    "mtm_btfp" = "MTM (BTFP)",
    "mtm_other" = "MTM (Other)",
    "uninsured_lev" = "Uninsured Leverage",
    "I(mtm_btfp * uninsured_lev)" = "MTM_btfp x Uninsured",
    "ln_assets" = "Log(Assets)",
    "cash_ratio" = "Cash Ratio",
    "securities_ratio" = "Securities Ratio",
    "loan_to_deposit" = "Loan/Deposit",
    "book_equity_ratio" = "Book Equity Ratio",
    "pct_wholesale_liability" = "% Wholesale Liab.",
    "fhlb_ratio" = "FHLB Ratio",
    "roa" = "ROA"
  ),
  gof_map = list(
    list("raw" = "nobs", "clean" = "N", "fmt" = 0),
    list("raw" = "r.squared", "clean" = "R2", "fmt" = 3)
  ),
  title = "BTFP Usage by Period"
)
BTFP Usage by Period
BTFP Acute BTFP Post-Acute BTFP Arbitrage
* p < 0.1, ** p < 0.05, *** p < 0.01
MTM (BTFP) -0.002 0.028 0.037**
(0.013) (0.017) (0.017)
MTM (Other) 0.002 0.002 0.008***
(0.002) (0.003) (0.003)
Uninsured Leverage 0.001* 0.001 0.002**
(0.001) (0.001) (0.001)
MTM_btfp x Uninsured 0.001 0.000 -0.000
(0.001) (0.001) (0.001)
Log(Assets) 0.032*** 0.023*** 0.037***
(0.005) (0.005) (0.005)
Cash Ratio -0.002*** -0.004*** -0.004***
(0.001) (0.001) (0.001)
Securities Ratio 0.001** 0.003*** 0.002***
(0.001) (0.001) (0.001)
Loan/Deposit -0.000 0.000 0.000
(0.000) (0.000) (0.000)
Book Equity Ratio -0.001* -0.002*** -0.000
(0.000) (0.001) (0.001)
% Wholesale Liab. 0.005** 0.002 0.001
(0.002) (0.002) (0.002)
FHLB Ratio 0.007*** 0.003* 0.007***
(0.001) (0.002) (0.002)
ROA 0.006 -0.003 -0.007
(0.007) (0.008) (0.008)
N 4282 4282 4282
R2 0.068 0.052 0.072

DW by Period

# STEP 2: TEMPORAL ANALYSIS - DW BY PERIOD

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

lpm_dw_pre <- feols(as.formula(paste("dw_pre_btfp ~", base_rhs)),
                    data = df, vcov = "hetero")

lpm_dw_acute <- feols(as.formula(paste("dw_acute ~", base_rhs)),
                      data = df, vcov = "hetero")

lpm_dw_post <- feols(as.formula(paste("dw_post ~", base_rhs)),
                     data = df, vcov = "hetero")

modelsummary(
  list(
    "DW Pre-BTFP" = lpm_dw_pre,
    "DW Acute" = lpm_dw_acute,
    "DW Post-Acute" = lpm_dw_post
  ),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  coef_map = c(
    "mtm_btfp" = "MTM (BTFP Eligible)",
    "mtm_other" = "MTM (Other)",
    "uninsured_lev" = "Uninsured Leverage",
    "I(mtm_btfp * uninsured_lev)" = "MTM x Uninsured",
    "ln_assets" = "Log(Assets)",
    "cash_ratio" = "Cash Ratio",
    "securities_ratio" = "Securities Ratio",
    "loan_to_deposit" = "Loan/Deposit",
    "book_equity_ratio" = "Book Equity Ratio",
    "pct_wholesale_liability" = "% Wholesale Liab.",
    "fhlb_ratio" = "FHLB Ratio",
    "roa" = "ROA"
  ),
  gof_map = list(
    list("raw" = "nobs", "clean" = "N", "fmt" = 0),
    list("raw" = "r.squared", "clean" = "R2", "fmt" = 3)
  ),
  title = "DW Usage by Period"
)
DW Usage by Period
DW Pre-BTFP DW Acute DW Post-Acute
* p < 0.1, ** p < 0.05, *** p < 0.01
MTM (BTFP Eligible) -0.001 -0.005 0.008
(0.011) (0.012) (0.016)
MTM (Other) -0.001 0.004* -0.002
(0.002) (0.002) (0.003)
Uninsured Leverage -0.000 0.000 0.001
(0.000) (0.001) (0.001)
MTM x Uninsured 0.001 0.001 0.000
(0.000) (0.001) (0.001)
Log(Assets) 0.035*** 0.045*** 0.064***
(0.004) (0.005) (0.006)
Cash Ratio -0.001*** -0.000 -0.002**
(0.000) (0.001) (0.001)
Securities Ratio 0.001* 0.000 -0.001
(0.000) (0.000) (0.001)
Loan/Deposit -0.000 -0.000 0.000
(0.000) (0.000) (0.000)
Book Equity Ratio 0.000 0.000 0.000
(0.000) (0.000) (0.000)
% Wholesale Liab. 0.004** 0.005** 0.001
(0.002) (0.002) (0.002)
FHLB Ratio 0.001 0.002 0.001
(0.001) (0.001) (0.002)
ROA 0.002 0.003 0.001
(0.005) (0.006) (0.009)
N 4282 4282 4282
R2 0.059 0.066 0.079

Borrower Comparison

df %>%
  filter(btfp == 1) %>%
  group_by(btfp_period) %>%
  summarize(
    N = n(),
    `MTM BTFP (%)` = mean(mtm_btfp, na.rm = TRUE),
    `Uninsured (%)` = mean(uninsured_lev, na.rm = TRUE),
    `% Insolvent` = mean(mtm_insolvent, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  kbl(caption = "Borrower Characteristics by Period", digits = 3) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Borrower Characteristics by Period
btfp_period N MTM BTFP (%) Uninsured (%) % Insolvent
Acute 462 0.861 27.378 28.571
Arbitrage 242 0.732 25.075 28.099
PostAcute 522 0.837 24.647 26.628
Winddown 33 0.720 24.918 24.242

Step 3: Intensive Margin

# STEP 3: INTENSIVE MARGIN

btfp_users <- df %>% filter(btfp == 1)

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "uninsured_lev + eligible_collateral + borrowing_subsidy + adjusted_equity",
  controls,
  sep = " + "
)

intensive_pct <- feols(as.formula(paste("btfp_amount_pct ~", base_rhs)),
                       data = btfp_users, vcov = "hetero")

rhs_run <- paste(base_rhs, "run_risk_1_dummy", sep = " + ")
intensive_run <- feols(as.formula(paste("btfp_amount_pct ~", rhs_run)),
                       data = btfp_users, vcov = "hetero")

modelsummary(
  list("Main" = intensive_pct, "Run Risk Dummy" = intensive_run),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  gof_map = c("nobs", "r.squared"),
  title = "Intensive Margin"
)
Intensive Margin
Main Run Risk Dummy
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) 43.272*** 43.342***
(15.185) (15.144)
uninsured_lev 0.130* 0.126
(0.075) (0.084)
eligible_collateral 0.143* 0.143*
(0.085) (0.085)
borrowing_subsidy -0.118 -0.119
(0.121) (0.121)
adjusted_equity 0.229 0.245
(0.363) (0.402)
ln_assets -0.157 -0.156
(0.557) (0.559)
cash_ratio -0.666*** -0.665***
(0.182) (0.182)
securities_ratio -0.241 -0.241
(0.185) (0.185)
loan_to_deposit -0.466*** -0.465***
(0.170) (0.170)
book_equity_ratio 0.546 0.531
(0.497) (0.527)
pct_wholesale_liability 0.668*** 0.667***
(0.253) (0.254)
fhlb_ratio 1.182*** 1.181***
(0.293) (0.294)
roa 1.699 1.688
(1.661) (1.647)
run_risk_1_dummy 0.151
(1.412)
Num.Obs. 1259 1259
R2 0.082 0.082

Step 4: Both Banks Analysis

# STEP 4: BOTH BANKS

btfp_users <- df %>% filter(btfp == 1)

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

rhs_other <- paste(base_rhs, "adjusted_equity", sep = " + ")
both_other <- feols(as.formula(paste("dw ~", rhs_other)),
                    data = btfp_users, vcov = "hetero")

rhs_maxout <- paste(base_rhs, "maxed_out_btfp", sep = " + ")
both_maxout <- feols(as.formula(paste("dw ~", rhs_maxout)),
                     data = btfp_users, vcov = "hetero")

modelsummary(
  list("DW | BTFP (Adj. Equity)" = both_other, "DW | BTFP (MaxOut)" = both_maxout),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  gof_map = c("nobs", "r.squared"),
  title = "Both Banks Analysis"
)
Both Banks Analysis
DW | BTFP (Adj. Equity) DW | BTFP (MaxOut)
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) -0.974*** -0.941***
(0.342) (0.341)
mtm_btfp 0.024 0.025
(0.041) (0.040)
mtm_other -0.013 -0.005
(0.017) (0.008)
uninsured_lev 0.004** 0.004**
(0.002) (0.002)
I(mtm_btfp * uninsured_lev) -0.001 -0.001
(0.001) (0.001)
ln_assets 0.091*** 0.090***
(0.012) (0.012)
cash_ratio -0.000 -0.001
(0.004) (0.004)
securities_ratio -0.001 -0.001
(0.004) (0.004)
loan_to_deposit 0.000 0.000
(0.003) (0.003)
book_equity_ratio 0.007 -0.002
(0.017) (0.005)
pct_wholesale_liability 0.009 0.009
(0.006) (0.006)
fhlb_ratio 0.003 0.003
(0.005) (0.005)
roa -0.012 -0.014
(0.028) (0.028)
adjusted_equity -0.008
(0.017)
maxed_out_btfp -0.024
(0.027)
Num.Obs. 1259 1259
R2 0.105 0.105

Robustness Tests

By Bank Size

controls <- "ln_assets + cash_ratio + securities_ratio + loan_to_deposit + book_equity_ratio + pct_wholesale_liability + fhlb_ratio + roa"

base_rhs <- paste(
  "mtm_btfp + mtm_other + uninsured_lev + I(mtm_btfp * uninsured_lev)",
  controls,
  sep = " + "
)

lpm_large <- feols(as.formula(paste("btfp ~", base_rhs)),
                   data = df %>% filter(size_bin == "large"),
                   vcov = "hetero")

lpm_small <- feols(as.formula(paste("btfp ~", base_rhs)),
                   data = df %>% filter(size_bin == "small"),
                   vcov = "hetero")

modelsummary(
  list("Large" = lpm_large, "Small" = lpm_small),
  stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
  gof_map = list(
    list("raw" = "nobs", "clean" = "N", "fmt" = 0),
    list("raw" = "r.squared", "clean" = "R2", "fmt" = 3)
  ),
  title = "By Bank Size"
)
By Bank Size
Large Small
* p < 0.1, ** p < 0.05, *** p < 0.01
(Intercept) -0.182 -0.944***
(0.447) (0.107)
mtm_btfp -0.018 0.080***
(0.057) (0.021)
mtm_other 0.023** 0.004
(0.010) (0.004)
uninsured_lev 0.003 0.002**
(0.002) (0.001)
I(mtm_btfp * uninsured_lev) 0.002 -0.002**
(0.002) (0.001)
ln_assets -0.001 0.089***
(0.020) (0.009)
cash_ratio -0.005 -0.004***
(0.004) (0.001)
securities_ratio 0.008** 0.003***
(0.004) (0.001)
loan_to_deposit 0.002 -0.000
(0.003) (0.000)
book_equity_ratio 0.000 -0.002**
(0.003) (0.001)
pct_wholesale_liability -0.008 0.004*
(0.007) (0.002)
fhlb_ratio 0.013** 0.005***
(0.005) (0.002)
roa 0.022 -0.006
(0.035) (0.010)
N 716 3566
R2 0.086 0.093

Visualization

# MTM by Facility
ggplot(df, aes(x = facility, y = mtm_btfp * 100, fill = facility)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_brewer(palette = "Set2") +
  labs(title = "MTM Losses by Facility Choice", y = "MTM Loss (%)") +
  theme_minimal() +
  theme(legend.position = "none")

# Insolvency Distribution
ggplot(df, aes(x = adjusted_equity * 100, fill = factor(btfp))) +
  geom_histogram(alpha = 0.6, position = "identity", bins = 50) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "red") +
  scale_fill_manual(values = c("gray60", "steelblue"), labels = c("Non-Borrower", "BTFP")) +
  labs(title = "Adjusted Equity Distribution", x = "Adjusted Equity (%)", fill = "") +
  theme_minimal()

# Create bins for MTM losses for visualization
df_plot <- df %>%
  mutate(mtm_bin = cut(mtm_btfp, breaks = quantile(mtm_btfp, probs = seq(0, 1, 0.1), na.rm = TRUE), include.lowest = TRUE)) %>%
  group_by(mtm_bin) %>%
  summarise(
    prob_btfp = mean(btfp, na.rm = TRUE),
    prob_dw = mean(dw, na.rm = TRUE),
    avg_mtm = mean(mtm_btfp * 100, na.rm = TRUE),
    .groups = "drop"
  )

ggplot(df_plot) +
  geom_line(aes(x = avg_mtm, y = prob_btfp, color = "BTFP Probability"), linewidth = 1.2) +
  geom_line(aes(x = avg_mtm, y = prob_dw, color = "DW Probability"), linewidth = 1.2, linetype = "dashed") +
  geom_point(aes(x = avg_mtm, y = prob_btfp, color = "BTFP Probability")) +
  geom_point(aes(x = avg_mtm, y = prob_dw, color = "DW Probability")) +
  scale_color_manual(values = c("BTFP Probability" = "steelblue", "DW Probability" = "darkorange")) +
  labs(
    title = "Facility Selection by MTM Loss Magnitude",
    subtitle = "Probability of borrowing increases with subsidy value (MTM loss)",
    x = "MTM Loss on BTFP-Eligible Securities (%)",
    y = "Probability of Borrowing",
    color = "Facility"
  ) +
  theme_minimal()

# Collateral Max-Out Scatter (Intensive Margin)
df %>%
  filter(any_fed == 1) %>%
  ggplot(aes(x = eligible_collateral, y = btfp_amount_pct)) +
  geom_point(aes(color = factor(dw)), alpha = 0.6) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red") +
  annotate("text", x = 15, y = 18, label = "Maxed Out BTFP Collateral", color = "red", angle = 35) +
  scale_color_manual(values = c("0" = "gray", "1" = "darkred"), labels = c("BTFP Only", "Used Both")) +
  labs(
    title = "BTFP Borrowing vs. Available Collateral",
    subtitle = "Banks using both facilities (red) often cluster near the collateral limit",
    x = "BTFP-Eligible Collateral (% of Assets)",
    y = "Actual BTFP Borrowing (% of Assets)",
    color = "Facility Choice"
  ) +
  theme_minimal()

# Temporal Distribution of First-Time Borrowers
df %>%
  filter(!is.na(btfp_period)) %>%
  group_by(btfp_period) %>%
  summarise(
    `Avg MTM Loss` = mean(mtm_btfp, na.rm = TRUE),
    `Avg Uninsured` = mean(uninsured_lev, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  pivot_longer(cols = -btfp_period) %>%
  ggplot(aes(x = factor(btfp_period, levels = c("Acute", "PostAcute", "Arbitrage")), y = value, fill = name)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_fill_brewer(palette = "Paired") +
  labs(
    title = "Characteristics of New BTFP Borrowers Over Time",
    subtitle = "Acute phase borrowers had higher vulnerability (MTM & Uninsured)",
    x = "Period of First Borrowing",
    y = "Mean Percentage (%)",
    fill = "Metric"
  ) +
  theme_minimal()

# Coefficient Plot
modelplot(
  list("BTFP (Selection)" = lpm_btfp, "DW (Liquidity)" = lpm_dw),
  coef_map = c(
    "mtm_btfp" = "MTM (BTFP-Eligible)",
    "mtm_other" = "MTM (Other)",
    "uninsured_lev" = "Uninsured Leverage"
  )
) +
  geom_vline(xintercept = 0, color = "red", linetype = "dotted") +
  labs(
    title = "Comparison of Borrowing Determinants",
    subtitle = "MTM losses drive BTFP selection but not necessarily DW usage",
    x = "Coefficient Estimate"
  ) +
  theme_minimal()

# Jiang-Style Vulnerability Map
ggplot(df, aes(x = uninsured_lev, y = mtm_btfp)) +
  annotate("rect", xmin = 25, xmax = Inf, ymin = 2, ymax = Inf,
           fill = "red", alpha = 0.1) +
  geom_point(aes(color = factor(btfp), alpha = factor(btfp)), size = 2) +
  scale_color_manual(values = c("0" = "gray70", "1" = "#2c7fb8"),
                     labels = c("Non-Borrower", "BTFP Borrower")) +
  scale_alpha_manual(values = c("0" = 0.3, "1" = 0.8), guide = "none") +
  geom_vline(xintercept = median(df$uninsured_lev, na.rm = TRUE), linetype = "dotted") +
  geom_hline(yintercept = median(df$mtm_btfp, na.rm = TRUE), linetype = "dotted") +
  labs(
    title = "Bank Vulnerability and BTFP Selection",
    subtitle = "Blue dots (BTFP users) cluster in the high-uninsured, high-MTM loss quadrant",
    x = "Uninsured Deposits / Total Assets (%)",
    y = "MTM Loss on BTFP-Eligible Securities (%)",
    color = "Facility Usage"
  ) +
  annotate("text", x = 60, y = 8, label = "High Vulnerability\nZone", color = "red", fontface = "bold") +
  theme_minimal() +
  theme(legend.position = "bottom")

# BTFP Intensive Margin: Borrowing vs. Subsidy Value
btfp_users <- df %>% filter(btfp == 1)

ggplot(btfp_users, aes(x = mtm_btfp, y = btfp_amount_pct)) +
  geom_point(color = "#2c7fb8", alpha = 0.6) +
  geom_smooth(method = "lm", color = "darkblue", se = TRUE) +
  geom_text(
    data = subset(btfp_users, btfp_amount_pct > quantile(btfp_amount_pct, 0.95)),
    aes(label = idrssd),
    vjust = -1,
    size = 3,
    check_overlap = TRUE
  ) +
  labs(
    title = "BTFP Intensive Margin - Subsidy Capture",
    subtitle = "Conditional on borrowing, larger MTM losses correlate with larger borrowing amounts",
    x = "MTM Loss on Eligible Collateral (The Subsidy %)",
    y = "BTFP Borrowing / Total Assets (%)"
  ) +
  theme_minimal()

## Figure A: Bank Vulnerability Map (Key Figure for Selection Story)

# Shows how banks sorted into facilities based on MTM losses and uninsured deposits

p_vuln <- ggplot(df, aes(x = uninsured_lev, y = mtm_btfp * 100)) +
  # Quadrant shading
  annotate("rect", xmin = median(df$uninsured_lev, na.rm = TRUE), xmax = Inf, 
           ymin = median(df$mtm_btfp * 100, na.rm = TRUE), ymax = Inf, 
           fill = "red", alpha = 0.1) +
  annotate("text", x = 45, y = 6, label = "High Vulnerability\n(High MTM + High Uninsured)", 
           color = "darkred", fontface = "bold", size = 4) +
  # Points
  geom_point(aes(color = facility, size = assets), alpha = 0.6) +
  # Median lines
  geom_vline(xintercept = median(df$uninsured_lev, na.rm = TRUE), linetype = "dotted", color = "gray40") +
  geom_hline(yintercept = median(df$mtm_btfp * 100, na.rm = TRUE), linetype = "dotted", color = "gray40") +
  scale_color_manual(values = c("None" = "gray80", "BTFP Only" = "#2166ac", 
                                 "DW Only" = "#b2182b", "Both" = "#762a83")) +
  scale_size_continuous(range = c(1, 8), labels = scales::comma, name = "Assets ($000s)") +
  labs(
    title = "Bank Vulnerability and Facility Selection",
    subtitle = "Banks with high MTM losses AND high uninsured deposits disproportionately chose BTFP",
    x = "Uninsured Deposits / Total Assets (%)",
    y = "MTM Loss on BTFP-Eligible Securities (%)",
    color = "Facility Choice"
  ) +
  theme_pub() +
  theme(legend.position = "right")

print(p_vuln)

Figure B: Facility Choice by Risk Quintiles (Heatmap)

# Create quintiles
df_quintile <- df %>%
  mutate(
    mtm_quintile = ntile(mtm_btfp, 5),
    uninsured_quintile = ntile(uninsured_lev, 5)
  ) %>%
  group_by(mtm_quintile, uninsured_quintile) %>%
  summarise(
    btfp_rate = mean(btfp, na.rm = TRUE) * 100,
    n = n(),
    .groups = "drop"
  )

p_heat <- ggplot(df_quintile, aes(x = factor(uninsured_quintile), y = factor(mtm_quintile), fill = btfp_rate)) +
  geom_tile(color = "white", linewidth = 0.5) +
  geom_text(aes(label = sprintf("%.1f%%\n(n=%d)", btfp_rate, n)), color = "white", size = 3.5) +
  scale_fill_gradient2(low = "#2166ac", mid = "#f7f7f7", high = "#b2182b", 
                       midpoint = mean(df$btfp) * 100, name = "BTFP\nUsage (%)") +
  labs(
    title = "BTFP Usage Rate by MTM Loss and Uninsured Deposit Quintiles",
    subtitle = "Higher quintiles = higher risk; BTFP usage concentrates in high-risk cells",
    x = "Uninsured Deposit Quintile (1=Low, 5=High)",
    y = "MTM Loss Quintile (1=Low, 5=High)"
  ) +
  theme_minimal() +
  theme(
    panel.grid = element_blank(),
    legend.position = "right"
  )

print(p_heat)

Figure C: Borrower Characteristics by Entry Period

# Shows how the "type" of borrower changed over time

entry_chars <- df %>%
  filter(btfp == 1) %>%
  group_by(btfp_period) %>%
  summarise(
    `MTM Loss (%)` = mean(mtm_btfp * 100, na.rm = TRUE),
    `Uninsured (%)` = mean(uninsured_lev, na.rm = TRUE),
    `Eligible Collateral (%)` = mean(eligible_collateral, na.rm = TRUE),
    `Adjusted Equity (%)` = mean(adjusted_equity, na.rm = TRUE),
    N = n(),
    .groups = "drop"
  ) %>%
  filter(!is.na(btfp_period)) %>%
  pivot_longer(cols = -c(btfp_period, N), names_to = "Metric", values_to = "Value")

p_entry <- ggplot(entry_chars, aes(x = factor(btfp_period, levels = c("Acute", "PostAcute", "Arbitrage")), 
                                    y = Value, fill = Metric)) +
  geom_bar(stat = "identity", position = "dodge", alpha = 0.8) +
  geom_text(aes(label = sprintf("%.1f", Value)), position = position_dodge(width = 0.9), 
            vjust = -0.5, size = 3) +
  scale_fill_brewer(palette = "Set2") +
  labs(
    title = "Characteristics of New BTFP Borrowers by Entry Period",
    subtitle = "Acute borrowers were distressed; Arbitrage borrowers had capacity",
    x = "Period of First BTFP Borrowing",
    y = "Mean Value (%)",
    fill = "Characteristic"
  ) +
  theme_pub() +
  facet_wrap(~Metric, scales = "free_y", ncol = 2)

print(p_entry)

Figure D: Coefficient Evolution Across Periods (Forest Plot)

# Extract coefficients from period-specific regressions

coef_data <- bind_rows(
  tidy(lpm_btfp_acute, conf.int = TRUE) %>% mutate(Period = "Acute", Facility = "BTFP"),
  tidy(lpm_btfp_post, conf.int = TRUE) %>% mutate(Period = "Post-Acute", Facility = "BTFP"),
  tidy(lpm_btfp_arb, conf.int = TRUE) %>% mutate(Period = "Arbitrage", Facility = "BTFP")
) %>%
  filter(term %in% c("mtm_btfp", "uninsured_lev", "eligible_collateral")) %>%
  mutate(
    term = recode(term,
                  "mtm_btfp" = "MTM Loss (BTFP-Eligible)",
                  "uninsured_lev" = "Uninsured Leverage",
                  "eligible_collateral" = "Eligible Collateral"),
    Period = factor(Period, levels = c("Acute", "Post-Acute", "Arbitrage"))
  )

p_coef <- ggplot(coef_data, aes(x = Period, y = estimate, color = term)) +
  geom_point(position = position_dodge(width = 0.5), size = 3) +
  geom_errorbar(aes(ymin = conf.low, ymax = conf.high), 
                position = position_dodge(width = 0.5), width = 0.2) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
  scale_color_brewer(palette = "Dark2") +
  labs(
    title = "Evolution of BTFP Borrowing Determinants Across Crisis Phases",
    subtitle = "Distress variables matter early; Collateral capacity matters late",
    x = "Crisis Period",
    y = "Coefficient Estimate",
    color = "Variable"
  ) +
  theme_pub() +
  theme(legend.position = "bottom")

print(p_coef)

Figure E: Collateral Max-Out Analysis

# Shows banks "maxing out" BTFP-eligible collateral

p_maxout <- df %>%
  filter(btfp == 1) %>%
  ggplot(aes(x = eligible_collateral, y = btfp_amount_pct)) +
  geom_point(aes(color = factor(dw), size = assets), alpha = 0.6) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red", linewidth = 1) +
  geom_smooth(method = "lm", se = TRUE, color = "darkblue", linetype = "solid") +
  annotate("text", x = 20, y = 22, label = "100% Utilization Line", 
           color = "red", angle = 45, fontface = "italic") +
  scale_color_manual(values = c("0" = "steelblue", "1" = "darkred"), 
                     labels = c("BTFP Only", "Used Both (BTFP + DW)")) +
  scale_size_continuous(range = c(1, 6), guide = "none") +
  labs(
    title = "BTFP Borrowing vs. Eligible Collateral Capacity",
    subtitle = "Banks using both facilities (red) cluster near the collateral constraint",
    x = "BTFP-Eligible Collateral (% of Assets)",
    y = "Actual BTFP Borrowing (% of Assets)",
    color = "Facility Choice"
  ) +
  theme_pub() +
  theme(legend.position = "bottom")

print(p_maxout)

Figure F: Utilization Distribution by Facility Choice

# Distribution of collateral utilization

df_util <- df %>%
  filter(btfp == 1, !is.na(btfp_utilization)) %>%
  mutate(
    facility_choice = ifelse(dw == 1, "Used Both", "BTFP Only"),
    btfp_utilization_pct = pmin(btfp_utilization * 100, 150)  # Cap at 150% for visualization
  )

p_util <- ggplot(df_util, aes(x = btfp_utilization_pct, fill = facility_choice)) +
  geom_histogram(alpha = 0.6, position = "identity", bins = 30) +
  geom_vline(xintercept = 90, linetype = "dashed", color = "red", linewidth = 1) +
  annotate("text", x = 95, y = Inf, label = "90% Threshold\n(Maxed Out)", 
           vjust = 2, hjust = 0, color = "red", size = 3.5) +
  scale_fill_manual(values = c("BTFP Only" = "steelblue", "Used Both" = "darkred")) +
  labs(
    title = "BTFP Collateral Utilization Distribution",
    subtitle = "Banks using DW in addition to BTFP have higher utilization rates",
    x = "BTFP Utilization (Borrowing / Eligible Collateral, %)",
    y = "Count",
    fill = "Facility Choice"
  ) +
  theme_pub()

print(p_util)

Figure G: Interest Rate Spread and Arbitrage Opportunity

# Calculate weekly average rates and spread

rate_spread <- bind_rows(btfp_weekly, dw_weekly) %>%
  select(week, facility, rate) %>%
  pivot_wider(names_from = facility, values_from = rate) %>%
  mutate(spread = DW - BTFP) %>%
  filter(!is.na(spread))

p_spread <- ggplot(rate_spread, aes(x = week, y = spread)) +
  geom_area(alpha = 0.3, fill = "steelblue") +
  geom_line(color = "darkblue", linewidth = 1) +
  geom_hline(yintercept = 0, linetype = "solid", color = "black") +
  geom_vline(xintercept = ARB_OPEN, linetype = "dashed", color = "red") +
  geom_vline(xintercept = ARB_CLOSE, linetype = "dashed", color = "red") +
  annotate("rect", xmin = ARB_OPEN, xmax = ARB_CLOSE, ymin = -Inf, ymax = Inf, 
           fill = "red", alpha = 0.1) +
  annotate("text", x = ARB_OPEN + 30, y = max(rate_spread$spread, na.rm = TRUE) * 0.8, 
           label = "Arbitrage\nWindow", color = "darkred", fontface = "bold") +
  labs(
    title = "Interest Rate Spread: DW Rate - BTFP Rate",
    subtitle = "Positive spread = BTFP cheaper; Arbitrage window highlighted in red",
    x = NULL,
    y = "Spread (Percentage Points)"
  ) +
  theme_pub()

print(p_spread)

Figure H: New Borrowers During Arbitrage vs Crisis

# Compare characteristics of new borrowers

new_borrower_comparison <- df %>%
  filter(btfp == 1, btfp_period %in% c("Acute", "Arbitrage")) %>%
  select(btfp_period, mtm_btfp, uninsured_lev, eligible_collateral, adjusted_equity, ln_assets) %>%
  pivot_longer(cols = -btfp_period, names_to = "Variable", values_to = "Value") %>%
  mutate(
    Variable = recode(Variable,
                      "mtm_btfp" = "MTM Loss (%)",
                      "uninsured_lev" = "Uninsured Leverage (%)",
                      "eligible_collateral" = "Eligible Collateral (%)",
                      "adjusted_equity" = "Adjusted Equity (%)",
                      "ln_assets" = "Log(Assets)")
  )

p_compare <- ggplot(new_borrower_comparison, aes(x = btfp_period, y = Value, fill = btfp_period)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c("Acute" = "#d73027", "Arbitrage" = "#4575b4")) +
  facet_wrap(~Variable, scales = "free_y", ncol = 3) +
  labs(
    title = "Comparison: Acute Crisis vs Arbitrage Borrowers",
    subtitle = "Acute borrowers were distressed; Arbitrage borrowers were opportunistic",
    x = "Entry Period",
    y = "Value"
  ) +
  theme_pub() +
  theme(legend.position = "none")

print(p_compare)

Figure I: Insolvency Measures Distribution by Facility

# Distribution of Jiang insolvency measures

insolvency_long <- df %>%
  select(facility, adjusted_equity, idcr_1, idcr_2, insolvency_1, insolvency_2) %>%
  pivot_longer(cols = -facility, names_to = "Measure", values_to = "Value") %>%
  mutate(
    Measure = recode(Measure,
                     "adjusted_equity" = "Adjusted Equity",
                     "idcr_1" = "IDCR (s=0.5)",
                     "idcr_2" = "IDCR (s=1.0)",
                     "insolvency_1" = "Capital Metric (s=0.5)",
                     "insolvency_2" = "Capital Metric (s=1.0)")
  )

p_insol <- ggplot(insolvency_long, aes(x = Value, fill = facility)) +
  geom_density(alpha = 0.5) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "red") +
  facet_wrap(~Measure, scales = "free", ncol = 2) +
  scale_fill_manual(values = c("None" = "gray70", "BTFP Only" = "#2166ac", 
                                "DW Only" = "#b2182b", "Both" = "#762a83")) +
  labs(
    title = "Distribution of Insolvency Measures by Facility Choice",
    subtitle = "Red line = Insolvency threshold (0); BTFP users skew toward distress",
    x = "Value",
    y = "Density",
    fill = "Facility"
  ) +
  theme_pub() +
  theme(legend.position = "bottom")

print(p_insol)

Figure J: Insolvency Rates by Facility

# Bar chart of insolvency rates

insolvency_rates <- df %>%
  group_by(facility) %>%
  summarise(
    `Adjusted Equity < 0` = mean(mtm_insolvent / 100, na.rm = TRUE) * 100,
    `IDCR (s=0.5) < 0` = mean(insolvent_idcr_s50, na.rm = TRUE) * 100,
    `IDCR (s=1.0) < 0` = mean(insolvent_idcr_s100, na.rm = TRUE) * 100,
    `Capital (s=0.5) < 0` = mean(insolvent_cap_s50, na.rm = TRUE) * 100,
    `Capital (s=1.0) < 0` = mean(insolvent_cap_s100, na.rm = TRUE) * 100,
    .groups = "drop"
  ) %>%
  pivot_longer(cols = -facility, names_to = "Measure", values_to = "Rate")

p_insol_rate <- ggplot(insolvency_rates, aes(x = facility, y = Rate, fill = Measure)) +
  geom_bar(stat = "identity", position = "dodge", alpha = 0.8) +
  geom_text(aes(label = sprintf("%.1f%%", Rate)), 
            position = position_dodge(width = 0.9), vjust = -0.5, size = 3) +
  scale_fill_brewer(palette = "RdYlBu") +
  labs(
    title = "Insolvency Rates by Facility Choice",
    subtitle = "BTFP borrowers had higher insolvency rates across all measures",
    x = "Facility Choice",
    y = "Insolvency Rate (%)",
    fill = "Insolvency Measure"
  ) +
  theme_pub() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

print(p_insol_rate)

Figure K: BTFP vs DW Coefficient Comparison (Forest Plot)

# Compare coefficients between BTFP and DW regressions

coef_compare <- bind_rows(
  tidy(lpm_btfp, conf.int = TRUE) %>% mutate(Model = "BTFP"),
  tidy(lpm_dw, conf.int = TRUE) %>% mutate(Model = "DW")
) %>%
  filter(term %in% c("mtm_btfp", "mtm_other", "uninsured_lev", "I(mtm_btfp * uninsured_lev)")) %>%
  mutate(
    term = recode(term,
                  "mtm_btfp" = "MTM Loss (BTFP-Eligible)",
                  "mtm_other" = "MTM Loss (Other)",
                  "uninsured_lev" = "Uninsured Leverage",
                  "I(mtm_btfp * uninsured_lev)" = "MTM x Uninsured"),
    term = factor(term, levels = c("MTM Loss (BTFP-Eligible)", "MTM Loss (Other)", 
                                    "Uninsured Leverage", "MTM x Uninsured"))
  )

p_forest <- ggplot(coef_compare, aes(x = estimate, y = term, color = Model)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
  geom_point(position = position_dodge(width = 0.5), size = 3) +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), 
                 position = position_dodge(width = 0.5), height = 0.2) +
  scale_color_manual(values = c("BTFP" = "#2166ac", "DW" = "#b2182b")) +
  labs(
    title = "Coefficient Comparison: BTFP vs DW Selection",
    subtitle = "MTM losses on eligible collateral drive BTFP selection but not DW",
    x = "Coefficient Estimate (with 95% CI)",
    y = NULL,
    color = "Dependent Variable"
  ) +
  theme_pub() +
  theme(legend.position = "bottom")

print(p_forest)

Figure L: Summary Statistics Comparison

# Radar/spider chart alternative: grouped bar chart

summary_comparison <- df %>%
  group_by(facility) %>%
  summarise(
    `Mean MTM Loss (%)` = mean(mtm_btfp * 100, na.rm = TRUE),
    `Mean Uninsured (%)` = mean(uninsured_lev, na.rm = TRUE),
    `Mean Eligible Collateral (%)` = mean(eligible_collateral, na.rm = TRUE),
    `Mean Adjusted Equity (%)` = mean(adjusted_equity, na.rm = TRUE),
    `Insolvency Rate (%)` = mean(mtm_insolvent, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  pivot_longer(cols = -facility, names_to = "Metric", values_to = "Value")

p_summary <- ggplot(summary_comparison, aes(x = Metric, y = Value, fill = facility)) +
  geom_bar(stat = "identity", position = "dodge", alpha = 0.8) +
  scale_fill_manual(values = c("None" = "gray70", "BTFP Only" = "#2166ac", 
                                "DW Only" = "#b2182b", "Both" = "#762a83")) +
  labs(
    title = "Bank Characteristics by Facility Choice",
    subtitle = "BTFP users had higher MTM losses and lower adjusted equity",
    x = NULL,
    y = "Mean Value",
    fill = "Facility"
  ) +
  theme_pub() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  coord_flip()

print(p_summary)

Figure M: Crisis Timeline with Key Events

# Create timeline of key events

events <- tibble(
  date = as.Date(c("2023-03-10", "2023-03-12", "2023-03-13", "2023-05-01", 
                   "2023-10-31", "2023-11-06", "2024-01-24", "2024-03-11")),
  event = c("SVB Fails", "Signature Fails", "BTFP Launched", "First Republic Fails",
            "DW Haircut Returns", "Arbitrage Opens", "Arbitrage Closes", "BTFP Closes"),
  y = c(1, 1.5, 2, 1, 1.5, 2, 1.5, 1)
)

# Daily volume for background
daily_vol <- bind_rows(btfp_daily, dw_daily) %>%
  group_by(date) %>%
  summarise(total = sum(volume, na.rm = TRUE), .groups = "drop")

p_timeline <- ggplot() +
  # Background volume
  geom_area(data = daily_vol, aes(x = date, y = total), alpha = 0.3, fill = "steelblue") +
  # Period shading
  annotate("rect", xmin = as.Date("2023-03-13"), xmax = as.Date("2023-05-01"), 
           ymin = -Inf, ymax = Inf, fill = "#d73027", alpha = 0.1) +
  annotate("rect", xmin = as.Date("2023-05-02"), xmax = as.Date("2023-10-31"), 
           ymin = -Inf, ymax = Inf, fill = "#fc8d59", alpha = 0.1) +
  annotate("rect", xmin = as.Date("2023-11-01"), xmax = as.Date("2024-01-24"), 
           ymin = -Inf, ymax = Inf, fill = "#4575b4", alpha = 0.1) +
  # Event markers
  geom_vline(data = events, aes(xintercept = date), linetype = "dashed", color = "gray40") +
  geom_point(data = events, aes(x = date, y = max(daily_vol$total) * y / 2), size = 3, color = "darkred") +
  geom_text(data = events, aes(x = date, y = max(daily_vol$total) * y / 2, label = event), 
            vjust = -1, hjust = 0.5, size = 3, angle = 45) +
  # Period labels
  annotate("text", x = as.Date("2023-04-07"), y = max(daily_vol$total) * 0.95, 
           label = "ACUTE", color = "#d73027", fontface = "bold", size = 4) +
  annotate("text", x = as.Date("2023-08-01"), y = max(daily_vol$total) * 0.95, 
           label = "POST-ACUTE", color = "#fc8d59", fontface = "bold", size = 4) +
  annotate("text", x = as.Date("2023-12-15"), y = max(daily_vol$total) * 0.95, 
           label = "ARBITRAGE", color = "#4575b4", fontface = "bold", size = 4) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b\n%Y") +
  scale_y_continuous(labels = scales::dollar_format(suffix = "B")) +
  labs(
    title = "Crisis Timeline: Key Events and Borrowing Volume",
    subtitle = "Background shows total daily borrowing volume (BTFP + DW)",
    x = NULL,
    y = "Daily Volume ($B)"
  ) +
  theme_pub()

print(p_timeline)

Variable Dictionary

tribble(
  ~Variable, ~Type, ~Description,
  "btfp", "Binary", "Bank borrowed from BTFP",
  "dw", "Binary", "Bank borrowed from DW",
  "mtm_btfp", "Continuous", "MTM loss on BTFP-eligible / Assets",
  "mtm_other", "Continuous", "MTM loss on non-eligible / Assets",
  "uninsured_lev", "Continuous", "Uninsured deposits / Assets",
  "eligible_collateral", "Continuous", "BTFP-eligible / Assets",
  "borrowing_subsidy", "Continuous", "MTM loss on OMO-eligible/ OMO-eligible",
  "run_risk_1", "Continuous", "%Uninsured x %MTM",
  "run_risk_1_dummy", "Binary", "Both above median",
  "idcr_1", "Continuous", "IDCR (s=0.5)",
  "idcr_2", "Continuous", "IDCR (s=1.0)",
  "insolvency_1", "Continuous", "Capital metric (s=0.5)",
  "insolvency_2", "Continuous", "Capital metric (s=1.0)",
  "adjusted_equity", "Continuous", "Equity ratio - MTM loss",
  "mtm_insolvent", "Binary", "Adjusted equity < 0"
) %>%
  kbl(caption = "Variable Dictionary") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Variable Dictionary
Variable Type Description
btfp Binary Bank borrowed from BTFP
dw Binary Bank borrowed from DW
mtm_btfp Continuous MTM loss on BTFP-eligible / Assets
mtm_other Continuous MTM loss on non-eligible / Assets
uninsured_lev Continuous Uninsured deposits / Assets
eligible_collateral Continuous BTFP-eligible / Assets
borrowing_subsidy Continuous MTM loss on OMO-eligible/ OMO-eligible
run_risk_1 Continuous %Uninsured x %MTM
run_risk_1_dummy Binary Both above median
idcr_1 Continuous IDCR (s=0.5)
idcr_2 Continuous IDCR (s=1.0)
insolvency_1 Continuous Capital metric (s=0.5)
insolvency_2 Continuous Capital metric (s=1.0)
adjusted_equity Continuous Equity ratio - MTM loss
mtm_insolvent Binary Adjusted equity < 0

Session Info

sessionInfo()
#> R version 4.3.1 (2023-06-16 ucrt)
#> Platform: x86_64-w64-mingw32/x64 (64-bit)
#> Running under: Windows 11 x64 (build 26200)
#> 
#> Matrix products: default
#> 
#> 
#> locale:
#> [1] LC_COLLATE=English_United States.utf8 
#> [2] LC_CTYPE=English_United States.utf8   
#> [3] LC_MONETARY=English_United States.utf8
#> [4] LC_NUMERIC=C                          
#> [5] LC_TIME=English_United States.utf8    
#> 
#> time zone: America/Chicago
#> tzcode source: internal
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#>  [1] forcats_1.0.0      purrr_1.0.4        tidyverse_2.0.0    psych_2.5.6       
#>  [5] moments_0.14.1     DescTools_0.99.60  modelsummary_2.4.0 kableExtra_1.4.0  
#>  [9] knitr_1.50         gridExtra_2.3      patchwork_1.3.2    scales_1.4.0      
#> [13] ggthemes_5.1.0     ggplot2_3.5.2      broom_1.0.9        lmtest_0.9-40     
#> [17] zoo_1.8-13         sandwich_3.1-1     fixest_0.12.1      readr_2.1.5       
#> [21] stringr_1.5.1      lubridate_1.9.4    tibble_3.2.1       tidyr_1.3.1       
#> [25] dplyr_1.1.4        data.table_1.17.0 
#> 
#> loaded via a namespace (and not attached):
#>  [1] tidyselect_1.2.1    Exact_3.3           viridisLite_0.4.2  
#>  [4] rootSolve_1.8.2.4   farver_2.1.2        fastmap_1.2.0      
#>  [7] bayestestR_0.16.1   digest_0.6.33       timechange_0.3.0   
#> [10] estimability_1.5.1  lifecycle_1.0.4     dreamerr_1.4.0     
#> [13] lmom_3.2            magrittr_2.0.3      compiler_4.3.1     
#> [16] rlang_1.1.1         sass_0.4.10         tools_4.3.1        
#> [19] yaml_2.3.10         labeling_0.4.3      bit_4.6.0          
#> [22] mnormt_2.1.1        xml2_1.3.8          RColorBrewer_1.1-3 
#> [25] tinytable_0.13.0    expm_1.0-0          withr_3.0.2        
#> [28] numDeriv_2016.8-1.1 datawizard_1.2.0    grid_4.3.1         
#> [31] fansi_1.0.6         xtable_1.8-4        e1071_1.7-16       
#> [34] emmeans_1.11.2-8    MASS_7.3-60         insight_1.3.1      
#> [37] cli_3.6.1           mvtnorm_1.3-3       crayon_1.5.3       
#> [40] rmarkdown_2.29      generics_0.1.4      performance_0.15.0 
#> [43] rstudioapi_0.17.1   httr_1.4.7          tzdb_0.5.0         
#> [46] parameters_0.27.0   readxl_1.4.5        gld_2.6.8          
#> [49] cachem_1.1.0        proxy_0.4-27        splines_4.3.1      
#> [52] parallel_4.3.1      cellranger_1.1.0    stringmagic_1.1.2  
#> [55] vctrs_0.6.5         boot_1.3-28.1       Matrix_1.5-4.1     
#> [58] jsonlite_2.0.0      litedown_0.7        hms_1.1.3          
#> [61] bit64_4.6.0-1       Formula_1.2-5       systemfonts_1.2.2  
#> [64] jquerylib_0.1.4     glue_1.8.0          stringi_1.8.7      
#> [67] gtable_0.3.6        tables_0.9.31       pillar_1.11.0      
#> [70] htmltools_0.5.9     R6_2.6.1            vroom_1.6.5        
#> [73] evaluate_1.0.4      lattice_0.21-8      haven_2.5.4        
#> [76] backports_1.5.0     bslib_0.9.0         class_7.3-22       
#> [79] Rcpp_1.0.14         checkmate_2.3.2     svglite_2.1.3      
#> [82] coda_0.19-4.1       nlme_3.1-162        mgcv_1.8-42        
#> [85] xfun_0.52           fs_1.6.5            pkgconfig_2.0.3