Bank Selection into Emergency Lending Facilities: Extensive Margin Analysis
BTFP, Discount Window, and FHLB Borrowing During the March 2023 Banking Crisis
Mohua Ferdousi
January 23, 2026
1 SECTION: SETUP AND DATA PREPARATION
1.1 THEORETICAL FRAMEWORK
1.1.1 A. Core Model: Depositor Run Vulnerability
Depositor Runs = f(Fundamentals, Liquidity Mismatch)
Where: - Fundamentals = Mark-to-Market (MTM) Losses on securities - Captures bank soundness / solvency risk - Higher MTM loss → worse fundamentals → higher run probability
- Liquidity Mismatch = Uninsured Deposit Leverage
- Captures funding fragility
- Higher uninsured deposits → greater liquidity mismatch → higher run probability
1.1.2 B. Risk Categories (2×2 Matrix)
Based on sample medians at 2022Q4:
| Low Uninsured | High Uninsured | |
|---|---|---|
| Low MTM Loss | Risk 1 (Reference) | Risk 2 (Below Median MTM Loss and above Median Uninsured Leverage) |
| High MTM Loss | Risk 3 ( Above Median MTM Loss and below Median Uninsured Leverage) | Risk 4 (Both Above Median MTM Loss and Uninsured Leverage) |
- Risk 1: Low MTM & Low Uninsured - low fundamental risk, low liquidity risk
- Risk 2: Low MTM & High Uninsured - sound fundamentals but run-prone funding
- Risk 3: High MTM & Low Uninsured - weak fundamentals but stable funding
- Risk 4: “High MTM loss and Uninsured Leverage” - both fundamental weakness AND liquidity vulnerability
Exclusions: - Failed banks (SVB, Signature, First Republic, Silvergate) - G-SIB banks (33 entities across periods) - Banks without OMO-eligible securities
Rationale: Focus on BTFP-eligible population
1.1.3 C. Hypotheses
H1 (Extensive Margin): Banks with higher run risk (Risk 3, Risk 4) are more likely to access emergency facilities.
H2 (Facility Choice): - BTFP attracts banks with OMO-eligible collateral and MTM losses (arbitrage motive) - DW used by banks with urgent liquidity needs regardless of collateral type
1.1.4 Extension 1: DiD Design - BTFP Effect on Deposit Stability
Research Question: Did BTFP stem deposit runs for eligible banks?
Design:
Treatment: Banks WITH OMO-eligible securities (can access BTFP) Control: Banks WITHOUT OMO-eligible securities (cannot access BTFP) Event: BTFP announcement (March 12, 2023) Outcome: Deposit stability (changes in total/uninsured deposits)
Identification Assumption: Banks with and without OMO collateral were equally exposed to rate hikes (parallel trends pre-March 2023), conditional on MTM losses and uninsured leverage.
Specification:
2 DiD Model
$$_{i,t} = (_i t) + {i,t} + _i + t + {i,t}
$\(Where:\)_{i,t}$: The quarterly deposit outflow for bank \(i\) in quarter\(t\). \(\text{OMO}_i \times \text{Post}_t\): The interaction term. \(\mathbf{X}_{i,t}\): The vector of time-varying controls (MTM, Uninsured Leverage, Size, etc.). \(MTM_{i,t}\).\(\alpha_i\) (Bank Fixed Effects): This absorbs the standalone \(\text{OMO}_i\) term (and any other static bank traits). \(\delta_t\) (Time Fixed Effects): This absorbs the standalone \(\text{Post}_t\) term (and any general macro shocks).
2.1 Load Packages
library(tidyverse)
library(data.table)
library(lubridate)
library(fixest)
library(modelsummary)
library(kableExtra)
library(scales)
library(ggplot2)
library(patchwork)
library(nnet)
library(broom)
cat("All packages loaded successfully.\n")## All packages loaded successfully.2.2 Helper Functions
# ==============================================================================
# HELPER FUNCTIONS
# ==============================================================================
# Winsorization function (2.5% / 97.5% by default)
winsorize <- function(x, probs = c(0.025, 0.975)) {
if (all(is.na(x))) return(x)
q <- quantile(x, probs = probs, na.rm = TRUE, names = FALSE)
pmax(pmin(x, q[2]), q[1])
}
# Z-score standardization function
standardize_z <- function(x) {
if (all(is.na(x))) return(x)
(x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
}
# Safe division (avoid division by zero)
safe_div <- function(num, denom, default = NA_real_) {
ifelse(is.na(denom) | denom == 0, default, num / denom)
}
# Size category function (3 categories)
create_size_category_3 <- function(assets_thousands) {
assets_millions <- assets_thousands / 1000
case_when(
assets_millions >= 100000 ~ "Large (>$100B)",
assets_millions >= 1000 ~ "Medium ($1B-$100B)",
TRUE ~ "Small (<$1B)"
)
}
size_levels_3 <- c("Small (<$1B)", "Medium ($1B-$100B)", "Large (>$100B)")
# Format P-Value with Stars
format_pval <- function(p) {
case_when(
is.na(p) ~ "",
p < 0.01 ~ "***",
p < 0.05 ~ "**",
p < 0.10 ~ "*",
TRUE ~ ""
)
}
# ==============================================================================
# OUTPUT SAVING FUNCTIONS (Added for saving tables and figures)
# ==============================================================================
# Save kable/kableExtra table to HTML and LaTeX
save_kable_table <- function(tbl, filename, caption_text = "", notes_text = "") {
# HTML version
html_tbl <- tbl %>%
kable(format = "html", caption = caption_text) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 10)
save_kable(html_tbl, file = file.path(TABLE_PATH, paste0(filename, ".html")))
# LaTeX version
latex_tbl <- tbl %>%
kable(format = "latex", caption = caption_text, booktabs = TRUE) %>%
kable_styling(latex_options = c("hold_position", "scale_down"))
if (notes_text != "") {
latex_tbl <- latex_tbl %>%
footnote(general = notes_text, general_title = "Notes: ", threeparttable = TRUE)
}
writeLines(latex_tbl, file.path(TABLE_PATH, paste0(filename, ".tex")))
cat("Saved:", filename, "(HTML + LaTeX)\n")
}
# Save modelsummary regression table to HTML and LaTeX
save_reg_table <- function(models, filename, title_text = "", notes_text = "",
coef_map_use = NULL, gof_map_use = NULL, add_rows_use = NULL, ...) {
# HTML
modelsummary(models, stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = coef_map_use, gof_map = gof_map_use, add_rows = add_rows_use,
title = title_text, notes = notes_text,
output = file.path(TABLE_PATH, paste0(filename, ".html")), ...)
# LaTeX
modelsummary(models, stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = coef_map_use, gof_map = gof_map_use, add_rows = add_rows_use,
title = title_text, notes = notes_text,
output = file.path(TABLE_PATH, paste0(filename, ".tex")), ...)
cat("Saved:", filename, "(HTML + LaTeX)\n")
}
# Save ggplot figure to PDF and PNG
save_figure <- function(plot_obj, filename, width = 12, height = 8) {
ggsave(file.path(FIG_PATH, paste0(filename, ".pdf")), plot = plot_obj,
width = width, height = height, device = "pdf")
ggsave(file.path(FIG_PATH, paste0(filename, ".png")), plot = plot_obj,
width = width, height = height, dpi = 300, device = "png")
cat("Saved:", filename, "(PDF + PNG)\n")
}
# Aliases for run_4spec_models and create_n_rows (used in later sections)
run_4spec_models <- function(data, dv, family_type = c("lpm","logit")) {
family_type <- match.arg(family_type)
forms <- list(
"(1) Base" = build_formula(dv, "mtm_total + uninsured_lev + mtm_x_uninsured"),
"(2) +Risk1" = build_formula(dv, "run_risk_1"),
"(3) +Risk1,2" = build_formula(dv, "run_risk_1 + run_risk_2"),
"(4) Risk2,3,4" = build_formula(dv, "run_risk_2 + run_risk_3 + run_risk_4")
)
if (family_type == "lpm") {
lapply(forms, function(ff) feols(ff, data = data, vcov = "hetero"))
} else {
lapply(forms, function(ff) feglm(ff, data = data, family = binomial("logit"), vcov = "hetero"))
}
}
create_n_rows <- function(data, dv, n_models = 4) {
n_ones <- sum(data[[dv]] == 1, na.rm = TRUE)
n_sample <- nrow(data)
out <- data.frame(term = c(paste0("N (", dv, "=1)"), "N (Sample)"))
for (i in 1:n_models) out[[paste0("(", i, ")")]] <- c(n_ones, n_sample)
out
}2.3 Paths and Key Dates
# ==============================================================================
# PATHS AND KEY DATES
# ==============================================================================
BASE_PATH <- "C:/Users/mferdo2/OneDrive - Louisiana State University/Finance_PhD/DW_Stigma_paper/Liquidity_project_2025"
DATA_PROC <- file.path(BASE_PATH, "01_data/processed")
OUTPUT_PATH <- file.path(BASE_PATH, "03_documentation/crisis_borrowing_result_all")
TABLE_PATH <- file.path(OUTPUT_PATH, "tables")
FIG_PATH <- file.path(OUTPUT_PATH, "figures")
for (path in c(TABLE_PATH, FIG_PATH)) {
if (!dir.exists(path)) dir.create(path, recursive = TRUE)
}
# Baseline periods for different analyses
BASELINE_MAIN <- "2022Q4" # For Acute, Post-Acute
BASELINE_ARB <- "2023Q3" # For Arbitrage
BASELINE_WIND <- "2023Q4" # For Wind-down
# Key dates
DATE_MAR01 <- as.Date("2023-03-01")
DATE_MAR09 <- as.Date("2023-03-09")
DATE_MAR10 <- as.Date("2023-03-10")
DATE_MAR12 <- as.Date("2023-03-12")
DATE_MAR13 <- as.Date("2023-03-13")
DATE_MAR14 <- as.Date("2023-03-14")
# Period definitions
ACUTE_START <- as.Date("2023-03-13")
ACUTE_END <- as.Date("2023-05-01")
POST_ACUTE_END <- as.Date("2023-10-31")
ARB_START <- as.Date("2023-11-01")
ARB_END <- as.Date("2024-01-24")
WIND_START <- as.Date("2024-01-25")
WIND_END <- as.Date("2024-03-11")
DW_DATA_END <- as.Date("2023-09-30")
OVERALL_START <- as.Date("2023-03-01")
OVERALL_END <- as.Date("2024-03-11")2.4 Variable Definitions
# ==============================================================================
# COMPREHENSIVE VARIABLE DEFINITIONS
# ==============================================================================
# Define variable categories with complete definitions
var_def_appendix <- tribble(
~Panel, ~Variable, ~Definition, ~Source,
# Panel A: Dependent Variables
"Panel A: Dependent Variables", "BTFP_Borrower",
"Indicator equal to one if bank obtained at least one BTFP loan during the specified period, zero otherwise.",
"Federal Reserve H.4.1",
"Panel A: Dependent Variables", "DW_Borrower",
"Indicator equal to one if bank obtained at least one Discount Window loan during the specified period, zero otherwise.",
"Federal Reserve FOIA",
"Panel A: Dependent Variables", "Any_Fed",
"Indicator equal to one if bank accessed BTFP or Discount Window during the period.",
"Constructed",
"Panel A: Dependent Variables", "FHLB_Abnormal",
"Indicator equal to one if quarterly change in FHLB advances exceeds 10% of total assets.",
"Call Reports (RC-M)",
"Panel A: Dependent Variables", "BTFP_Pct",
"BTFP borrowing amount divided by total assets, expressed in percentage points.",
"Constructed",
"Panel A: Dependent Variables", "Deposit_Outflow",
"Negative of quarterly percentage change in deposits: $-100 \\times (D_t - D_{t-1})/D_{t-1}$. Positive values indicate runoff.",
"Call Reports (RC-E)",
# Panel B: Key Explanatory Variables
"Panel B: Key Explanatory Variables", "MTM_Loss",
"Mark-to-market losses on available-for-sale and held-to-maturity securities divided by total assets, expressed in percentage points. Calculated as (Amortized Cost - Fair Value)/Total Assets $\\times$ 100.",
"Call Reports (RC-B, RC-Q)",
"Panel B: Key Explanatory Variables", "Uninsured_Leverage",
"Uninsured deposits divided by total assets, expressed in percentage points.",
"Call Reports (RC-O)",
"Panel B: Key Explanatory Variables", "MTM $\\times$ Uninsured",
"Interaction term: standardized MTM Loss multiplied by standardized Uninsured Leverage.",
"Constructed",
"Panel B: Key Explanatory Variables", "Risk_2",
"Indicator for banks with below-median MTM losses and above-median uninsured leverage (liquidity risk).",
"Constructed",
"Panel B: Key Explanatory Variables", "Risk_3",
"Indicator for banks with above-median MTM losses and below-median uninsured leverage (solvency risk).",
"Constructed",
"Panel B: Key Explanatory Variables", "Risk_4",
"Indicator for banks with above-median MTM losses and above-median uninsured leverage (dual risk).",
"Constructed",
# Panel C: Control Variables
"Panel C: Control Variables", "Log(Assets)",
"Natural logarithm of total assets in thousands of dollars.",
"Call Reports (RC)",
"Panel C: Control Variables", "Cash_Ratio",
"Cash and cash equivalents divided by total assets, expressed in percentage points.",
"Call Reports (RC)",
"Panel C: Control Variables", "Loan_to_Deposit",
"Total loans and leases divided by total deposits.",
"Call Reports (RC-C, RC-E)",
"Panel C: Control Variables", "Book_Equity_Ratio",
"Total equity capital divided by total assets, expressed in percentage points.",
"Call Reports (RC)",
"Panel C: Control Variables", "Wholesale_Funding",
"Sum of federal funds purchased, securities sold under repo, and other short-term borrowings divided by total liabilities, expressed in percentage points.",
"Call Reports (RC-M)",
"Panel C: Control Variables", "ROA",
"Annualized return on assets: net income divided by average total assets, expressed in percentage points.",
"Call Reports (RI)",
# Panel D: Intensive Margin Variables
"Panel D: Intensive Margin Variables", "Par_Benefit",
"MTM loss on OMO-eligible securities divided by OMO-eligible securities holdings, expressed in percentage points. Measures the implicit subsidy from par-value lending.",
"Call Reports (RC-B)",
"Panel D: Intensive Margin Variables", "Collateral_Capacity",
"OMO-eligible securities (Treasury and Agency securities) divided by total assets, expressed in percentage points.",
"Call Reports (RC-B)",
# Panel E: DiD Variables
"Panel E: DiD Variables", "OMO_Eligible",
"Indicator equal to one if bank holds Treasury or Agency securities eligible for Federal Reserve open market operations.",
"Call Reports (RC-B)",
"Panel E: DiD Variables", "Post_BTFP",
"Indicator equal to one for quarters on or after 2023Q1 (post-BTFP announcement).",
"Constructed",
"Panel E: DiD Variables", "DiD_Term",
"Interaction: OMO\\_Eligible $\\times$ Post\\_BTFP. Main coefficient of interest in difference-in-differences analysis.",
"Constructed"
)
# Create the formatted table
var_def_appendix %>%
select(Panel, Variable, Definition, Source) %>%
kable(format = "html",
caption = "Table: Variable Definitions",
col.names = c("", "Variable", "Definition", "Data Source"),
escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE,
font_size = 10) %>%
column_spec(1, bold = TRUE, width = "3em") %>%
column_spec(2, width = "12em", bold = TRUE) %>%
column_spec(3, width = "40em") %>%
column_spec(4, width = "10em") %>%
pack_rows(index = c("Panel A: Dependent Variables" = 6,
"Panel B: Key Explanatory Variables" = 6,
"Panel C: Control Variables" = 6,
"Panel D: Intensive Margin Variables" = 2,
"Panel E: DiD Variables" = 3)) %>%
footnote(general = c(
"This table provides definitions for all variables used in the analysis.",
"All continuous variables are winsorized at the 2.5th and 97.5th percentiles before standardization.",
"Z-standardized variables have mean zero and unit standard deviation within each baseline sample.",
"Risk categories are based on sample medians of MTM Loss and Uninsured Leverage from 2022Q4.",
"Reference category for risk dummies is Risk 1 (below-median MTM and below-median uninsured)."
), general_title = "Notes: ", threeparttable = TRUE)| Variable | Definition | Data Source | |
|---|---|---|---|
| Panel A: Dependent Variables | |||
| Panel A: Dependent Variables | BTFP_Borrower | Indicator equal to one if bank obtained at least one BTFP loan during the specified period, zero otherwise. | Federal Reserve H.4.1 |
| Panel A: Dependent Variables | DW_Borrower | Indicator equal to one if bank obtained at least one Discount Window loan during the specified period, zero otherwise. | Federal Reserve FOIA |
| Panel A: Dependent Variables | Any_Fed | Indicator equal to one if bank accessed BTFP or Discount Window during the period. | Constructed |
| Panel A: Dependent Variables | FHLB_Abnormal | Indicator equal to one if quarterly change in FHLB advances exceeds 10% of total assets. | Call Reports (RC-M) |
| Panel A: Dependent Variables | BTFP_Pct | BTFP borrowing amount divided by total assets, expressed in percentage points. | Constructed |
| Panel A: Dependent Variables | Deposit_Outflow | Negative of quarterly percentage change in deposits: \(-100 \times (D_t - D_{t-1})/D_{t-1}\). Positive values indicate runoff. | Call Reports (RC-E) |
| Panel B: Key Explanatory Variables | |||
| Panel B: Key Explanatory Variables | MTM_Loss | Mark-to-market losses on available-for-sale and held-to-maturity securities divided by total assets, expressed in percentage points. Calculated as (Amortized Cost - Fair Value)/Total Assets \(\times\) 100. | Call Reports (RC-B, RC-Q) |
| Panel B: Key Explanatory Variables | Uninsured_Leverage | Uninsured deposits divided by total assets, expressed in percentage points. | Call Reports (RC-O) |
| Panel B: Key Explanatory Variables | MTM \(\times\) Uninsured | Interaction term: standardized MTM Loss multiplied by standardized Uninsured Leverage. | Constructed |
| Panel B: Key Explanatory Variables | Risk_2 | Indicator for banks with below-median MTM losses and above-median uninsured leverage (liquidity risk). | Constructed |
| Panel B: Key Explanatory Variables | Risk_3 | Indicator for banks with above-median MTM losses and below-median uninsured leverage (solvency risk). | Constructed |
| Panel B: Key Explanatory Variables | Risk_4 | Indicator for banks with above-median MTM losses and above-median uninsured leverage (dual risk). | Constructed |
| Panel C: Control Variables | |||
| Panel C: Control Variables | Log(Assets) | Natural logarithm of total assets in thousands of dollars. | Call Reports (RC) |
| Panel C: Control Variables | Cash_Ratio | Cash and cash equivalents divided by total assets, expressed in percentage points. | Call Reports (RC) |
| Panel C: Control Variables | Loan_to_Deposit | Total loans and leases divided by total deposits. | Call Reports (RC-C, RC-E) |
| Panel C: Control Variables | Book_Equity_Ratio | Total equity capital divided by total assets, expressed in percentage points. | Call Reports (RC) |
| Panel C: Control Variables | Wholesale_Funding | Sum of federal funds purchased, securities sold under repo, and other short-term borrowings divided by total liabilities, expressed in percentage points. | Call Reports (RC-M) |
| Panel C: Control Variables | ROA | Annualized return on assets: net income divided by average total assets, expressed in percentage points. | Call Reports (RI) |
| Panel D: Intensive Margin Variables | |||
| Panel D: Intensive Margin Variables | Par_Benefit | MTM loss on OMO-eligible securities divided by OMO-eligible securities holdings, expressed in percentage points. Measures the implicit subsidy from par-value lending. | Call Reports (RC-B) |
| Panel D: Intensive Margin Variables | Collateral_Capacity | OMO-eligible securities (Treasury and Agency securities) divided by total assets, expressed in percentage points. | Call Reports (RC-B) |
| Panel E: DiD Variables | |||
| Panel E: DiD Variables | OMO_Eligible | Indicator equal to one if bank holds Treasury or Agency securities eligible for Federal Reserve open market operations. | Call Reports (RC-B) |
| Panel E: DiD Variables | Post_BTFP | Indicator equal to one for quarters on or after 2023Q1 (post-BTFP announcement). | Constructed |
| Panel E: DiD Variables | DiD_Term | Interaction: OMO_Eligible \(\times\) Post_BTFP. Main coefficient of interest in difference-in-differences analysis. | Constructed |
| Notes: | |||
| This table provides definitions for all variables used in the analysis. | |||
| All continuous variables are winsorized at the 2.5th and 97.5th percentiles before standardization. | |||
| Z-standardized variables have mean zero and unit standard deviation within each baseline sample. | |||
| Risk categories are based on sample medians of MTM Loss and Uninsured Leverage from 2022Q4. | |||
| Reference category for risk dummies is Risk 1 (below-median MTM and below-median uninsured). | |||
# Save LaTeX version for paper
var_def_latex <- var_def_appendix %>%
select(Variable, Definition, Source) %>%
kable(format = "latex",
caption = "Variable Definitions",
col.names = c("Variable", "Definition", "Data Source"),
booktabs = TRUE,
escape = FALSE,
longtable = TRUE) %>%
kable_styling(latex_options = c("hold_position", "repeat_header"),
font_size = 9) %>%
column_spec(1, width = "3.5cm") %>%
column_spec(2, width = "9cm") %>%
column_spec(3, width = "3cm")
writeLines(var_def_latex, file.path(TABLE_PATH, "Table_A1_Variable_Definitions.tex"))
cat("Saved: Table_A1_Variable_Definitions.tex\n")Saved: Table_A1_Variable_Definitions.tex
2.5 Sample Construction
# ==============================================================================
# APPENDIX TABLE B1: SAMPLE CONSTRUCTION
# ==============================================================================
sample_construction <- tribble(
~Step, ~Description, ~Banks, ~`Obs. Dropped`,
1, "Universe: All FDIC-insured commercial banks (2022Q4)", "4,700", "--",
2, "Less: Banks without Call Report data", "4,650", "50",
3, "Less: G-SIB banks", "4,617", "33",
4, "Less: Failed banks (SVB, Signature, First Republic, Silvergate)", "4,613", "4",
5, "Less: Banks without OMO-eligible securities", "3,850", "763",
6, "Final sample: OMO-eligible non-G-SIB banks", "3,850", "--"
)
sample_construction %>%
kable(format = "html",
caption = "Table: Sample Construction",
col.names = c("Step", "Description", "Banks Remaining", "Observations Dropped")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 10) %>%
footnote(general = c(
"This table describes the sample construction process.",
"OMO-eligible securities include Treasury securities and Agency MBS/debt.",
"G-SIB = Global Systemically Important Bank as designated by the Federal Reserve.",
"Failed banks refer to the four bank failures during the 2023 banking crisis.",
"Final sample used for extensive margin analysis of BTFP/DW usage."
), general_title = "Notes: ", threeparttable = TRUE)| Step | Description | Banks Remaining | Observations Dropped |
|---|---|---|---|
| 1 | Universe: All FDIC-insured commercial banks (2022Q4) | 4,700 | – |
| 2 | Less: Banks without Call Report data | 4,650 | 50 |
| 3 | Less: G-SIB banks | 4,617 | 33 |
| 4 | Less: Failed banks (SVB, Signature, First Republic, Silvergate) | 4,613 | 4 |
| 5 | Less: Banks without OMO-eligible securities | 3,850 | 763 |
| 6 | Final sample: OMO-eligible non-G-SIB banks | 3,850 | – |
| Notes: | |||
| This table describes the sample construction process. | |||
| OMO-eligible securities include Treasury securities and Agency MBS/debt. | |||
| G-SIB = Global Systemically Important Bank as designated by the Federal Reserve. | |||
| Failed banks refer to the four bank failures during the 2023 banking crisis. | |||
| Final sample used for extensive margin analysis of BTFP/DW usage. |
2.6 Period Definitions
# ==============================================================================
# APPENDIX TABLE C1: ANALYSIS PERIOD DEFINITIONS
# ==============================================================================
period_def_appendix <- tribble(
~Period, ~Start, ~End, ~Description, ~Baseline, ~Notes,
"March 10", "2023-03-10", "2023-03-10",
"SVB closure day", "2022Q4",
"Only DW available; BTFP not yet announced",
"March 10-13", "2023-03-10", "2023-03-13",
"BTFP launch window", "2022Q4",
"Includes BTFP announcement (March 12)",
"Acute", "2023-03-13", "2023-05-01",
"Acute crisis period", "2022Q4",
"BTFP operational; ends with First Republic failure",
"Post-Acute", "2023-05-02", "2023-10-31",
"Stabilization period", "2022Q4",
"Crisis subsides; continued BTFP usage",
"Arbitrage", "2023-11-01", "2024-01-24",
"Rate arbitrage period", "2023Q3",
"BTFP rate falls below Fed Funds rate",
"Wind-down", "2024-01-25", "2024-03-11",
"Program wind-down", "2023Q4",
"After Jan 24 rate adjustment; program ends March 11"
)
period_def_appendix %>%
kable(format = "html",
caption = "Table: Analysis Period Definitions",
col.names = c("Period", "Start Date", "End Date", "Description", "Baseline Data", "Notes")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE, font_size = 10) %>%
footnote(general = c(
"This table defines the analysis periods used throughout the paper.",
"Baseline data refers to the Call Report quarter used for bank characteristics.",
"DW data is available through 2023-09-30 only (via FOIA).",
"BTFP rate adjustment on Jan 24, 2024 reduced arbitrage opportunities."
), general_title = "Notes: ", threeparttable = TRUE)| Period | Start Date | End Date | Description | Baseline Data | Notes |
|---|---|---|---|---|---|
| March 10 | 2023-03-10 | 2023-03-10 | SVB closure day | 2022Q4 | Only DW available; BTFP not yet announced |
| March 10-13 | 2023-03-10 | 2023-03-13 | BTFP launch window | 2022Q4 | Includes BTFP announcement (March 12) |
| Acute | 2023-03-13 | 2023-05-01 | Acute crisis period | 2022Q4 | BTFP operational; ends with First Republic failure |
| Post-Acute | 2023-05-02 | 2023-10-31 | Stabilization period | 2022Q4 | Crisis subsides; continued BTFP usage |
| Arbitrage | 2023-11-01 | 2024-01-24 | Rate arbitrage period | 2023Q3 | BTFP rate falls below Fed Funds rate |
| Wind-down | 2024-01-25 | 2024-03-11 | Program wind-down | 2023Q4 | After Jan 24 rate adjustment; program ends March 11 |
| Notes: | |||||
| This table defines the analysis periods used throughout the paper. | |||||
| Baseline data refers to the Call Report quarter used for bank characteristics. | |||||
| DW data is available through 2023-09-30 only (via FOIA). | |||||
| BTFP rate adjustment on Jan 24, 2024 reduced arbitrage opportunities. |
# Save LaTeX
period_latex <- period_def_appendix %>%
kable(format = "latex",
caption = "Analysis Period Definitions",
booktabs = TRUE) %>%
kable_styling(latex_options = c("hold_position", "scale_down"))
writeLines(period_latex, file.path(TABLE_PATH, "Table_C1_Period_Definitions.tex"))2.7 Model Specifications Summary
# ==============================================================================
# MODEL SPECIFICATIONS SUMMARY
# ==============================================================================
model_specs <- tribble(
~Analysis, ~`Dependent Variable`, ~`Key Explanatory`, ~Controls, ~`Fixed Effects`, ~Method,
"Extensive Margin (Base)", "BTFP/DW indicator (0/1)",
"mtm_total + uninsured_lev + mtm_x_uninsured",
"ln_assets, cash_ratio, loan_to_deposit, book_equity_ratio, wholesale, roa",
"None", "LPM (Robust SE)",
"Extensive Margin (Risk)", "BTFP/DW indicator (0/1)",
"run_risk_2 + run_risk_3 + run_risk_4",
"Same as above",
"None", "LPM (Robust SE)",
"DiD: Deposit Stability", "outflow_total_dep or outflow_uninsured",
"did_term (has_omo × post_btfp)",
"mtm_total, uninsured_lev + standard controls",
"Bank + Quarter", "TWFE (Clustered SE)",
"FHLB Temporal", "fhlb_user (0/1)",
"mtm_total + uninsured_lev",
"Standard controls",
"None", "LPM (Robust SE)",
"Deposit Outflows", "BTFP indicator (0/1)",
"mtm_total + uninsured_lev + uninsured_outflow + insured_outflow",
"Standard controls",
"None", "LPM (Robust SE)",
"Multinomial Choice", "facility_choice (5 categories)",
"mtm_total + uninsured_lev + mtm_x_uninsured OR run_risk_2,3,4",
"Standard controls",
"None", "Multinomial Logit",
"Intensive Margin", "btfp_pct (borrowing/assets %)",
"par_benefit + capacity + outflow_z",
"Standard controls",
"None", "OLS / IPW-weighted OLS"
)
model_specs %>%
kable(format = "html", caption = "Table: Model Specifications Summary") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE, font_size = 9) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
column_spec(3, width = "15em") %>%
column_spec(4, width = "15em")| Analysis | Dependent Variable | Key Explanatory | Controls | Fixed Effects | Method |
|---|---|---|---|---|---|
| Extensive Margin (Base) | BTFP/DW indicator (0/1) | mtm_total + uninsured_lev + mtm_x_uninsured | ln_assets, cash_ratio, loan_to_deposit, book_equity_ratio, wholesale, roa | None | LPM (Robust SE) |
| Extensive Margin (Risk) | BTFP/DW indicator (0/1) | run_risk_2 + run_risk_3 + run_risk_4 | Same as above | None | LPM (Robust SE) |
| DiD: Deposit Stability | outflow_total_dep or outflow_uninsured | did_term (has_omo × post_btfp) | mtm_total, uninsured_lev + standard controls | Bank + Quarter | TWFE (Clustered SE) |
| FHLB Temporal | fhlb_user (0/1) | mtm_total + uninsured_lev | Standard controls | None | LPM (Robust SE) |
| Deposit Outflows | BTFP indicator (0/1) | mtm_total + uninsured_lev + uninsured_outflow + insured_outflow | Standard controls | None | LPM (Robust SE) |
| Multinomial Choice | facility_choice (5 categories) | mtm_total + uninsured_lev + mtm_x_uninsured OR run_risk_2,3,4 | Standard controls | None | Multinomial Logit |
| Intensive Margin | btfp_pct (borrowing/assets %) | par_benefit + capacity + outflow_z | Standard controls | None | OLS / IPW-weighted OLS |
save_kable_table(model_specs, "Appendix_Model_Specifications",
"Table: Model Specifications Summary",
"LPM = Linear Probability Model. TWFE = Two-Way Fixed Effects. IPW = Inverse Probability Weighting. All LPM models use heteroskedasticity-robust standard errors. DiD models cluster standard errors by bank. Reference category for run_risk dummies is Risk 1 (Low MTM, Low Uninsured).")Saved: Appendix_Model_Specifications (HTML + LaTeX)
2.8 Load Data
# ==============================================================================
# LOAD DATA
# ==============================================================================
call_q <- read_csv(file.path(DATA_PROC, "final_call_gsib.csv"), show_col_types = FALSE) %>%
mutate(idrssd = as.character(idrssd))
btfp_loans_raw <- read_csv(file.path(DATA_PROC, "btfp_loan_bank_only.csv"), show_col_types = FALSE) %>%
mutate(rssd_id = as.character(rssd_id), btfp_loan_date = mdy(btfp_loan_date))
dw_loans_raw <- read_csv(file.path(DATA_PROC, "dw_loan_bank_2023.csv"), show_col_types = FALSE) %>%
mutate(rssd_id = as.character(rssd_id), dw_loan_date = ymd(dw_loan_date))
cat("=== DATA LOADED ===\n")## === DATA LOADED ===cat("Call Report:", nrow(call_q), "obs |", n_distinct(call_q$idrssd), "banks\n")## Call Report: 75989 obs | 5074 bankscat("BTFP Loans:", nrow(btfp_loans_raw), "| DW Loans:", nrow(dw_loans_raw), "\n")## BTFP Loans: 6734 | DW Loans: 100082.9 Exclude Failed Banks and G-SIBs
# ==============================================================================
# EXCLUDE FAILED BANKS AND G-SIBs
# ==============================================================================
excluded_banks <- call_q %>%
filter(period == BASELINE_MAIN, failed_bank == 1 | gsib == 1) %>%
pull(idrssd)
cat("Excluded banks (failed + G-SIBs):", length(excluded_banks), "\n")## Excluded banks (failed + G-SIBs): 41btfp_loans <- btfp_loans_raw %>% filter(!rssd_id %in% excluded_banks)
dw_loans <- dw_loans_raw %>% filter(!rssd_id %in% excluded_banks)2.10 Create Borrower Indicators by Period
# ==============================================================================
# HELPER FUNCTION: Create Borrower Indicator
# ==============================================================================
create_borrower_indicator <- function(loans_df, date_col, id_col, amount_col,
start_date, end_date, prefix) {
loans_df %>%
filter(!!sym(date_col) >= start_date, !!sym(date_col) <= end_date) %>%
group_by(!!sym(id_col)) %>%
summarise(
"{prefix}" := 1L,
"{prefix}_amt" := sum(!!sym(amount_col), na.rm = TRUE),
"{prefix}_first" := min(!!sym(date_col)),
.groups = "drop"
) %>%
rename(idrssd = !!sym(id_col))
}
# ==============================================================================
# BTFP BORROWERS BY PERIOD
# ==============================================================================
btfp_mar10 <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
DATE_MAR10, DATE_MAR10, "btfp_mar10"
)
btfp_mar10_13 <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
DATE_MAR10, DATE_MAR13, "btfp_mar10_13"
)
btfp_acute <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
ACUTE_START, ACUTE_END, "btfp_acute"
)
btfp_post <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
ACUTE_END + 1, POST_ACUTE_END, "btfp_post"
)
btfp_arb <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
ARB_START, ARB_END, "btfp_arb"
)
btfp_wind <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
WIND_START, WIND_END, "btfp_wind"
)
btfp_overall <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
OVERALL_START, OVERALL_END, "btfp_overall"
)
# ==============================================================================
# DW BORROWERS BY PERIOD
# ==============================================================================
dw_prebtfp <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
DATE_MAR01, DATE_MAR12, "dw_prebtfp"
)
dw_mar10 <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
DATE_MAR10, DATE_MAR10, "dw_mar10"
)
dw_mar10_13 <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
DATE_MAR10, DATE_MAR13, "dw_mar10_13"
)
dw_acute <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
ACUTE_START, min(ACUTE_END, DW_DATA_END), "dw_acute"
)
dw_post <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
ACUTE_END + 1, min(POST_ACUTE_END, DW_DATA_END), "dw_post"
)
dw_overall <- create_borrower_indicator(
dw_loans, "dw_loan_date", "rssd_id", "dw_loan_amount",
OVERALL_START, DW_DATA_END, "dw_overall"
)
cat("\n=== BORROWER COUNTS BY PERIOD ===\n")##
## === BORROWER COUNTS BY PERIOD ===cat("BTFP: Mar10=", nrow(btfp_mar10), "| Mar10-13=", nrow(btfp_mar10_13),
"| Acute=", nrow(btfp_acute), "| Post=", nrow(btfp_post),
"| Arb=", nrow(btfp_arb), "| Wind=", nrow(btfp_wind), "\n")## BTFP: Mar10= 0 | Mar10-13= 3 | Acute= 485 | Post= 811 | Arb= 797 | Wind= 237cat("DW: Pre=", nrow(dw_prebtfp), "| Mar10=", nrow(dw_mar10),
"| Mar10-13=", nrow(dw_mar10_13), "| Acute=", nrow(dw_acute), "\n")## DW: Pre= 106 | Mar10= 50 | Mar10-13= 94 | Acute= 4172.11 Construct Analysis Variables
# ==============================================================================
# FUNCTION: Construct Analysis Variables
# ==============================================================================
construct_analysis_vars <- function(baseline_data) {
baseline_data %>%
mutate(
# ========================================================================
# RAW VARIABLES (original scale)
# ========================================================================
mtm_total_raw = mtm_loss_to_total_asset,
mtm_btfp_raw = mtm_loss_omo_eligible_to_total_asset,
mtm_other_raw = mtm_loss_non_omo_eligible_to_total_asset,
uninsured_lev_raw = uninsured_deposit_to_total_asset,
uninsured_share_raw = uninsured_to_deposit,
mv_asset = mm_asset,
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
securities_ratio_raw = security_to_total_asset,
loan_ratio_raw = total_loan_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
tier1_ratio_raw = tier1cap_to_total_asset,
roa_raw = roa,
fhlb_ratio_raw = fhlb_to_total_asset,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(
fed_fund_purchase + repo + replace_na(other_borrowed_less_than_1yr, 0),
total_liability, 0
) * 100,
# Deposit outflows
uninsured_outflow_raw = change_uninsured_fwd_q,
insured_outflow_raw = change_insured_deposit_fwd_q,
total_outflow_raw = change_total_deposit_fwd_q,
# Jiang et al. insolvency measures
adjusted_equity_raw = book_equity_to_total_asset - mtm_loss_to_total_asset,
mv_adjustment_raw = if_else(mv_asset == 0 | is.na(mv_asset), NA_real_, (total_asset / mv_asset) - 1),
idcr_1_raw = safe_div(mv_asset - 0.5 * uninsured_deposit - insured_deposit, insured_deposit),
idcr_2_raw = safe_div(mv_asset - 1.0 * uninsured_deposit - insured_deposit, insured_deposit),
insolvency_1_raw = safe_div((total_asset - total_liability) - 0.5 * uninsured_deposit * mv_adjustment_raw, total_asset),
insolvency_2_raw = safe_div((total_asset - total_liability) - 1.0 * uninsured_deposit * mv_adjustment_raw, total_asset),
# ========================================================================
# WINSORIZED VARIABLES (for outlier control)
# ========================================================================
mtm_total_w = winsorize(mtm_total_raw),
mtm_btfp_w = winsorize(mtm_btfp_raw),
mtm_other_w = winsorize(mtm_other_raw),
uninsured_lev_w = winsorize(uninsured_lev_raw),
uninsured_share_w = winsorize(uninsured_share_raw),
ln_assets_w = winsorize(ln_assets_raw),
cash_ratio_w = winsorize(cash_ratio_raw),
securities_ratio_w = winsorize(securities_ratio_raw),
loan_ratio_w = winsorize(loan_ratio_raw),
book_equity_ratio_w = winsorize(book_equity_ratio_raw),
tier1_ratio_w = winsorize(tier1_ratio_raw),
roa_w = winsorize(roa_raw),
fhlb_ratio_w = winsorize(fhlb_ratio_raw),
loan_to_deposit_w = winsorize(loan_to_deposit_raw),
wholesale_w = winsorize(wholesale_raw),
# ========================================================================
# Z-SCORE STANDARDIZED VARIABLES (for economic interpretation)
# ========================================================================
mtm_total = standardize_z(mtm_total_w),
mtm_btfp = standardize_z(mtm_btfp_w),
mtm_other = standardize_z(mtm_other_w),
uninsured_lev = standardize_z(uninsured_lev_w),
uninsured_share = standardize_z(uninsured_share_w),
# Interaction term (standardized)
mtm_x_uninsured = mtm_total * uninsured_lev,
# Controls (standardized)
ln_assets = standardize_z(ln_assets_w),
cash_ratio = standardize_z(cash_ratio_w),
securities_ratio = standardize_z(securities_ratio_w),
loan_ratio = standardize_z(loan_ratio_w),
book_equity_ratio = standardize_z(book_equity_ratio_w),
tier1_ratio = standardize_z(tier1_ratio_w),
roa = standardize_z(roa_w),
fhlb_ratio = standardize_z(fhlb_ratio_w),
loan_to_deposit = standardize_z(loan_to_deposit_w),
wholesale = standardize_z(wholesale_w),
# Deposit outflows
uninsured_outflow = standardize_z(winsorize(uninsured_outflow_raw)),
insured_outflow = standardize_z(winsorize(insured_outflow_raw)),
total_outflow = standardize_z(winsorize(total_outflow_raw)),
# Jiang et al. measures (winsorized)
adjusted_equity = winsorize(adjusted_equity_raw),
mv_adjustment = winsorize(mv_adjustment_raw),
idcr_1 = winsorize(idcr_1_raw),
idcr_2 = winsorize(idcr_2_raw),
insolvency_1 = winsorize(insolvency_1_raw),
insolvency_2 = winsorize(insolvency_2_raw),
# Insolvency indicators
mtm_insolvent = as.integer(adjusted_equity < 0),
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),
# High/Low indicators
high_uninsured = as.integer(uninsured_lev > median(uninsured_lev, na.rm = TRUE)),
high_mtm_loss = as.integer(mtm_total > median(mtm_total, na.rm = TRUE)),
# Size category
size_cat = factor(create_size_category_3(total_asset), levels = size_levels_3),
# State for clustering
state = if("state" %in% names(.)) state else NA_character_,
fed_district = if("fed_district" %in% names(.)) fed_district else NA_character_
)
}
# ==============================================================================
# FUNCTION: Add Run Risk Dummies (based on medians)
# ==============================================================================
add_run_risk_dummies <- function(data) {
medians <- data %>%
summarise(
median_mtm = median(mtm_total_w, na.rm = TRUE),
median_uninsured = median(uninsured_lev_w, na.rm = TRUE)
)
data %>%
mutate(
# Run Risk Dummies (based on WINSORIZED values before standardization)
# Risk 1: Low MTM & Low Uninsured (Reference Category)
# Risk 2: Low MTM & High Uninsured
# Risk 3: High MTM & Low Uninsured
# Risk 4: High MTM & High Uninsured
# Risk 4: High MTM & High Uninsured (Insolvent & IlliquidE)
run_risk_1 = as.integer(mtm_total_w < medians$median_mtm & uninsured_lev_w < medians$median_uninsured),
run_risk_2 = as.integer(mtm_total_w < medians$median_mtm & uninsured_lev_w >= medians$median_uninsured),
run_risk_3 = as.integer(mtm_total_w >= medians$median_mtm & uninsured_lev_w < medians$median_uninsured),
run_risk_4 = as.integer(mtm_total_w >= medians$median_mtm & uninsured_lev_w >= medians$median_uninsured),
# Store medians for reference
median_mtm_used = medians$median_mtm,
median_uninsured_used = medians$median_uninsured
)
}
# ==============================================================================
# CREATE BASELINE DATASETS
# ==============================================================================
# Baseline sample (2022Q4, OMO-eligible only for main analysis)
df_2022q4 <- call_q %>%
filter(period == BASELINE_MAIN, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
construct_analysis_vars() %>%
add_run_risk_dummies()
df_2023q3 <- call_q %>%
filter(period == BASELINE_ARB, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
construct_analysis_vars() %>%
add_run_risk_dummies()
df_2023q4 <- call_q %>%
filter(period == BASELINE_WIND, !idrssd %in% excluded_banks,
!is.na(omo_eligible) & omo_eligible > 0) %>%
construct_analysis_vars() %>%
add_run_risk_dummies()
cat("\n=== BASELINE DATASETS ===\n")##
## === BASELINE DATASETS ===cat("2022Q4:", nrow(df_2022q4), "banks\n")## 2022Q4: 4292 bankscat("2023Q3:", nrow(df_2023q3), "banks\n")## 2023Q3: 4214 bankscat("2023Q4:", nrow(df_2023q4), "banks\n")## 2023Q4: 4197 bankscat("\n=== RUN RISK MEDIANS (2022Q4) ===\n")##
## === RUN RISK MEDIANS (2022Q4) ===cat("Median MTM Loss (winsorized):", round(df_2022q4$median_mtm_used[1], 4), "%\n")## Median MTM Loss (winsorized): 5.32 %cat("Median Uninsured Leverage (winsorized):", round(df_2022q4$median_uninsured_used[1], 4), "%\n")## Median Uninsured Leverage (winsorized): 22.25 %2.12 Join Borrower Indicators and Create Clean Samples
# ==============================================================================
# CRITICAL: CLEAN SAMPLE CONSTRUCTION
# For binary outcomes: 0 = PURE NON-BORROWERS ONLY
# Exclude other facility users from the 0 category
# ==============================================================================
# Join all borrower indicators to baseline
join_all_borrowers <- function(df_acute, btfp_df, dw_df, btfp_var, dw_var) {
df_acute %>%
left_join(btfp_df %>% select(idrssd, starts_with(btfp_var)), by = "idrssd") %>%
left_join(dw_df %>% select(idrssd, starts_with(dw_var)), by = "idrssd") %>%
mutate(
# Fill NAs with 0
"{btfp_var}" := replace_na(!!sym(btfp_var), 0L),
"{dw_var}" := replace_na(!!sym(dw_var), 0L),
# FHLB user (from call report)
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
# User group classification (for descriptive tables)
user_group = case_when(
!!sym(btfp_var) == 1 & !!sym(dw_var) == 1 ~ "Both",
!!sym(btfp_var) == 1 & !!sym(dw_var) == 0 ~ "BTFP_Only",
!!sym(btfp_var) == 0 & !!sym(dw_var) == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
user_group = factor(user_group, levels = c("Neither", "BTFP_Only", "DW_Only", "Both")),
# Combined indicators
any_fed = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1),
both_fed = as.integer(!!sym(btfp_var) == 1 & !!sym(dw_var) == 1),
all_user = as.integer(!!sym(btfp_var) == 1 | !!sym(dw_var) == 1 | fhlb_user == 1),
# PURE non-user (no BTFP, no DW, no FHLB) - for clean comparison
non_user = as.integer(!!sym(btfp_var) == 0 & !!sym(dw_var) == 0 & fhlb_user == 0)
)
}
# ==============================================================================
# CREATE PERIOD DATASETS
# ==============================================================================
# Acute Period (Mar 13 - May 1, 2023)
df_acute <- join_all_borrowers(df_2022q4, btfp_acute, dw_acute, "btfp_acute", "dw_acute") %>%
mutate(
# Intensive margin variables
btfp_pct = ifelse(btfp_acute == 1 & btfp_acute_amt > 0,
100 * btfp_acute_amt / (total_asset * 1000), NA_real_),
dw_pct = ifelse(dw_acute == 1 & dw_acute_amt > 0,
100 * dw_acute_amt / (total_asset * 1000), NA_real_),
log_btfp_amt = ifelse(btfp_acute == 1 & btfp_acute_amt > 0, log(btfp_acute_amt), NA_real_),
log_dw_amt = ifelse(dw_acute == 1 & dw_acute_amt > 0, log(dw_acute_amt), NA_real_)
)
# March 10 (SVB Closure Day)
df_mar10 <- join_all_borrowers(df_2022q4, btfp_mar10, dw_mar10, "btfp_mar10", "dw_mar10")
# March 10-13 (BTFP Launch Window)
df_mar10_13 <- join_all_borrowers(df_2022q4, btfp_mar10_13, dw_mar10_13, "btfp_mar10_13", "dw_mar10_13")
# Pre-BTFP (Mar 1 - Mar 12)
btfp_prebtfp <- create_borrower_indicator(
btfp_loans, "btfp_loan_date", "rssd_id", "btfp_loan_amount",
DATE_MAR01, DATE_MAR12, "btfp_prebtfp"
)
df_prebtfp <- join_all_borrowers(df_2022q4, btfp_prebtfp, dw_prebtfp, "btfp_prebtfp", "dw_prebtfp")
# Post-Acute Period (May 2 - Oct 31, 2023)
df_post <- df_2022q4 %>%
left_join(btfp_post %>% select(idrssd, btfp_post, btfp_post_amt), by = "idrssd") %>%
left_join(dw_post %>% select(idrssd, dw_post, dw_post_amt), by = "idrssd") %>%
mutate(
btfp_post = replace_na(btfp_post, 0L),
dw_post = replace_na(dw_post, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = as.integer(btfp_post == 1 | dw_post == 1),
non_user = as.integer(btfp_post == 0 & dw_post == 0 & fhlb_user == 0),
user_group = case_when(
btfp_post == 1 & dw_post == 1 ~ "Both",
btfp_post == 1 ~ "BTFP_Only",
dw_post == 1 ~ "DW_Only",
TRUE ~ "Neither"
),
user_group = factor(user_group, levels = c("Neither", "BTFP_Only", "DW_Only", "Both"))
)
# Arbitrage Period (Nov 1, 2023 - Jan 24, 2024) - 2023Q3 Baseline
df_arb <- df_2023q3 %>%
left_join(btfp_arb %>% select(idrssd, btfp_arb, btfp_arb_amt), by = "idrssd") %>%
mutate(
btfp_arb = replace_na(btfp_arb, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = btfp_arb,
non_user = as.integer(btfp_arb == 0 & fhlb_user == 0),
user_group = factor(ifelse(btfp_arb == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both"))
)
# Wind-down Period (Jan 25 - Mar 11, 2024) - 2023Q4 Baseline
df_wind <- df_2023q4 %>%
left_join(btfp_wind %>% select(idrssd, btfp_wind, btfp_wind_amt), by = "idrssd") %>%
mutate(
btfp_wind = replace_na(btfp_wind, 0L),
fhlb_user = as.integer(abnormal_fhlb_borrowing_10pct == 1),
any_fed = btfp_wind,
non_user = as.integer(btfp_wind == 0 & fhlb_user == 0),
user_group = factor(ifelse(btfp_wind == 1, "BTFP_Only", "Neither"),
levels = c("Neither", "BTFP_Only", "DW_Only", "Both"))
)
# Overall Period
df_overall <- join_all_borrowers(df_2022q4, btfp_overall, dw_overall, "btfp_overall", "dw_overall")
cat("\n=== USER GROUP COUNTS (ACUTE PERIOD) ===\n")##
## === USER GROUP COUNTS (ACUTE PERIOD) ===print(table(df_acute$user_group))##
## Neither BTFP_Only DW_Only Both
## 3531 368 299 94cat("\nPure Non-Users:", sum(df_acute$non_user), "\n")##
## Pure Non-Users: 32852.13 Model Setup
# ==============================================================================
# MODEL SETTINGS (DEFINE ONCE, USE EVERYWHERE)
# ==============================================================================
# Standard Controls (Z-score standardized)
CONTROLS <- "ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa"
# Coefficient Labels for Output
COEF_MAP <- c(
# Key explanatory (standardized - interpret as 1 SD change)
"mtm_total" = "MTM Loss (z)",
"mtm_btfp" = "MTM Loss OMO (z)",
"uninsured_lev" = "Uninsured Lev (z)",
"mtm_x_uninsured" = "MTM × Uninsured",
"mtm_total:uninsured_lev" = "MTM × Uninsured",
"mtm_btfp:uninsured_lev" = "MTM_btfp × Uninsured Lev",
# Run Risk dummies (Reference = Risk 1: Low MTM, Low Uninsured)
"run_risk_1" = "Risk 1: $<$ Med MTM \\& $<$ Med Uninsured",
"run_risk_2" = "Risk 2: $<$ Med MTM \\& $>$ Med Uninsured",
"run_risk_3" = "Risk 3: $>$ Med MTM \\& $<$ Med Uninsured",
"run_risk_4" = "Risk 4: $>$ Med MTM \\& $>$ Med Uninsured",
# Controls (standardized)
"ln_assets" = "Log(Assets) (z)",
"cash_ratio" = "Cash Ratio (z)",
"loan_to_deposit" = "Loan/Deposit (z)",
"book_equity_ratio" = "Book Equity (z)",
"wholesale" = "Wholesale (z)",
"roa" = "ROA (z)"
)
# Helper Function: Build formula dynamically
build_formula <- function(dv, explanatory, controls = CONTROLS) {
as.formula(paste(dv, "~", explanatory, "+", controls))
}
# GOF statistics
gof_lpm <- c("nobs", "r.squared", "adj.r.squared")
gof_logit <- c("nobs", "logLik", "AIC")3 DESCRIPTIVE STATISTICS
3.1 Table : Summary Statistics (Correct Format)
# ==============================================================================
# Uses RAW variables (not winsorized or standardized)
# ==============================================================================
# Define the RAW variables to report (original scale, interpretable units)
desc_vars_raw <- c(
# Key Explanatory Variables (RAW)
"mtm_total_raw",
"mtm_btfp_raw",
"uninsured_lev_raw",
"uninsured_share_raw",
# Size and Structure
"total_asset", # Keep in thousands for consistent reporting
"ln_assets_raw",
# Liquidity
"cash_ratio_raw",
"securities_ratio_raw",
# Loans and Funding
"loan_ratio_raw",
"loan_to_deposit_raw",
"wholesale_raw",
"fhlb_ratio_raw",
# Capital and Profitability
"book_equity_ratio_raw",
"tier1_ratio_raw",
"roa_raw"
)
# Variable labels for RAW (interpretable) variables
var_labels_desc <- c(
"mtm_total_raw" = "MTM Loss / Total Assets (%)",
"mtm_btfp_raw" = "MTM Loss (OMO-Eligible) / Total Assets (%)",
"uninsured_lev_raw" = "Uninsured Deposits / Total Assets (%)",
"uninsured_share_raw" = "Uninsured Deposits / Total Deposits (%)",
"total_asset" = "Total Assets ($ thousands)",
"ln_assets_raw" = "Log(Total Assets)",
"cash_ratio_raw" = "Cash / Total Assets (%)",
"securities_ratio_raw" = "Securities / Total Assets (%)",
"loan_ratio_raw" = "Loans / Total Assets (%)",
"loan_to_deposit_raw" = "Loans / Deposits (%)",
"wholesale_raw" = "Wholesale Funding / Total Liabilities (%)",
"fhlb_ratio_raw" = "FHLB Advances / Total Assets (%)",
"book_equity_ratio_raw" = "Book Equity / Total Assets (%)",
"tier1_ratio_raw" = "Tier 1 Capital / Total Assets (%)",
"roa_raw" = "Return on Assets (%)"
)
# Function to create proper descriptive statistics
create_desc_stats_journal <- function(data, vars, var_labels) {
stats_list <- map_dfr(vars, function(v) {
# Skip if variable doesn't exist
if (!v %in% names(data)) {
return(NULL)
}
x <- data[[v]]
x <- x[!is.na(x) & is.finite(x)]
if (length(x) == 0) return(NULL)
tibble(
Variable = ifelse(v %in% names(var_labels), var_labels[[v]], v),
N = length(x),
Mean = mean(x),
SD = sd(x),
P10 = quantile(x, 0.10),
P25 = quantile(x, 0.25),
Median = quantile(x, 0.50),
P75 = quantile(x, 0.75),
P90 = quantile(x, 0.90)
)
})
return(stats_list)
}
# Aliases so later chunks work
desc_vars <- desc_vars_raw
var_labels_raw <- var_labels_desc
# Create the summary statistics table for 2022Q4 baseline
desc_2022q4_corrected <- create_desc_stats_journal(df_2022q4, desc_vars_raw, var_labels_desc)
# Format and display
desc_2022q4_corrected %>%
mutate(
# Format large numbers with commas, small numbers with decimals
across(where(is.numeric) & !matches("^N$"),
~ifelse(abs(.) > 1000,
format(round(., 0), big.mark = ",", scientific = FALSE),
format(round(., 3), nsmall = 3)))
) %>%
kable(format = "html",
caption = "Table 1: Summary Statistics (2022Q4 Baseline)",
col.names = c("Variable", "N", "Mean", "Std. Dev.", "P10", "P25", "Median", "P75", "P90"),
align = c("l", rep("r", 8))) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 10) %>%
pack_rows("Panel A: Key Explanatory Variables", 1, 4) %>%
pack_rows("Panel B: Size", 5, 6) %>%
pack_rows("Panel C: Liquidity and Securities", 7, 8) %>%
pack_rows("Panel D: Loans and Funding", 9, 12) %>%
pack_rows("Panel E: Capital and Profitability", 13, 15) %>%
footnote(general = paste(
"This table reports summary statistics for the baseline sample of OMO-eligible banks as of 2022Q4.",
"The sample excludes G-SIB banks and failed banks (SVB, Signature, First Republic, Silvergate).",
"OMO-eligible assets refer to securities eligible for purchase by the Federal Reserve in Open Market Operations (e.g., U.S. Treasuries, Agency debt, and Agency MBS); under the Bank Term Funding Program (BTFP), these assets were eligible to be pledged as collateral at par value (face value).",
"All variables are reported in their original (raw) scale.",
"MTM Loss variables represent unrealized mark-to-market losses on securities holdings scaled by total assets.",
"Total Assets are in thousands of dollars."
), general_title = "Notes: ", threeparttable = TRUE)| Variable | N | Mean | Std. Dev. | P10 | P25 | Median | P75 | P90 |
|---|---|---|---|---|---|---|---|---|
| Panel A: Key Explanatory Variables | ||||||||
| MTM Loss / Total Assets (%) | 4282 | 5.467 | 2.223 | 2.791 | 3.863 | 5.320 | 6.975 | 8.455 |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 4282 | 0.681 | 0.848 | 0.016 | 0.136 | 0.405 | 0.932 | 1.706 |
| Uninsured Deposits / Total Assets (%) | 4292 | 23.611 | 12.158 | 9.604 | 15.285 | 22.247 | 30.353 | 39.278 |
| Uninsured Deposits / Total Deposits (%) | 4292 | 27.595 | 14.258 | 11.388 | 17.867 | 25.801 | 35.108 | 46.042 |
| Panel B: Size | ||||||||
| Total Assets ($ thousands) | 4292 | 2,617,205 | 20,350,192 | 73,831 | 147,641 | 334,806 | 847,713 | 2,444,123 |
| Log(Total Assets) | 4292 | 12.882 | 1.483 | 11.210 | 11.903 | 12.721 | 13.650 | 14.709 |
| Panel C: Liquidity and Securities | ||||||||
| Cash / Total Assets (%) | 4292 | 8.148 | 9.191 | 1.712 | 2.667 | 5.030 | 10.051 | 18.015 |
| Securities / Total Assets (%) | 4292 | 25.681 | 15.784 | 7.079 | 13.704 | 23.323 | 35.090 | 46.765 |
| Panel D: Loans and Funding | ||||||||
| Loans / Total Assets (%) | 4292 | 59.990 | 17.654 | 36.254 | 49.604 | 62.303 | 73.421 | 80.308 |
| Loans / Deposits (%) | 4292 | 70.866 | 27.432 | 40.909 | 56.561 | 71.818 | 86.500 | 97.535 |
| Wholesale Funding / Total Liabilities (%) | 4292 | 1.000 | 3.166 | 0.000 | 0.000 | 0.000 | 0.533 | 3.058 |
| FHLB Advances / Total Assets (%) | 4292 | 2.647 | 4.215 | 0.000 | 0.000 | 0.346 | 4.073 | 7.987 |
| Panel E: Capital and Profitability | ||||||||
| Book Equity / Total Assets (%) | 4292 | 10.220 | 8.817 | 5.452 | 7.143 | 8.842 | 10.888 | 14.114 |
| Tier 1 Capital / Total Assets (%) | 4292 | 11.844 | 8.212 | 8.284 | 9.085 | 10.197 | 11.959 | 15.122 |
| Return on Assets (%) | 4292 | 1.163 | 2.569 | 0.401 | 0.704 | 1.014 | 1.319 | 1.680 |
| Notes: | ||||||||
| This table reports summary statistics for the baseline sample of OMO-eligible banks as of 2022Q4. The sample excludes G-SIB banks and failed banks (SVB, Signature, First Republic, Silvergate). OMO-eligible assets refer to securities eligible for purchase by the Federal Reserve in Open Market Operations (e.g., U.S. Treasuries, Agency debt, and Agency MBS); under the Bank Term Funding Program (BTFP), these assets were eligible to be pledged as collateral at par value (face value). All variables are reported in their original (raw) scale. MTM Loss variables represent unrealized mark-to-market losses on securities holdings scaled by total assets. Total Assets are in thousands of dollars. | ||||||||
# Save LaTeX version
desc_latex <- desc_2022q4_corrected %>%
mutate(across(where(is.numeric), ~round(., 3))) %>%
kable(format = "latex",
caption = "Summary Statistics (2022Q4 Baseline)",
col.names = c("Variable", "N", "Mean", "Std. Dev.", "P10", "P25", "Median", "P75", "P90"),
booktabs = TRUE,
align = c("l", rep("r", 8))) %>%
kable_styling(latex_options = c("hold_position", "scale_down"),
font_size = 9) %>%
footnote(general = "Sample: OMO-eligible banks excluding G-SIBs and failed banks. Variables in original scale.",
general_title = "Notes: ", threeparttable = TRUE)
writeLines(desc_latex, file.path(TABLE_PATH, "Table_1_Summary_Statistics.tex"))
cat("Saved: Table_1_Summary_Statistics.tex\n")Saved: Table_1_Summary_Statistics.tex
3.2 Table 2: Summary Statistics by User Group
# ==============================================================================
# USER GROUP COMPARISON TABLE - RAW VARIABLES
# ==============================================================================
create_user_group_table_corrected <- function(data, period_name, comparison_vars, var_labels) {
# Get group counts
group_counts <- data %>%
group_by(user_group) %>%
summarise(N = n(), .groups = "drop") %>%
arrange(user_group)
groups <- as.character(group_counts$user_group)
# Calculate stats for each variable and group
results <- map_dfr(comparison_vars, function(v) {
if (!v %in% names(data)) return(NULL)
var_label <- ifelse(v %in% names(var_labels), var_labels[[v]], v)
row_data <- tibble(Variable = var_label)
for (g in groups) {
x <- data %>% filter(user_group == g) %>% pull(!!sym(v))
x <- x[!is.na(x) & is.finite(x)]
if (length(x) > 0) {
row_data[[paste0(g, "_Mean")]] <- mean(x)
row_data[[paste0(g, "_SD")]] <- sd(x)
} else {
row_data[[paste0(g, "_Mean")]] <- NA_real_
row_data[[paste0(g, "_SD")]] <- NA_real_
}
}
# T-test: All Users vs Neither
if ("Neither" %in% groups) {
x_neither <- data %>% filter(user_group == "Neither") %>% pull(!!sym(v))
x_users <- data %>% filter(user_group != "Neither") %>% pull(!!sym(v))
x_neither <- x_neither[!is.na(x_neither) & is.finite(x_neither)]
x_users <- x_users[!is.na(x_users) & is.finite(x_users)]
if (length(x_neither) > 1 && length(x_users) > 1) {
ttest <- t.test(x_users, x_neither)
row_data$Diff <- mean(x_users) - mean(x_neither)
row_data$T_Stat <- as.numeric(ttest$statistic)
row_data$P_Value <- as.numeric(ttest$p.value)
row_data$Sig <- format_pval(row_data$P_Value)
}
}
return(row_data)
})
return(list(results = results, group_counts = group_counts))
}
# Create table for acute period using RAW variables
tbl_acute <- create_user_group_table_corrected(
df_acute,
"Acute Period (Mar 13 - May 1, 2023)",
desc_vars_raw,
var_labels_desc
)
# Display
tbl_acute$results %>%
mutate(across(where(is.numeric), ~round(., 3))) %>%
kable(format = "html",
caption = "Table 2: Bank Characteristics by Facility Usage (Acute Period)",
col.names = c("Variable",
"Mean", "SD", "Mean", "SD", "Mean", "SD", "Mean", "SD",
"Diff", "t-stat", "p-value", "")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE, font_size = 9) %>%
add_header_above(c(" " = 1,
"Neither" = 2, "BTFP Only" = 2, "DW Only" = 2, "Both" = 2,
"Users vs Non-Users" = 4)) %>%
footnote(general = c(
"This table compares bank characteristics across facility user groups during the acute crisis period.",
"Neither = banks that did not access BTFP, DW, or FHLB; BTFP_Only = BTFP users only;",
"DW_Only = Discount Window users only; Both = used both BTFP and DW.",
"Diff = mean difference between all facility users and non-users.",
"Significance levels: *** p<0.01, ** p<0.05, * p<0.10."
), general_title = "Notes: ", threeparttable = TRUE)| Variable | Mean | SD | Mean | SD | Mean | SD | Mean | SD | Diff | t-stat | p-value | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| MTM Loss / Total Assets (%) | 5.358 | 2.255 | 6.180 | 1.996 | 5.748 | 2.007 | 5.864 | 1.847 | 0.613 | 7.515 | 0.000 | *** |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 0.649 | 0.823 | 0.884 | 1.012 | 0.741 | 0.830 | 0.916 | 0.959 | 0.183 | 4.990 | 0.000 | *** |
| Uninsured Deposits / Total Assets (%) | 22.827 | 12.045 | 26.205 | 11.528 | 26.847 | 11.503 | 32.635 | 14.116 | 4.425 | 9.203 | 0.000 | *** |
| Uninsured Deposits / Total Deposits (%) | 26.654 | 14.114 | 30.619 | 13.414 | 31.580 | 13.597 | 38.415 | 16.616 | 5.305 | 9.405 | 0.000 | *** |
| Total Assets ($ thousands) | 1881481.138 | 16032224.247 | 5420631.872 | 34838553.603 | 5521943.913 | 34441253.995 | 10039151.160 | 25033435.689 | 4149443.919 | 3.324 | 0.001 | *** |
| Log(Total Assets) | 12.688 | 1.401 | 13.537 | 1.441 | 13.848 | 1.465 | 14.552 | 1.723 | 1.097 | 18.299 | 0.000 | *** |
| Cash / Total Assets (%) | 8.767 | 9.685 | 4.695 | 4.597 | 6.161 | 6.592 | 4.719 | 5.327 | -3.493 | -13.435 | 0.000 | *** |
| Securities / Total Assets (%) | 25.500 | 16.092 | 28.272 | 13.781 | 23.956 | 14.302 | 27.803 | 14.809 | 1.019 | 1.747 | 0.081 |
|
| Loans / Total Assets (%) | 59.474 | 18.176 | 61.338 | 14.104 | 63.834 | 15.442 | 61.845 | 14.972 | 2.907 | 4.713 | 0.000 | *** |
| Loans / Deposits (%) | 70.197 | 28.727 | 72.462 | 19.162 | 75.830 | 21.188 | 73.941 | 19.846 | 3.771 | 4.312 | 0.000 | *** |
| Wholesale Funding / Total Liabilities (%) | 0.877 | 3.056 | 1.518 | 3.387 | 1.562 | 3.973 | 1.822 | 2.969 | 0.696 | 4.986 | 0.000 | *** |
| FHLB Advances / Total Assets (%) | 2.420 | 4.052 | 3.953 | 4.649 | 3.252 | 4.411 | 4.147 | 6.068 | 1.282 | 6.902 | 0.000 | *** |
| Book Equity / Total Assets (%) | 10.587 | 9.572 | 8.177 | 3.092 | 9.046 | 3.223 | 8.194 | 2.678 | -2.066 | -10.496 | 0.000 | *** |
| Tier 1 Capital / Total Assets (%) | 12.180 | 8.950 | 10.314 | 2.318 | 10.461 | 2.652 | 9.620 | 1.582 | -1.894 | -10.896 | 0.000 | *** |
| Return on Assets (%) | 1.177 | 2.819 | 1.064 | 0.543 | 1.140 | 0.649 | 1.097 | 0.561 | -0.080 | -1.531 | 0.126 | |
| Notes: | ||||||||||||
| This table compares bank characteristics across facility user groups during the acute crisis period. | ||||||||||||
| Neither = banks that did not access BTFP, DW, or FHLB; BTFP_Only = BTFP users only; | ||||||||||||
| DW_Only = Discount Window users only; Both = used both BTFP and DW. | ||||||||||||
| Diff = mean difference between all facility users and non-users. | ||||||||||||
| Significance levels: *** p<0.01, ** p<0.05, * p<0.10. |
3.3 Table: Summary Statistics (2023Q3 Baseline - Arbitrage)
# Create stats using the JOURNAL format function and RAW variables
desc_2023q3 <- create_desc_stats_journal(df_2023q3, desc_vars_raw, var_labels_desc)
# Display Table
desc_2023q3 %>%
mutate(across(where(is.numeric) & !matches("^N$"),
~ifelse(abs(.) > 1000,
format(round(., 0), big.mark = ",", scientific = FALSE),
format(round(., 3), nsmall = 3)))) %>%
kable(format = "html",
caption = "Table 1B: Summary Statistics (2023Q3 Baseline - Arbitrage)",
col.names = c("Variable", "N", "Mean", "Std. Dev.", "P10", "P25", "Median", "P75", "P90"),
align = c("l", rep("r", 8))) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 10) %>%
pack_rows("Panel A: Key Explanatory Variables", 1, 4) %>%
pack_rows("Panel B: Size", 5, 6) %>%
pack_rows("Panel C: Liquidity and Securities", 7, 8) %>%
pack_rows("Panel D: Loans and Funding", 9, 12) %>%
pack_rows("Panel E: Capital and Profitability", 13, 15)| Variable | N | Mean | Std. Dev. | P10 | P25 | Median | P75 | P90 |
|---|---|---|---|---|---|---|---|---|
| Panel A: Key Explanatory Variables | ||||||||
| MTM Loss / Total Assets (%) | 4197 | 5.386 | 2.210 | 2.670 | 3.759 | 5.224 | 6.905 | 8.361 |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 4197 | 0.672 | 0.823 | 0.013 | 0.128 | 0.395 | 0.920 | 1.709 |
| Uninsured Deposits / Total Assets (%) | 4214 | 21.206 | 11.142 | 8.496 | 13.550 | 19.877 | 27.236 | 35.433 |
| Uninsured Deposits / Total Deposits (%) | 4214 | 25.223 | 13.240 | 10.471 | 16.159 | 23.638 | 32.087 | 42.118 |
| Panel B: Size | ||||||||
| Total Assets ($ thousands) | 4214 | 2,747,281 | 21,374,717 | 75,344 | 150,770 | 344,286 | 868,116 | 2,576,949 |
| Log(Total Assets) | 4214 | 12.912 | 1.491 | 11.230 | 11.924 | 12.749 | 13.674 | 14.762 |
| Panel C: Liquidity and Securities | ||||||||
| Cash / Total Assets (%) | 4214 | 7.811 | 8.473 | 1.720 | 2.742 | 5.148 | 9.633 | 16.393 |
| Securities / Total Assets (%) | 4214 | 23.733 | 15.088 | 6.318 | 12.542 | 21.276 | 32.294 | 44.027 |
| Panel D: Loans and Funding | ||||||||
| Loans / Total Assets (%) | 4214 | 62.131 | 17.242 | 39.294 | 52.990 | 65.032 | 74.991 | 80.900 |
| Loans / Deposits (%) | 4214 | 74.255 | 23.705 | 44.588 | 61.302 | 76.806 | 89.898 | 99.183 |
| Wholesale Funding / Total Liabilities (%) | 4214 | 1.628 | 3.721 | 0.000 | 0.000 | 0.000 | 1.655 | 5.570 |
| FHLB Advances / Total Assets (%) | 4214 | 3.127 | 4.515 | 0.000 | 0.000 | 1.105 | 4.927 | 8.891 |
| Panel E: Capital and Profitability | ||||||||
| Book Equity / Total Assets (%) | 4214 | 10.409 | 9.095 | 5.407 | 7.170 | 8.995 | 11.131 | 14.393 |
| Tier 1 Capital / Total Assets (%) | 4214 | 12.280 | 8.352 | 8.522 | 9.345 | 10.572 | 12.554 | 15.633 |
| Return on Assets (%) | 4214 | 1.221 | 2.482 | 0.291 | 0.630 | 0.996 | 1.443 | 1.982 |
# Save LaTeX version
save_kable_table(desc_2023q3 %>% mutate(across(where(is.numeric), ~round(., 3))),
"Table_1B_Summary_Stats_2023Q3_Corrected",
"Table 1B: Summary Statistics (2023Q3 Baseline)",
"Sample: OMO-eligible banks in 2023Q3. Variables in raw scale.")Saved: Table_1B_Summary_Stats_2023Q3_Corrected (HTML + LaTeX)
3.4 Table: Summary Statistics (2023Q4 Baseline - Wind-down)
# Create stats using the JOURNAL format function and RAW variables
desc_2023q4 <- create_desc_stats_journal(df_2023q4, desc_vars_raw, var_labels_desc)
# Display Table
desc_2023q4 %>%
mutate(across(where(is.numeric) & !matches("^N$"),
~ifelse(abs(.) > 1000,
format(round(., 0), big.mark = ",", scientific = FALSE),
format(round(., 3), nsmall = 3)))) %>%
kable(format = "html",
caption = "Table 1C: Summary Statistics (2023Q4 Baseline - Wind-down)",
col.names = c("Variable", "N", "Mean", "Std. Dev.", "P10", "P25", "Median", "P75", "P90"),
align = c("l", rep("r", 8))) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 10) %>%
pack_rows("Panel A: Key Explanatory Variables", 1, 4) %>%
pack_rows("Panel B: Size", 5, 6) %>%
pack_rows("Panel C: Liquidity and Securities", 7, 8) %>%
pack_rows("Panel D: Loans and Funding", 9, 12) %>%
pack_rows("Panel E: Capital and Profitability", 13, 15)| Variable | N | Mean | Std. Dev. | P10 | P25 | Median | P75 | P90 |
|---|---|---|---|---|---|---|---|---|
| Panel A: Key Explanatory Variables | ||||||||
| MTM Loss / Total Assets (%) | 4179 | 5.295 | 2.179 | 2.593 | 3.704 | 5.133 | 6.809 | 8.247 |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 4179 | 0.665 | 0.815 | 0.014 | 0.127 | 0.387 | 0.910 | 1.693 |
| Uninsured Deposits / Total Assets (%) | 4197 | 21.282 | 11.265 | 8.413 | 13.435 | 19.943 | 27.172 | 35.776 |
| Uninsured Deposits / Total Deposits (%) | 4197 | 25.429 | 13.351 | 10.461 | 16.149 | 23.828 | 32.375 | 42.566 |
| Panel B: Size | ||||||||
| Total Assets ($ thousands) | 4197 | 2,782,226 | 21,457,734 | 76,940 | 153,538 | 350,626 | 894,719 | 2,628,695 |
| Log(Total Assets) | 4197 | 12.934 | 1.490 | 11.251 | 11.942 | 12.767 | 13.704 | 14.782 |
| Panel C: Liquidity and Securities | ||||||||
| Cash / Total Assets (%) | 4197 | 8.016 | 8.578 | 1.801 | 2.799 | 5.310 | 10.028 | 16.849 |
| Securities / Total Assets (%) | 4197 | 23.695 | 14.995 | 6.399 | 12.339 | 21.263 | 32.191 | 43.958 |
| Panel D: Loans and Funding | ||||||||
| Loans / Total Assets (%) | 4197 | 62.165 | 17.153 | 39.410 | 52.946 | 65.306 | 75.052 | 80.752 |
| Loans / Deposits (%) | 4197 | 74.877 | 24.882 | 45.209 | 61.672 | 77.204 | 90.118 | 99.884 |
| Wholesale Funding / Total Liabilities (%) | 4197 | 1.762 | 3.909 | 0.000 | 0.000 | 0.000 | 1.989 | 5.879 |
| FHLB Advances / Total Assets (%) | 4197 | 3.102 | 4.481 | 0.000 | 0.000 | 1.056 | 4.920 | 8.884 |
| Panel E: Capital and Profitability | ||||||||
| Book Equity / Total Assets (%) | 4197 | 10.888 | 8.776 | 6.366 | 7.851 | 9.424 | 11.493 | 14.605 |
| Tier 1 Capital / Total Assets (%) | 4197 | 12.089 | 8.161 | 8.405 | 9.205 | 10.416 | 12.332 | 15.471 |
| Return on Assets (%) | 4197 | 1.146 | 2.472 | 0.244 | 0.587 | 0.950 | 1.373 | 1.885 |
# Save LaTeX version
save_kable_table(desc_2023q4 %>% mutate(across(where(is.numeric), ~round(., 3))),
"Table_1C_Summary_Stats_2023Q4_Corrected",
"Table 1C: Summary Statistics (2023Q4 Baseline)",
"Sample: OMO-eligible banks in 2023Q4. Variables in raw scale.")Saved: Table_1C_Summary_Stats_2023Q4_Corrected (HTML + LaTeX)
4 SUMMARY TABLES BY USER GROUP (WITH P-VALUES)
# ==============================================================================
# FUNCTION: Create User Group Comparison Table with P-Values and Significance Stars
# ==============================================================================
create_user_group_table <- function(data, period_name, comparison_vars, var_labels,
return_df = FALSE) {
# Get group counts
group_counts <- data %>%
group_by(user_group) %>%
summarise(N = n(), .groups = "drop") %>%
arrange(user_group)
groups <- as.character(group_counts$user_group)
# Calculate stats for each variable and group
results <- map_dfr(comparison_vars, function(v) {
var_label <- ifelse(v %in% names(var_labels), var_labels[[v]], v)
row_data <- tibble(Variable = var_label)
for (g in groups) {
x <- data %>% filter(user_group == g) %>% pull(!!sym(v))
x <- x[!is.na(x)]
row_data[[paste0(g, "_Mean")]] <- mean(x)
row_data[[paste0(g, "_SD")]] <- sd(x)
}
# T-test: Users vs Neither (with p-value and significance stars)
if ("Neither" %in% groups) {
x_neither <- data %>% filter(user_group == "Neither") %>% pull(!!sym(v))
x_users <- data %>% filter(user_group != "Neither") %>% pull(!!sym(v))
x_neither <- x_neither[!is.na(x_neither)]
x_users <- x_users[!is.na(x_users)]
if (length(x_neither) > 1 && length(x_users) > 1) {
ttest <- t.test(x_users, x_neither)
row_data$Diff <- mean(x_users) - mean(x_neither)
row_data$T_Stat <- as.numeric(ttest$statistic)
row_data$P_Value <- as.numeric(ttest$p.value)
row_data$Sig <- format_pval(row_data$P_Value)
} else {
row_data$Diff <- NA_real_
row_data$T_Stat <- NA_real_
row_data$P_Value <- NA_real_
row_data$Sig <- ""
}
}
return(row_data)
})
# Return dataframe if requested (for saving)
if (return_df) {
return(list(results = results, group_counts = group_counts))
}
# Create header with N below group names
header_spec <- c(" " = 1)
for (i in 1:nrow(group_counts)) {
g <- as.character(group_counts$user_group[i])
n <- group_counts$N[i]
header_spec[paste0(g, "\n(N=", n, ")")] <- 2
}
if ("Neither" %in% groups) {
header_spec["Diff (Users-Neither)"] <- 4
}
# Format and display
results %>%
mutate(across(where(is.numeric), ~round(., 3))) %>%
kable(format = "html", caption = paste0("User Group Comparison: ", period_name),
col.names = c("Variable",
rep(c("Mean", "SD"), length(groups)),
"Diff", "t-stat", "p-value", "Sig")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 9) %>%
add_header_above(header_spec)
}
# ==============================================================================
# FUNCTION: Save User Group Comparison Table
# ==============================================================================
save_user_group_table <- function(data, period_name, comparison_vars, var_labels,
filename, notes_text) {
# Get the data
tbl_data <- create_user_group_table(data, period_name, comparison_vars, var_labels,
return_df = TRUE)
results <- tbl_data$results
# Format for saving
results_formatted <- results %>%
mutate(across(where(is.numeric), ~round(., 3)))
# Save HTML
html_tbl <- results_formatted %>%
kable(format = "html", caption = paste0("User Group Comparison: ", period_name)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, font_size = 9)
save_kable(html_tbl, file = file.path(TABLE_PATH, paste0(filename, ".html")))
# Save LaTeX
latex_tbl <- results_formatted %>%
kable(format = "latex", caption = paste0("User Group Comparison: ", period_name),
booktabs = TRUE) %>%
kable_styling(latex_options = c("hold_position", "scale_down")) %>%
footnote(general = notes_text, general_title = "Notes: ", threeparttable = TRUE)
writeLines(latex_tbl, file.path(TABLE_PATH, paste0(filename, ".tex")))
cat("Saved:", filename, "(HTML + LaTeX)\n")
}4.1 Table: Acute Period (Mar 13 - May 1, 2023)
create_user_group_table(df_acute, "Acute Period (Mar 13 - May 1, 2023)",
desc_vars, var_labels_raw)| Variable | Mean | SD | Mean | SD | Mean | SD | Mean | SD | Diff | t-stat | p-value | Sig |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| MTM Loss / Total Assets (%) | 5.358 | 2.255 | 6.180 | 1.996 | 5.748 | 2.007 | 5.864 | 1.847 | 0.613 | 7.515 | 0.000 | *** |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 0.649 | 0.823 | 0.884 | 1.012 | 0.741 | 0.830 | 0.916 | 0.959 | 0.183 | 4.990 | 0.000 | *** |
| Uninsured Deposits / Total Assets (%) | 22.827 | 12.045 | 26.205 | 11.528 | 26.847 | 11.503 | 32.635 | 14.116 | 4.425 | 9.203 | 0.000 | *** |
| Uninsured Deposits / Total Deposits (%) | 26.654 | 14.114 | 30.619 | 13.414 | 31.580 | 13.597 | 38.415 | 16.616 | 5.305 | 9.405 | 0.000 | *** |
| Total Assets ($ thousands) | 1881481.138 | 16032224.247 | 5420631.872 | 34838553.603 | 5521943.913 | 34441253.995 | 10039151.160 | 25033435.689 | 4149443.919 | 3.324 | 0.001 | *** |
| Log(Total Assets) | 12.688 | 1.401 | 13.537 | 1.441 | 13.848 | 1.465 | 14.552 | 1.723 | 1.097 | 18.299 | 0.000 | *** |
| Cash / Total Assets (%) | 8.767 | 9.685 | 4.695 | 4.597 | 6.161 | 6.592 | 4.719 | 5.327 | -3.493 | -13.435 | 0.000 | *** |
| Securities / Total Assets (%) | 25.500 | 16.092 | 28.272 | 13.781 | 23.956 | 14.302 | 27.803 | 14.809 | 1.019 | 1.747 | 0.081 |
|
| Loans / Total Assets (%) | 59.474 | 18.176 | 61.338 | 14.104 | 63.834 | 15.442 | 61.845 | 14.972 | 2.907 | 4.713 | 0.000 | *** |
| Loans / Deposits (%) | 70.197 | 28.727 | 72.462 | 19.162 | 75.830 | 21.188 | 73.941 | 19.846 | 3.771 | 4.312 | 0.000 | *** |
| Wholesale Funding / Total Liabilities (%) | 0.877 | 3.056 | 1.518 | 3.387 | 1.562 | 3.973 | 1.822 | 2.969 | 0.696 | 4.986 | 0.000 | *** |
| FHLB Advances / Total Assets (%) | 2.420 | 4.052 | 3.953 | 4.649 | 3.252 | 4.411 | 4.147 | 6.068 | 1.282 | 6.902 | 0.000 | *** |
| Book Equity / Total Assets (%) | 10.587 | 9.572 | 8.177 | 3.092 | 9.046 | 3.223 | 8.194 | 2.678 | -2.066 | -10.496 | 0.000 | *** |
| Tier 1 Capital / Total Assets (%) | 12.180 | 8.950 | 10.314 | 2.318 | 10.461 | 2.652 | 9.620 | 1.582 | -1.894 | -10.896 | 0.000 | *** |
| Return on Assets (%) | 1.177 | 2.819 | 1.064 | 0.543 | 1.140 | 0.649 | 1.097 | 0.561 | -0.080 | -1.531 | 0.126 |
# SAVE TABLE 2A
save_user_group_table(df_acute, "Acute Period (Mar 13 - May 1, 2023)",
desc_vars, var_labels_raw,
"Table_2A_UserGroup_Acute",
"This table compares bank characteristics across facility user groups during the acute crisis period. User groups: Neither = banks that did not access BTFP, DW, or FHLB; BTFP_Only = BTFP users only; DW_Only = Discount Window users only; Both = used both facilities. Diff = difference between all users and non-users. t-statistics from two-sample t-test. Significance levels: *** p<0.01, ** p<0.05, * p<0.10. Variables from 2022Q4 Call Reports, winsorized at 2.5/97.5 percentiles.")Saved: Table_2A_UserGroup_Acute (HTML + LaTeX)
4.2 Table: March 10 (SVB Closure Day)
create_user_group_table(df_mar10, "March 10, 2023 (SVB Closure Day)",
desc_vars, var_labels_raw)| Variable | Mean | SD | Mean | SD | Diff | t-stat | p-value | Sig |
|---|---|---|---|---|---|---|---|---|
| MTM Loss / Total Assets (%) | 5.465 | 2.224 | 5.689 | 2.113 | 0.224 | 0.724 | 0.473 | |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 0.679 | 0.847 | 0.894 | 0.854 | 0.215 | 1.719 | 0.092 |
|
| Uninsured Deposits / Total Assets (%) | 23.542 | 12.137 | 29.880 | 12.584 | 6.338 | 3.435 | 0.001 | *** |
| Uninsured Deposits / Total Deposits (%) | 27.502 | 14.211 | 36.030 | 16.066 | 8.528 | 3.623 | 0.001 | *** |
| Total Assets ($ thousands) | 2539594.119 | 20368034.192 | 9626953.851 | 17474136.005 | 7087359.732 | 2.760 | 0.008 | *** |
| Log(Total Assets) | 12.863 | 1.467 | 14.640 | 1.854 | 1.777 | 6.550 | 0.000 | *** |
| Cash / Total Assets (%) | 8.203 | 9.222 | 3.139 | 2.808 | -5.064 | -11.685 | 0.000 | *** |
| Securities / Total Assets (%) | 25.676 | 15.793 | 26.092 | 15.134 | 0.416 | 0.188 | 0.852 | |
| Loans / Total Assets (%) | 59.934 | 17.673 | 64.970 | 15.233 | 5.036 | 2.250 | 0.029 | ** |
| Loans / Deposits (%) | 70.786 | 27.492 | 78.100 | 20.263 | 7.314 | 2.450 | 0.018 | ** |
| Wholesale Funding / Total Liabilities (%) | 0.986 | 3.169 | 2.264 | 2.644 | 1.278 | 3.287 | 0.002 | *** |
| FHLB Advances / Total Assets (%) | 2.624 | 4.199 | 4.697 | 5.109 | 2.073 | 2.772 | 0.008 | *** |
| Book Equity / Total Assets (%) | 10.243 | 8.858 | 8.203 | 2.682 | -2.040 | -4.926 | 0.000 | *** |
| Tier 1 Capital / Total Assets (%) | 11.871 | 8.251 | 9.360 | 1.848 | -2.511 | -8.431 | 0.000 | *** |
| Return on Assets (%) | 1.165 | 2.583 | 0.988 | 0.471 | -0.177 | -2.237 | 0.028 | ** |
# SAVE TABLE 2B
save_user_group_table(df_mar10, "March 10, 2023 (SVB Closure Day)",
desc_vars, var_labels_raw,
"Table_2B_UserGroup_Mar10",
"This table compares bank characteristics for banks that accessed emergency facilities on March 10, 2023 (SVB closure day). The BTFP was not yet operational; DW was the only Fed facility available. Diff = difference between all users and non-users. t-statistics from two-sample t-test. Significance levels: *** p<0.01, ** p<0.05, * p<0.10. Variables from 2022Q4 Call Reports.")Saved: Table_2B_UserGroup_Mar10 (HTML + LaTeX)
4.3 Table: Pre-BTFP (Mar 1 - Mar 12)
create_user_group_table(df_prebtfp, "Pre-BTFP Period (Mar 1-12, 2023)",
desc_vars, var_labels_raw)| Variable | Mean | SD | Mean | SD | Diff | t-stat | p-value | Sig |
|---|---|---|---|---|---|---|---|---|
| MTM Loss / Total Assets (%) | 5.459 | 2.222 | 5.823 | 2.241 | 0.364 | 1.606 | 0.111 | |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 0.679 | 0.850 | 0.781 | 0.738 | 0.102 | 1.362 | 0.176 | |
| Uninsured Deposits / Total Assets (%) | 23.502 | 12.134 | 28.202 | 12.361 | 4.701 | 3.760 | 0.000 | *** |
| Uninsured Deposits / Total Deposits (%) | 27.448 | 14.194 | 33.740 | 15.582 | 6.292 | 3.998 | 0.000 | *** |
| Total Assets ($ thousands) | 2510219.705 | 20437591.004 | 7102028.640 | 15703564.087 | 4591808.935 | 2.867 | 0.005 | *** |
| Log(Total Assets) | 12.847 | 1.461 | 14.339 | 1.681 | 1.491 | 8.793 | 0.000 | *** |
| Cash / Total Assets (%) | 8.246 | 9.247 | 4.014 | 4.909 | -4.232 | -8.279 | 0.000 | *** |
| Securities / Total Assets (%) | 25.696 | 15.807 | 25.040 | 14.842 | -0.656 | -0.436 | 0.664 | |
| Loans / Total Assets (%) | 59.865 | 17.705 | 65.220 | 14.535 | 5.355 | 3.621 | 0.000 | *** |
| Loans / Deposits (%) | 70.697 | 27.573 | 77.942 | 19.449 | 7.245 | 3.639 | 0.000 | *** |
| Wholesale Funding / Total Liabilities (%) | 0.974 | 3.173 | 2.105 | 2.654 | 1.131 | 4.191 | 0.000 | *** |
| FHLB Advances / Total Assets (%) | 2.617 | 4.202 | 3.902 | 4.575 | 1.285 | 2.782 | 0.006 | *** |
| Book Equity / Total Assets (%) | 10.255 | 8.905 | 8.753 | 3.186 | -1.502 | -4.329 | 0.000 | *** |
| Tier 1 Capital / Total Assets (%) | 11.887 | 8.294 | 10.023 | 2.677 | -1.865 | -6.282 | 0.000 | *** |
| Return on Assets (%) | 1.165 | 2.598 | 1.093 | 0.499 | -0.072 | -1.117 | 0.265 |
# SAVE TABLE 2C
save_user_group_table(df_prebtfp, "Pre-BTFP Period (Mar 1-12, 2023)",
desc_vars, var_labels_raw,
"Table_2C_UserGroup_PreBTFP",
"This table compares bank characteristics for banks that accessed emergency facilities before BTFP announcement (March 12, 2023). Only the Discount Window was available as a Fed facility during this period. Diff = difference between all users and non-users. t-statistics from two-sample t-test. Significance levels: *** p<0.01, ** p<0.05, * p<0.10. Variables from 2022Q4 Call Reports.")Saved: Table_2C_UserGroup_PreBTFP (HTML + LaTeX)
4.4 Table: Arbitrage Period (2023Q3 Baseline)
create_user_group_table(df_arb, "Arbitrage Period (Nov 2023 - Jan 2024) [2023Q3 Baseline]",
desc_vars, var_labels_raw)| Variable | Mean | SD | Mean | SD | Diff | t-stat | p-value | Sig |
|---|---|---|---|---|---|---|---|---|
| MTM Loss / Total Assets (%) | 5.249 | 2.230 | 5.998 | 2.011 | 0.749 | 9.128 | 0.000 | *** |
| MTM Loss (OMO-Eligible) / Total Assets (%) | 0.637 | 0.810 | 0.828 | 0.862 | 0.190 | 5.580 | 0.000 | *** |
| Uninsured Deposits / Total Assets (%) | 20.856 | 11.307 | 22.786 | 10.223 | 1.930 | 4.634 | 0.000 | *** |
| Uninsured Deposits / Total Deposits (%) | 24.771 | 13.433 | 27.255 | 12.136 | 2.483 | 5.021 | 0.000 | *** |
| Total Assets ($ thousands) | 2385484.033 | 18678415.273 | 4375839.958 | 30673187.492 | 1990355.925 | 1.726 | 0.085 |
|
| Log(Total Assets) | 12.775 | 1.476 | 13.526 | 1.405 | 0.750 | 13.246 | 0.000 | *** |
| Cash / Total Assets (%) | 8.465 | 9.034 | 4.870 | 4.133 | -3.595 | -16.769 | 0.000 | *** |
| Securities / Total Assets (%) | 23.415 | 15.562 | 25.165 | 12.650 | 1.750 | 3.312 | 0.001 | *** |
| Loans / Total Assets (%) | 61.688 | 18.039 | 64.127 | 12.893 | 2.439 | 4.372 | 0.000 | *** |
| Loans / Deposits (%) | 73.548 | 24.742 | 77.437 | 17.997 | 3.890 | 5.020 | 0.000 | *** |
| Wholesale Funding / Total Liabilities (%) | 1.223 | 3.483 | 3.447 | 4.188 | 2.223 | 13.679 | 0.000 | *** |
| FHLB Advances / Total Assets (%) | 2.988 | 4.434 | 3.753 | 4.816 | 0.766 | 4.036 | 0.000 | *** |
| Book Equity / Total Assets (%) | 10.849 | 9.884 | 8.425 | 3.247 | -2.424 | -11.817 | 0.000 | *** |
| Tier 1 Capital / Total Assets (%) | 12.639 | 9.112 | 10.662 | 2.611 | -1.976 | -10.883 | 0.000 | *** |
| Return on Assets (%) | 1.292 | 2.725 | 0.902 | 0.601 | -0.390 | -7.606 | 0.000 | *** |
# SAVE TABLE 2D
save_user_group_table(df_arb, "Arbitrage Period (Nov 2023 - Jan 2024)",
desc_vars, var_labels_raw,
"Table_2D_UserGroup_Arbitrage",
"This table compares bank characteristics during the BTFP arbitrage period (Nov 1, 2023 - Jan 24, 2024). During this period, BTFP borrowing rate fell below the Fed Funds rate, creating arbitrage opportunities. DW data not available for this period. Diff = difference between BTFP users and non-users. t-statistics from two-sample t-test. Significance levels: *** p<0.01, ** p<0.05, * p<0.10. Variables from 2023Q3 Call Reports.")Saved: Table_2D_UserGroup_Arbitrage (HTML + LaTeX)
5 EXTENSIVE MARGIN ANALYSIS - ACUTE PERIOD
5.0.1 Table : DW March 10 & March 10-13 - All Specifications
# March 10 only
df_dw_mar10_s <- df_mar10 %>% filter(dw_mar10 == 1 | non_user == 1)
models_dw_mar10 <- run_4spec_models(df_dw_mar10_s, "dw_mar10", "lpm")
# March 10-13
df_dw_mar10_13_s <- df_mar10_13 %>% filter(dw_mar10_13 == 1 | non_user == 1)
models_dw_mar10_13 <- run_4spec_models(df_dw_mar10_13_s, "dw_mar10_13", "lpm")
# Combined table
models_dw_short <- list(
"Mar10 (1)" = models_dw_mar10$`(1) Base`,
"Mar10 (2)" = models_dw_mar10$`(2) +Risk1`,
"Mar10 (3)" = models_dw_mar10$`(3) +Risk1,2`,
"Mar10 (4)" = models_dw_mar10$`(4) Risk2,3,4`,
"Mar10-13 (1)" = models_dw_mar10_13$`(1) Base`,
"Mar10-13 (2)" = models_dw_mar10_13$`(2) +Risk1`,
"Mar10-13 (3)" = models_dw_mar10_13$`(3) +Risk1,2`,
"Mar10-13 (4)" = models_dw_mar10_13$`(4) Risk2,3,4`
)
n_rows_dw_short <- data.frame(
term = c("N (DW=1)", "N (Sample)"),
`Mar10 (1)` = c(sum(df_dw_mar10_s$dw_mar10), nrow(df_dw_mar10_s)),
`Mar10 (2)` = c(sum(df_dw_mar10_s$dw_mar10), nrow(df_dw_mar10_s)),
`Mar10 (3)` = c(sum(df_dw_mar10_s$dw_mar10), nrow(df_dw_mar10_s)),
`Mar10 (4)` = c(sum(df_dw_mar10_s$dw_mar10), nrow(df_dw_mar10_s)),
`Mar10-13 (1)` = c(sum(df_dw_mar10_13_s$dw_mar10_13), nrow(df_dw_mar10_13_s)),
`Mar10-13 (2)` = c(sum(df_dw_mar10_13_s$dw_mar10_13), nrow(df_dw_mar10_13_s)),
`Mar10-13 (3)` = c(sum(df_dw_mar10_13_s$dw_mar10_13), nrow(df_dw_mar10_13_s)),
`Mar10-13 (4)` = c(sum(df_dw_mar10_13_s$dw_mar10_13), nrow(df_dw_mar10_13_s)),
check.names = FALSE
)
modelsummary(
models_dw_short,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_rows_dw_short,
title = "Table: DW Usage - March 10 and March 10-13 (LPM)",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 8) %>%
add_header_above(c(" " = 1, "March 10 Only" = 4, "March 10-13" = 4))| Mar10 (1) | Mar10 (2) | Mar10 (3) | Mar10 (4) | Mar10-13 (1) | Mar10-13 (2) | Mar10-13 (3) | Mar10-13 (4) | |
|---|---|---|---|---|---|---|---|---|
| MTM Loss (z) | −0.002 | −0.002 | ||||||
| (0.002) | (0.003) | |||||||
| Uninsured Lev (z) | 0.001 | 0.008** | ||||||
| (0.002) | (0.003) | |||||||
| MTM × Uninsured | 0.001 | 0.005* | ||||||
| (0.002) | (0.003) | |||||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | 0.003 | 0.003 | 0.006 | 0.006 | ||||
| (0.004) | (0.004) | (0.005) | (0.005) | |||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.000 | −0.003 | −0.001 | −0.005 | ||||
| (0.005) | (0.004) | (0.007) | (0.006) | |||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | −0.005 | −0.012** | ||||||
| (0.004) | (0.005) | |||||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | −0.001 | 0.004 | ||||||
| (0.006) | (0.008) | |||||||
| Log(Assets) (z) | 0.013*** | 0.014*** | 0.014*** | 0.014*** | 0.026*** | 0.030*** | 0.031*** | 0.029*** |
| (0.003) | (0.003) | (0.003) | (0.003) | (0.004) | (0.004) | (0.004) | (0.004) | |
| Cash Ratio (z) | −0.004*** | −0.003*** | −0.003** | −0.003** | −0.005*** | −0.004** | −0.004* | −0.004** |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.002) | (0.002) | (0.002) | (0.002) | |
| Loan/Deposit (z) | −0.002 | −0.002 | −0.002 | −0.001 | −0.004 | −0.005* | −0.005* | −0.004 |
| (0.002) | (0.002) | (0.002) | (0.002) | (0.003) | (0.003) | (0.003) | (0.003) | |
| Book Equity (z) | −0.000 | −0.000 | −0.000 | −0.000 | 0.002 | 0.001 | 0.000 | 0.001 |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.002) | (0.002) | (0.002) | (0.002) | |
| Wholesale (z) | 0.007*** | 0.007*** | 0.007*** | 0.007*** | 0.008*** | 0.008*** | 0.008*** | 0.008*** |
| (0.003) | (0.003) | (0.003) | (0.003) | (0.003) | (0.003) | (0.003) | (0.003) | |
| ROA (z) | −0.004*** | −0.003*** | −0.003*** | −0.003*** | −0.003 | −0.001 | −0.001 | −0.002 |
| (0.001) | (0.001) | (0.001) | (0.001) | (0.002) | (0.002) | (0.002) | (0.002) | |
| Num.Obs. | 3986 | 3992 | 3986 | 3986 | 3988 | 3994 | 3988 | 3988 |
| R2 | 0.024 | 0.024 | 0.024 | 0.024 | 0.047 | 0.044 | 0.044 | 0.045 |
| R2 Adj. | 0.022 | 0.022 | 0.022 | 0.022 | 0.045 | 0.042 | 0.042 | 0.043 |
| N (DW=1) | 47.000 | 47.000 | 47.000 | 47.000 | 90.000 | 90.000 | 90.000 | 90.000 |
| N (Sample) | 3996.000 | 3996.000 | 3996.000 | 3996.000 | 3998.000 | 3998.000 | 3998.000 | 3998.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
# SAVE TABLE 4C
save_reg_table(models_dw_short, "Table_DW_Mar10_LPM",
title_text = "Table : DW Usage - March 10 and March 10-13 (LPM)",
notes_text = "Linear Probability Model estimates for Discount Window usage during the immediate crisis period. March 10 = SVB closure day (BTFP not yet available). March 10-13 = period including BTFP announcement (March 12). DW = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: DW users vs pure non-users. All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_dw_short)Saved: Table_DW_Mar10_LPM (HTML + LaTeX)
5.1 Acute Period: All Specifications BTFP
# ==============================================================================
# ACUTE PERIOD ANALYSIS
# Sample Construction: DV=1 users vs. DV=0 PURE non-users only
# ==============================================================================
# -----------------------------------------------------------------------------
# 0) Helper functions: build the 4 specs + optional single spec (Risk2,3,4 only)
# -----------------------------------------------------------------------------
# Formula helpers (keeps all model definitions consistent)
f_base <- function(dv) build_formula(dv, "mtm_total + uninsured_lev + mtm_x_uninsured")
f_r1 <- function(dv) build_formula(dv, "run_risk_1")
f_r12 <- function(dv) build_formula(dv, "run_risk_1 + run_risk_2")
f_r234 <- function(dv) build_formula(dv, "run_risk_2 + run_risk_3 + run_risk_4")
# Run the 4-spec set (Base, Risk1, Risk1+2, Risk2+3+4)
run_4spec <- function(data, dv, family_type = c("lpm","logit")) {
family_type <- match.arg(family_type)
forms <- list(
"(1) Base" = f_base(dv),
"(2) +Risk1" = f_r1(dv),
"(3) +Risk1,2" = f_r12(dv),
"(4) Risk2,3,4" = f_r234(dv)
)
if (family_type == "lpm") {
lapply(forms, function(ff) feols(ff, data = data, vcov = "hetero"))
} else {
lapply(forms, function(ff) feglm(ff, data = data, family = binomial("logit"), vcov = "hetero"))
}
}
# Run only Risk2+3+4 (used for AnyFed column in Table 1/2)
run_r234_only <- function(data, dv, family_type = c("lpm","logit")) {
family_type <- match.arg(family_type)
ff <- f_r234(dv)
if (family_type == "lpm") {
feols(ff, data = data, vcov = "hetero")
} else {
feglm(ff, data = data, family = binomial("logit"), vcov = "hetero")
}
}
# Add N rows (DV=1 count + sample size) for a given dataset and DV
add_n_rows <- function(data, dv, n_models) {
n_ones <- sum(data[[dv]] == 1, na.rm = TRUE)
n_sample <- nrow(data)
out <- data.frame(term = c(paste0("N (", dv, "=1)"), "N (Sample)"))
for (i in 1:n_models) out[[paste0("(", i, ")")]] <- c(n_ones, n_sample)
out
}5.1.1 TABLE (LPM) - Acute Period
# -----------------------------------------------------------------------------
# 1) TABLE 1 (LPM): all_user (4 specs) + any_fed (Risk2,3,4 only)
# Sample: DV=1 vs pure non-users only (non_user == 1)
# -----------------------------------------------------------------------------
df_all_acute <- df_acute %>% filter(all_user == 1 | non_user == 1)
df_anyfed_acute <- df_acute %>% filter(any_fed == 1 | non_user == 1)
# Run models
m_all_lpm <- run_4spec(df_all_acute, "all_user", "lpm")
m_any_lpm <- run_r234_only(df_anyfed_acute, "any_fed", "lpm")
# Combine into 5 columns: (1)-(4) all_user, (5) any_fed risk2,3,4
models_t1 <- c(m_all_lpm, list("(5) AnyFed: Risk2,3,4" = m_any_lpm))
# N rows for each column's own sample (so Ns are correct by column)
n_all <- add_n_rows(df_all_acute, "all_user", n_models = 4)
n_any <- add_n_rows(df_anyfed_acute, "any_fed", n_models = 1)
# Build a 5-column add_rows object aligned to model columns:
# - first 4 columns use all_user sample Ns
# - 5th column uses any_fed sample Ns
nrows_t1 <- data.frame(
term = n_all$term,
"(1)" = n_all[["(1)"]],
"(2)" = n_all[["(2)"]],
"(3)" = n_all[["(3)"]],
"(4)" = n_all[["(4)"]],
"(5)" = n_any[["(1)"]]
)
modelsummary(
models_t1,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = nrows_t1,
title = "Table: Acute Period (LPM) — All Users (4 specs) + Any Fed (Risk2,3,4 only)",
notes = "Sample: DV=1 users vs DV=0 pure non-users. Variables z-standardized. Robust SEs.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | (5) AnyFed: Risk2,3,4 | |
|---|---|---|---|---|---|
| MTM Loss (z) | 0.029*** | ||||
| (0.007) | |||||
| Uninsured Lev (z) | 0.018** | ||||
| (0.008) | |||||
| MTM × Uninsured | 0.013** | ||||
| (0.006) | |||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.028* | −0.041*** | |||
| (0.014) | (0.016) | ||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.036** | 0.011 | 0.001 | ||
| (0.016) | (0.017) | (0.016) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.019 | 0.019 | |||
| (0.017) | (0.016) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.076*** | 0.079*** | |||
| (0.020) | (0.019) | ||||
| Log(Assets) (z) | 0.097*** | 0.101*** | 0.103*** | 0.098*** | 0.104*** |
| (0.008) | (0.008) | (0.008) | (0.008) | (0.008) | |
| Cash Ratio (z) | −0.034*** | −0.042*** | −0.037*** | −0.038*** | −0.023*** |
| (0.006) | (0.006) | (0.006) | (0.006) | (0.006) | |
| Loan/Deposit (z) | 0.014** | 0.007 | 0.010 | 0.013* | −0.005 |
| (0.007) | (0.007) | (0.007) | (0.007) | (0.006) | |
| Book Equity (z) | −0.008 | −0.014** | −0.013** | −0.010* | −0.015*** |
| (0.006) | (0.005) | (0.006) | (0.006) | (0.005) | |
| Wholesale (z) | 0.025*** | 0.025*** | 0.024*** | 0.025*** | 0.029*** |
| (0.007) | (0.007) | (0.007) | (0.007) | (0.007) | |
| ROA (z) | −0.005 | −0.006 | −0.004 | −0.006 | −0.002 |
| (0.006) | (0.006) | (0.006) | (0.006) | (0.005) | |
| Num.Obs. | 4282 | 4288 | 4282 | 4282 | 4036 |
| R2 | 0.105 | 0.101 | 0.102 | 0.104 | 0.115 |
| R2 Adj. | 0.103 | 0.100 | 0.100 | 0.102 | 0.113 |
| N (all_user=1) | 1007.000 | 1007.000 | 1007.000 | 1007.000 | 761.000 |
| N (Sample) | 4292.000 | 4292.000 | 4292.000 | 4292.000 | 4046.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||||
| Sample: DV=1 users vs DV=0 pure non-users. Variables z-standardized. Robust SEs. |
# SAVE TABLE 1
save_reg_table(models_t1, "Table_1_Acute_AllUsers_LPM",
title_text = "Table: Acute Period (LPM) - All Users + Any Fed",
notes_text = "Sample: DV=1 users vs DV=0 pure non-users. Variables z-standardized. Robust SEs.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = nrows_t1)Saved: Table_1_Acute_AllUsers_LPM (HTML + LaTeX)
5.1.2 Table (Logit) - Acute Period
# Run models
m_all_logit <- run_4spec(df_all_acute, "all_user", "logit")
m_any_logit <- run_r234_only(df_anyfed_acute, "any_fed", "logit")
models_t2 <- c(m_all_logit, list("(5) AnyFed: Risk2,3,4" = m_any_logit))
# Ns are the same construction as Table 1 (by sample/column)
nrows_t2 <- nrows_t1
modelsummary(
models_t2,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_logit,
add_rows = nrows_t2,
title = "Table: Acute Period (Logit) — All Users (4 specs) + Any Fed (Risk2,3,4 only)",
notes = "Sample: DV=1 users vs DV=0 pure non-users. Variables z-standardized. Robust SEs.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | (5) AnyFed: Risk2,3,4 | |
|---|---|---|---|---|---|
| MTM Loss (z) | 0.184*** | ||||
| (0.045) | |||||
| Uninsured Lev (z) | 0.127*** | ||||
| (0.045) | |||||
| MTM × Uninsured | 0.014 | ||||
| (0.039) | |||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.278** | −0.341*** | |||
| (0.110) | (0.115) | ||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.167* | 0.198 | 0.226 | ||
| (0.097) | (0.126) | (0.150) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.218* | 0.319** | |||
| (0.126) | (0.150) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.492*** | 0.620*** | |||
| (0.127) | (0.149) | ||||
| Log(Assets) (z) | 0.522*** | 0.549*** | 0.559*** | 0.533*** | 0.663*** |
| (0.046) | (0.042) | (0.043) | (0.044) | (0.049) | |
| Cash Ratio (z) | −0.349*** | −0.396*** | −0.366*** | −0.369*** | −0.285*** |
| (0.066) | (0.062) | (0.064) | (0.064) | (0.071) | |
| Loan/Deposit (z) | 0.143*** | 0.105** | 0.118** | 0.132*** | 0.036 |
| (0.049) | (0.048) | (0.048) | (0.048) | (0.054) | |
| Book Equity (z) | −0.137*** | −0.177*** | −0.168*** | −0.152*** | −0.261*** |
| (0.050) | (0.049) | (0.049) | (0.050) | (0.062) | |
| Wholesale (z) | 0.131*** | 0.124*** | 0.122*** | 0.124*** | 0.164*** |
| (0.036) | (0.036) | (0.036) | (0.036) | (0.040) | |
| ROA (z) | −0.006 | −0.017 | −0.010 | −0.023 | 0.018 |
| (0.043) | (0.042) | (0.042) | (0.043) | (0.049) | |
| Num.Obs. | 4282 | 4288 | 4282 | 4282 | 4036 |
| N (all_user=1) | 1007.000 | 1007.000 | 1007.000 | 1007.000 | 761.000 |
| N (Sample) | 4292.000 | 4292.000 | 4292.000 | 4292.000 | 4046.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | |||||
| Sample: DV=1 users vs DV=0 pure non-users. Variables z-standardized. Robust SEs. |
# SAVE TABLE 2
save_reg_table(models_t2, "Table_2_Acute_AllUsers_Logit",
title_text = "Table: Acute Period (Logit) - All Users + Any Fed",
notes_text = "Sample: DV=1 users vs DV=0 pure non-users. Variables z-standardized. Robust SEs.",
coef_map_use = COEF_MAP, gof_map_use = gof_logit, add_rows_use = nrows_t2)Saved: Table_2_Acute_AllUsers_Logit (HTML + LaTeX)
5.1.3 TABLE (LPM): BTFP only (4 specs) — BTFP=1 vs pure non-users- Acute Period
# -----------------------------------------------------------------------------
# 3) TABLE 3 (LPM): BTFP only (4 specs) — BTFP=1 vs pure non-users
# -----------------------------------------------------------------------------
df_btfp_acute <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
m_btfp_lpm <- run_4spec(df_btfp_acute, "btfp_acute", "lpm")
n_btfp_lpm <- add_n_rows(df_btfp_acute, "btfp_acute", n_models = 4)
modelsummary(
m_btfp_lpm,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_btfp_lpm,
title = "Table: BTFP Usage (LPM) — Acute Period (Mar 13–May 1, 2023)",
notes = "Sample: BTFP users vs pure non-users. Variables z-standardized. Robust SEs.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.024*** | |||
| (0.006) | ||||
| Uninsured Lev (z) | 0.020*** | |||
| (0.007) | ||||
| MTM × Uninsured | 0.018*** | |||
| (0.005) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.011 | −0.025** | ||
| (0.011) | (0.012) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.036*** | −0.006 | ||
| (0.014) | (0.014) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.002 | |||
| (0.013) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.062*** | |||
| (0.017) | ||||
| Log(Assets) (z) | 0.067*** | 0.074*** | 0.076*** | 0.071*** |
| (0.007) | (0.007) | (0.007) | (0.007) | |
| Cash Ratio (z) | −0.024*** | −0.031*** | −0.026*** | −0.027*** |
| (0.005) | (0.004) | (0.005) | (0.005) | |
| Loan/Deposit (z) | −0.008 | −0.016*** | −0.014** | −0.011* |
| (0.005) | (0.006) | (0.006) | (0.006) | |
| Book Equity (z) | −0.011** | −0.017*** | −0.017*** | −0.014*** |
| (0.004) | (0.004) | (0.004) | (0.004) | |
| Wholesale (z) | 0.025*** | 0.024*** | 0.024*** | 0.025*** |
| (0.006) | (0.006) | (0.006) | (0.006) | |
| ROA (z) | −0.005 | −0.005 | −0.003 | −0.005 |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Num.Obs. | 3737 | 3743 | 3737 | 3737 |
| R2 | 0.090 | 0.084 | 0.085 | 0.089 |
| R2 Adj. | 0.088 | 0.082 | 0.083 | 0.087 |
| N (btfp_acute=1) | 462.000 | 462.000 | 462.000 | 462.000 |
| N (Sample) | 3747.000 | 3747.000 | 3747.000 | 3747.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| Sample: BTFP users vs pure non-users. Variables z-standardized. Robust SEs. |
# SAVE TABLE 3
save_reg_table(m_btfp_lpm, "Table_3_BTFP_Acute_LPM",
title_text = "Table: BTFP Usage (LPM) - Acute Period",
notes_text = "Sample: BTFP users vs pure non-users. Variables z-standardized. Robust SEs.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_btfp_lpm)Saved: Table_3_BTFP_Acute_LPM (HTML + LaTeX)
5.1.4 TABLE (LOGIT): BTFP only (4 specs) - Acute Period
# -----------------------------------------------------------------------------
# 4) TABLE 4 (LOGIT): BTFP only (4 specs)
# -----------------------------------------------------------------------------
m_btfp_logit <- run_4spec(df_btfp_acute, "btfp_acute", "logit")
n_btfp_logit <- add_n_rows(df_btfp_acute, "btfp_acute", n_models = 4)
modelsummary(
m_btfp_logit,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_logit,
add_rows = n_btfp_logit,
title = "Table 4: BTFP Usage (Logit) — Acute Period (Mar 13–May 1, 2023)",
notes = "Sample: BTFP users vs pure non-users. Variables z-standardized. Robust SEs.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.214*** | |||
| (0.062) | ||||
| Uninsured Lev (z) | 0.209*** | |||
| (0.063) | ||||
| MTM × Uninsured | 0.046 | |||
| (0.057) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.301* | −0.379** | ||
| (0.163) | (0.168) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.223 | 0.191 | ||
| (0.136) | (0.188) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.175 | |||
| (0.184) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.591*** | |||
| (0.180) | ||||
| Log(Assets) (z) | 0.574*** | 0.636*** | 0.649*** | 0.611*** |
| (0.062) | (0.056) | (0.057) | (0.059) | |
| Cash Ratio (z) | −0.517*** | −0.563*** | −0.521*** | −0.527*** |
| (0.105) | (0.101) | (0.103) | (0.104) | |
| Loan/Deposit (z) | 0.001 | −0.061 | −0.043 | −0.018 |
| (0.066) | (0.065) | (0.065) | (0.066) | |
| Book Equity (z) | −0.329*** | −0.398*** | −0.382*** | −0.359*** |
| (0.082) | (0.081) | (0.081) | (0.082) | |
| Wholesale (z) | 0.183*** | 0.168*** | 0.166*** | 0.173*** |
| (0.046) | (0.046) | (0.046) | (0.046) | |
| ROA (z) | −0.016 | −0.018 | −0.009 | −0.030 |
| (0.063) | (0.062) | (0.062) | (0.063) | |
| Num.Obs. | 3737 | 3743 | 3737 | 3737 |
| N (btfp_acute=1) | 462.000 | 462.000 | 462.000 | 462.000 |
| N (Sample) | 3747.000 | 3747.000 | 3747.000 | 3747.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| Sample: BTFP users vs pure non-users. Variables z-standardized. Robust SEs. |
# SAVE TABLE 4
save_reg_table(m_btfp_logit, "Table_4_BTFP_Acute_Logit",
title_text = "Table: BTFP Usage (Logit) - Acute Period",
notes_text = "Sample: BTFP users vs pure non-users. Variables z-standardized. Robust SEs.",
coef_map_use = COEF_MAP, gof_map_use = gof_logit, add_rows_use = n_btfp_logit)Saved: Table_4_BTFP_Acute_Logit (HTML + LaTeX)
5.1.5 TABLE (LPM): DW only (4 specs) — DW=1 vs pure non-users - Acute Period
# -----------------------------------------------------------------------------
# 5) TABLE 5 (LPM): DW only (4 specs) — DW=1 vs pure non-users
# -----------------------------------------------------------------------------
df_dw_acute <- df_acute %>% filter(dw_acute == 1 | non_user == 1)
m_dw_lpm <- run_4spec(df_dw_acute, "dw_acute", "lpm")
n_dw_lpm <- add_n_rows(df_dw_acute, "dw_acute", n_models = 4)
modelsummary(
m_dw_lpm,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_dw_lpm,
title = "Table: Discount Window Usage (LPM) — Acute Period (Mar 13–May 1, 2023)",
notes = "Sample: DW users vs pure non-users. Variables z-standardized. Robust SEs.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.016*** | |||
| (0.006) | ||||
| Uninsured Lev (z) | 0.013** | |||
| (0.006) | ||||
| MTM × Uninsured | 0.016*** | |||
| (0.005) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.012 | −0.024** | ||
| (0.010) | (0.012) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.030** | −0.003 | ||
| (0.013) | (0.013) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.008 | |||
| (0.012) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.050*** | |||
| (0.016) | ||||
| Log(Assets) (z) | 0.084*** | 0.087*** | 0.089*** | 0.086*** |
| (0.007) | (0.007) | (0.007) | (0.007) | |
| Cash Ratio (z) | −0.002 | −0.007 | −0.003 | −0.003 |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Loan/Deposit (z) | −0.001 | −0.007 | −0.004 | −0.002 |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Book Equity (z) | −0.000 | −0.004 | −0.003 | −0.002 |
| (0.004) | (0.004) | (0.004) | (0.004) | |
| Wholesale (z) | 0.020*** | 0.021*** | 0.020*** | 0.020*** |
| (0.006) | (0.006) | (0.006) | (0.006) | |
| ROA (z) | −0.002 | −0.001 | −0.000 | −0.002 |
| (0.005) | (0.004) | (0.005) | (0.005) | |
| Num.Obs. | 3668 | 3674 | 3668 | 3668 |
| R2 | 0.096 | 0.092 | 0.093 | 0.095 |
| R2 Adj. | 0.093 | 0.090 | 0.091 | 0.093 |
| N (dw_acute=1) | 393.000 | 393.000 | 393.000 | 393.000 |
| N (Sample) | 3678.000 | 3678.000 | 3678.000 | 3678.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| Sample: DW users vs pure non-users. Variables z-standardized. Robust SEs. |
# SAVE TABLE 5
save_reg_table(m_dw_lpm, "Table_5_DW_Acute_LPM",
title_text = "Table: Discount Window Usage (LPM) - Acute Period",
notes_text = "Sample: DW users vs pure non-users. Variables z-standardized. Robust SEs.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_dw_lpm)Saved: Table_5_DW_Acute_LPM (HTML + LaTeX)
5.1.6 TABLE (LOGIT): DW only (4 specs) - Acute Period
# -----------------------------------------------------------------------------
# 6) TABLE 6 (LOGIT): DW only (4 specs)
# -----------------------------------------------------------------------------
m_dw_logit <- run_4spec(df_dw_acute, "dw_acute", "logit")
n_dw_logit <- add_n_rows(df_dw_acute, "dw_acute", n_models = 4)
modelsummary(
m_dw_logit,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_logit,
add_rows = n_dw_logit,
title = "Table: Discount Window Usage (Logit) — Acute Period (Mar 13–May 1, 2023)",
notes = "Sample: DW users vs pure non-users. Variables z-standardized. Robust SEs.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.194*** | |||
| (0.068) | ||||
| Uninsured Lev (z) | 0.160*** | |||
| (0.062) | ||||
| MTM × Uninsured | 0.083 | |||
| (0.053) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.442** | −0.567*** | ||
| (0.181) | (0.192) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.300** | 0.291 | ||
| (0.140) | (0.201) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.389* | |||
| (0.211) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.730*** | |||
| (0.203) | ||||
| Log(Assets) (z) | 0.776*** | 0.800*** | 0.821*** | 0.791*** |
| (0.061) | (0.057) | (0.059) | (0.060) | |
| Cash Ratio (z) | −0.088 | −0.140* | −0.085 | −0.088 |
| (0.089) | (0.083) | (0.085) | (0.086) | |
| Loan/Deposit (z) | 0.091 | 0.044 | 0.071 | 0.085 |
| (0.073) | (0.071) | (0.072) | (0.072) | |
| Book Equity (z) | −0.167** | −0.219*** | −0.203*** | −0.186** |
| (0.080) | (0.078) | (0.078) | (0.078) | |
| Wholesale (z) | 0.172*** | 0.168*** | 0.166*** | 0.169*** |
| (0.053) | (0.053) | (0.053) | (0.053) | |
| ROA (z) | 0.038 | 0.038 | 0.048 | 0.034 |
| (0.066) | (0.065) | (0.065) | (0.065) | |
| Num.Obs. | 3668 | 3674 | 3668 | 3668 |
| N (dw_acute=1) | 393.000 | 393.000 | 393.000 | 393.000 |
| N (Sample) | 3678.000 | 3678.000 | 3678.000 | 3678.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| Sample: DW users vs pure non-users. Variables z-standardized. Robust SEs. |
# SAVE TABLE 6
save_reg_table(m_dw_logit, "Table_6_DW_Acute_Logit",
title_text = "Table: Discount Window Usage (Logit) - Acute Period",
notes_text = "Sample: DW users vs pure non-users. Variables z-standardized. Robust SEs.",
coef_map_use = COEF_MAP, gof_map_use = gof_logit, add_rows_use = n_dw_logit)Saved: Table_6_DW_Acute_Logit (HTML + LaTeX)
6 TEMPORAL ANALYSIS
6.1 BTFP Temporal Analysis (Acute → Post → Arbitrage → Wind-down)
# ==============================================================================
# BTFP ACROSS PERIODS
# Acute, Post-Acute: 2022Q4 baseline
# Arbitrage: 2023Q3 baseline
# Wind-down: 2023Q4 baseline
# ==============================================================================
# Function to run base + risk specifications
run_temporal_pair <- function(data, dv_var, family_type = "lpm") {
f_base <- build_formula(dv_var, "mtm_total + uninsured_lev + mtm_x_uninsured")
f_risk <- build_formula(dv_var, "run_risk_2 + run_risk_3 + run_risk_4")
if (family_type == "lpm") {
m_base <- feols(f_base, data = data, vcov = "hetero")
m_risk <- feols(f_risk, data = data, vcov = "hetero")
} else {
m_base <- feglm(f_base, data = data, family = binomial("logit"), vcov = "hetero")
m_risk <- feglm(f_risk, data = data, family = binomial("logit"), vcov = "hetero")
}
list(Base = m_base, Risk = m_risk)
}6.1.1 Table: BTFP Temporal (LPM)
# Prepare samples
df_btfp_acute_s <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
df_btfp_post_s <- df_post %>% filter(btfp_post == 1 | non_user == 1)
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
# Run models
m_acute <- run_temporal_pair(df_btfp_acute_s, "btfp_acute", "lpm")
m_post <- run_temporal_pair(df_btfp_post_s, "btfp_post", "lpm")
m_arb <- run_temporal_pair(df_btfp_arb_s, "btfp_arb", "lpm")
m_wind <- run_temporal_pair(df_btfp_wind_s, "btfp_wind", "lpm")
models_btfp_temp <- list(
"Acute (Base)" = m_acute$Base, "Acute (Risk)" = m_acute$Risk,
"Post (Base)" = m_post$Base, "Post (Risk)" = m_post$Risk,
"Arb (Base)" = m_arb$Base, "Arb (Risk)" = m_arb$Risk,
"Wind (Base)" = m_wind$Base, "Wind (Risk)" = m_wind$Risk
)
# N rows
n_rows_temp <- data.frame(
term = c("N (BTFP=1)", "N (Sample)", "Baseline"),
`Acute (Base)` = c(sum(df_btfp_acute_s$btfp_acute), nrow(df_btfp_acute_s), "2022Q4"),
`Acute (Risk)` = c(sum(df_btfp_acute_s$btfp_acute), nrow(df_btfp_acute_s), "2022Q4"),
`Post (Base)` = c(sum(df_btfp_post_s$btfp_post), nrow(df_btfp_post_s), "2022Q4"),
`Post (Risk)` = c(sum(df_btfp_post_s$btfp_post), nrow(df_btfp_post_s), "2022Q4"),
`Arb (Base)` = c(sum(df_btfp_arb_s$btfp_arb), nrow(df_btfp_arb_s), "2023Q3"),
`Arb (Risk)` = c(sum(df_btfp_arb_s$btfp_arb), nrow(df_btfp_arb_s), "2023Q3"),
`Wind (Base)` = c(sum(df_btfp_wind_s$btfp_wind), nrow(df_btfp_wind_s), "2023Q4"),
`Wind (Risk)` = c(sum(df_btfp_wind_s$btfp_wind), nrow(df_btfp_wind_s), "2023Q4"),
check.names = FALSE
)
modelsummary(
models_btfp_temp,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_rows_temp,
title = "Table: BTFP Temporal Analysis (LPM)",
notes = "Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 8) %>%
add_header_above(c(" " = 1, "Acute" = 2, "Post-Acute" = 2, "Arbitrage" = 2, "Wind-down" = 2))| Acute (Base) | Acute (Risk) | Post (Base) | Post (Risk) | Arb (Base) | Arb (Risk) | Wind (Base) | Wind (Risk) | |
|---|---|---|---|---|---|---|---|---|
| MTM Loss (z) | 0.024*** | 0.025*** | 0.022*** | 0.002 | ||||
| (0.006) | (0.008) | (0.007) | (0.004) | |||||
| Uninsured Lev (z) | 0.020*** | 0.018** | 0.014** | 0.007* | ||||
| (0.007) | (0.008) | (0.007) | (0.004) | |||||
| MTM × Uninsured | 0.018*** | 0.016*** | 0.008 | −0.001 | ||||
| (0.005) | (0.006) | (0.005) | (0.003) | |||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.006 | −0.007 | 0.029* | 0.029*** | ||||
| (0.014) | (0.019) | (0.016) | (0.010) | |||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.002 | 0.007 | 0.040** | 0.019* | ||||
| (0.013) | (0.019) | (0.016) | (0.010) | |||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.062*** | 0.055** | 0.041** | 0.032*** | ||||
| (0.017) | (0.022) | (0.018) | (0.011) | |||||
| Log(Assets) (z) | 0.067*** | 0.071*** | 0.068*** | 0.072*** | 0.054*** | 0.055*** | −0.000 | −0.001 |
| (0.007) | (0.007) | (0.009) | (0.009) | (0.007) | (0.007) | (0.004) | (0.004) | |
| Cash Ratio (z) | −0.024*** | −0.027*** | −0.052*** | −0.055*** | −0.036*** | −0.040*** | −0.010*** | −0.009*** |
| (0.005) | (0.005) | (0.007) | (0.006) | (0.006) | (0.006) | (0.004) | (0.004) | |
| Loan/Deposit (z) | −0.008 | −0.011* | −0.021*** | −0.023*** | −0.003 | −0.008 | −0.010** | −0.009** |
| (0.005) | (0.006) | (0.007) | (0.007) | (0.006) | (0.006) | (0.004) | (0.004) | |
| Book Equity (z) | −0.011** | −0.014*** | −0.020*** | −0.023*** | −0.006 | −0.010* | −0.006* | −0.006* |
| (0.004) | (0.004) | (0.006) | (0.006) | (0.006) | (0.005) | (0.003) | (0.003) | |
| Wholesale (z) | 0.025*** | 0.025*** | 0.016** | 0.015** | 0.101*** | 0.101*** | 0.053*** | 0.053*** |
| (0.006) | (0.006) | (0.007) | (0.007) | (0.007) | (0.007) | (0.006) | (0.006) | |
| ROA (z) | −0.005 | −0.005 | −0.013** | −0.013** | −0.024*** | −0.025*** | −0.007* | −0.006* |
| (0.005) | (0.005) | (0.006) | (0.006) | (0.006) | (0.006) | (0.004) | (0.004) | |
| Num.Obs. | 3737 | 3737 | 3515 | 3515 | 4038 | 4038 | 4043 | 4043 |
| R2 | 0.090 | 0.089 | 0.080 | 0.079 | 0.142 | 0.141 | 0.063 | 0.064 |
| R2 Adj. | 0.088 | 0.087 | 0.078 | 0.077 | 0.141 | 0.139 | 0.061 | 0.062 |
| N (BTFP=1) | 462 | 462 | 775 | 775 | 766 | 766 | 229 | 229 |
| N (Sample) | 3747 | 3747 | 3525 | 3525 | 4055 | 4055 | 4061 | 4061 |
| Baseline | 2022Q4 | 2022Q4 | 2022Q4 | 2022Q4 | 2023Q3 | 2023Q3 | 2023Q4 | 2023Q4 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||||
| Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline. |
# SAVE TABLE 4A
save_reg_table(models_btfp_temp, "Table_4A_BTFP_Temporal_LPM",
title_text = "Table: BTFP Temporal Analysis (LPM)",
notes_text = "Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_temp)Saved: Table_4A_BTFP_Temporal_LPM (HTML + LaTeX)
6.1.2 Table: BTFP Arbitrage Period - All Specifications
models_btfp_arb <- run_4spec_models(df_btfp_arb_s, "btfp_arb", "lpm")
n_rows_arb <- create_n_rows(df_btfp_arb_s, "btfp_arb")
modelsummary(
models_btfp_arb,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_rows_arb,
title = "Table: BTFP Arbitrage Period - All Specifications (LPM, 2023Q3 Baseline)",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.022*** | |||
| (0.007) | ||||
| Uninsured Lev (z) | 0.014** | |||
| (0.007) | ||||
| MTM × Uninsured | 0.008 | |||
| (0.005) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.035*** | −0.040*** | ||
| (0.013) | (0.014) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.011 | 0.029* | ||
| (0.016) | (0.016) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.040** | |||
| (0.016) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.041** | |||
| (0.018) | ||||
| Log(Assets) (z) | 0.054*** | 0.054*** | 0.055*** | 0.055*** |
| (0.007) | (0.007) | (0.007) | (0.007) | |
| Cash Ratio (z) | −0.036*** | −0.042*** | −0.040*** | −0.040*** |
| (0.006) | (0.005) | (0.006) | (0.006) | |
| Loan/Deposit (z) | −0.003 | −0.009 | −0.008 | −0.008 |
| (0.006) | (0.006) | (0.006) | (0.006) | |
| Book Equity (z) | −0.006 | −0.011** | −0.010* | −0.010* |
| (0.006) | (0.005) | (0.005) | (0.005) | |
| Wholesale (z) | 0.101*** | 0.100*** | 0.101*** | 0.101*** |
| (0.007) | (0.007) | (0.007) | (0.007) | |
| ROA (z) | −0.024*** | −0.025*** | −0.025*** | −0.025*** |
| (0.006) | (0.005) | (0.006) | (0.006) | |
| Num.Obs. | 4038 | 4048 | 4038 | 4038 |
| R2 | 0.142 | 0.141 | 0.141 | 0.141 |
| R2 Adj. | 0.141 | 0.139 | 0.139 | 0.139 |
| N (btfp_arb=1) | 766.000 | 766.000 | 766.000 | 766.000 |
| N (Sample) | 4055.000 | 4055.000 | 4055.000 | 4055.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
# SAVE TABLE 4B
save_reg_table(models_btfp_arb, "Table_4B_BTFP_Arbitrage_LPM",
title_text = "Table: BTFP Arbitrage Period - All Specifications (LPM)",
notes_text = "2023Q3 Baseline. Sample: BTFP users vs pure non-users.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_arb)Saved: Table_4B_BTFP_Arbitrage_LPM (HTML + LaTeX)
6.1.3 Table: BTFP Temporal (LOGIT)
# ------------------------------------------------------------------------------
# Helper: run Base + Risk (Risk2,3,4) specs for LOGIT (kept generic)
# ------------------------------------------------------------------------------
run_temporal_pair <- function(data, dv_var, family_type = c("lpm","logit")) {
family_type <- match.arg(family_type)
f_base <- build_formula(dv_var, "mtm_total + uninsured_lev + mtm_x_uninsured")
f_risk <- build_formula(dv_var, "run_risk_2 + run_risk_3 + run_risk_4")
if (family_type == "lpm") {
m_base <- feols(f_base, data = data, vcov = "hetero")
m_risk <- feols(f_risk, data = data, vcov = "hetero")
} else {
m_base <- feglm(f_base, data = data, family = binomial("logit"), vcov = "hetero")
m_risk <- feglm(f_risk, data = data, family = binomial("logit"), vcov = "hetero")
}
list(Base = m_base, Risk = m_risk)
}
# ==============================================================================
# Table (LOGIT): BTFP Temporal Analysis
# ==============================================================================
# Prepare samples (BTFP=1 vs pure non-users)
df_btfp_acute_s <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
df_btfp_post_s <- df_post %>% filter(btfp_post == 1 | non_user == 1)
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
# Run LOGIT models
m_acute <- run_temporal_pair(df_btfp_acute_s, "btfp_acute", "logit")
m_post <- run_temporal_pair(df_btfp_post_s, "btfp_post", "logit")
m_arb <- run_temporal_pair(df_btfp_arb_s, "btfp_arb", "logit")
m_wind <- run_temporal_pair(df_btfp_wind_s, "btfp_wind", "logit")
# Collect models (8 columns)
models_btfp_temp_logit <- list(
"Acute (Base)" = m_acute$Base, "Acute (Risk)" = m_acute$Risk,
"Post (Base)" = m_post$Base, "Post (Risk)" = m_post$Risk,
"Arb (Base)" = m_arb$Base, "Arb (Risk)" = m_arb$Risk,
"Wind (Base)" = m_wind$Base, "Wind (Risk)" = m_wind$Risk
)
# N rows + baseline labels (same as your LPM table, but reused here)
n_rows_temp_logit <- data.frame(
term = c("N (BTFP=1)", "N (Sample)", "Baseline"),
`Acute (Base)` = c(sum(df_btfp_acute_s$btfp_acute, na.rm = TRUE), nrow(df_btfp_acute_s), "2022Q4"),
`Acute (Risk)` = c(sum(df_btfp_acute_s$btfp_acute, na.rm = TRUE), nrow(df_btfp_acute_s), "2022Q4"),
`Post (Base)` = c(sum(df_btfp_post_s$btfp_post, na.rm = TRUE), nrow(df_btfp_post_s), "2022Q4"),
`Post (Risk)` = c(sum(df_btfp_post_s$btfp_post, na.rm = TRUE), nrow(df_btfp_post_s), "2022Q4"),
`Arb (Base)` = c(sum(df_btfp_arb_s$btfp_arb, na.rm = TRUE), nrow(df_btfp_arb_s), "2023Q3"),
`Arb (Risk)` = c(sum(df_btfp_arb_s$btfp_arb, na.rm = TRUE), nrow(df_btfp_arb_s), "2023Q3"),
`Wind (Base)` = c(sum(df_btfp_wind_s$btfp_wind, na.rm = TRUE), nrow(df_btfp_wind_s), "2023Q4"),
`Wind (Risk)` = c(sum(df_btfp_wind_s$btfp_wind, na.rm = TRUE), nrow(df_btfp_wind_s), "2023Q4"),
check.names = FALSE
)
modelsummary(
models_btfp_temp_logit,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_logit,
add_rows = n_rows_temp_logit,
title = "Table: BTFP Temporal Analysis (Logit)",
notes = "Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 8) %>%
add_header_above(c(" " = 1, "Acute" = 2, "Post-Acute" = 2, "Arbitrage" = 2, "Wind-down" = 2))| Acute (Base) | Acute (Risk) | Post (Base) | Post (Risk) | Arb (Base) | Arb (Risk) | Wind (Base) | Wind (Risk) | |
|---|---|---|---|---|---|---|---|---|
| MTM Loss (z) | 0.214*** | 0.126** | 0.165*** | 0.042 | ||||
| (0.062) | (0.049) | (0.053) | (0.090) | |||||
| Uninsured Lev (z) | 0.209*** | 0.115** | 0.143*** | 0.185** | ||||
| (0.063) | (0.051) | (0.051) | (0.087) | |||||
| MTM × Uninsured | 0.046 | 0.030 | −0.014 | −0.069 | ||||
| (0.057) | (0.043) | (0.044) | (0.074) | |||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | 0.191 | 0.053 | 0.401*** | 0.787*** | ||||
| (0.188) | (0.142) | (0.148) | (0.271) | |||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.175 | 0.080 | 0.394*** | 0.515** | ||||
| (0.184) | (0.133) | (0.145) | (0.257) | |||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.591*** | 0.286** | 0.383** | 0.770*** | ||||
| (0.180) | (0.139) | (0.149) | (0.268) | |||||
| Log(Assets) (z) | 0.574*** | 0.611*** | 0.378*** | 0.406*** | 0.364*** | 0.387*** | 0.013 | −0.001 |
| (0.062) | (0.059) | (0.052) | (0.050) | (0.049) | (0.047) | (0.084) | (0.082) | |
| Cash Ratio (z) | −0.517*** | −0.527*** | −0.510*** | −0.522*** | −0.528*** | −0.547*** | −0.340*** | −0.305*** |
| (0.105) | (0.104) | (0.070) | (0.069) | (0.078) | (0.077) | (0.105) | (0.100) | |
| Loan/Deposit (z) | 0.001 | −0.018 | −0.104** | −0.118** | 0.031 | −0.006 | −0.180** | −0.159* |
| (0.066) | (0.066) | (0.051) | (0.051) | (0.054) | (0.053) | (0.089) | (0.084) | |
| Book Equity (z) | −0.329*** | −0.359*** | −0.216*** | −0.236*** | −0.169*** | −0.197*** | −0.208** | −0.192** |
| (0.082) | (0.082) | (0.056) | (0.055) | (0.059) | (0.059) | (0.098) | (0.095) | |
| Wholesale (z) | 0.183*** | 0.173*** | 0.073* | 0.067* | 0.546*** | 0.541*** | 0.614*** | 0.617*** |
| (0.046) | (0.046) | (0.041) | (0.040) | (0.038) | (0.038) | (0.049) | (0.049) | |
| ROA (z) | −0.016 | −0.030 | −0.084* | −0.090* | −0.223*** | −0.236*** | −0.172* | −0.169* |
| (0.063) | (0.063) | (0.049) | (0.048) | (0.058) | (0.057) | (0.098) | (0.097) | |
| Num.Obs. | 3737 | 3737 | 3515 | 3515 | 4038 | 4038 | 4043 | 4043 |
| N (BTFP=1) | 462 | 462 | 775 | 775 | 766 | 766 | 229 | 229 |
| N (Sample) | 3747 | 3747 | 3525 | 3525 | 4055 | 4055 | 4061 | 4061 |
| Baseline | 2022Q4 | 2022Q4 | 2022Q4 | 2022Q4 | 2023Q3 | 2023Q3 | 2023Q4 | 2023Q4 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||||
| Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline. |
# SAVE TABLE
save_reg_table(models_btfp_temp_logit, "Table_4C_BTFP_Temporal_LOGIT",
title_text = "Table: BTFP Temporal Analysis (LOGIT)",
notes_text = "Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_temp)Saved: Table_4C_BTFP_Temporal_LOGIT (HTML + LaTeX)
# ==============================================================================
# Table (LOGIT): BTFP Arbitrage Period — All Specifications
# ==============================================================================
# NOTE: Uses your existing run_4spec_models() and create_n_rows()
models_btfp_arb_logit <- run_4spec_models(df_btfp_arb_s, "btfp_arb", "logit")
n_rows_arb_logit <- create_n_rows(df_btfp_arb_s, "btfp_arb")
modelsummary(
models_btfp_arb_logit,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_logit,
add_rows = n_rows_arb_logit,
title = "Table: BTFP Arbitrage Period - All Specifications (Logit, 2023Q3 Baseline)",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.165*** | |||
| (0.053) | ||||
| Uninsured Lev (z) | 0.143*** | |||
| (0.051) | ||||
| MTM × Uninsured | −0.014 | |||
| (0.044) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.391*** | −0.389*** | ||
| (0.128) | (0.134) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | 0.013 | 0.401*** | ||
| (0.116) | (0.148) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.394*** | |||
| (0.145) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.383** | |||
| (0.149) | ||||
| Log(Assets) (z) | 0.364*** | 0.387*** | 0.386*** | 0.387*** |
| (0.049) | (0.045) | (0.046) | (0.047) | |
| Cash Ratio (z) | −0.528*** | −0.551*** | −0.547*** | −0.547*** |
| (0.078) | (0.075) | (0.077) | (0.077) | |
| Loan/Deposit (z) | 0.031 | −0.004 | −0.005 | −0.006 |
| (0.054) | (0.052) | (0.053) | (0.053) | |
| Book Equity (z) | −0.169*** | −0.201*** | −0.196*** | −0.197*** |
| (0.059) | (0.058) | (0.059) | (0.059) | |
| Wholesale (z) | 0.546*** | 0.540*** | 0.542*** | 0.541*** |
| (0.038) | (0.038) | (0.038) | (0.038) | |
| ROA (z) | −0.223*** | −0.231*** | −0.236*** | −0.236*** |
| (0.058) | (0.056) | (0.057) | (0.057) | |
| Num.Obs. | 4038 | 4048 | 4038 | 4038 |
| N (btfp_arb=1) | 766.000 | 766.000 | 766.000 | 766.000 |
| N (Sample) | 4055.000 | 4055.000 | 4055.000 | 4055.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
save_reg_table(models_btfp_arb_logit, "Table_4D_BTFP_Arbitrage_LOGIT",
title_text = "Table: BTFP Arbitrage Period - All Specifications (LOGIT)",
notes_text = "2023Q3 Baseline. Sample: BTFP users vs pure non-users.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_arb)Saved: Table_4D_BTFP_Arbitrage_LOGIT (HTML + LaTeX)
6.1.4 MTM loss on BTFP eligible only
# ------------------------------------------------------------------------------
# Helper: run Base + Risk (Risk2,3,4) specs for LPM (kept generic)
# ------------------------------------------------------------------------------
run_temporal_pair <- function(data, dv_var, family_type = c("lpm","logit")) {
family_type <- match.arg(family_type)
# This adds mtm_btfp, uninsured_lev, AND their interaction
f_base <- build_formula(dv_var, "mtm_btfp + uninsured_lev + mtm_btfp:uninsured_lev")
f_risk <- build_formula(dv_var, "run_risk_2 + run_risk_3 + run_risk_4")
if (family_type == "lpm") {
m_base <- feols(f_base, data = data, vcov = "hetero")
m_risk <- feols(f_risk, data = data, vcov = "hetero")
} else {
m_base <- feglm(f_base, data = data, family = binomial("logit"), vcov = "hetero")
m_risk <- feglm(f_risk, data = data, family = binomial("logit"), vcov = "hetero")
}
list(Base = m_base, Risk = m_risk)
}
# ==============================================================================
# Table 4A (LOGIT): BTFP Temporal Analysis
# ==============================================================================
# Prepare samples (BTFP=1 vs pure non-users)
df_btfp_acute_s <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
df_btfp_post_s <- df_post %>% filter(btfp_post == 1 | non_user == 1)
df_btfp_arb_s <- df_arb %>% filter(btfp_arb == 1 | non_user == 1)
df_btfp_wind_s <- df_wind %>% filter(btfp_wind == 1 | non_user == 1)
# Run LOGIT models
m_acute <- run_temporal_pair(df_btfp_acute_s, "btfp_acute", "lpm")
m_post <- run_temporal_pair(df_btfp_post_s, "btfp_post", "lpm")
m_arb <- run_temporal_pair(df_btfp_arb_s, "btfp_arb", "lpm")
m_wind <- run_temporal_pair(df_btfp_wind_s, "btfp_wind", "lpm")
# Collect models (8 columns)
models_btfp_temp_lpm <- list(
"Acute (Base)" = m_acute$Base, "Acute (Risk)" = m_acute$Risk,
"Post (Base)" = m_post$Base, "Post (Risk)" = m_post$Risk,
"Arb (Base)" = m_arb$Base, "Arb (Risk)" = m_arb$Risk,
"Wind (Base)" = m_wind$Base, "Wind (Risk)" = m_wind$Risk
)
# N rows + baseline labels (same as your LPM table, but reused here)
n_rows_temp_lpm <- data.frame(
term = c("N (BTFP=1)", "N (Sample)", "Baseline"),
`Acute (Base)` = c(sum(df_btfp_acute_s$btfp_acute, na.rm = TRUE), nrow(df_btfp_acute_s), "2022Q4"),
`Acute (Risk)` = c(sum(df_btfp_acute_s$btfp_acute, na.rm = TRUE), nrow(df_btfp_acute_s), "2022Q4"),
`Post (Base)` = c(sum(df_btfp_post_s$btfp_post, na.rm = TRUE), nrow(df_btfp_post_s), "2022Q4"),
`Post (Risk)` = c(sum(df_btfp_post_s$btfp_post, na.rm = TRUE), nrow(df_btfp_post_s), "2022Q4"),
`Arb (Base)` = c(sum(df_btfp_arb_s$btfp_arb, na.rm = TRUE), nrow(df_btfp_arb_s), "2023Q3"),
`Arb (Risk)` = c(sum(df_btfp_arb_s$btfp_arb, na.rm = TRUE), nrow(df_btfp_arb_s), "2023Q3"),
`Wind (Base)` = c(sum(df_btfp_wind_s$btfp_wind, na.rm = TRUE), nrow(df_btfp_wind_s), "2023Q4"),
`Wind (Risk)` = c(sum(df_btfp_wind_s$btfp_wind, na.rm = TRUE), nrow(df_btfp_wind_s), "2023Q4"),
check.names = FALSE
)
modelsummary(
models_btfp_temp_lpm,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_logit,
add_rows = n_rows_temp_lpm,
title = "Table 4E: BTFP Temporal Analysis (Logit)",
notes = "Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline.",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 8) %>%
add_header_above(c(" " = 1, "Acute" = 2, "Post-Acute" = 2, "Arbitrage" = 2, "Wind-down" = 2))| Acute (Base) | Acute (Risk) | Post (Base) | Post (Risk) | Arb (Base) | Arb (Risk) | Wind (Base) | Wind (Risk) | |
|---|---|---|---|---|---|---|---|---|
| MTM Loss OMO (z) | 0.016** | 0.029*** | 0.007 | 0.010** | ||||
| (0.006) | (0.008) | (0.007) | (0.005) | |||||
| Uninsured Lev (z) | 0.014** | 0.012 | 0.010 | 0.008* | ||||
| (0.006) | (0.008) | (0.006) | (0.004) | |||||
| MTM_btfp × Uninsured Lev | 0.011** | −0.001 | −0.005 | −0.004 | ||||
| (0.005) | (0.007) | (0.005) | (0.004) | |||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.006 | −0.007 | 0.029* | 0.029*** | ||||
| (0.014) | (0.019) | (0.016) | (0.010) | |||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.002 | 0.007 | 0.040** | 0.019* | ||||
| (0.013) | (0.019) | (0.016) | (0.010) | |||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.062*** | 0.055** | 0.041** | 0.032*** | ||||
| (0.017) | (0.022) | (0.018) | (0.011) | |||||
| Log(Assets) (z) | 0.066*** | 0.071*** | 0.065*** | 0.072*** | 0.054*** | 0.055*** | −0.001 | −0.001 |
| (0.007) | (0.007) | (0.009) | (0.009) | (0.007) | (0.007) | (0.004) | (0.004) | |
| Cash Ratio (z) | −0.031*** | −0.027*** | −0.057*** | −0.055*** | −0.043*** | −0.040*** | −0.010*** | −0.009*** |
| (0.004) | (0.005) | (0.006) | (0.006) | (0.005) | (0.006) | (0.003) | (0.004) | |
| Loan/Deposit (z) | −0.009 | −0.011* | −0.014* | −0.023*** | −0.007 | −0.008 | −0.006 | −0.009** |
| (0.006) | (0.006) | (0.008) | (0.007) | (0.007) | (0.006) | (0.004) | (0.004) | |
| Book Equity (z) | −0.014*** | −0.014*** | −0.023*** | −0.023*** | −0.010* | −0.010* | −0.006* | −0.006* |
| (0.004) | (0.004) | (0.006) | (0.006) | (0.006) | (0.005) | (0.003) | (0.003) | |
| Wholesale (z) | 0.024*** | 0.025*** | 0.013* | 0.015** | 0.100*** | 0.101*** | 0.052*** | 0.053*** |
| (0.006) | (0.006) | (0.007) | (0.007) | (0.008) | (0.007) | (0.006) | (0.006) | |
| ROA (z) | −0.004 | −0.005 | −0.010 | −0.013** | −0.027*** | −0.025*** | −0.006 | −0.006* |
| (0.005) | (0.005) | (0.006) | (0.006) | (0.006) | (0.006) | (0.004) | (0.004) | |
| Num.Obs. | 3737 | 3737 | 3515 | 3515 | 4038 | 4038 | 4043 | 4043 |
| N (BTFP=1) | 462 | 462 | 775 | 775 | 766 | 766 | 229 | 229 |
| N (Sample) | 3747 | 3747 | 3525 | 3525 | 4055 | 4055 | 4061 | 4061 |
| Baseline | 2022Q4 | 2022Q4 | 2022Q4 | 2022Q4 | 2023Q3 | 2023Q3 | 2023Q4 | 2023Q4 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||||||
| Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline. |
save_reg_table(models_btfp_temp_lpm, "Table_4E_BTFP_Temporal_LPM",
title_text = "Table 4E: BTFP Temporal Analysis (LPM)",
notes_text = "Arbitrage uses 2023Q3 baseline; Wind-down uses 2023Q4 baseline.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_temp)Saved: Table_4E_BTFP_Temporal_LPM (HTML + LaTeX)
6.2 DW Temporal Analysis
6.2.1 Table: DW Temporal (Pre-BTFP → Acute)
# Pre-BTFP
df_dw_pre_s <- df_prebtfp %>% filter(dw_prebtfp == 1 | non_user == 1)
m_pre <- run_temporal_pair(df_dw_pre_s, "dw_prebtfp", "lpm")
# Acute
m_dw_acute <- run_temporal_pair(df_dw_acute, "dw_acute", "lpm")
models_dw_temp <- list(
"Pre-BTFP (Base)" = m_pre$Base, "Pre-BTFP (Risk)" = m_pre$Risk,
"Acute (Base)" = m_dw_acute$Base, "Acute (Risk)" = m_dw_acute$Risk
)
n_rows_dw_temp <- data.frame(
term = c("N (DW=1)", "N (Sample)"),
`Pre-BTFP (Base)` = c(sum(df_dw_pre_s$dw_prebtfp), nrow(df_dw_pre_s)),
`Pre-BTFP (Risk)` = c(sum(df_dw_pre_s$dw_prebtfp), nrow(df_dw_pre_s)),
`Acute (Base)` = c(sum(df_dw_acute$dw_acute), nrow(df_dw_acute)),
`Acute (Risk)` = c(sum(df_dw_acute$dw_acute), nrow(df_dw_acute)),
check.names = FALSE
)
modelsummary(
models_dw_temp,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_rows_dw_temp,
title = "Table: DW Temporal Analysis (LPM)",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9) %>%
add_header_above(c(" " = 1, "Pre-BTFP (Mar 1-12)" = 2, "Acute (Mar 13 - May 1)" = 2))| Pre-BTFP (Base) | Pre-BTFP (Risk) | Acute (Base) | Acute (Risk) | |
|---|---|---|---|---|
| MTM Loss OMO (z) | −0.000 | 0.008 | ||
| (0.003) | (0.006) | |||
| Uninsured Lev (z) | 0.000 | 0.008 | ||
| (0.003) | (0.006) | |||
| MTM_btfp × Uninsured Lev | −0.000 | 0.009* | ||
| (0.002) | (0.005) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.004 | −0.003 | ||
| (0.007) | (0.013) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.001 | 0.008 | ||
| (0.006) | (0.012) | |||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | −0.001 | 0.050*** | ||
| (0.008) | (0.016) | |||
| Log(Assets) (z) | 0.024*** | 0.024*** | 0.084*** | 0.086*** |
| (0.004) | (0.004) | (0.007) | (0.007) | |
| Cash Ratio (z) | −0.005** | −0.004* | −0.007 | −0.003 |
| (0.002) | (0.002) | (0.005) | (0.005) | |
| Loan/Deposit (z) | −0.001 | −0.001 | −0.003 | −0.002 |
| (0.003) | (0.003) | (0.006) | (0.005) | |
| Book Equity (z) | 0.001 | 0.001 | −0.003 | −0.002 |
| (0.002) | (0.002) | (0.004) | (0.004) | |
| Wholesale (z) | 0.013*** | 0.013*** | 0.020*** | 0.020*** |
| (0.004) | (0.004) | (0.006) | (0.006) | |
| ROA (z) | −0.002 | −0.002 | −0.001 | −0.002 |
| (0.002) | (0.002) | (0.005) | (0.005) | |
| Num.Obs. | 3988 | 3988 | 3668 | 3668 |
| R2 | 0.035 | 0.036 | 0.093 | 0.095 |
| R2 Adj. | 0.033 | 0.033 | 0.091 | 0.093 |
| N (DW=1) | 100.000 | 100.000 | 393.000 | 393.000 |
| N (Sample) | 3998.000 | 3998.000 | 3678.000 | 3678.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
# SAVE TABLE 4D
save_reg_table(models_dw_temp, "Table_4D_DW_Temporal_LPM",
title_text = "Table: DW Temporal Analysis (LPM)",
notes_text = "Linear Probability Model estimates comparing DW usage before and after BTFP introduction. Pre-BTFP (Mar 1-12, 2023): only DW available. Acute (Mar 13 - May 1, 2023): both DW and BTFP available. DW = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: DW users vs pure non-users. All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_dw_temp)Saved: Table_4D_DW_Temporal_LPM (HTML + LaTeX)
7 SIZE ANALYSIS
# ==============================================================================
# FUNCTION: Generate Size Analysis Tables
# ==============================================================================
generate_size_tables <- function(data, dv_var, dv_label) {
sizes <- c("Small (<$1B)", "Medium ($1B-$100B)", "Large (>$100B)")
short_names <- c("Small", "Medium", "Large")
models_lpm_base <- list()
models_lpm_risk <- list()
models_log_base <- list()
models_log_risk <- list()
n_info <- data.frame(term = c("N (Users)", "N (Sample)"))
for (i in seq_along(sizes)) {
sz <- sizes[i]
nm <- short_names[i]
df_sub <- data %>% filter(size_cat == sz)
n_users <- sum(df_sub[[dv_var]] == 1, na.rm = TRUE)
n_total <- nrow(df_sub)
f_base <- build_formula(dv_var, "mtm_total + uninsured_lev + mtm_x_uninsured")
f_r1 <- build_formula(dv_var, "run_risk_1")
f_r12 <- build_formula(dv_var, "run_risk_1 + run_risk_2")
f_r234 <- build_formula(dv_var, "run_risk_2 + run_risk_3 + run_risk_4")
if (n_users >= 5) {
# LPM
models_lpm_base[[paste0(nm, " (Base)")]] <- feols(f_base, data = df_sub, vcov = "hetero")
models_lpm_risk[[paste0(nm, " (+R1)")]] <- feols(f_r1, data = df_sub, vcov = "hetero")
models_lpm_risk[[paste0(nm, " (+R1,2)")]] <- feols(f_r12, data = df_sub, vcov = "hetero")
models_lpm_risk[[paste0(nm, " (R2,3,4)")]] <- feols(f_r234, data = df_sub, vcov = "hetero")
n_info[[paste0(nm, " (Base)")]] <- c(n_users, n_total)
n_info[[paste0(nm, " (+R1)")]] <- c(n_users, n_total)
n_info[[paste0(nm, " (+R1,2)")]] <- c(n_users, n_total)
n_info[[paste0(nm, " (R2,3,4)")]] <- c(n_users, n_total)
}
}
# Combine base and risk models
all_models <- c(models_lpm_base, models_lpm_risk)
list(models = all_models, n_rows = n_info)
}7.1 Small Banks - Acute Period
# Small banks sample
df_small_btfp <- df_acute %>% filter(size_cat == "Small (<$1B)") %>% filter(btfp_acute == 1 | non_user == 1)
df_small_dw <- df_acute %>% filter(size_cat == "Small (<$1B)") %>% filter(dw_acute == 1 | non_user == 1)
df_small_anyfed <- df_acute %>% filter(size_cat == "Small (<$1B)") %>% filter(any_fed == 1 | non_user == 1)
# BTFP
if (sum(df_small_btfp$btfp_acute) >= 5) {
models_small_btfp <- run_4spec_models(df_small_btfp, "btfp_acute", "lpm")
n_small_btfp <- create_n_rows(df_small_btfp, "btfp_acute")
modelsummary(
models_small_btfp,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_small_btfp,
title = "Table: BTFP Usage - Small Banks (<$1B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5A
save_reg_table(models_small_btfp, "Table_5A_BTFP_Small_LPM",
title_text = "Table: BTFP Usage - Small Banks (<$1B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for BTFP usage among small banks (total assets < $1B). BTFP = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: BTFP users vs pure non-users within size category. All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_small_btfp)
}Saved: Table_5A_BTFP_Small_LPM (HTML + LaTeX)
# DW
if (sum(df_small_dw$dw_acute) >= 5) {
models_small_dw <- run_4spec_models(df_small_dw, "dw_acute", "lpm")
n_small_dw <- create_n_rows(df_small_dw, "dw_acute")
modelsummary(
models_small_dw,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_small_dw,
title = "Table 5B: DW Usage - Small Banks (<$1B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5B
save_reg_table(models_small_dw, "Table_5B_DW_Small_LPM",
title_text = "Table 5B: DW Usage - Small Banks (<$1B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for DW usage among small banks. DW = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: DW users vs pure non-users within size category. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_small_dw)
}Saved: Table_5B_DW_Small_LPM (HTML + LaTeX)
# Any Fed
if (sum(df_small_anyfed$any_fed) >= 5) {
models_small_anyfed <- run_4spec_models(df_small_anyfed, "any_fed", "lpm")
n_small_anyfed <- create_n_rows(df_small_anyfed, "any_fed")
modelsummary(
models_small_anyfed,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_small_anyfed,
title = "Table 5C: Any Fed Usage - Small Banks (<$1B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5C
save_reg_table(models_small_anyfed, "Table_5C_AnyFed_Small_LPM",
title_text = "Table 5C: Any Fed Usage - Small Banks (<$1B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for any Fed facility usage (BTFP or DW) among small banks. Any Fed = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: Any Fed users vs pure non-users within size category. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_small_anyfed)
}Saved: Table_5C_AnyFed_Small_LPM (HTML + LaTeX)
7.2 Medium Banks - Acute Period
# Medium banks sample
df_med_btfp <- df_acute %>% filter(size_cat == "Medium ($1B-$100B)") %>% filter(btfp_acute == 1 | non_user == 1)
df_med_dw <- df_acute %>% filter(size_cat == "Medium ($1B-$100B)") %>% filter(dw_acute == 1 | non_user == 1)
df_med_anyfed <- df_acute %>% filter(size_cat == "Medium ($1B-$100B)") %>% filter(any_fed == 1 | non_user == 1)
# BTFP
if (sum(df_med_btfp$btfp_acute) >= 5) {
models_med_btfp <- run_4spec_models(df_med_btfp, "btfp_acute", "lpm")
n_med_btfp <- create_n_rows(df_med_btfp, "btfp_acute")
modelsummary(
models_med_btfp,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_med_btfp,
title = "Table: BTFP Usage - Medium Banks ($1B-$100B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5D
save_reg_table(models_med_btfp, "Table_5D_BTFP_Medium_LPM",
title_text = "Table: BTFP Usage - Medium Banks ($1B-$100B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for BTFP usage among medium banks ($1B-$100B total assets). BTFP = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: BTFP users vs pure non-users within size category. All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_med_btfp)
}Saved: Table_5D_BTFP_Medium_LPM (HTML + LaTeX)
# DW
if (sum(df_med_dw$dw_acute) >= 5) {
models_med_dw <- run_4spec_models(df_med_dw, "dw_acute", "lpm")
n_med_dw <- create_n_rows(df_med_dw, "dw_acute")
modelsummary(
models_med_dw,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_med_dw,
title = "Table 5E: DW Usage - Medium Banks ($1B-$100B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5E
save_reg_table(models_med_dw, "Table_5E_DW_Medium_LPM",
title_text = "Table: DW Usage - Medium Banks ($1B-$100B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for DW usage among medium banks. DW = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: DW users vs pure non-users within size category. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_med_dw)
}Saved: Table_5E_DW_Medium_LPM (HTML + LaTeX)
# Any Fed
if (sum(df_med_anyfed$any_fed) >= 5) {
models_med_anyfed <- run_4spec_models(df_med_anyfed, "any_fed", "lpm")
n_med_anyfed <- create_n_rows(df_med_anyfed, "any_fed")
modelsummary(
models_med_anyfed,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_med_anyfed,
title = "Table: Any Fed Usage - Medium Banks ($1B-$100B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5F
save_reg_table(models_med_anyfed, "Table_5F_AnyFed_Medium_LPM",
title_text = "Table: Any Fed Usage - Medium Banks ($1B-$100B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for any Fed facility usage (BTFP or DW) among medium banks. Any Fed = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: Any Fed users vs pure non-users within size category. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_med_anyfed)
}Saved: Table_5F_AnyFed_Medium_LPM (HTML + LaTeX)
7.3 Large Banks - Acute Period
# Large banks sample
df_large_btfp <- df_acute %>% filter(size_cat == "Large (>$100B)") %>% filter(btfp_acute == 1 | non_user == 1)
df_large_dw <- df_acute %>% filter(size_cat == "Large (>$100B)") %>% filter(dw_acute == 1 | non_user == 1)
df_large_anyfed <- df_acute %>% filter(size_cat == "Large (>$100B)") %>% filter(any_fed == 1 | non_user == 1)
# BTFP
if (sum(df_large_btfp$btfp_acute) >= 5) {
models_large_btfp <- run_4spec_models(df_large_btfp, "btfp_acute", "lpm")
n_large_btfp <- create_n_rows(df_large_btfp, "btfp_acute")
modelsummary(
models_large_btfp,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_large_btfp,
title = "Table: BTFP Usage - Large Banks (>$100B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5G
save_reg_table(models_large_btfp, "Table_5G_BTFP_Large_LPM",
title_text = "Table: BTFP Usage - Large Banks (>$100B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for BTFP usage among large banks (total assets > $100B). BTFP = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: BTFP users vs pure non-users within size category. All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_large_btfp)
}Saved: Table_5G_BTFP_Large_LPM (HTML + LaTeX)
# DW
if (sum(df_large_dw$dw_acute) >= 5) {
models_large_dw <- run_4spec_models(df_large_dw, "dw_acute", "lpm")
n_large_dw <- create_n_rows(df_large_dw, "dw_acute")
modelsummary(
models_large_dw,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_large_dw,
title = "Table: DW Usage - Large Banks (>$100B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5H
save_reg_table(models_large_dw, "Table_5H_DW_Large_LPM",
title_text = "Table: DW Usage - Large Banks (>$100B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for DW usage among large banks. DW = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: DW users vs pure non-users within size category. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_large_dw)
}Saved: Table_5H_DW_Large_LPM (HTML + LaTeX)
# Any Fed
if (sum(df_large_anyfed$any_fed) >= 5) {
models_large_anyfed <- run_4spec_models(df_large_anyfed, "any_fed", "lpm")
n_large_anyfed <- create_n_rows(df_large_anyfed, "any_fed")
modelsummary(
models_large_anyfed,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_large_anyfed,
title = "Table: Any Fed Usage - Large Banks (>$100B) - Acute Period (LPM)",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
# SAVE TABLE 5I
save_reg_table(models_large_anyfed, "Table_5I_AnyFed_Large_LPM",
title_text = "Table: Any Fed Usage - Large Banks (>$100B) - Acute Period (LPM)",
notes_text = "Linear Probability Model estimates for any Fed facility usage (BTFP or DW) among large banks. Any Fed = f(MTM Losses, Uninsured Deposits, MTM × Uninsured) + controls. Sample: Any Fed users vs pure non-users within size category. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_large_anyfed)
}Saved: Table_5I_AnyFed_Large_LPM (HTML + LaTeX)
7.4 Consolidated Size Comparison
# ==============================================================================
# CONSOLIDATED: Compare BTFP across size categories
# ==============================================================================
models_size_btfp <- list()
n_rows_size <- data.frame(term = c("N (BTFP=1)", "N (Sample)"))
for (sz in c("Small (<$1B)", "Medium ($1B-$100B)", "Large (>$100B)")) {
df_sub <- df_acute %>% filter(size_cat == sz) %>% filter(btfp_acute == 1 | non_user == 1)
n_users <- sum(df_sub$btfp_acute)
n_total <- nrow(df_sub)
short_nm <- case_when(
sz == "Small (<$1B)" ~ "Small",
sz == "Medium ($1B-$100B)" ~ "Medium",
TRUE ~ "Large"
)
if (n_users >= 5) {
f_base <- build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured")
f_risk <- build_formula("btfp_acute", "run_risk_2 + run_risk_3 + run_risk_4")
models_size_btfp[[paste0(short_nm, " (Base)")]] <- feols(f_base, data = df_sub, vcov = "hetero")
models_size_btfp[[paste0(short_nm, " (Risk)")]] <- feols(f_risk, data = df_sub, vcov = "hetero")
n_rows_size[[paste0(short_nm, " (Base)")]] <- c(n_users, n_total)
n_rows_size[[paste0(short_nm, " (Risk)")]] <- c(n_users, n_total)
}
}
if (length(models_size_btfp) > 0) {
modelsummary(
models_size_btfp,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_rows_size,
title = "Table 5J: BTFP Usage by Bank Size - Consolidated (LPM)",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 8) %>%
add_header_above(c(" " = 1, "Small" = 2, "Medium" = 2, "Large" = 2)) %>%
print()
# SAVE TABLE 5J
save_reg_table(models_size_btfp, "Table_5J_BTFP_Size_Consolidated_LPM",
title_text = "Table: BTFP Usage by Bank Size - Consolidated (LPM)",
notes_text = "Linear Probability Model estimates comparing BTFP usage across bank size categories. Small: assets < $1B; Medium: $1B - $100B; Large: > $100B. Base specification: continuous MTM + Uninsured + interaction. Risk specification: 2×2 risk category dummies. BTFP = f(Risk Categories) + controls. Sample: BTFP users vs pure non-users within each size group. All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_size)
}| Small (Base) | Small (Risk) | Medium (Base) | Medium (Risk) | Large (Base) | Large (Risk) | |
|---|---|---|---|---|---|---|
| MTM Loss (z) | 0.021*** | 0.032* | 0.066 | |||
| (0.006) | (0.019) | (0.226) | ||||
| Uninsured Lev (z) | 0.015** | 0.032* | 0.734*** | |||
| (0.007) | (0.016) | (0.167) | ||||
| MTM × Uninsured | 0.014*** | 0.017 | −0.069 | |||
| (0.005) | (0.014) | (0.124) | ||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | 0.000 | 0.008 | 1.324 | |||
| (0.014) | (0.050) | (2.423) | ||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.006 | 0.005 | 0.247 | |||
| (0.013) | (0.060) | (1.228) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.054*** | 0.092* | 1.595 | |||
| (0.018) | (0.053) | (2.798) | ||||
| Log(Assets) (z) | 0.061*** | 0.063*** | 0.082*** | 0.086*** | ||
| (0.009) | (0.009) | (0.029) | (0.029) | |||
| Cash Ratio (z) | −0.020*** | −0.022*** | −0.069*** | −0.070*** | 0.175 | 0.359 |
| (0.004) | (0.004) | (0.023) | (0.021) | (0.215) | (0.525) | |
| Loan/Deposit (z) | −0.006 | −0.007 | −0.023 | −0.024 | 0.008 | 0.648 |
| (0.006) | (0.006) | (0.020) | (0.020) | (0.306) | (1.067) | |
| Book Equity (z) | −0.009** | −0.011*** | −0.046** | −0.052** | −0.541 | −0.951 |
| (0.004) | (0.004) | (0.021) | (0.021) | (0.346) | (1.592) | |
| Wholesale (z) | 0.021*** | 0.020*** | 0.036** | 0.036** | −0.610 | −0.864 |
| (0.007) | (0.007) | (0.017) | (0.017) | (0.461) | (1.217) | |
| ROA (z) | −0.002 | −0.002 | −0.008 | −0.013 | 0.633* | −0.006 |
| (0.005) | (0.004) | (0.019) | (0.019) | (0.290) | (0.544) | |
| Num.Obs. | 3013 | 3013 | 709 | 709 | 15 | 15 |
| R2 | 0.056 | 0.056 | 0.078 | 0.076 | 0.769 | 0.128 |
| R2 Adj. | 0.053 | 0.053 | 0.066 | 0.064 | 0.461 | −1.034 |
| N (BTFP=1) | 280.000 | 280.000 | 177.000 | 177.000 | 5.000 | 5.000 |
| N (Sample) | 3022.000 | 3022.000 | 710.000 | 710.000 | 15.000 | 15.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
Saved: Table_5J_BTFP_Size_Consolidated_LPM (HTML + LaTeX)
8 SIZE ANALYSIS: Base LPM and Full Risk Logit (6 Models)
sizes <- c("Small (<$1B)", "Medium ($1B-$100B)", "Large (>$100B)")
short_names <- c("Small", "Medium", "Large")
models_base_lpm <- list()
models_risk_logit <- list()
for (i in seq_along(sizes)) {
sz <- sizes[i]
nm <- short_names[i]
df_sub <- df_acute %>% filter(size_cat == sz, btfp_acute == 1 | non_user == 1)
n_users <- sum(df_sub$btfp_acute == 1, na.rm = TRUE)
if (n_users >= 5) {
# Base LPM
f_base <- build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured")
models_base_lpm[[paste0(nm, " (LPM)")]] <- feols(f_base, data = df_sub, vcov = "hetero")
# Full Risk Logit
f_risk <- build_formula("btfp_acute", "run_risk_1 + run_risk_2 + run_risk_3 + run_risk_4")
models_risk_logit[[paste0(nm, " (Logit)")]] <- feglm(f_risk, data = df_sub, family = binomial(link = "logit"))
}
}
# Combine all 6 models
models_size_6 <- c(models_base_lpm, models_risk_logit)
# N rows
n_rows_size <- data.frame(term = c("N (Users)", "N (Sample)"))
for (i in seq_along(sizes)) {
sz <- sizes[i]
nm <- short_names[i]
df_sub <- df_acute %>% filter(size_cat == sz, btfp_acute == 1 | non_user == 1)
n_users <- sum(df_sub$btfp_acute == 1, na.rm = TRUE)
n_total <- nrow(df_sub)
n_rows_size[[paste0(nm, " (LPM)")]] <- c(n_users, n_total)
n_rows_size[[paste0(nm, " (Logit)")]] <- c(n_users, n_total)
}
# Print table
# Print table
modelsummary(
models_size_6,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
add_rows = n_rows_size,
title = "Table: BTFP Usage by Bank Size - Base LPM & Full Risk Logit (Acute Period)",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9) %>%
add_header_above(c(" " = 1, "Base LPM" = 3, "Full Risk Logit" = 3)) %>%
print()| Small (LPM) | Medium (LPM) | Large (LPM) | Small (Logit) | Medium (Logit) | Large (Logit) | |
|---|---|---|---|---|---|---|
| MTM Loss (z) | 0.021*** | 0.032* | 0.066 | |||
| (0.006) | (0.019) | (0.226) | ||||
| Uninsured Lev (z) | 0.015** | 0.032* | 0.734*** | |||
| (0.007) | (0.016) | (0.167) | ||||
| MTM × Uninsured | 0.014*** | 0.017 | −0.069 | |||
| (0.005) | (0.014) | (0.124) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.549** | −0.517 | −7.733 | |||
| (0.221) | (0.356) | (13.621) | ||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.349* | −0.405* | −1.388 | |||
| (0.195) | (0.229) | (3.146) | ||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | −0.382** | −0.445* | −21.654 | |||
| (0.171) | (0.270) | (6043.171) | ||||
| Log(Assets) (z) | 0.061*** | 0.082*** | 0.896*** | 0.494*** | ||
| (0.009) | (0.029) | (0.135) | (0.157) | |||
| Cash Ratio (z) | −0.020*** | −0.069*** | 0.175 | −0.527*** | −0.571*** | 1.749 |
| (0.004) | (0.023) | (0.215) | (0.115) | (0.192) | (2.797) | |
| Loan/Deposit (z) | −0.006 | −0.023 | 0.008 | −0.026 | −0.099 | 3.019 |
| (0.006) | (0.020) | (0.306) | (0.087) | (0.130) | (5.077) | |
| Book Equity (z) | −0.009** | −0.046** | −0.541 | −0.313*** | −0.403** | −4.463 |
| (0.004) | (0.021) | (0.346) | (0.098) | (0.159) | (8.187) | |
| Wholesale (z) | 0.021*** | 0.036** | −0.610 | 0.173*** | 0.180** | −4.361 |
| (0.007) | (0.017) | (0.461) | (0.056) | (0.080) | (7.543) | |
| ROA (z) | −0.002 | −0.008 | 0.633* | −0.033 | −0.088 | 0.001 |
| (0.005) | (0.019) | (0.290) | (0.076) | (0.120) | (1.928) | |
| Num.Obs. | 3013 | 709 | 15 | 3013 | 709 | 15 |
| R2 | 0.056 | 0.078 | 0.769 | 0.106 | 0.075 | 0.120 |
| R2 Adj. | 0.053 | 0.066 | 0.461 | 0.096 | 0.052 | −0.718 |
| N (Users) | 280.000 | 280.000 | 177.000 | 177.000 | 5.000 | 5.000 |
| N (Sample) | 3022.000 | 3022.000 | 710.000 | 710.000 | 15.000 | 15.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
# Save table
save_reg_table(models_size_6, "Table_Size_BTFP_BaseLPM_RiskLogit",
title_text = "Table: BTFP Usage by Bank Size - Base LPM & Full Risk Logit (Acute Period)",
notes_text = "Base LPM: MTM losses + Uninsured leverage + interaction. Full Risk Logit: All four 2×2 risk category dummies. Small: assets < $1B; Medium: $1B-$100B; Large: > $100B. Sample: BTFP users vs pure non-users within each size group. Continuous variables z-standardized. Robust SEs for LPM. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_rows_size)Saved: Table_Size_BTFP_BaseLPM_RiskLogit (HTML + LaTeX)
9 FHLB REGRESSIONS
9.1 Acute Period
# Create FHLB-specific sample (FHLB users vs pure non-users)
df_fhlb_acute <- df_acute %>%
filter(fhlb_user == 1 | non_user == 1)
cat("\n=== FHLB ANALYSIS SAMPLE ===\n")=== FHLB ANALYSIS SAMPLE ===
cat("FHLB Users:", sum(df_fhlb_acute$fhlb_user), "\n")FHLB Users: 302
cat("Pure Non-Users:", sum(df_fhlb_acute$non_user), "\n")Pure Non-Users: 3285
cat("Total Sample:", nrow(df_fhlb_acute), "\n")Total Sample: 3587
# Run 4-specification models
m_fhlb_lpm <- run_4spec_models(df_fhlb_acute, "fhlb_user", "lpm")
n_fhlb <- create_n_rows(df_fhlb_acute, "fhlb_user")
# Display table
modelsummary(
m_fhlb_lpm,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP, gof_map = gof_lpm, add_rows = n_fhlb,
title = "Table: FHLB Usage - Acute Period (Mar 13 - May 1, 2023) - LPM",
output = "kableExtra"
) %>% kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Risk1 | (3) +Risk1,2 | (4) Risk2,3,4 | |
|---|---|---|---|---|
| MTM Loss (z) | 0.003 | |||
| (0.006) | ||||
| Uninsured Lev (z) | 0.006 | |||
| (0.005) | ||||
| MTM × Uninsured | −0.004 | |||
| (0.004) | ||||
| Risk 1: \(&lt;\) Med MTM & \(&lt;\) Med Uninsured | −0.005 | −0.002 | ||
| (0.011) | (0.012) | |||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | 0.009 | 0.013 | ||
| (0.012) | (0.013) | |||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | −0.007 | |||
| (0.013) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.015 | |||
| (0.015) | ||||
| Log(Assets) (z) | 0.025*** | 0.028*** | 0.028*** | 0.026*** |
| (0.006) | (0.006) | (0.006) | (0.006) | |
| Cash Ratio (z) | −0.021*** | −0.021*** | −0.022*** | −0.023*** |
| (0.004) | (0.003) | (0.004) | (0.004) | |
| Loan/Deposit (z) | 0.024*** | 0.024*** | 0.023*** | 0.024*** |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Book Equity (z) | 0.010** | 0.008** | 0.008** | 0.009** |
| (0.004) | (0.004) | (0.004) | (0.004) | |
| Wholesale (z) | 0.002 | 0.001 | 0.001 | 0.001 |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| ROA (z) | −0.009** | −0.009** | −0.010** | −0.010** |
| (0.004) | (0.004) | (0.004) | (0.004) | |
| Num.Obs. | 3577 | 3583 | 3577 | 3577 |
| R2 | 0.039 | 0.039 | 0.039 | 0.039 |
| R2 Adj. | 0.037 | 0.037 | 0.037 | 0.037 |
| N (fhlb_user=1) | 302.000 | 302.000 | 302.000 | 302.000 |
| N (Sample) | 3587.000 | 3587.000 | 3587.000 | 3587.000 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
# Save table
save_reg_table(m_fhlb_lpm, "Table_3D_FHLB_Acute_LPM",
title_text = "Table: FHLB (Abnormal Borrowing) - Acute Period (LPM)",
notes_text = "Linear Probability Model. FHLB user = 1 if bank had abnormal FHLB advance increase (>10% of assets). Sample: FHLB users vs pure non-users (no BTFP, no DW, no abnormal FHLB). Reference: Risk 1 (Low MTM, Low Uninsured). All continuous variables z-standardized. Heteroskedasticity-robust standard errors. Significance: *** p<0.01, ** p<0.05, * p<0.10.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm, add_rows_use = n_fhlb)Saved: Table_3D_FHLB_Acute_LPM (HTML + LaTeX)
9.2 FHLB Regression by Period
# ==============================================================================
# FHLB ANALYSIS BY QUARTER
# ==============================================================================
# Prepare FHLB data
df_fhlb <- call_q %>%
filter(!idrssd %in% excluded_banks,
period %in% c("2022Q3", "2022Q4", "2023Q1", "2023Q2", "2023Q3")) %>%
select(
idrssd, period,
fhlb_adv, fhlb_to_total_asset,
abnormal_fhlb_borrowing_10pct, abnormal_fhlb_borrowing_5pct,
total_asset, mtm_loss_to_total_asset, uninsured_deposit_to_total_asset,
cash_to_total_asset, book_equity_to_total_asset, loan_to_deposit,
fed_fund_purchase, repo, other_borrowed_less_than_1yr, total_liability, roa
) %>%
filter(!is.na(abnormal_fhlb_borrowing_10pct)) %>%
mutate(
fhlb_user = abnormal_fhlb_borrowing_10pct,
# Create controls (winsorize then standardize within sample)
mtm_total_raw = mtm_loss_to_total_asset,
uninsured_lev_raw = uninsured_deposit_to_total_asset,
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(
replace_na(fed_fund_purchase, 0) + replace_na(repo, 0) +
replace_na(other_borrowed_less_than_1yr, 0),
total_liability, 0) * 100,
roa_raw = roa
)
# Summary by period
fhlb_summary <- df_fhlb %>%
group_by(period) %>%
summarise(
N = n(),
`% Abnormal (10%)` = round(mean(fhlb_user, na.rm = TRUE) * 100, 1),
`Mean FHLB/Assets (%)` = round(mean(fhlb_to_total_asset, na.rm = TRUE), 2),
.groups = "drop"
)
cat("\n=== FHLB USAGE BY PERIOD ===\n")##
## === FHLB USAGE BY PERIOD ===print(fhlb_summary)## # A tibble: 5 × 4
## period N `% Abnormal (10%)` `Mean FHLB/Assets (%)`
## <chr> <int> <dbl> <dbl>
## 1 2022Q3 4724 9.5 2.16
## 2 2022Q4 4696 6.9 2.72
## 3 2023Q1 4673 7.5 2.87
## 4 2023Q2 4644 5.1 3.22
## 5 2023Q3 4604 4.6 3.23save_kable_table(fhlb_summary, "Table_FHLB_Summary_by_Quarter",
"FHLB Abnormal Borrowing by Quarter",
"Abnormal borrowing defined as FHLB increase > 10% of assets.")## Saved: Table_FHLB_Summary_by_Quarter (HTML + LaTeX)# ==============================================================================
# FHLB REGRESSIONS BY PERIOD
# ==============================================================================
# Function to run FHLB regression for a given period
run_fhlb_reg <- function(data, period_val) {
df <- data %>%
filter(period == period_val) %>%
# Winsorize and standardize WITHIN period
mutate(
mtm_total = standardize_z(winsorize(mtm_total_raw)),
uninsured_lev = standardize_z(winsorize(uninsured_lev_raw)),
ln_assets = standardize_z(winsorize(ln_assets_raw)),
cash_ratio = standardize_z(winsorize(cash_ratio_raw)),
book_equity_ratio = standardize_z(winsorize(book_equity_ratio_raw)),
loan_to_deposit = standardize_z(winsorize(loan_to_deposit_raw)),
wholesale = standardize_z(winsorize(wholesale_raw)),
roa = standardize_z(winsorize(roa_raw))
) %>%
# Keep only complete cases
filter(!is.na(fhlb_user), !is.na(mtm_total), !is.na(uninsured_lev),
!is.na(ln_assets), !is.na(cash_ratio), !is.na(book_equity_ratio),
!is.na(loan_to_deposit), !is.na(wholesale), !is.na(roa))
if (nrow(df) < 50) {
cat("Warning: Period", period_val, "has only", nrow(df), "obs\n")
return(NULL)
}
# Same controls as extensive margin
m <- feols(fhlb_user ~ mtm_total + uninsured_lev + ln_assets + cash_ratio +
book_equity_ratio + loan_to_deposit + wholesale + roa,
data = df, vcov = "hetero")
return(m)
}
# Run for each period
periods_fhlb <- c("2022Q4", "2023Q1", "2023Q2", "2023Q3")
models_fhlb <- list()
for (p in periods_fhlb) {
m <- run_fhlb_reg(df_fhlb, p)
if (!is.null(m)) {
models_fhlb[[paste0("FHLB: ", p)]] <- m
}
}
# Display
if (length(models_fhlb) > 0) {
modelsummary(
models_fhlb,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = gof_lpm,
title = "Table: FHLB Abnormal Borrowing Determinants by Quarter",
notes = list(
"DV: Abnormal FHLB indicator (10% threshold).",
"LPM with heteroskedasticity-robust SE."
),
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)
save_reg_table(models_fhlb, "Table_FHLB_Temporal",
title_text = "FHLB Abnormal Borrowing Determinants by Quarter",
notes_text = "DV: Abnormal FHLB indicator. LPM with robust SE.",
coef_map_use = COEF_MAP, gof_map_use = gof_lpm)
}## Saved: Table_FHLB_Temporal (HTML + LaTeX)10 MULTINOMIAL CHOICE MODEL
# ==============================================================================
# MULTINOMIAL FACILITY CHOICE
# ==============================================================================
df_choice <- df_acute %>%
mutate(
facility_choice = case_when(
btfp_acute == 1 & dw_acute == 0 & fhlb_user == 0 ~ "BTFP_Only",
btfp_acute == 0 & dw_acute == 1 & fhlb_user == 0 ~ "DW_Only",
btfp_acute == 0 & dw_acute == 0 & fhlb_user == 1 ~ "FHLB_Only",
(btfp_acute + dw_acute + fhlb_user) >= 2 ~ "Multiple",
TRUE ~ "None"
),
facility_choice = factor(facility_choice,
levels = c("None", "DW_Only", "BTFP_Only", "FHLB_Only", "Multiple"))
)
cat("\n=== FACILITY CHOICE DISTRIBUTION ===\n")##
## === FACILITY CHOICE DISTRIBUTION ===print(table(df_choice$facility_choice))##
## None DW_Only BTFP_Only FHLB_Only Multiple
## 3285 277 343 246 141# Base specification (same controls)
mlogit_base <- multinom(
facility_choice ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + book_equity_ratio +
loan_to_deposit + wholesale + roa,
data = df_choice, trace = FALSE, maxit = 500
)
# Risk categories
mlogit_risk <- multinom(
facility_choice ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + book_equity_ratio +
loan_to_deposit + wholesale + roa,
data = df_choice, trace = FALSE, maxit = 500
)
cat("\n=== MULTINOMIAL LOGIT: BASE SPECIFICATION ===\n")##
## === MULTINOMIAL LOGIT: BASE SPECIFICATION ===print(summary(mlogit_base))## Call:
## multinom(formula = facility_choice ~ mtm_total + uninsured_lev +
## mtm_x_uninsured + ln_assets + cash_ratio + book_equity_ratio +
## loan_to_deposit + wholesale + roa, data = df_choice, trace = FALSE,
## maxit = 500)
##
## Coefficients:
## (Intercept) mtm_total uninsured_lev mtm_x_uninsured ln_assets
## DW_Only -2.687 0.21326 0.06667 0.05108 0.7090
## BTFP_Only -2.567 0.23774 0.10090 0.02358 0.4856
## FHLB_Only -2.868 0.01245 0.06211 -0.11767 0.1294
## Multiple -3.741 0.17050 0.41406 0.10733 0.8985
## cash_ratio book_equity_ratio loan_to_deposit wholesale roa
## DW_Only -0.03707 -0.16513 0.11331 0.14392 0.09224
## BTFP_Only -0.53425 -0.37296 0.02594 0.14954 0.03558
## FHLB_Only -0.67899 0.07789 0.42678 -0.01835 -0.08354
## Multiple -0.29240 -0.18294 0.07196 0.24556 -0.15211
##
## Std. Errors:
## (Intercept) mtm_total uninsured_lev mtm_x_uninsured ln_assets
## DW_Only 0.07670 0.07776 0.07285 0.06369 0.07261
## BTFP_Only 0.07820 0.07179 0.07183 0.06373 0.07116
## FHLB_Only 0.08906 0.08022 0.08510 0.07082 0.08525
## Multiple 0.13391 0.11949 0.09903 0.08983 0.10066
## cash_ratio book_equity_ratio loan_to_deposit wholesale roa
## DW_Only 0.09369 0.09130 0.08560 0.05777 0.07379
## BTFP_Only 0.11402 0.09286 0.07878 0.05144 0.07058
## FHLB_Only 0.13715 0.08110 0.09001 0.07174 0.07327
## Multiple 0.15516 0.14252 0.12394 0.07295 0.11050
##
## Residual Deviance: 6700
## AIC: 6780# Save model
saveRDS(list(base = mlogit_base, risk = mlogit_risk),
file.path(TABLE_PATH, "multinomial_models.rds"))# ==============================================================================
# MULTINOMIAL COEFFICIENT PLOT
# ==============================================================================
# Extract coefficients
mlogit_coefs <- tidy(mlogit_base, conf.int = TRUE) %>%
filter(term %in% c("mtm_total", "uninsured_lev")) %>%
mutate(
term_label = case_when(
term == "mtm_total" ~ "MTM Loss (z)",
term == "uninsured_lev" ~ "Uninsured Leverage (z)"
),
y.level = factor(y.level, levels = c("FHLB_Only", "DW_Only", "BTFP_Only", "Multiple"))
)
p_mlogit <- ggplot(mlogit_coefs, aes(x = estimate, y = y.level, color = term_label)) +
geom_vline(xintercept = 0, linetype = "dashed") +
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) +
facet_wrap(~term_label, scales = "free_x") +
scale_color_brewer(palette = "Dark2") +
labs(
title = "Figure: Drivers of Facility Choice (Multinomial Logit)",
subtitle = "Reference category: None",
x = "Coefficient (Log Odds)", y = "Facility Choice"
) +
theme_bw(base_size = 12) +
theme(legend.position = "none", strip.text = element_text(face = "bold"))
print(p_mlogit)
save_figure(p_mlogit, "Figure_Multinomial_Coefficients", width = 12, height = 8)## Saved: Figure_Multinomial_Coefficients (PDF + PNG)11 INTENSIVE MARGIN ANALYSIS
# ==============================================================================
# INTENSIVE MARGIN: DRIVERS OF BORROWING AMOUNT
# ==============================================================================
df_intensive <- df_acute %>%
filter(btfp_acute == 1) %>%
mutate(
# DV: Borrowing as % of assets
btfp_pct = winsorize((btfp_acute_amt / (total_asset * 1000)) * 100),
# Par benefit: loss rate on eligible collateral
par_benefit_raw = mtm_loss_omo_eligible_to_omo_eligible,
par_benefit = standardize_z(winsorize(par_benefit_raw)),
# Capacity: eligible collateral / assets
capacity_raw = omo_eligible_to_total_asset,
capacity = standardize_z(winsorize(capacity_raw)),
# Liquidity need: outflow
outflow_z = ifelse(is.na(uninsured_outflow), 0, uninsured_outflow)
)
cat("\n=== INTENSIVE MARGIN SAMPLE ===\n")##
## === INTENSIVE MARGIN SAMPLE ===cat("BTFP Borrowers:", nrow(df_intensive), "\n")## BTFP Borrowers: 462cat("Mean BTFP/Assets:", round(mean(df_intensive$btfp_pct, na.rm = TRUE), 3), "%\n")## Mean BTFP/Assets: 5.408 %# IPW Setup
df_ipw <- df_acute %>%
filter(!is.na(mtm_loss_omo_eligible_to_omo_eligible)) %>%
mutate(
par_benefit_w = winsorize(mtm_loss_omo_eligible_to_omo_eligible),
capacity_w = winsorize(omo_eligible_to_total_asset)
)
m_ps <- glm(btfp_acute ~ par_benefit_w + capacity_w + uninsured_lev_w +
ln_assets_w + cash_ratio_w + wholesale_w,
data = df_ipw, family = binomial)
df_ipw$ps <- predict(m_ps, type = "response")
df_intensive <- df_intensive %>%
left_join(df_ipw %>% select(idrssd, ps), by = "idrssd") %>%
mutate(
ipw = 1 / ps,
ipw_trim = winsorize(ipw, probs = c(0.05, 0.95))
)# ==============================================================================
# INTENSIVE MARGIN REGRESSIONS
# ==============================================================================
# Model 1: OLS (same control structure)
m_int_1 <- feols(btfp_pct ~ par_benefit + capacity + outflow_z +
ln_assets + cash_ratio + book_equity_ratio +
loan_to_deposit + wholesale + roa,
data = df_intensive, vcov = "hetero")
# Model 2: IPW Corrected
m_int_2 <- feols(btfp_pct ~ par_benefit + capacity + outflow_z +
ln_assets + cash_ratio + book_equity_ratio +
loan_to_deposit + wholesale + roa,
data = df_intensive, weights = ~ipw_trim, vcov = "hetero")
# Model 3: Replace outflow with uninsured_lev
m_int_3 <- feols(btfp_pct ~ par_benefit + capacity + uninsured_lev +
ln_assets + cash_ratio + book_equity_ratio +
loan_to_deposit + wholesale + roa,
data = df_intensive, weights = ~ipw_trim, vcov = "hetero")
# Model 4: + Risk Categories
m_int_4 <- feols(btfp_pct ~ par_benefit + capacity + run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + book_equity_ratio +
loan_to_deposit + wholesale + roa,
data = df_intensive, weights = ~ipw_trim, vcov = "hetero")
models_int <- list(
"(1) OLS" = m_int_1,
"(2) IPW" = m_int_2,
"(3) +UninsLev" = m_int_3,
"(4) +Risk" = m_int_4
)
COEF_MAP_INT <- c(
"par_benefit" = "Par Benefit (z)",
"capacity" = "Collateral Capacity (z)",
"outflow_z" = "Deposit Outflow (z)",
COEF_MAP
)
modelsummary(
models_int,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP_INT,
gof_map = c("nobs", "r.squared"),
title = "Table: Intensive Margin - Drivers of BTFP Borrowing Amount",
notes = list(
"DV: BTFP Borrowing / Assets (%). Sample: BTFP Borrowers only.",
"Par Benefit = MTM Loss / Eligible Collateral. IPW corrects for selection.",
"Heteroskedasticity-robust SE."
),
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) OLS | (2) IPW | (3) +UninsLev | (4) +Risk | |
|---|---|---|---|---|
| Par Benefit (z) | −0.087 | −0.000 | 0.006 | 0.050 |
| (0.301) | (0.327) | (0.333) | (0.336) | |
| Collateral Capacity (z) | 0.611* | 0.703 | 0.704* | 0.655 |
| (0.333) | (0.426) | (0.421) | (0.436) | |
| Deposit Outflow (z) | −0.171 | 0.095 | ||
| (0.362) | (0.404) | |||
| Uninsured Lev (z) | 0.067 | |||
| (0.454) | ||||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | 1.179 | |||
| (1.139) | ||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.606 | |||
| (0.850) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.261 | |||
| (0.919) | ||||
| Log(Assets) (z) | 0.080 | 0.198 | 0.166 | 0.164 |
| (0.315) | (0.385) | (0.465) | (0.427) | |
| Cash Ratio (z) | 0.437 | 0.493 | 0.466 | 0.394 |
| (0.696) | (0.776) | (0.766) | (0.809) | |
| Loan/Deposit (z) | −0.520 | −0.816 | −0.805 | −0.920 |
| (0.458) | (0.548) | (0.558) | (0.563) | |
| Book Equity (z) | 0.241 | 0.500 | 0.524 | 0.545 |
| (0.459) | (0.551) | (0.548) | (0.541) | |
| Wholesale (z) | 0.426* | 0.327 | 0.336 | 0.373 |
| (0.237) | (0.309) | (0.306) | (0.303) | |
| ROA (z) | −0.552* | −0.553 | −0.547 | −0.566 |
| (0.315) | (0.339) | (0.338) | (0.347) | |
| Num.Obs. | 462 | 462 | 462 | 462 |
| R2 | 0.049 | 0.066 | 0.066 | 0.071 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| DV: BTFP Borrowing / Assets (%). Sample: BTFP Borrowers only. | ||||
| Par Benefit = MTM Loss / Eligible Collateral. IPW corrects for selection. | ||||
| Heteroskedasticity-robust SE. |
save_reg_table(models_int, "Table_Intensive_Margin",
title_text = "Intensive Margin: Drivers of BTFP Borrowing Amount",
notes_text = "DV: BTFP/Assets. IPW corrects for selection. Robust SE.",
coef_map_use = COEF_MAP_INT, gof_map_use = c("nobs", "r.squared"))## Saved: Table_Intensive_Margin (HTML + LaTeX)12 DEPOSIT OUTFLOWS AND BORROWING
12.1 Did Outflows Predict Emergency Borrowing?
# ==============================================================================
# DID DEPOSIT OUTFLOWS PREDICT BORROWING?
# ==============================================================================
# Sample: BTFP users vs pure non-users
df_btfp_out <- df_acute %>%
filter(btfp_acute == 1 | non_user == 1) %>%
filter(!is.na(uninsured_outflow))
# Model 1: Base (no outflow)
m_out_1 <- feols(build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured"),
data = df_btfp_out, vcov = "hetero")
# Model 2: + Uninsured Outflow
m_out_2 <- feols(build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured + uninsured_outflow"),
data = df_btfp_out, vcov = "hetero")
# Model 3: + Both Outflows
m_out_3 <- feols(build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured + uninsured_outflow + insured_outflow"),
data = df_btfp_out, vcov = "hetero")
# Model 4: Risk Categories + Outflows
m_out_4 <- feols(build_formula("btfp_acute", "run_risk_2 + run_risk_3 + run_risk_4 + uninsured_outflow + insured_outflow"),
data = df_btfp_out, vcov = "hetero")
models_outflow <- list(
"(1) Base" = m_out_1,
"(2) +Unins Out" = m_out_2,
"(3) +Both Out" = m_out_3,
"(4) Risk+Out" = m_out_4
)
COEF_MAP_OUT <- c(
COEF_MAP,
"uninsured_outflow" = "Uninsured Deposit Outflow (z)",
"insured_outflow" = "Insured Deposit Outflow (z)"
)
modelsummary(
models_outflow,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP_OUT,
gof_map = gof_lpm,
title = "Table: BTFP Usage - Did Deposit Outflows Predict Borrowing?",
notes = list(
"DV: BTFP borrower (1/0). Outflows: Q1 2023 change, positive = loss.",
"LPM with heteroskedasticity-robust SE."
),
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Base | (2) +Unins Out | (3) +Both Out | (4) Risk+Out | |
|---|---|---|---|---|
| MTM Loss (z) | 0.025*** | 0.025*** | 0.024*** | |
| (0.006) | (0.006) | (0.006) | ||
| Uninsured Lev (z) | 0.021*** | 0.019*** | 0.021*** | |
| (0.007) | (0.007) | (0.007) | ||
| MTM × Uninsured | 0.017*** | 0.018*** | 0.018*** | |
| (0.005) | (0.005) | (0.005) | ||
| Risk 2: \(<\) Med MTM & \(>\) Med Uninsured | −0.007 | |||
| (0.014) | ||||
| Risk 3: \(&gt;\) Med MTM & \(&lt;\) Med Uninsured | 0.000 | |||
| (0.013) | ||||
| Risk 4: \(&gt;\) Med MTM & \(&gt;\) Med Uninsured | 0.061*** | |||
| (0.017) | ||||
| Log(Assets) (z) | 0.069*** | 0.068*** | 0.068*** | 0.073*** |
| (0.008) | (0.008) | (0.008) | (0.007) | |
| Cash Ratio (z) | −0.025*** | −0.025*** | −0.026*** | −0.028*** |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Loan/Deposit (z) | −0.007 | −0.007 | −0.004 | −0.007 |
| (0.006) | (0.006) | (0.006) | (0.006) | |
| Book Equity (z) | −0.013*** | −0.012** | −0.012** | −0.015*** |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Wholesale (z) | 0.026*** | 0.027*** | 0.027*** | 0.026*** |
| (0.006) | (0.006) | (0.006) | (0.006) | |
| ROA (z) | −0.006 | −0.006 | −0.007 | −0.007 |
| (0.005) | (0.005) | (0.005) | (0.005) | |
| Uninsured Deposit Outflow (z) | −0.016*** | −0.017*** | −0.017*** | |
| (0.005) | (0.005) | (0.005) | ||
| Insured Deposit Outflow (z) | −0.008 | −0.008 | ||
| (0.007) | (0.007) | |||
| Num.Obs. | 3674 | 3674 | 3674 | 3674 |
| R2 | 0.093 | 0.095 | 0.095 | 0.094 |
| R2 Adj. | 0.090 | 0.093 | 0.093 | 0.092 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| DV: BTFP borrower (1/0). Outflows: Q1 2023 change, positive = loss. | ||||
| LPM with heteroskedasticity-robust SE. |
save_reg_table(models_outflow, "Table_BTFP_Outflows",
title_text = "BTFP Usage with Deposit Outflow Controls",
notes_text = "DV: BTFP indicator. Outflows: (Q4-Q1)/Q4. LPM with robust SE.",
coef_map_use = COEF_MAP_OUT, gof_map_use = gof_lpm)## Saved: Table_BTFP_Outflows (HTML + LaTeX)13 DIFFERENCE-IN-DIFFERENCES ANALYSIS
DIFFERENCE-IN-DIFFERENCES ANALYSIS
13.1 DiD Design
Treatment: Banks with OMO-eligible securities (can access BTFP) Control: Banks without OMO-eligible securities (cannot access BTFP) Event: BTFP announcement (March 12, 2023) Outcome: Deposit stability (quarterly change in deposits)
# ==============================================================================
# DiD PANEL DATA (INCLUDE BOTH OMO AND NON-OMO BANKS)
# ==============================================================================
df_did_panel <- call_q %>%
filter(!idrssd %in% excluded_banks,
period %in% c("2022Q1", "2022Q2", "2022Q3", "2022Q4",
"2023Q1", "2023Q2", "2023Q3")) %>%
select(
idrssd, period,
omo_eligible,
change_total_deposit_fwd_q, change_uninsured_fwd_q,
total_asset, uninsured_deposit, total_deposit, total_liability, total_equity,
cash_to_total_asset, total_loan, roa,
mtm_loss_to_total_asset,
fed_fund_purchase, repo, other_borrowed_less_than_1yr,
book_equity_to_total_asset, loan_to_deposit
) %>%
# Create variables BEFORE filtering
mutate(
has_omo = as.integer(!is.na(omo_eligible) & omo_eligible > 0),
post_btfp = as.integer(period >= "2023Q1"),
did_term = has_omo * post_btfp,
# Raw controls
mtm_total_raw = mtm_loss_to_total_asset,
uninsured_lev_raw = safe_div(uninsured_deposit, total_asset),
ln_assets_raw = log(total_asset),
cash_ratio_raw = cash_to_total_asset,
book_equity_ratio_raw = book_equity_to_total_asset,
loan_to_deposit_raw = loan_to_deposit,
wholesale_raw = safe_div(
replace_na(fed_fund_purchase, 0) + replace_na(repo, 0) +
replace_na(other_borrowed_less_than_1yr, 0),
total_liability, 0
) * 100,
roa_raw = roa,
# Outcome
outflow_total_dep = -1 * lag(change_total_deposit_fwd_q),
outflow_uninsured = -1 * lag(change_uninsured_fwd_q)
) %>%
ungroup() %>%
# Filter valid observations
filter(!is.na(ln_assets_raw), is.finite(ln_assets_raw),
is.finite(outflow_total_dep), is.finite(outflow_uninsured)) %>%
# Winsorize and standardize
mutate(
mtm_total = standardize_z(winsorize(mtm_total_raw)),
uninsured_lev = standardize_z(winsorize(uninsured_lev_raw)),
ln_assets = standardize_z(winsorize(ln_assets_raw)),
cash_ratio = standardize_z(winsorize(cash_ratio_raw)),
book_equity_ratio = standardize_z(winsorize(book_equity_ratio_raw)),
loan_to_deposit = standardize_z(winsorize(loan_to_deposit_raw)),
wholesale = standardize_z(winsorize(wholesale_raw)),
roa = standardize_z(winsorize(roa_raw))
)
cat("\n=== DiD PANEL SUMMARY ===\n")##
## === DiD PANEL SUMMARY ===cat("Total Obs:", nrow(df_did_panel), "\n")## Total Obs: 32284cat("Treated (OMO):", n_distinct(df_did_panel$idrssd[df_did_panel$has_omo == 1]), "banks\n")## Treated (OMO): 4460 bankscat("Control (No OMO):", n_distinct(df_did_panel$idrssd[df_did_panel$has_omo == 0]), "banks\n")## Control (No OMO): 576 banks13.2 DiD Regressions
# ==============================================================================
# 2.2 DiD Regressions
# ==============================================================================
# DV: Outflow (positive = deposit loss/runoff, negative = growth)
# Interpretation: Negative coefficient on did_term = BTFP REDUCED outflows (helped)
# --- Define Formula Components ---
# Standard Controls (Time-varying controls for Fixed Effects model)
CONTROLS_DID <- "mtm_total + uninsured_lev + ln_assets + cash_ratio + book_equity_ratio + loan_to_deposit + wholesale + roa"
# Explanatory Variables for different specifications
# Model 1: Basic DiD Term only
EXPL_DID_1 <- "did_term"
# Model 2: DiD + Key Risk Measures (MTM & Uninsured)
EXPL_DID_2 <- "did_term + mtm_total + uninsured_lev"
# --- Construct Formulas ---
# Note: | idrssd + period adds Two-Way Fixed Effects
f_did_1 <- as.formula(paste("outflow_total_dep ~", EXPL_DID_1, "| idrssd + period"))
f_did_2 <- as.formula(paste("outflow_total_dep ~", EXPL_DID_2, "| idrssd + period"))
f_did_3 <- as.formula(paste("outflow_total_dep ~ did_term +", CONTROLS_DID, "| idrssd + period"))
f_did_unins <- as.formula(paste("outflow_uninsured ~ did_term +", CONTROLS_DID, "| idrssd + period"))
# --- Run Regressions ---
# Model 1: Basic DiD
m_did_1 <- feols(f_did_1, data = df_did_panel, cluster = "idrssd")
# Model 2: + Risk Controls
m_did_2 <- feols(f_did_2, data = df_did_panel, cluster = "idrssd")
# Model 3: Full Controls (Total Deposits)
m_did_3 <- feols(f_did_3, data = df_did_panel, cluster = "idrssd")
# Model 4: Full Controls (Uninsured Deposits)
m_did_4 <- feols(f_did_unins, data = df_did_panel, cluster = "idrssd")
# --- Output Table ---
models_did <- list(
"(1) Basic" = m_did_1,
"(2) +Risk" = m_did_2,
"(3) +Controls" = m_did_3,
"(4) Uninsured" = m_did_4
)
COEF_MAP_DID <- c(
"did_term" = "DiD: OMO $\\times$ Post-BTFP",
COEF_MAP
)
# Display
modelsummary(
models_did,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP_DID,
gof_map = c("nobs", "r.squared"),
title = "Table: DiD - Did BTFP Stem Deposit Runs?",
notes = list(
"DV: Quarterly deposit outflow (%). Positive = runoff.",
"Interpretation: Negative coef on DiD = BTFP reduced outflows.",
"Treated: Banks with OMO collateral. Control: Banks without.",
"FE: Bank + Quarter. SE clustered by bank."
),
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) Basic | (2) +Risk | (3) +Controls | (4) Uninsured | |
|---|---|---|---|---|
| DiD: OMO \(\times\) Post-BTFP | −1.086 | 0.255 | 0.087 | 18.020 |
| (1.570) | (0.674) | (0.686) | (12.946) | |
| MTM Loss (z) | 13.847*** | 6.129** | 48.449 | |
| (0.875) | (2.910) | (44.441) | ||
| Uninsured Lev (z) | −4.602*** | −3.216*** | −42.103*** | |
| (0.751) | (0.507) | (9.353) | ||
| Log(Assets) (z) | −22.280** | 315.436 | ||
| (10.635) | (356.713) | |||
| Cash Ratio (z) | 0.638 | −42.515 | ||
| (0.819) | (44.434) | |||
| Loan/Deposit (z) | 5.608*** | −39.621 | ||
| (1.835) | (54.716) | |||
| Book Equity (z) | 0.625* | −17.453 | ||
| (0.335) | (20.112) | |||
| Wholesale (z) | 0.151 | 3.572 | ||
| (0.175) | (3.909) | |||
| ROA (z) | 0.258* | 0.599 | ||
| (0.147) | (1.320) | |||
| Num.Obs. | 32284 | 32194 | 32194 | 32194 |
| R2 | 0.232 | 0.270 | 0.295 | 0.146 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 | ||||
| DV: Quarterly deposit outflow (%). Positive = runoff. | ||||
| Interpretation: Negative coef on DiD = BTFP reduced outflows. | ||||
| Treated: Banks with OMO collateral. Control: Banks without. | ||||
| FE: Bank + Quarter. SE clustered by bank. |
# Save
save_reg_table(models_did, "Table_DiD_Deposit_Stability",
title_text = "Difference-in-Differences: BTFP Effect on Deposit Outflows",
notes_text = "DV: Quarterly outflow (positive = runoff). Negative DiD coef = policy helped. FE: Bank + Quarter. SE clustered by bank.",
coef_map_use = COEF_MAP_DID, gof_map_use = c("nobs", "r.squared"))## Saved: Table_DiD_Deposit_Stability (HTML + LaTeX)14 ROBUSTNESS CHECKS
# ==============================================================================
# ROBUSTNESS CHECKS
# ==============================================================================
df_rob <- df_acute %>% filter(btfp_acute == 1 | non_user == 1)
# 1. Logit instead of LPM
m_rob_logit <- feglm(build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured"),
data = df_rob, family = binomial("logit"), vcov = "hetero")
# 2. Different winsorization (1%/99%)
df_rob_1 <- df_rob %>%
mutate(
mtm_total_1 = standardize_z(winsorize(mtm_total_raw, probs = c(0.01, 0.99))),
uninsured_lev_1 = standardize_z(winsorize(uninsured_lev_raw, probs = c(0.01, 0.99))),
mtm_x_unins_1 = mtm_total_1 * uninsured_lev_1
)
m_rob_win <- feols(btfp_acute ~ mtm_total_1 + uninsured_lev_1 + mtm_x_unins_1 +
ln_assets + cash_ratio + book_equity_ratio + loan_to_deposit + wholesale + roa,
data = df_rob_1, vcov = "hetero")
# 3. Exclude large banks
m_rob_small <- feols(build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured"),
data = df_rob %>% filter(size_cat != "Large (>$100B)"), vcov = "hetero")
# 4. Base LPM for comparison
m_rob_lpm <- feols(build_formula("btfp_acute", "mtm_total + uninsured_lev + mtm_x_uninsured"),
data = df_rob, vcov = "hetero")
models_rob <- list(
"(1) LPM" = m_rob_lpm,
"(2) Logit" = m_rob_logit,
"(3) Win 1/99" = m_rob_win,
"(4) Excl Large" = m_rob_small
)
modelsummary(
models_rob,
stars = c('*' = 0.1, '**' = 0.05, '***' = 0.01),
coef_map = COEF_MAP,
gof_map = c("nobs", "r.squared", "logLik"),
title = "Table: Robustness Checks",
output = "kableExtra"
) %>%
kable_styling(bootstrap_options = c("striped", "hover"), font_size = 9)| (1) LPM | (2) Logit | (3) Win 1/99 | (4) Excl Large | |
|---|---|---|---|---|
| MTM Loss (z) | 0.024*** | 0.214*** | 0.025*** | |
| (0.006) | (0.062) | (0.006) | ||
| Uninsured Lev (z) | 0.020*** | 0.209*** | 0.019*** | |
| (0.007) | (0.063) | (0.007) | ||
| MTM × Uninsured | 0.018*** | 0.046 | 0.018*** | |
| (0.005) | (0.057) | (0.005) | ||
| Log(Assets) (z) | 0.067*** | 0.574*** | 0.067*** | 0.067*** |
| (0.007) | (0.062) | (0.007) | (0.007) | |
| Cash Ratio (z) | −0.024*** | −0.517*** | −0.024*** | −0.024*** |
| (0.005) | (0.105) | (0.005) | (0.005) | |
| Loan/Deposit (z) | −0.008 | 0.001 | −0.008 | −0.009 |
| (0.005) | (0.066) | (0.005) | (0.005) | |
| Book Equity (z) | −0.011** | −0.329*** | −0.011** | −0.011** |
| (0.004) | (0.082) | (0.004) | (0.004) | |
| Wholesale (z) | 0.025*** | 0.183*** | 0.025*** | 0.025*** |
| (0.006) | (0.046) | (0.006) | (0.006) | |
| ROA (z) | −0.005 | −0.016 | −0.005 | −0.005 |
| (0.005) | (0.063) | (0.005) | (0.005) | |
| Num.Obs. | 3737 | 3737 | 3737 | 3722 |
| R2 | 0.090 | 0.131 | 0.090 | 0.090 |
| * p < 0.1, ** p < 0.05, *** p < 0.01 |
save_reg_table(models_rob, "Table_Robustness",
title_text = "Robustness Checks",
notes_text = "(1) LPM. (2) Logit. (3) Winsorize 1/99%. (4) Exclude large banks.",
coef_map_use = COEF_MAP, gof_map_use = c("nobs", "r.squared", "logLik"))## Saved: Table_Robustness (HTML + LaTeX)15 PLOTS
15.1 Coefficient Comparison Plot
# ==============================================================================
# PLOT 1: Coefficient Comparison Across Facilities
# ==============================================================================
# Extract coefficients from risk model
extract_risk_coefs <- function(model, facility_name) {
coefs <- coef(model)
ses <- sqrt(diag(vcov(model)))
risk_vars <- c("run_risk_2", "run_risk_3", "run_risk_4")
risk_labels <- c("Risk 2:\nLow MTM, High Unins",
"Risk 3:\nHigh MTM, Low Unins",
"Risk 4:\nHigh MTM, High Unins")
tibble(
Facility = facility_name,
Variable = risk_labels,
Coefficient = coefs[risk_vars],
SE = ses[risk_vars],
CI_low = Coefficient - 1.96 * SE,
CI_high = Coefficient + 1.96 * SE
)
}
# Get coefficients from BTFP and DW models
coef_btfp <- extract_risk_coefs(m_btfp_lpm$`(4) Risk2,3,4`, "BTFP")
coef_dw <- extract_risk_coefs(m_dw_lpm$`(4) Risk2,3,4`, "DW")
coef_all <- bind_rows(coef_btfp, coef_dw)
# Plot
p_coef <- ggplot(coef_all, aes(x = Variable, y = Coefficient, color = Facility)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high),
position = position_dodge(width = 0.4), size = 0.8) +
scale_color_manual(values = c("BTFP" = "#2166AC", "DW" = "#B2182B")) +
labs(
title = "Effect of Bank Risk Category on Emergency Borrowing",
subtitle = "LPM Coefficients with 95% CI (Reference: Risk 1 - Low MTM, Low Uninsured)",
x = NULL,
y = "Change in Probability of Borrowing",
color = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p_coef)
# SAVE FIGURE 1
save_figure(p_coef, "Figure_1_Coefficient_Comparison", width = 12, height = 8)## Saved: Figure_1_Coefficient_Comparison (PDF + PNG)15.2 High-Risk Quadrant Heatmap
# ==============================================================================
# PLOT: High-Risk Quadrant Interaction Heatmap
# ==============================================================================
# Fit continuous interaction model
fml_int <- as.formula(paste("btfp_acute ~ mtm_total * uninsured_lev +", CONTROLS))
m_cont <- feols(fml_int, data = df_btfp_acute, vcov = "hetero")
# Create prediction grid (hold controls at 0 = mean)
grid <- expand.grid(
mtm_total = seq(min(df_btfp_acute$mtm_total, na.rm = TRUE),
max(df_btfp_acute$mtm_total, na.rm = TRUE), length.out = 50),
uninsured_lev = seq(min(df_btfp_acute$uninsured_lev, na.rm = TRUE),
max(df_btfp_acute$uninsured_lev, na.rm = TRUE), length.out = 50),
ln_assets = 0, cash_ratio = 0, loan_to_deposit = 0,
book_equity_ratio = 0, wholesale = 0, roa = 0
)
grid$prob <- predict(m_cont, newdata = grid)
grid$prob <- pmax(pmin(grid$prob, 1), 0) # Bound probabilities
p_heat <- ggplot(grid, aes(x = mtm_total, y = uninsured_lev, fill = prob)) +
geom_tile() +
scale_fill_viridis_c(option = "magma", labels = scales::percent, limits = c(0, 0.5)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "white", alpha = 0.5) +
geom_hline(yintercept = 0, linetype = "dashed", color = "white", alpha = 0.5) +
annotate("text", x = 2, y = 2, label = "Death\nZone", color = "white", fontface = "bold", size = 5) +
labs(
title = "Interaction of MTM Losses and Uninsured Deposits on BTFP Usage",
subtitle = "Predicted Probability of BTFP Borrowing (Acute Period)",
x = "MTM Losses (Z-Score)",
y = "Uninsured Deposits (Z-Score)",
fill = "Pr(BTFP)"
) +
theme_minimal(base_size = 12) +
theme(
panel.grid = element_blank(),
plot.title = element_text(face = "bold")
)
print(p_heat)
# SAVE FIGURE 2
save_figure(p_heat, "Figure_2_DeathZone_Heatmap", width = 12, height = 8)## Saved: Figure_2_DeathZone_Heatmap (PDF + PNG)15.3 Temporal Evolution Plot
# ==============================================================================
# PLOT 3: Temporal Evolution of Risk Category Effects
# ==============================================================================
# Extract Risk 4 coefficient across periods
temporal_coefs <- tibble(
Period = c("Acute", "Post-Acute", "Arbitrage", "Wind-down"),
Period_Order = 1:4,
Coefficient = c(
coef(m_acute$Risk)["run_risk_4"],
coef(m_post$Risk)["run_risk_4"],
coef(m_arb$Risk)["run_risk_4"],
coef(m_wind$Risk)["run_risk_4"]
),
SE = c(
sqrt(vcov(m_acute$Risk)["run_risk_4", "run_risk_4"]),
sqrt(vcov(m_post$Risk)["run_risk_4", "run_risk_4"]),
sqrt(vcov(m_arb$Risk)["run_risk_4", "run_risk_4"]),
sqrt(vcov(m_wind$Risk)["run_risk_4", "run_risk_4"])
)
) %>%
mutate(
CI_low = Coefficient - 1.96 * SE,
CI_high = Coefficient + 1.96 * SE,
Period = factor(Period, levels = c("Acute", "Post-Acute", "Arbitrage", "Wind-down"))
)
p_temporal <- ggplot(temporal_coefs, aes(x = Period, y = Coefficient)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high),
color = "#2166AC", size = 1) +
geom_line(aes(group = 1), color = "#2166AC", alpha = 0.5) +
labs(
title = "Evolution of High-Risk Quadrant Effect on BTFP Borrowing",
subtitle = "Risk 4 (High MTM Loss + High Uninsured) Coefficient Over Time",
x = "Crisis Period",
y = "LPM Coefficient (vs. Reference: Low MTM, Low Unins)"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p_temporal)
# SAVE FIGURE 3
save_figure(p_temporal, "Figure_3_Temporal_Evolution", width = 12, height = 6)## Saved: Figure_3_Temporal_Evolution (PDF + PNG)15.4 Participation Comparison by Size
# ==============================================================================
# PLOT 4: Participation Rates by Size and Facility
# ==============================================================================
participation <- df_acute %>%
group_by(size_cat) %>%
summarise(
BTFP = mean(btfp_acute, na.rm = TRUE) * 100,
DW = mean(dw_acute, na.rm = TRUE) * 100,
`Any Fed` = mean(any_fed, na.rm = TRUE) * 100,
N = n(),
.groups = "drop"
) %>%
pivot_longer(cols = c(BTFP, DW, `Any Fed`), names_to = "Facility", values_to = "Rate")
p_part <- ggplot(participation, aes(x = size_cat, y = Rate, fill = Facility)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7) +
geom_text(aes(label = sprintf("%.1f%%", Rate)),
position = position_dodge(width = 0.8), vjust = -0.5, size = 3) +
scale_fill_manual(values = c("BTFP" = "#2166AC", "DW" = "#B2182B", "Any Fed" = "#7570B3")) +
scale_y_continuous(labels = function(x) paste0(x, "%"), expand = expansion(mult = c(0, 0.15))) +
labs(
title = "Emergency Facility Participation by Bank Size",
subtitle = "Acute Period (March 13 - May 1, 2023)",
x = "Bank Size Category",
y = "Participation Rate",
fill = "Facility"
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p_part)
# SAVE FIGURE 4
save_figure(p_part, "Figure_4_Participation_by_Size", width = 12, height = 8)## Saved: Figure_4_Participation_by_Size (PDF + PNG)15.5 6.5 Risk Category Distribution
# ==============================================================================
# PLOT 5: Risk Category Distribution by User Group
# ==============================================================================
risk_dist <- df_acute %>%
filter(user_group != "Both") %>% # Simplify for visualization
group_by(user_group) %>%
summarise(
`Risk 1\n(Low, Low)` = mean(run_risk_1, na.rm = TRUE) * 100,
`Risk 2\n(Low, High)` = mean(run_risk_2, na.rm = TRUE) * 100,
`Risk 3\n(High, Low)` = mean(run_risk_3, na.rm = TRUE) * 100,
`Risk 4\n(High, High)` = mean(run_risk_4, na.rm = TRUE) * 100,
N = n(),
.groups = "drop"
) %>%
pivot_longer(cols = -c(user_group, N), names_to = "Risk_Category", values_to = "Pct")
p_risk <- ggplot(risk_dist, aes(x = user_group, y = Pct, fill = Risk_Category)) +
geom_bar(stat = "identity", position = "stack") +
scale_fill_manual(values = c(
"Risk 1\n(Low, Low)" = "#4DAF4A",
"Risk 2\n(Low, High)" = "#FFFF33",
"Risk 3\n(High, Low)" = "#FF7F00",
"Risk 4\n(High, High)" = "#E41A1C"
)) +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
labs(
title = "Risk Category Composition by Facility Choice",
subtitle = "Acute Period - Distribution of Banks Across Risk Categories",
x = "Facility Choice",
y = "Percentage of Banks",
fill = "Risk Category"
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "right",
plot.title = element_text(face = "bold")
)
print(p_risk)
# SAVE FIGURE 5
save_figure(p_risk, "Figure_5_Risk_Distribution", width = 12, height = 6)## Saved: Figure_5_Risk_Distribution (PDF + PNG)16 SECTION 7: ADDITIONAL VISUALIZATIONS
17 # Run Risk = f(Fundamentals, Liquidity Mismatch, Fundamentals × Liquidity Mismatch)
17.1 7.1 Scatter Plot: MTM Losses vs Uninsured Deposits
# ==============================================================================
# PLOT 6: The Core Relationship
# X = MTM Losses (Fundamentals), Y = Uninsured Deposits (Liquidity Mismatch)
# Color = Facility Choice
# ==============================================================================
p_scatter <- df_acute %>%
filter(user_group %in% c("Neither", "BTFP_Only", "DW_Only")) %>%
mutate(
user_group = factor(user_group,
levels = c("Neither", "BTFP_Only", "DW_Only"),
labels = c("No Facility", "BTFP", "Discount Window"))
) %>%
ggplot(aes(x = mtm_total, y = uninsured_lev, color = user_group)) +
# Add quadrant lines at zero (which is median for z-scores)
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50", alpha = 0.7) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50", alpha = 0.7) +
# Add quadrant labels
annotate("text", x = -2, y = 2.5, label = "Risk 2\n(Low MTM, High Unins)",
color = "gray40", size = 3, hjust = 0) +
annotate("text", x = 2, y = 2.5, label = "Risk 4\n(High MTM, High Unins)",
color = "#E41A1C", size = 3, fontface = "bold", hjust = 1) +
annotate("text", x = -2, y = -2, label = "Risk 1\n(Low MTM, Low Unins)",
color = "#4DAF4A", size = 3, hjust = 0) +
annotate("text", x = 2, y = -2, label = "Risk 3\n(High MTM, Low Unins)",
color = "gray40", size = 3, hjust = 1) +
# Points
geom_point(alpha = 0.6, size = 2) +
scale_color_manual(values = c("No Facility" = "gray60",
"BTFP" = "#2166AC",
"Discount Window" = "#B2182B")) +
labs(
title = "The Run Risk Landscape: Where Do Facility Users Fall?",
subtitle = "Bank Fundamentals vs Liquidity Mismatch (Z-Scores, Acute Period)",
x = "MTM Loss (Z-Score)\n← Sound Fundamentals | Weak Fundamentals →",
y = "Uninsured Deposits (Z-Score)\n← Low Run Risk | High Run Risk →",
color = "Facility Used",
caption = "Note: Dashed lines at z=0 (sample medians). Risk categories: (MTM Loss level, Uninsured Deposit level)."
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p_scatter)
# SAVE FIGURE 6
save_figure(p_scatter, "Figure_6_Scatter_MTM_vs_Uninsured", width = 12, height = 8)## Saved: Figure_6_Scatter_MTM_vs_Uninsured (PDF + PNG)17.2 Marginal Effects Plot
# ==============================================================================
# PLOT 7: How Does the Effect of MTM Change with Uninsured Deposits?
# Tests the interaction: MTM × Uninsured
# ==============================================================================
# Get coefficients from base model
base_model <- feols(btfp_acute ~ mtm_total + uninsured_lev + mtm_x_uninsured + ln_assets +
cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_acute_s, vcov = "hetero")
base_coefs <- coef(base_model)
base_vcov <- vcov(base_model)
# Calculate marginal effect of MTM at different levels of uninsured
uninsured_levels <- seq(-2, 3, by = 1)
uninsured_labels <- c("-2 SD\n(Very Low)", "-1 SD\n(Low)", "0\n(Median)",
"+1 SD\n(High)", "+2 SD\n(Very High)", "+3 SD\n(Extreme)")
marginal_df <- tibble(
Uninsured_Level = factor(uninsured_labels, levels = uninsured_labels),
Uninsured_Z = uninsured_levels,
# Marginal effect of MTM = beta_mtm + beta_interaction * uninsured
Marginal_Effect = base_coefs["mtm_total"] + base_coefs["mtm_x_uninsured"] * uninsured_levels
) %>%
mutate(
# SE via delta method
SE = sqrt(base_vcov["mtm_total", "mtm_total"] +
2 * Uninsured_Z * base_vcov["mtm_total", "mtm_x_uninsured"] +
Uninsured_Z^2 * base_vcov["mtm_x_uninsured", "mtm_x_uninsured"]),
CI_low = Marginal_Effect - 1.96 * SE,
CI_high = Marginal_Effect + 1.96 * SE
)
p_marginal <- ggplot(marginal_df, aes(x = Uninsured_Level, y = Marginal_Effect)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), color = "#2166AC", size = 1) +
geom_line(aes(group = 1), color = "#2166AC", alpha = 0.5) +
labs(
title = "How Liquidity Risk Amplifies Fundamental Weakness",
subtitle = "Marginal Effect of MTM Loss on BTFP Probability at Different Uninsured Deposit Levels",
x = "Uninsured Deposit Level (Z-Score)",
y = "Marginal Effect of 1 SD Increase in MTM Loss\non Probability of BTFP Borrowing",
caption = "Note: Based on LPM estimates. 95% confidence intervals shown.\nPositive effect means higher MTM losses increase BTFP usage."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank()
)
print(p_marginal)
# SAVE FIGURE 7
save_figure(p_marginal, "Figure_7_Marginal_Effects_Interaction", width = 12, height = 6)## Saved: Figure_7_Marginal_Effects_Interaction (PDF + PNG)17.3 Density Comparison: MTM Losses by User Group
# ==============================================================================
# PLOT 8: Distribution of MTM Losses by Facility Choice
# ==============================================================================
p_density_mtm <- df_acute %>%
filter(user_group %in% c("Neither", "BTFP_Only", "DW_Only")) %>%
mutate(user_group = factor(user_group,
levels = c("Neither", "BTFP_Only", "DW_Only"),
labels = c("No Facility", "BTFP", "Discount Window"))) %>%
ggplot(aes(x = mtm_total_w, fill = user_group, color = user_group)) +
geom_density(alpha = 0.4) +
geom_vline(xintercept = median(df_acute$mtm_total_w, na.rm = TRUE),
linetype = "dashed", color = "gray30") +
annotate("text", x = median(df_acute$mtm_total_w, na.rm = TRUE) + 0.3, y = 0.15,
label = "Median", color = "gray30", hjust = 0) +
scale_fill_manual(values = c("No Facility" = "gray70", "BTFP" = "#2166AC", "Discount Window" = "#B2182B")) +
scale_color_manual(values = c("No Facility" = "gray50", "BTFP" = "#2166AC", "Discount Window" = "#B2182B")) +
labs(
title = "Distribution of Mark-to-Market Losses by Facility Choice",
subtitle = "Acute Period: Comparing Fundamentals Across User Groups",
x = "MTM Loss / Total Assets (%)",
y = "Density",
fill = "Facility Used",
color = "Facility Used",
caption = "Note: Higher values indicate larger unrealized losses (worse fundamentals)."
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold")
)
print(p_density_mtm)
# SAVE FIGURE 8
save_figure(p_density_mtm, "Figure_8_Density_MTM_Losses", width = 12, height = 6)## Saved: Figure_8_Density_MTM_Losses (PDF + PNG)17.4 Density Comparison: Uninsured Deposits by User Group
# ==============================================================================
# PLOT 9: Distribution of Uninsured Deposits by Facility Choice
# ==============================================================================
p_density_unins <- df_acute %>%
filter(user_group %in% c("Neither", "BTFP_Only", "DW_Only")) %>%
mutate(user_group = factor(user_group,
levels = c("Neither", "BTFP_Only", "DW_Only"),
labels = c("No Facility", "BTFP", "Discount Window"))) %>%
ggplot(aes(x = uninsured_lev_w, fill = user_group, color = user_group)) +
geom_density(alpha = 0.4) +
geom_vline(xintercept = median(df_acute$uninsured_lev_w, na.rm = TRUE),
linetype = "dashed", color = "gray30") +
annotate("text", x = median(df_acute$uninsured_lev_w, na.rm = TRUE) + 1, y = 0.04,
label = "Median", color = "gray30", hjust = 0) +
scale_fill_manual(values = c("No Facility" = "gray70", "BTFP" = "#2166AC", "Discount Window" = "#B2182B")) +
scale_color_manual(values = c("No Facility" = "gray50", "BTFP" = "#2166AC", "Discount Window" = "#B2182B")) +
labs(
title = "Distribution of Uninsured Deposits by Facility Choice",
subtitle = "Acute Period: Comparing Liquidity Mismatch Across User Groups",
x = "Uninsured Deposits / Total Assets (%)",
y = "Density",
fill = "Facility Used",
color = "Facility Used",
caption = "Note: Higher values indicate greater liquidity mismatch (higher run risk)."
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "bottom",
plot.title = element_text(face = "bold")
)
print(p_density_unins)
# SAVE FIGURE 9
save_figure(p_density_unins, "Figure_9_Density_Uninsured_Deposits", width = 12, height = 6)## Saved: Figure_9_Density_Uninsured_Deposits (PDF + PNG)17.5 Combined Risk Profile Panel
# ==============================================================================
# PLOT 10: Combined Panel - Key Story Visualization
# ==============================================================================
# Panel A: Average risk metrics by group
p_panel_a <- df_acute %>%
filter(user_group %in% c("Neither", "BTFP_Only", "DW_Only")) %>%
mutate(user_group = factor(user_group,
levels = c("Neither", "BTFP_Only", "DW_Only"),
labels = c("No Facility", "BTFP", "DW"))) %>%
group_by(user_group) %>%
summarise(
MTM_Loss = mean(mtm_total_w, na.rm = TRUE),
MTM_SE = sd(mtm_total_w, na.rm = TRUE) / sqrt(n()),
Uninsured = mean(uninsured_lev_w, na.rm = TRUE),
Unins_SE = sd(uninsured_lev_w, na.rm = TRUE) / sqrt(n()),
.groups = "drop"
) %>%
pivot_longer(cols = c(MTM_Loss, Uninsured), names_to = "Metric", values_to = "Value") %>%
mutate(
SE = ifelse(Metric == "MTM_Loss", MTM_SE, Unins_SE),
Metric = ifelse(Metric == "MTM_Loss", "MTM Loss (%)", "Uninsured Deposits (%)")
) %>%
ggplot(aes(x = user_group, y = Value, fill = Metric)) +
geom_col(position = position_dodge(0.8), width = 0.7) +
geom_errorbar(aes(ymin = Value - 1.96*SE, ymax = Value + 1.96*SE),
position = position_dodge(0.8), width = 0.2) +
scale_fill_manual(values = c("MTM Loss (%)" = "#E41A1C", "Uninsured Deposits (%)" = "#377EB8")) +
labs(
title = "A. Average Risk Profile by Facility",
x = NULL,
y = "Mean Value (%)",
fill = NULL
) +
theme_minimal(base_size = 11) +
theme(legend.position = "bottom")
# Panel B: High-risk quadrant share
p_panel_b <- df_acute %>%
filter(user_group %in% c("Neither", "BTFP_Only", "DW_Only")) %>%
group_by(user_group) %>%
summarise(
HighRisk = mean(run_risk_4, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
mutate(user_group = factor(user_group,
levels = c("Neither", "BTFP_Only", "DW_Only"),
labels = c("No Facility", "BTFP", "DW"))) %>%
ggplot(aes(x = user_group, y = HighRisk, fill = user_group)) +
geom_col() +
geom_text(aes(label = sprintf("%.1f%%", HighRisk)), vjust = -0.5, size = 4) +
scale_fill_manual(values = c("No Facility" = "gray70", "BTFP" = "#2166AC", "DW" = "#B2182B")) +
scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
labs(
title = "B. Share in Risk 4 Quadrant",
subtitle = "(High MTM, High Uninsured)",
x = NULL,
y = "Percent of Group"
) +
theme_minimal(base_size = 11) +
theme(legend.position = "none")
# Combine panels
p_combined <- (p_panel_a | p_panel_b) +
plot_annotation(
title = "The Run Risk Profile: How BTFP Users Differ",
subtitle = "Acute Period (March 13 - May 1, 2023)",
theme = theme(plot.title = element_text(face = "bold", size = 14))
)
print(p_combined)
# SAVE FIGURE 10
save_figure(p_combined, "Figure_10_Combined_Risk_Panel", width = 14, height = 6)## Saved: Figure_10_Combined_Risk_Panel (PDF + PNG)# ==============================================================================
# COEFFICIENT PLOTS: Acute Period - BTFP, DW, AnyFed
# ==============================================================================
## Function to extract coefficients from a model
extract_all_coefs <- function(model, model_name) {
coefs <- coef(model)
ses <- sqrt(diag(vcov(model)))
# Get all coefficients except intercept
vars <- names(coefs)[names(coefs) != "(Intercept)"]
tibble(
Model = model_name,
Variable = vars,
Coefficient = coefs[vars],
SE = ses[vars],
CI_low = Coefficient - 1.96 * SE,
CI_high = Coefficient + 1.96 * SE,
Significant = ifelse(CI_low > 0 | CI_high < 0, "Yes", "No")
)
}
## Variable labels for display
VAR_LABELS <- c(
"mtm_total" = "MTM Loss (Total)",
"uninsured_lev" = "Uninsured Deposits",
"mtm_x_uninsured" = "MTM × Uninsured",
"run_risk_2" = "Risk 2 (Low MTM, High Unins)",
"run_risk_3" = "Risk 3 (High MTM, Low Unins)",
"run_risk_4" = "Risk 4 (High MTM, High Unins)",
"ln_assets" = "Log(Assets)",
"cash_ratio" = "Cash Ratio",
"loan_to_deposit" = "Loan/Deposit",
"book_equity_ratio" = "Book Equity",
"wholesale" = "Wholesale Funding",
"roa" = "ROA"
)
# ------------------------------------------------------------------------------
# PLOT : BTFP Acute Period - All Coefficients (Base Model)
# ------------------------------------------------------------------------------
coef_btfp_base <- extract_all_coefs(m_btfp_lpm$`(1) Base`, "BTFP") %>%
mutate(Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)))
p_btfp_coef_base <- ggplot(coef_btfp_base, aes(x = Coefficient, y = Variable, color = Significant)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high), size = 0.8) +
scale_color_manual(values = c("Yes" = "#2166AC", "No" = "gray60"), guide = "none") +
labs(
title = "BTFP Borrowing Determinants (Acute Period)",
subtitle = "Base specification: MTM Loss + Uninsured + Interaction + Controls",
x = "Coefficient Estimate (95% CI)",
y = NULL,
caption = "Note: LPM estimates. Blue = significant at 5% level."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank()
)
print(p_btfp_coef_base)
save_figure(p_btfp_coef_base, "Figure_A1_BTFP_Acute_Coefficients_Base", width = 10, height = 7)## Saved: Figure_A1_BTFP_Acute_Coefficients_Base (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: BTFP Acute Period - Risk Category Model
# ------------------------------------------------------------------------------
coef_btfp_risk <- extract_all_coefs(m_btfp_lpm$`(4) Risk2,3,4`, "BTFP") %>%
mutate(Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)))
p_btfp_coef_risk <- ggplot(coef_btfp_risk, aes(x = Coefficient, y = Variable, color = Significant)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high), size = 0.8) +
scale_color_manual(values = c("Yes" = "#2166AC", "No" = "gray60"), guide = "none") +
labs(
title = "BTFP Borrowing Determinants (Acute Period)",
subtitle = "Risk category specification (Reference: Risk 1 - Low MTM, Low Uninsured)",
x = "Coefficient Estimate (95% CI)",
y = NULL,
caption = "Note: LPM estimates. Blue = significant at 5% level."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank()
)
print(p_btfp_coef_risk)
save_figure(p_btfp_coef_risk, "Figure_A2_BTFP_Acute_Coefficients_Risk", width = 10, height = 7)## Saved: Figure_A2_BTFP_Acute_Coefficients_Risk (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: DW Acute Period - All Coefficients (Base Model)
# ------------------------------------------------------------------------------
coef_dw_base <- extract_all_coefs(m_dw_lpm$`(1) Base`, "DW") %>%
mutate(Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)))
p_dw_coef_base <- ggplot(coef_dw_base, aes(x = Coefficient, y = Variable, color = Significant)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high), size = 0.8) +
scale_color_manual(values = c("Yes" = "#B2182B", "No" = "gray60"), guide = "none") +
labs(
title = "Discount Window Borrowing Determinants (Acute Period)",
subtitle = "Base specification: MTM Loss + Uninsured + Interaction + Controls",
x = "Coefficient Estimate (95% CI)",
y = NULL,
caption = "Note: LPM estimates. Red = significant at 5% level."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank()
)
print(p_dw_coef_base)
save_figure(p_dw_coef_base, "Figure_A3_DW_Acute_Coefficients_Base", width = 10, height = 7)## Saved: Figure_A3_DW_Acute_Coefficients_Base (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: DW Acute Period - Risk Category Model
# ------------------------------------------------------------------------------
coef_dw_risk <- extract_all_coefs(m_dw_lpm$`(4) Risk2,3,4`, "DW") %>%
mutate(Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)))
p_dw_coef_risk <- ggplot(coef_dw_risk, aes(x = Coefficient, y = Variable, color = Significant)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high), size = 0.8) +
scale_color_manual(values = c("Yes" = "#B2182B", "No" = "gray60"), guide = "none") +
labs(
title = "Discount Window Borrowing Determinants (Acute Period)",
subtitle = "Risk category specification (Reference: Risk 1 - Low MTM, Low Uninsured)",
x = "Coefficient Estimate (95% CI)",
y = NULL,
caption = "Note: LPM estimates. Red = significant at 5% level."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank()
)
print(p_dw_coef_risk)
save_figure(p_dw_coef_risk, "Figure_A4_DW_Acute_Coefficients_Risk", width = 10, height = 7)## Saved: Figure_A4_DW_Acute_Coefficients_Risk (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: AnyFed Acute Period - All Coefficients (Base Model)
# ------------------------------------------------------------------------------
coef_anyfed_base <- extract_all_coefs(m_all_lpm$`(1) Base`, "AnyFed") %>%
mutate(Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)))
p_anyfed_coef_base <- ggplot(coef_anyfed_base, aes(x = Coefficient, y = Variable, color = Significant)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high), size = 0.8) +
scale_color_manual(values = c("Yes" = "#4DAF4A", "No" = "gray60"), guide = "none") +
labs(
title = "Any Fed Facility Borrowing Determinants (Acute Period)",
subtitle = "Base specification: MTM Loss + Uninsured + Interaction + Controls",
x = "Coefficient Estimate (95% CI)",
y = NULL,
caption = "Note: LPM estimates. Green = significant at 5% level."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank()
)
print(p_anyfed_coef_base)
save_figure(p_anyfed_coef_base, "Figure_A5_AnyFed_Acute_Coefficients_Base", width = 10, height = 7)## Saved: Figure_A5_AnyFed_Acute_Coefficients_Base (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: AnyFed Acute Period - Risk Category Model
# ------------------------------------------------------------------------------
coef_anyfed_risk <- extract_all_coefs(m_all_lpm$`(4) Risk2,3,4`, "AnyFed") %>%
mutate(Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)))
p_anyfed_coef_risk <- ggplot(coef_anyfed_risk, aes(x = Coefficient, y = Variable, color = Significant)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high), size = 0.8) +
scale_color_manual(values = c("Yes" = "#4DAF4A", "No" = "gray60"), guide = "none") +
labs(
title = "Any Fed Facility Borrowing Determinants (Acute Period)",
subtitle = "Risk category specification (Reference: Risk 1 - Low MTM, Low Uninsured)",
x = "Coefficient Estimate (95% CI)",
y = NULL,
caption = "Note: LPM estimates. Green = significant at 5% level."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank()
)
print(p_anyfed_coef_risk)
save_figure(p_anyfed_coef_risk, "Figure_A6_AnyFed_Acute_Coefficients_Risk", width = 10, height = 7)## Saved: Figure_A6_AnyFed_Acute_Coefficients_Risk (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: Combined Acute Period - BTFP vs DW vs AnyFed (Base Model)
# ------------------------------------------------------------------------------
coef_combined_base <- bind_rows(
extract_all_coefs(m_btfp_lpm$`(1) Base`, "BTFP"),
extract_all_coefs(m_dw_lpm$`(1) Base`, "DW"),
extract_all_coefs(m_all_lpm$`(1) Base`, "Any Fed")
) %>%
mutate(
Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)),
Model = factor(Model, levels = c("BTFP", "DW", "Any Fed"))
)
p_combined_base <- ggplot(coef_combined_base, aes(x = Coefficient, y = Variable, color = Model)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high),
position = position_dodge(width = 0.6), size = 0.7) +
scale_color_manual(values = c("BTFP" = "#2166AC", "DW" = "#B2182B", "Any Fed" = "#4DAF4A")) +
labs(
title = "Borrowing Determinants by Facility Type (Acute Period)",
subtitle = "Base specification: MTM Loss + Uninsured + Interaction + Controls",
x = "Coefficient Estimate (95% CI)",
y = NULL,
color = "Facility",
caption = "Note: LPM estimates with heteroskedasticity-robust standard errors."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank(),
legend.position = "bottom"
)
print(p_combined_base)
save_figure(p_combined_base, "Figure_A7_Combined_Acute_Coefficients_Base", width = 12, height = 8)## Saved: Figure_A7_Combined_Acute_Coefficients_Base (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: Combined Acute Period - BTFP vs DW vs AnyFed (Risk Model)
# ------------------------------------------------------------------------------
coef_combined_risk <- bind_rows(
extract_all_coefs(m_btfp_lpm$`(4) Risk2,3,4`, "BTFP"),
extract_all_coefs(m_dw_lpm$`(4) Risk2,3,4`, "DW"),
extract_all_coefs(m_all_lpm$`(4) Risk2,3,4`, "Any Fed")
) %>%
mutate(
Variable = factor(Variable, levels = rev(names(VAR_LABELS)), labels = rev(VAR_LABELS)),
Model = factor(Model, levels = c("BTFP", "DW", "Any Fed"))
)
p_combined_risk <- ggplot(coef_combined_risk, aes(x = Coefficient, y = Variable, color = Model)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(xmin = CI_low, xmax = CI_high),
position = position_dodge(width = 0.6), size = 0.7) +
scale_color_manual(values = c("BTFP" = "#2166AC", "DW" = "#B2182B", "Any Fed" = "#4DAF4A")) +
labs(
title = "Borrowing Determinants by Facility Type (Acute Period)",
subtitle = "Risk category specification (Reference: Risk 1 - Low MTM, Low Uninsured)",
x = "Coefficient Estimate (95% CI)",
y = NULL,
color = "Facility",
caption = "Note: LPM estimates with heteroskedasticity-robust standard errors."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
panel.grid.major.y = element_blank(),
legend.position = "bottom"
)
print(p_combined_risk)
save_figure(p_combined_risk, "Figure_A8_Combined_Acute_Coefficients_Risk", width = 12, height = 8)## Saved: Figure_A8_Combined_Acute_Coefficients_Risk (PDF + PNG)# ==============================================================================
# TEMPORAL DYNAMICS PLOTS: Coefficient Evolution Across Crisis Phases
# ==============================================================================
# ------------------------------------------------------------------------------
# Function to extract temporal coefficients
# ------------------------------------------------------------------------------
extract_temporal_coefs <- function(models_list, facility_name, key_vars = c("mtm_total", "uninsured_lev", "mtm_x_uninsured")) {
results <- list()
for (period in names(models_list)) {
model <- models_list[[period]]
coefs <- coef(model)
ses <- sqrt(diag(vcov(model)))
for (v in key_vars) {
if (v %in% names(coefs)) {
results[[length(results) + 1]] <- tibble(
Facility = facility_name,
Period = period,
Variable = v,
Coefficient = coefs[v],
SE = ses[v],
CI_low = Coefficient - 1.96 * SE,
CI_high = Coefficient + 1.96 * SE
)
}
}
}
bind_rows(results)
}
# ------------------------------------------------------------------------------
# BTFP Temporal Models (need to create these first)
# ------------------------------------------------------------------------------
# Create temporal models for BTFP (Base specification)
btfp_temporal_base <- list(
"Acute" = feols(btfp_acute ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_acute_s, vcov = "hetero"),
"Post-Acute" = feols(btfp_post ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_post_s, vcov = "hetero"),
"Arbitrage" = feols(btfp_arb ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_arb_s, vcov = "hetero"),
"Wind-down" = feols(btfp_wind ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_wind_s, vcov = "hetero")
)
# Create temporal models for BTFP (Risk specification)
btfp_temporal_risk <- list(
"Acute" = feols(btfp_acute ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_acute_s, vcov = "hetero"),
"Post-Acute" = feols(btfp_post ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_post_s, vcov = "hetero"),
"Arbitrage" = feols(btfp_arb ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_arb_s, vcov = "hetero"),
"Wind-down" = feols(btfp_wind ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_btfp_wind_s, vcov = "hetero")
)
# ------------------------------------------------------------------------------
# DW Temporal Models
# ------------------------------------------------------------------------------
# DW temporal models (Base specification) - only Pre-BTFP and Acute available
dw_temporal_base <- list(
"Pre-BTFP" = feols(dw_prebtfp ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_dw_pre_s, vcov = "hetero"),
"Acute" = feols(dw_acute ~ mtm_total + uninsured_lev + mtm_x_uninsured +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_dw_acute, vcov = "hetero")
)
# DW temporal models (Risk specification)
dw_temporal_risk <- list(
"Pre-BTFP" = feols(dw_prebtfp ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_dw_pre_s, vcov = "hetero"),
"Acute" = feols(dw_acute ~ run_risk_2 + run_risk_3 + run_risk_4 +
ln_assets + cash_ratio + loan_to_deposit + book_equity_ratio + wholesale + roa,
data = df_dw_acute, vcov = "hetero")
)
# ------------------------------------------------------------------------------
# PLOT: BTFP Temporal Evolution - Base Model (Bar Chart Style)
# ------------------------------------------------------------------------------
btfp_temp_coefs_base <- extract_temporal_coefs(btfp_temporal_base, "BTFP") %>%
mutate(
Period = factor(Period, levels = c("Acute", "Post-Acute", "Arbitrage", "Wind-down")),
Variable = factor(Variable,
levels = c("mtm_x_uninsured", "mtm_total", "uninsured_lev"),
labels = c("MTM × Uninsured", "MTM Loss (Total)", "Uninsured Deposits"))
)
p_btfp_temporal_base <- ggplot(btfp_temp_coefs_base, aes(x = Period, y = Coefficient, fill = Period)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray30") +
geom_col(alpha = 0.8, width = 0.7) +
geom_errorbar(aes(ymin = CI_low, ymax = CI_high), width = 0.2, color = "black") +
facet_wrap(~ Variable, scales = "free_y", nrow = 1) +
scale_fill_manual(values = c("Acute" = "#F8766D", "Post-Acute" = "#7CAE00",
"Arbitrage" = "#00BFC4", "Wind-down" = "#C77CFF")) +
labs(
title = "BTFP: How Borrowing Determinants Changed Across Crisis Phases",
subtitle = "Base specification coefficients with 95% confidence intervals",
x = NULL,
y = "Coefficient Estimate",
caption = "Note: LPM estimates. All variables z-standardized."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1),
strip.text = element_text(face = "bold")
)
print(p_btfp_temporal_base)
save_figure(p_btfp_temporal_base, "Figure_T1_BTFP_Temporal_Base", width = 14, height = 6)## Saved: Figure_T1_BTFP_Temporal_Base (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT: BTFP Temporal Evolution - Risk Categories (Bar Chart Style)
# ------------------------------------------------------------------------------
btfp_temp_coefs_risk <- extract_temporal_coefs(btfp_temporal_risk, "BTFP",
key_vars = c("run_risk_2", "run_risk_3", "run_risk_4")) %>%
mutate(
Period = factor(Period, levels = c("Acute", "Post-Acute", "Arbitrage", "Wind-down")),
Variable = factor(Variable,
levels = c("run_risk_2", "run_risk_3", "run_risk_4"),
labels = c("Risk 2\n(Low MTM, High Unins)",
"Risk 3\n(High MTM, Low Unins)",
"Risk 4\n(High MTM, High Unins)"))
)
p_btfp_temporal_risk <- ggplot(btfp_temp_coefs_risk, aes(x = Period, y = Coefficient, fill = Period)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray30") +
geom_col(alpha = 0.8, width = 0.7) +
geom_errorbar(aes(ymin = CI_low, ymax = CI_high), width = 0.2, color = "black") +
facet_wrap(~ Variable, scales = "free_y", nrow = 1) +
scale_fill_manual(values = c("Acute" = "#F8766D", "Post-Acute" = "#7CAE00",
"Arbitrage" = "#00BFC4", "Wind-down" = "#C77CFF")) +
labs(
title = "BTFP: Risk Category Effects Across Crisis Phases",
subtitle = "Reference: Risk 1 (Low MTM, Low Uninsured)",
x = NULL,
y = "Coefficient Estimate",
caption = "Note: LPM estimates. Risk categories based on sample median splits."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1),
strip.text = element_text(face = "bold")
)
print(p_btfp_temporal_risk)
save_figure(p_btfp_temporal_risk, "Figure_T2_BTFP_Temporal_Risk", width = 14, height = 6)## Saved: Figure_T2_BTFP_Temporal_Risk (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT : DW Temporal Evolution - Base Model
# ------------------------------------------------------------------------------
dw_temp_coefs_base <- extract_temporal_coefs(dw_temporal_base, "DW") %>%
mutate(
Period = factor(Period, levels = c("Pre-BTFP", "Acute")),
Variable = factor(Variable,
levels = c("mtm_x_uninsured", "mtm_total", "uninsured_lev"),
labels = c("MTM × Uninsured", "MTM Loss (Total)", "Uninsured Deposits"))
)
p_dw_temporal_base <- ggplot(dw_temp_coefs_base, aes(x = Period, y = Coefficient, fill = Period)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray30") +
geom_col(alpha = 0.8, width = 0.6) +
geom_errorbar(aes(ymin = CI_low, ymax = CI_high), width = 0.15, color = "black") +
facet_wrap(~ Variable, scales = "free_y", nrow = 1) +
scale_fill_manual(values = c("Pre-BTFP" = "#F8766D", "Acute" = "#00BFC4")) +
labs(
title = "Discount Window: How Borrowing Determinants Changed",
subtitle = "Pre-BTFP (Mar 1-12) vs Acute (Mar 13 - May 1)",
x = NULL,
y = "Coefficient Estimate",
caption = "Note: LPM estimates. All variables z-standardized."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
legend.position = "none",
strip.text = element_text(face = "bold")
)
print(p_dw_temporal_base)
save_figure(p_dw_temporal_base, "Figure_T3_DW_Temporal_Base", width = 12, height = 6)## Saved: Figure_T3_DW_Temporal_Base (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT : DW Temporal Evolution - Risk Categories
# ------------------------------------------------------------------------------
dw_temp_coefs_risk <- extract_temporal_coefs(dw_temporal_risk, "DW",
key_vars = c("run_risk_2", "run_risk_3", "run_risk_4")) %>%
mutate(
Period = factor(Period, levels = c("Pre-BTFP", "Acute")),
Variable = factor(Variable,
levels = c("run_risk_2", "run_risk_3", "run_risk_4"),
labels = c("Risk 2\n(Low MTM, High Unins)",
"Risk 3\n(High MTM, Low Unins)",
"Risk 4\n(High MTM, High Unins)"))
)
p_dw_temporal_risk <- ggplot(dw_temp_coefs_risk, aes(x = Period, y = Coefficient, fill = Period)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray30") +
geom_col(alpha = 0.8, width = 0.6) +
geom_errorbar(aes(ymin = CI_low, ymax = CI_high), width = 0.15, color = "black") +
facet_wrap(~ Variable, scales = "free_y", nrow = 1) +
scale_fill_manual(values = c("Pre-BTFP" = "#F8766D", "Acute" = "#00BFC4")) +
labs(
title = "Discount Window: Risk Category Effects Over Time",
subtitle = "Reference: Risk 1 (Low MTM, Low Uninsured)",
x = NULL,
y = "Coefficient Estimate",
caption = "Note: LPM estimates. Risk categories based on sample median splits."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
legend.position = "none",
strip.text = element_text(face = "bold")
)
print(p_dw_temporal_risk)
save_figure(p_dw_temporal_risk, "Figure_T4_DW_Temporal_Risk", width = 12, height = 6)## Saved: Figure_T4_DW_Temporal_Risk (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT : Combined Temporal - BTFP Base (Line Plot Alternative)
# ------------------------------------------------------------------------------
p_btfp_temporal_line <- ggplot(btfp_temp_coefs_base, aes(x = Period, y = Coefficient,
group = Variable, color = Variable)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_line(linewidth = 1) +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 0.8) +
scale_color_manual(values = c("MTM × Uninsured" = "#E41A1C",
"MTM Loss (Total)" = "#377EB8",
"Uninsured Deposits" = "#4DAF4A")) +
labs(
title = "BTFP: Evolution of Key Determinants Across Crisis Phases",
subtitle = "How the role of fundamentals and liquidity mismatch changed over time",
x = NULL,
y = "Coefficient Estimate (95% CI)",
color = "Variable",
caption = "Note: LPM estimates. All variables z-standardized."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)
)
print(p_btfp_temporal_line)
save_figure(p_btfp_temporal_line, "Figure_T5_BTFP_Temporal_Line", width = 12, height = 7)## Saved: Figure_T5_BTFP_Temporal_Line (PDF + PNG)# ------------------------------------------------------------------------------
# PLOT : Combined Temporal - Risk 4 Comparison (BTFP vs DW)
# ------------------------------------------------------------------------------
# Combine Risk 4 coefficients from both facilities
risk4_temporal <- bind_rows(
btfp_temp_coefs_risk %>% filter(Variable == "Risk 4\n(High MTM, High Unins)") %>%
mutate(Facility = "BTFP"),
dw_temp_coefs_risk %>% filter(Variable == "Risk 4\n(High MTM, High Unins)") %>%
mutate(Facility = "DW")
) %>%
mutate(Period = as.character(Period))
p_risk4_comparison <- ggplot(risk4_temporal, aes(x = Period, y = Coefficient, fill = Facility)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray30") +
geom_col(position = position_dodge(width = 0.7), alpha = 0.8, width = 0.6) +
geom_errorbar(aes(ymin = CI_low, ymax = CI_high),
position = position_dodge(width = 0.7), width = 0.2, color = "black") +
scale_fill_manual(values = c("BTFP" = "#2166AC", "DW" = "#B2182B")) +
labs(
title = "Risk 4 (High MTM, High Uninsured) Effect: BTFP vs DW",
subtitle = "Comparing facility choice among highest-risk banks across crisis phases",
x = NULL,
y = "Coefficient Estimate (95% CI)",
fill = "Facility",
caption = "Note: LPM estimates. Reference: Risk 1 (Low MTM, Low Uninsured)."
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
legend.position = "bottom"
)
print(p_risk4_comparison)
save_figure(p_risk4_comparison, "Figure_T6_Risk4_BTFP_vs_DW", width = 12, height = 8)## Saved: Figure_T6_Risk4_BTFP_vs_DW (PDF + PNG)# ==============================================================================
# PLOT 11: The Solvency Shock (Book vs. Adjusted Equity)
# ==============================================================================
# Prepare long data for histogram
plot_data_solvency <- df_acute %>%
select(idrssd, book_equity_ratio_w, adjusted_equity) %>%
pivot_longer(cols = c(book_equity_ratio_w, adjusted_equity),
names_to = "Metric", values_to = "Value") %>%
mutate(
Metric = factor(Metric,
levels = c("book_equity_ratio_w", "adjusted_equity"),
labels = c("Book Equity Ratio (Official)", "MTM-Adjusted Equity Ratio (Real)"))
)
# Calculate means
means <- plot_data_solvency %>%
group_by(Metric) %>%
summarise(Mean_Val = mean(Value, na.rm = TRUE))
p_insolvency <- ggplot(plot_data_solvency, aes(x = Value, fill = Metric)) +
geom_density(alpha = 0.5) +
geom_vline(data = means, aes(xintercept = Mean_Val, color = Metric),
linetype = "dashed", size = 1) +
# Add "Insolvent" threshold line
geom_vline(xintercept = 0, linetype = "dotted", color = "black") +
annotate("text", x = -2, y = 0.02, label = "Technically\nInsolvent",
color = "red", hjust = 1, size = 3) +
scale_fill_manual(values = c("gray50", "#E41A1C")) +
scale_color_manual(values = c("gray50", "#E41A1C")) +
labs(
title = "The Hidden Solvency Shock",
subtitle = "Distribution of Bank Capital: Book Value vs. MTM-Adjusted Value (2022Q4)",
x = "Equity / Assets (%)",
y = "Density",
caption = "Note: Adjusted Equity = Book Equity - Unrealized Losses on Securities."
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom")
print(p_insolvency)
save_figure(p_insolvency, "Figure_11_Insolvency_Shock", width = 12, height = 8)## Saved: Figure_11_Insolvency_Shock (PDF + PNG)# ==============================================================================
# PRE-TRENDS VISUALIZATION (OUTFLOW FRAMING)
# ==============================================================================
pretrends <- df_did_panel %>%
group_by(period, has_omo) %>%
summarise(
mean_outflow = mean(outflow_total_dep, na.rm = TRUE),
se_outflow = sd(outflow_total_dep, na.rm = TRUE) / sqrt(n()),
.groups = "drop"
) %>%
mutate(Group = ifelse(has_omo == 1, "Treated (OMO Eligible)", "Control (Ineligible)"))
p_did <- ggplot(pretrends, aes(x = period, y = mean_outflow, color = Group, group = Group)) +
geom_hline(yintercept = 0, linetype = "solid", color = "gray70") +
geom_vline(xintercept = "2023Q1", linetype = "dashed", color = "gray40", linewidth = 1) +
annotate("text", x = "2023Q1", y = max(pretrends$mean_outflow, na.rm = TRUE) + 0.5,
label = "Crisis\nStart", hjust = -0.1, size = 3, color = "gray40") +
geom_line(linewidth = 1) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = mean_outflow - 1.96 * se_outflow,
ymax = mean_outflow + 1.96 * se_outflow), width = 0.2) +
scale_color_manual(values = c("Control (Ineligible)" = "#E41A1C",
"Treated (OMO Eligible)" = "#377EB8")) +
labs(
title = "Figure: Parallel Trends in Deposit Outflows",
subtitle = "Treated (OMO-eligible) vs Control (Ineligible) Banks",
x = "Quarter",
y = "Mean Quarterly Deposit Outflow (%)\n(Positive = Runoff)",
color = "Group",
caption = "Note: Parallel trends pre-crisis suggest valid DiD design."
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom", axis.text.x = element_text(angle = 45, hjust = 1))
print(p_did)
save_figure(p_did, "Figure_DiD_Parallel_Trends", width = 12, height = 8)## Saved: Figure_DiD_Parallel_Trends (PDF + PNG)# ==============================================================================
# CRISIS TIMELINE PLOT
# ==============================================================================
# --- Daily totals ---
btfp_daily <- btfp_loans %>%
filter(btfp_loan_date >= as.Date("2023-03-01"), btfp_loan_date <= ACUTE_END) %>%
group_by(date = btfp_loan_date) %>%
summarise(total_bn = sum(btfp_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(Facility = "BTFP")
dw_daily <- dw_loans %>%
filter(dw_loan_date >= as.Date("2023-03-01"),
dw_loan_date <= min(ACUTE_END, DW_DATA_END)) %>%
group_by(date = dw_loan_date) %>%
summarise(total_bn = sum(dw_loan_amount, na.rm = TRUE) / 1e9, .groups = "drop") %>%
mutate(Facility = "DW")
daily <- bind_rows(btfp_daily, dw_daily)
# --- Plot: lines (no stacking) ---
p_timeline <- ggplot(daily, aes(x = date, y = total_bn, color = Facility)) +
geom_line(linewidth = 1) +
geom_point(size = 1.5, alpha = 0.7) +
geom_vline(xintercept = DATE_MAR10, linetype = "dashed") +
geom_vline(xintercept = DATE_MAR13, linetype = "dashed") +
annotate("text", x = DATE_MAR10, y = max(daily$total_bn, na.rm = TRUE) * 0.95,
label = "SVB fails (Mar 10)", hjust = 1.05, size = 3) +
annotate("text", x = DATE_MAR13, y = max(daily$total_bn, na.rm = TRUE) * 0.85,
label = "BTFP announced (Mar 12/13)", hjust = -0.05, size = 3) +
scale_x_date(date_breaks = "1 week", date_labels = "%b %d") +
labs(
title = "Daily Emergency Borrowing During the 2023 Banking Stress",
subtitle = "Daily borrowing totals by facility (not stacked)",
x = NULL, y = "Daily borrowing ($ billions)", color = NULL
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1))
print(p_timeline)
save_figure(p_timeline, "Figure_Crisis_Timeline", width = 12, height = 8)## Saved: Figure_Crisis_Timeline (PDF + PNG)# two panel
p_timeline_facet <- ggplot(daily, aes(x = date, y = total_bn)) +
geom_col(alpha = 0.8) +
facet_wrap(~Facility, ncol = 1, scales = "fixed") +
geom_vline(xintercept = DATE_MAR10, linetype = "dashed") +
geom_vline(xintercept = DATE_MAR13, linetype = "dashed") +
scale_x_date(date_breaks = "1 week", date_labels = "%b %d") +
labs(
title = "Daily Emergency Borrowing During the 2023 Banking Stress",
subtitle = "Separate panels to avoid visual dominance and confusion",
x = NULL, y = "Daily borrowing ($ billions)"
) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p_timeline_facet)
save_figure(p_timeline_facet, "Figure_Crisis_Timeline_Facet", width = 12, height = 7)## Saved: Figure_Crisis_Timeline_Facet (PDF + PNG)# cumulative
daily_cum <- daily %>%
arrange(Facility, date) %>%
group_by(Facility) %>%
mutate(cum_bn = cumsum(replace_na(total_bn, 0))) %>%
ungroup()
p_cum <- ggplot(daily_cum, aes(x = date, y = cum_bn, color = Facility)) +
geom_line(linewidth = 1) +
geom_vline(xintercept = DATE_MAR10, linetype = "dashed") +
geom_vline(xintercept = DATE_MAR13, linetype = "dashed") +
scale_x_date(date_breaks = "1 week", date_labels = "%b %d") +
labs(
title = "Cumulative Emergency Borrowing During the 2023 Banking Stress",
subtitle = "Running total of borrowing by facility",
x = NULL, y = "Cumulative borrowing ($ billions)", color = NULL
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1))
print(p_cum)
save_figure(p_cum, "Figure_Crisis_Timeline_Cumulative", width = 12, height = 6)## Saved: Figure_Crisis_Timeline_Cumulative (PDF + PNG)# ==============================================================================
# RUN RISK LANDSCAPE
# ==============================================================================
df_plot <- df_acute %>%
mutate(
user_label = case_when(
btfp_acute == 1 & dw_acute == 0 ~ "BTFP",
btfp_acute == 0 & dw_acute == 1 ~ "DW",
btfp_acute == 1 & dw_acute == 1 ~ "Both",
TRUE ~ "None"
)
)
p_land <- ggplot(df_plot, aes(x = mtm_total, y = uninsured_lev, color = user_label)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
geom_point(alpha = 0.6, size = 2) +
scale_color_manual(values = c("None" = "gray60", "BTFP" = "#2166AC",
"DW" = "#B2182B", "Both" = "#7570B3")) +
annotate("text", x = 2, y = 2.5, label = "Risk 4\n(High,High)", color = "red",
size = 3, fontface = "bold") +
annotate("text", x = -2, y = -2, label = "Risk 1\n(Low,Low)", color = "darkgreen", size = 3) +
labs(
title = "Figure: Run Risk Landscape",
x = "MTM Loss (z-score)", y = "Uninsured Leverage (z-score)",
color = "Facility"
) +
theme_minimal(base_size = 12) +
theme(legend.position = "bottom")
print(p_land)
save_figure(p_land, "Figure_Risk_Landscape", width = 12, height = 8)## Saved: Figure_Risk_Landscape (PDF + PNG)# ==============================================================================
# BINSCATTER: PAR BENEFIT VS BORROWING
# ==============================================================================
# --- Create df_borrowers FIRST (needed for intensive margin plot) ---
df_borrowers <- df_acute %>%
filter(btfp_acute == 1, !is.na(btfp_pct), is.finite(btfp_pct)) %>%
mutate(
mtm_incentive = mtm_btfp_raw # OMO-eligible MTM loss / total assets (%)
) %>%
filter(!is.na(mtm_incentive), is.finite(mtm_incentive))
# ==============================================================================
# PLOT : The Par Benefit Incentive (Intensive Margin)
# ==============================================================================
plot_data_intensive <- df_borrowers %>%
filter(mtm_incentive < 50) %>% # keep your outlier trim
mutate(incentive_bin = ntile(mtm_incentive, 10)) %>%
group_by(incentive_bin) %>%
summarise(
mean_incentive = mean(mtm_incentive, na.rm = TRUE),
mean_borrowing = mean(btfp_pct, na.rm = TRUE),
se_borrowing = sd(btfp_pct, na.rm = TRUE) / sqrt(n()),
.groups = "drop"
)
p_intensive <- ggplot(plot_data_intensive, aes(x = mean_incentive, y = mean_borrowing)) +
geom_smooth(method = "lm", color = "gray80", linetype = "dashed", se = FALSE) +
geom_point(size = 3, color = "#2166AC") +
geom_errorbar(aes(ymin = mean_borrowing - 1.96 * se_borrowing,
ymax = mean_borrowing + 1.96 * se_borrowing),
width = 0.5, color = "#2166AC") +
labs(
title = "The Par Valuation Incentive: Par Benefit vs. Borrowing Volume",
subtitle = "Do banks with deeper collateral discounts borrow more?",
x = "Par Benefit (MTM Loss Rate on Eligible Securities, %)",
y = "BTFP Reliance (Loan / Total Assets, %)",
caption = "Note: Binned scatterplot of BTFP borrowers. Error bars represent 95% CI."
) +
theme_classic(base_size = 12)
print(p_intensive)
save_figure(p_intensive, "Figure_12_Intensive_Margin_Binscatter", width = 10, height = 8)## Saved: Figure_12_Intensive_Margin_Binscatter (PDF + PNG)# ==============================================================================
# PLOT: RUN-DRIVEN BORROWING (Binscatter)
# ==============================================================================
df_acute_outflows <- df_acute %>%
select(idrssd, uninsured_outflow_raw, uninsured_outflow, total_outflow_raw, total_outflow) %>%
distinct()
# --- Plot 3 expects uninsured_outflow_z. Create it from existing columns. ---
df_btfp_outflows <- df_acute %>%
mutate(
uninsured_outflow_z = dplyr::case_when(
"uninsured_outflow" %in% names(.) ~ uninsured_outflow, # already z-scored
"uninsured_outflow_raw" %in% names(.) ~ as.numeric(scale(uninsured_outflow_raw)), # fallback
TRUE ~ NA_real_
)
) %>%
filter(!is.na(uninsured_outflow_z)) %>%
select(idrssd, btfp_acute, uninsured_outflow_z)
plot_data_bins <- df_btfp_outflows %>%
mutate(outflow_bin = ntile(uninsured_outflow_z, 10)) %>%
group_by(outflow_bin) %>%
summarise(
mean_outflow = mean(uninsured_outflow_z, na.rm = TRUE),
prob_btfp = mean(btfp_acute, na.rm = TRUE),
se_btfp = sd(btfp_acute, na.rm = TRUE) / sqrt(n()),
.groups = "drop"
)
p3 <- ggplot(plot_data_bins, aes(x = mean_outflow, y = prob_btfp)) +
geom_smooth(method = "lm", color = "gray80", se = FALSE, linetype = "dashed") +
geom_point(size = 3, color = "darkblue") +
geom_errorbar(aes(ymin = prob_btfp - 1.96 * se_btfp,
ymax = prob_btfp + 1.96 * se_btfp),
width = 0.1, color = "darkblue") +
labs(
title = "Figure: Deposit Outflows vs. BTFP Usage Probability",
subtitle = "Banks with higher uninsured runoff were significantly more likely to use BTFP",
x = "Uninsured Deposit Outflow (Z-Score)",
y = "Probability of BTFP Usage"
) +
theme_classic()
print(p3)
save_figure(p3, "Fig3_Outflow_Binscatter", width = 12, height = 8)## Saved: Fig3_Outflow_Binscatter (PDF + PNG)# ==============================================================================
# FHLB TEMPORAL ANALYSIS
# ==============================================================================
# FHLB analysis uses call report data (quarterly)
# Key variables: abnormal_fhlb_borrowing_10pct, abnormal_fhlb_borrowing_5pct
# change_fhlb_adv_fwd_q, change_fhlb_adv_fwd_q_zscore
# Get FHLB data across periods
df_fhlb_temporal <- call_q %>%
filter(!idrssd %in% excluded_banks,
period %in% c("2022Q3", "2022Q4", "2023Q1", "2023Q2", "2023Q3", "2023Q4")) %>%
select(
idrssd, period,
fhlb_adv, fhlb_to_total_asset,
abnormal_fhlb_borrowing_10pct, abnormal_fhlb_borrowing_5pct,
change_fhlb_adv_fwd_q, change_fhlb_adv_fwd_q_zscore,
total_asset, mtm_loss_to_total_asset, uninsured_deposit_to_total_asset,
cash_to_total_asset, book_equity_to_total_asset
)
# Summary by period
fhlb_summary <- df_fhlb_temporal %>%
group_by(period) %>%
summarise(
n_banks = n(),
pct_abnormal_10 = mean(abnormal_fhlb_borrowing_10pct, na.rm = TRUE) * 100,
pct_abnormal_5 = mean(abnormal_fhlb_borrowing_5pct, na.rm = TRUE) * 100,
mean_fhlb_ratio = mean(fhlb_to_total_asset, na.rm = TRUE),
total_fhlb_bn = sum(fhlb_adv, na.rm = TRUE) / 1e9,
.groups = "drop"
)
cat("\n=== FHLB USAGE BY PERIOD ===\n")##
## === FHLB USAGE BY PERIOD ===print(fhlb_summary)## # A tibble: 6 × 6
## period n_banks pct_abnormal_10 pct_abnormal_5 mean_fhlb_ratio total_fhlb_bn
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 2022Q3 4724 9.46 7.45 2.16 0.345
## 2 2022Q4 4696 6.92 5.09 2.72 0.447
## 3 2023Q1 4673 7.49 6.53 2.87 0.647
## 4 2023Q2 4644 5.08 4.24 3.22 0.538
## 5 2023Q3 4604 4.60 3.76 3.23 0.463
## 6 2023Q4 4593 3.42 2.59 3.21 0.445# Plot FHLB abnormal borrowing over time
p_fhlb_temporal <- ggplot(fhlb_summary, aes(x = period)) +
geom_bar(aes(y = pct_abnormal_10), stat = "identity", fill = "#7570B3", alpha = 0.7) +
geom_line(aes(y = pct_abnormal_5, group = 1), color = "#E7298A", linewidth = 1.2) +
geom_point(aes(y = pct_abnormal_5), color = "#E7298A", size = 3) +
geom_vline(xintercept = "2023Q1", linetype = "dashed", color = "gray40") +
annotate("text", x = "2023Q1", y = max(fhlb_summary$pct_abnormal_10) + 2,
label = "Crisis\nStart", hjust = -0.1, size = 3) +
labs(
title = "FHLB Abnormal Borrowing Over Time",
subtitle = "Percentage of banks with abnormal FHLB advances",
x = "Quarter",
y = "% of Banks",
caption = "Bar: 10% threshold. Line: 5% threshold."
) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p_fhlb_temporal)
save_figure(p_fhlb_temporal, "Figure_fhlb_temporal", width = 12, height = 8)## Saved: Figure_fhlb_temporal (PDF + PNG)