1 Setup and Data Loading

1.1 Install & Load Packages

# Install if missing (run once)
required <- c("arrow", "data.table", "fixest", "modelsummary",
              "ggplot2", "patchwork", "scales", "kableExtra",
              "broom", "sandwich", "lmtest")
to_install <- required[!required %in% rownames(installed.packages())]
if (length(to_install)) install.packages(to_install)

library(arrow)
library(data.table)
library(fixest)
library(modelsummary)
library(ggplot2)
library(patchwork)
library(scales)
library(kableExtra)

# ── Paths — UPDATE THESE ──
project_dir <- normalizePath("../..", winslash = "/")
data_path   <- file.path(project_dir, "02_data", "processed data",
                         "bank_quarter_panel.parquet")
cars_path   <- file.path(project_dir, "02_data", "processed data",
                         "crsp_event_study_cars.parquet")
expo_path   <- file.path(project_dir, "02_data", "processed data",
                         "exposure_2022Q4.parquet")
results_dir <- file.path(project_dir, "03_code", "results")
dir.create(results_dir, showWarnings = FALSE, recursive = TRUE)

1.2 Load Data

panel <- as.data.table(read_parquet(data_path))

# Load CARs if available
has_cars <- file.exists(cars_path)
if (has_cars) {
  cars_df <- as.data.table(read_parquet(cars_path))
  cat("CARs loaded:", nrow(cars_df), "records\n")
}

## CARs loaded: 874 records

# Load exposure for distribution plots
has_expo <- file.exists(expo_path)
if (has_expo) {
  exposure_idi <- as.data.table(read_parquet(expo_path))
}

1.3 Inspect & Prepare Variables

cat("Panel dimensions:", nrow(panel), "rows ×", ncol(panel), "cols\n")

## Panel dimensions: 131118 rows × 155 cols

cat("Banks:", uniqueN(panel$idrssd), "\n")

## Banks: 4819

cat("Treated:", panel[treated == 1, uniqueN(idrssd)], "\n")

## Treated: 160

cat("Control:", panel[treated == 0, uniqueN(idrssd)], "\n")

## Control: 4659

cat("Quarters:", uniqueN(panel$period), "\n\n")

## Quarters: 28

# ── Factor versions for fixed effects ──
period_levels <- sort(unique(panel$period))
panel[, period_f := factor(period, levels = period_levels, ordered = TRUE)]
panel[, period_idx := as.integer(period_f)]
panel[, idrssd_f := as.factor(idrssd)]

# ── Confirm key variables ──
key_vars <- c("recip_ratio", "exposure", "treated", "post", "event_time",
              "exposure_post", "d_ln_loans", "d_ln_deposits",
              "L_ln_assets", "L_equity_to_asset", "eud_2022q4",
              "n_idis_in_org", "total_asset", "is_gsib")
cat("Key variable check:\n")

## Key variable check:

for (v in key_vars) {
  present <- v %in% names(panel)
  cat(sprintf("  %-25s %s\n", v, ifelse(present, "OK", "*** MISSING ***")))
}

##   recip_ratio               OK
##   exposure                  OK
##   treated                   OK
##   post                      OK
##   event_time                OK
##   exposure_post             OK
##   d_ln_loans                OK
##   d_ln_deposits             OK
##   L_ln_assets               OK
##   L_equity_to_asset         OK
##   eud_2022q4                OK
##   n_idis_in_org             OK
##   total_asset               OK
##   is_gsib                   OK

1.4 Create Additional Variables

# ── Outcome variables: ensure they exist ──
# Borrowings ratio
if (!"borrow_ratio" %in% names(panel) & "other_borrowed" %in% names(panel)) {
  panel[, borrow_ratio := other_borrowed / total_asset]
}

# Liquid ratio
if (!"liquid_ratio" %in% names(panel)) {
  cash_col <- intersect(c("cash", "cash_bal"), names(panel))
  sec_col  <- intersect(c("securities", "total_securities"), names(panel))
  if (length(cash_col) > 0 & length(sec_col) > 0) {
    panel[, liquid_ratio := (get(cash_col[1]) + get(sec_col[1])) / total_asset]
  }
}

# Equity ratio (may be named differently)
if (!"equity_ratio" %in% names(panel) & "L_equity_to_asset" %in% names(panel)) {
  # Reconstruct from lag if needed — or just use the lag name directly
  # The lag IS the control; the level is the outcome
  eq_col <- intersect(c("equity_to_asset", "equity_ratio"), names(panel))
  if (length(eq_col) > 0) panel[, equity_ratio := get(eq_col[1])]
}

# ROA
if (!"roa" %in% names(panel)) {
  roa_col <- intersect(c("roa", "ROA", "net_income_to_asset"), names(panel))
  if (length(roa_col) > 0) panel[, roa := get(roa_col[1])]
}

# ── Size categories ──
# Note: is_gsib comes from the pipeline (04_clean) using exact FSB RSSD list,
# NOT from a naive $250B asset threshold.
panel[, size_cat := fcase(
  is_gsib == 1,            "> $250B (G-SIB)",
  total_asset < 10000000,  "< $10B",
  total_asset < 100000000, "$10B-$100B",
  default = "$100B-$250B"
)]

panel[, non_gsib := as.integer(is_gsib == 0)]

# ── Exposure groups ──
panel[, exposure_group := fcase(
  treated == 0, "Control",
  exposure <= quantile(exposure[treated == 1], 0.5, na.rm = TRUE), "Low Exposure",
  default = "High Exposure"
)]
panel[, exposure_group := factor(exposure_group,
  levels = c("Control", "Low Exposure", "High Exposure"))]

# ── Heterogeneity indicators (from 2022Q4, pre-determined) ──
q4 <- panel[period == "2022Q4"]
q4_indicators <- q4[, .(
  idrssd,
  low_capital   = as.integer(L_equity_to_asset < median(L_equity_to_asset, na.rm = TRUE)),
  no_network    = as.integer(is.na(recip_ratio) | recip_ratio < 0.001),
  high_htm      = as.integer(FALSE) # placeholder — set TRUE if you have HTM data
)]
# Deduplicate
q4_indicators <- unique(q4_indicators, by = "idrssd")
panel <- merge(panel, q4_indicators, by = "idrssd", all.x = TRUE)

# ── Anticipation interactions ──
# The pipeline already creates exposure_post_news / exposure_post_pay.
# Ensure the Rmd-friendly names exist too.
if (!"exposure_postnews" %in% names(panel)) {
  if ("exposure_post_news" %in% names(panel)) {
    panel[, exposure_postnews := exposure_post_news]
    panel[, exposure_postpay  := exposure_post_pay]
  } else {
    panel[, post_news := as.integer(period %in% c("2023Q2","2023Q3","2023Q4"))]
    panel[, post_pay  := as.integer(yq_num >= 20241)]
    panel[, exposure_postnews := exposure * post_news]
    panel[, exposure_postpay  := exposure * post_pay]
  }
}

# ── Triple interactions ──
panel[, expo_post_lowcap := exposure_post * low_capital]
panel[, expo_post_nonet  := exposure_post * no_network]

# ── Standard control formula (reusable) ──
# This is the set of lagged controls from your original code
ctrl_vars <- intersect(
  c("L_ln_assets", "L_equity_to_asset", "L_loan_to_asset",
    "L_deposit_to_asset", "L_nib_share", "L_roa"),
  names(panel)
)
ctrl_formula <- paste(ctrl_vars, collapse = " + ")
cat("Control variables:", ctrl_formula, "\n")

## Control variables: L_ln_assets + L_equity_to_asset + L_loan_to_asset + L_deposit_to_asset + L_nib_share + L_roa

2 Diagnostic: What Does the Data Actually Show?

Before running publication tables, we diagnose where the story is.

2.1 Table 1: Summary Statistics

# ── Pre-period summary by treatment group ──
pre <- panel[event_time < 0]

sumstat_vars <- intersect(
  c("total_asset", "recip_ratio", "d_ln_loans", "d_ln_deposits",
    "L_equity_to_asset", "L_loan_to_asset", "L_deposit_to_asset",
    "L_nib_share", "L_roa"),
  names(panel)
)

make_sumstat <- function(dt, vars) {
  rbindlist(lapply(vars, function(v) {
    x <- dt[[v]][!is.na(dt[[v]])]
    data.table(Variable = v, N = length(x), Mean = mean(x), SD = sd(x),
               P25 = quantile(x, 0.25), Median = median(x), P75 = quantile(x, 0.75))
  }))
}

ss_treat <- make_sumstat(pre[treated == 1], sumstat_vars)[, Group := "Treated"]
ss_ctrl  <- make_sumstat(pre[treated == 0], sumstat_vars)[, Group := "Control"]
ss_all   <- make_sumstat(pre,               sumstat_vars)[, Group := "Full"]

# Display
table1 <- merge(
  ss_treat[, .(Variable, N_T = N, Mean_T = round(Mean, 4), SD_T = round(SD, 4))],
  ss_ctrl[, .(Variable, N_C = N, Mean_C = round(Mean, 4), SD_C = round(SD, 4))],
  by = "Variable"
)
table1[, Diff := Mean_T - Mean_C]

kable(table1, caption = "Table 1: Pre-Period Summary Statistics",
      digits = 4) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Table 1: Pre-Period Summary Statistics
Variable	N_T	Mean_T	SD_T	N_C	Mean_C	SD_C	Diff
L_deposit_to_asset	3004	7.923050e+01	1.272220e+01	87392	83.3432	12.6714	-4.112700e+00
L_equity_to_asset	3004	1.174750e+01	7.429600e+00	87392	12.2756	10.5075	-5.281000e-01
L_loan_to_asset	3004	6.083620e+01	1.899970e+01	87392	61.3319	18.2097	-4.957000e-01
L_nib_share	3004	2.725780e+01	1.570660e+01	87392	24.3388	12.8981	2.919000e+00
L_roa	3004	1.305200e+00	2.168300e+00	87392	1.3762	9.0151	-7.100000e-02
d_ln_deposits	3004	2.440000e-02	5.990000e-02	87392	0.0207	0.0552	3.700000e-03
d_ln_loans	3004	2.030000e-02	5.040000e-02	87392	0.0183	0.0518	2.000000e-03
recip_ratio	3164	4.150000e-02	5.180000e-02	92051	0.0163	0.0422	2.520000e-02
total_asset	3164	1.142688e+08	3.582265e+08	92051	753698.2056	2280897.0847	1.135151e+08

# ── Save Table 1 ──
kable(table1, format = "latex", caption = "Pre-Period Summary Statistics",
      digits = 4, booktabs = TRUE) %>%
  writeLines(file.path(results_dir, "table1_sumstats.tex"))

2.2 Figure 1: Time Series (Treated vs Control)

ts <- panel[, .(
  mean_recip  = mean(recip_ratio, na.rm = TRUE),
  mean_loans  = mean(d_ln_loans, na.rm = TRUE),
  mean_deps   = mean(d_ln_deposits, na.rm = TRUE),
  n           = uniqueN(idrssd)
), by = .(period_f, treated)]
ts[, group := ifelse(treated == 1, "Treated (Exposure > 0)", "Control (Exposure = 0)")]

vline_assess <- which(period_levels == "2024Q1")
vline_npr    <- which(period_levels == "2023Q2")

# ── 1a: Reciprocal Deposits ──
fig1a <- ggplot(ts, aes(x = period_f, y = mean_recip * 100,
                        color = group, group = group)) +
  geom_line(linewidth = 1) + geom_point(size = 1.5) +
  geom_vline(xintercept = vline_assess, linetype = "dashed", color = "red") +
  geom_vline(xintercept = vline_npr, linetype = "dotted", color = "darkorange") +
  scale_color_manual(values = c("#B2182B", "#2166AC")) +
  labs(x = NULL, y = "Reciprocal Deps / Assets (%)",
       title = "A. Reciprocal Deposit Ratio", color = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7),
        legend.position = "bottom")

# ── 1b: Loan Growth ──
fig1b <- ggplot(ts, aes(x = period_f, y = mean_loans * 100,
                        color = group, group = group)) +
  geom_line(linewidth = 1) + geom_point(size = 1.5) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  geom_vline(xintercept = vline_assess, linetype = "dashed", color = "red") +
  scale_color_manual(values = c("#B2182B", "#2166AC")) +
  labs(x = NULL, y = "Loan Growth (%)", title = "B. Loan Growth", color = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7),
        legend.position = "bottom")

# ── 1c: Deposit Growth ──
fig1c <- ggplot(ts, aes(x = period_f, y = mean_deps * 100,
                        color = group, group = group)) +
  geom_line(linewidth = 1) + geom_point(size = 1.5) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  geom_vline(xintercept = vline_assess, linetype = "dashed", color = "red") +
  scale_color_manual(values = c("#B2182B", "#2166AC")) +
  labs(x = "Quarter", y = "Deposit Growth (%)", title = "C. Deposit Growth", color = NULL) +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7),
        legend.position = "bottom")

fig1_combined <- fig1a / fig1b / fig1c + plot_layout(guides = "collect") &
  theme(legend.position = "bottom")
fig1_combined

ggsave(file.path(results_dir, "fig1_timeseries_panel.pdf"),
       fig1_combined, width = 11, height = 14)

2.3 Figure 1-bis: Time Series by Size Group

This is the critical diagnostic. The original Figure 1 pools G-SIBs with community banks. G-SIBs don’t use reciprocal networks. Split by size.

ts_size <- panel[treated == 1, .(
  mean_recip = mean(recip_ratio, na.rm = TRUE),
  n          = uniqueN(idrssd)
), by = .(period_f, size_cat)]

fig1_size <- ggplot(ts_size, aes(x = period_f, y = mean_recip * 100,
                                  color = size_cat, group = size_cat)) +
  geom_line(linewidth = 1) + geom_point(size = 1.5) +
  geom_vline(xintercept = vline_assess, linetype = "dashed", color = "red") +
  labs(x = "Quarter", y = "Reciprocal Deps / Assets (%)",
       title = "Reciprocal Deposits by Bank Size (Treated Banks Only)",
       subtitle = "G-SIBs (>$250B) likely don't use reciprocal networks — check if they drag down the average",
       color = "Size Group") +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 8),
        legend.position = "bottom")

fig1_size

ggsave(file.path(results_dir, "fig1_size_split.pdf"), fig1_size, width = 11, height = 7)

3 Event Studies: All Outcomes

Run event studies for every outcome to find where the assessment effect lives.

3.1 Helper Function

run_event_study <- function(depvar, data = panel, trim = c(-16, 7),
                            label = depvar) {
  # Trim event time
  est_data <- data[event_time >= trim[1] & event_time <= trim[2]]
  est_data[, et := event_time]  # use numeric, not factor

  # Build formula
  fml <- as.formula(paste0(
    depvar, " ~ i(et, exposure, ref = -1) + ", ctrl_formula,
    " | idrssd + period"
  ))

  # Estimate
  mod <- feols(fml, data = est_data, cluster = ~idrssd, lean = TRUE)

  # Extract coefficients
  ct <- as.data.table(coeftable(mod), keep.rownames = "term")
  ct <- ct[grepl("^et::", term)]
  ct[, event_time := as.integer(gsub(".*::(-?\\d+):.*", "\\1", term))]
  setnames(ct, old = names(ct)[2:5], new = c("beta", "se", "tval", "pval"))

  # Add reference
  ref <- data.table(term = "ref", beta = 0, se = 0, tval = NA,
                    pval = NA, event_time = -1L)
  ct <- rbind(ct[, .(event_time, beta, se, tval, pval)],
              ref[, .(event_time, beta, se, tval, pval)])
  ct <- ct[order(event_time)]
  ct[, `:=`(ci_lo = beta - 1.96 * se, ci_hi = beta + 1.96 * se,
            outcome = label)]

  list(model = mod, coefs = ct)
}

plot_event_study <- function(coefs, title_str, color = "#2166AC",
                             multiply = 100, ylab = "pp") {
  ggplot(coefs, aes(x = event_time, y = beta * multiply)) +
    geom_ribbon(aes(ymin = ci_lo * multiply, ymax = ci_hi * multiply),
                fill = color, alpha = 0.18) +
    geom_line(color = color, linewidth = 0.9) +
    geom_point(color = color, size = 2) +
    geom_hline(yintercept = 0, linewidth = 0.4) +
    geom_vline(xintercept = -0.5, linetype = "dashed", color = "red", linewidth = 0.7) +
    geom_point(data = coefs[event_time == -1], aes(x = event_time, y = 0),
               color = "red", size = 3, shape = 18) +
    scale_x_continuous(breaks = seq(-16, 7, by = 2)) +
    labs(x = "Quarters Relative to 2024Q1",
         y = bquote(hat(beta)[k] ~ " (" * .(ylab) * ")"),
         title = title_str,
         subtitle = "Reference: k = −1 (2023Q4). 95% CI, clustered by bank.") +
    theme_minimal(base_size = 12) +
    theme(plot.title = element_text(face = "bold", size = 13),
          plot.subtitle = element_text(size = 10, color = "grey40"))
}

3.2 Reciprocal Deposits (Full Sample)

es_recip <- run_event_study("recip_ratio", label = "Reciprocal / Assets")
plot_event_study(es_recip$coefs, "Event Study: Reciprocal Deposit Ratio (Full Sample)")

3.3 Reciprocal Deposits (Excluding G-SIBs)

Key diagnostic: Does the story change without the largest banks?

es_recip_nogsib <- run_event_study("recip_ratio",
  data = panel[is_gsib == 0],
  label = "Reciprocal / Assets (excl. G-SIBs)")

plot_event_study(es_recip_nogsib$coefs,
  "Event Study: Reciprocal Deposits (Excluding G-SIBs, Assets < $250B)",
  color = "#D55E00")

3.4 Reciprocal Deposits (Mid-Size Only: $10B-$100B)

es_recip_mid <- run_event_study("recip_ratio",
  data = panel[total_asset >= 10000000 & total_asset < 100000000],
  label = "Reciprocal / Assets ($10B-$100B)")

plot_event_study(es_recip_mid$coefs,
  "Event Study: Reciprocal Deposits (Mid-Size Banks: $10B-$100B)",
  color = "#009E73")

3.5 Loan Growth

es_loans <- run_event_study("d_ln_loans", label = "Loan Growth")
plot_event_study(es_loans$coefs,
  "Event Study: Loan Growth (Full Sample)")

3.6 Loan Growth (Excluding G-SIBs)

es_loans_nogsib <- run_event_study("d_ln_loans",
  data = panel[is_gsib == 0], label = "Loan Growth (excl. G-SIBs)")

plot_event_study(es_loans_nogsib$coefs,
  "Event Study: Loan Growth (Excluding G-SIBs)", color = "#D55E00")

3.7 Deposit Growth

if ("d_ln_deposits" %in% names(panel)) {
  es_deps <- run_event_study("d_ln_deposits", label = "Deposit Growth")
  plot_event_study(es_deps$coefs,
    "Event Study: Deposit Growth (Full Sample)")
}

3.8 All Outcomes — Combined Panel

# Run all outcomes
all_outcomes <- c("recip_ratio", "d_ln_loans")
optional_outcomes <- c("d_ln_deposits", "borrow_ratio", "liquid_ratio",
                       "equity_ratio", "roa")
all_outcomes <- c(all_outcomes, intersect(optional_outcomes, names(panel)))

# Run for full sample
all_es <- lapply(all_outcomes, function(v) {
  res <- run_event_study(v, label = v)
  res$coefs
})
all_es_dt <- rbindlist(all_es)

# Nicer labels
label_map <- c(
  recip_ratio   = "Reciprocal Deps / Assets",
  d_ln_loans    = "Loan Growth",
  d_ln_deposits = "Deposit Growth",
  borrow_ratio  = "Borrowings / Assets",
  liquid_ratio  = "Liquid Assets / Assets",
  equity_ratio  = "Equity / Assets",
  roa           = "ROA"
)
all_es_dt[, outcome_label := ifelse(outcome %in% names(label_map),
                                    label_map[outcome], outcome)]

ggplot(all_es_dt, aes(x = event_time, y = beta * 100)) +
  geom_ribbon(aes(ymin = ci_lo * 100, ymax = ci_hi * 100),
              fill = "steelblue", alpha = 0.15) +
  geom_line(color = "steelblue", linewidth = 0.7) +
  geom_point(color = "steelblue", size = 1.5) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  geom_vline(xintercept = -0.5, linetype = "dashed", color = "red", linewidth = 0.5) +
  facet_wrap(~ outcome_label, scales = "free_y", ncol = 2) +
  scale_x_continuous(breaks = seq(-16, 7, by = 4)) +
  labs(x = "Quarters Relative to 2024Q1",
       y = expression(hat(beta)[k] ~ " (pp)"),
       title = "Event Studies: All Outcomes (Full Sample)") +
  theme_minimal(base_size = 11) +
  theme(strip.text = element_text(face = "bold"))

ggsave(file.path(results_dir, "fig_event_study_all_outcomes.pdf"),
       plot = last_plot(), width = 11, height = 14)

3.9 All Outcomes — Excluding G-SIBs

all_es_nogsib <- lapply(all_outcomes, function(v) {
  res <- run_event_study(v, data = panel[is_gsib == 0], label = v)
  res$coefs
})
all_es_nogsib_dt <- rbindlist(all_es_nogsib)
all_es_nogsib_dt[, outcome_label := ifelse(outcome %in% names(label_map),
                                           label_map[outcome], outcome)]

ggplot(all_es_nogsib_dt, aes(x = event_time, y = beta * 100)) +
  geom_ribbon(aes(ymin = ci_lo * 100, ymax = ci_hi * 100),
              fill = "#D55E00", alpha = 0.15) +
  geom_line(color = "#D55E00", linewidth = 0.7) +
  geom_point(color = "#D55E00", size = 1.5) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  geom_vline(xintercept = -0.5, linetype = "dashed", color = "red", linewidth = 0.5) +
  facet_wrap(~ outcome_label, scales = "free_y", ncol = 2) +
  scale_x_continuous(breaks = seq(-16, 7, by = 4)) +
  labs(x = "Quarters Relative to 2024Q1",
       y = expression(hat(beta)[k] ~ " (pp)"),
       title = "Event Studies: All Outcomes (Excluding G-SIBs, Assets < $250B)") +
  theme_minimal(base_size = 11) +
  theme(strip.text = element_text(face = "bold"))

ggsave(file.path(results_dir, "fig_event_study_all_nogsib.pdf"),
       plot = last_plot(), width = 11, height = 14)

4 Threshold Design

4.1 Diagnostics: How Many Banks Near the Threshold?

THRESHOLD <- 5000000

thresh_all <- panel[!is.na(n_idis_in_org) & n_idis_in_org == 1 &
                    !is.na(eud_2022q4)]

cat("Distribution of single-IDI banks around $5B:\n\n")

## Distribution of single-IDI banks around $5B:

# Count banks in various bandwidths
for (bw in c(1, 2, 3, 5)) {
  lo <- THRESHOLD - bw * 1e6
  hi <- THRESHOLD + bw * 1e6
  n_below <- thresh_all[eud_2022q4 >= lo & eud_2022q4 < THRESHOLD, uniqueN(idrssd)]
  n_above <- thresh_all[eud_2022q4 >= THRESHOLD & eud_2022q4 <= hi, uniqueN(idrssd)]
  cat(sprintf("  $%dB–$%dB bandwidth:  Below = %d,  Above = %d,  Total = %d\n",
              THRESHOLD/1e6 - bw, THRESHOLD/1e6 + bw, n_below, n_above, n_below + n_above))
}

##   $4B–$6B bandwidth:  Below = 13,  Above = 19,  Total = 32
##   $3B–$7B bandwidth:  Below = 30,  Above = 27,  Total = 57
##   $2B–$8B bandwidth:  Below = 79,  Above = 31,  Total = 110
##   $0B–$10B bandwidth:  Below = 4078,  Above = 45,  Total = 4123

4.2 Threshold Plot: Reciprocal Deposits (Improved)

# Use wider bandwidth and fewer bins for more power
thresh_data <- panel[n_idis_in_org == 1 &
                     !is.na(eud_2022q4) &
                     eud_2022q4 >= 1000000 &   # $1B
                     eud_2022q4 <= 10000000]    # $10B

thresh_data[, running_b := (eud_2022q4 - THRESHOLD) / 1e6]

pre  <- thresh_data[yq_num < 20241,
  .(pre_recip = mean(recip_ratio, na.rm = TRUE), running_b = running_b[1]),
  by = idrssd]
post <- thresh_data[yq_num >= 20241,
  .(post_recip = mean(recip_ratio, na.rm = TRUE)),
  by = idrssd]
change <- merge(pre, post, by = "idrssd")
change[, delta_recip := post_recip - pre_recip]

cat(sprintf("Threshold sample: %d banks (below: %d, above: %d)\n",
            nrow(change), sum(change$running_b < 0), sum(change$running_b >= 0)))

## Threshold sample: 236 banks (below: 192, above: 44)

# 10 bins instead of 20 for less noise
change[, bin := cut(running_b, breaks = 10)]
binned <- change[, .(x = mean(running_b), y = mean(delta_recip) * 100,
                     n = .N), by = bin][!is.na(bin)]

fig3_improved <- ggplot() +
  geom_point(data = binned, aes(x = x, y = y, size = n),
             color = "#2166AC", alpha = 0.7, show.legend = FALSE) +
  scale_size_continuous(range = c(3, 10)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "red", linewidth = 1) +
  geom_hline(yintercept = 0, linewidth = 0.3, color = "grey50") +
  geom_smooth(data = change[running_b < 0],
              aes(x = running_b, y = delta_recip * 100),
              method = "lm", se = TRUE, color = "#2166AC", fill = "#2166AC",
              alpha = 0.15, linewidth = 1.1) +
  geom_smooth(data = change[running_b >= 0],
              aes(x = running_b, y = delta_recip * 100),
              method = "lm", se = TRUE, color = "#2166AC", fill = "#2166AC",
              alpha = 0.15, linewidth = 1.1) +
  annotate("text", x = 0.15, y = max(binned$y, na.rm = TRUE),
           label = "$5B Threshold", color = "red", hjust = 0,
           fontface = "bold", size = 3.5) +
  labs(x = "Uninsured Deposits − $5B ($ Billions)",
       y = "Δ Reciprocal Deposit Ratio (Post − Pre, pp)",
       title = "Threshold Plot: Reciprocal Deposits ($1B–$10B bandwidth, 10 bins)") +
  theme_minimal(base_size = 12)

fig3_improved

ggsave(file.path(results_dir, "fig3_threshold_improved.pdf"),
       fig3_improved, width = 10, height = 6.5)

4.3 Threshold Plot: Loan Growth

pre_l  <- thresh_data[yq_num < 20241,
  .(pre_loans = mean(d_ln_loans, na.rm = TRUE), running_b = running_b[1]),
  by = idrssd]
post_l <- thresh_data[yq_num >= 20241,
  .(post_loans = mean(d_ln_loans, na.rm = TRUE)),
  by = idrssd]
change_l <- merge(pre_l, post_l, by = "idrssd")
change_l[, delta_loans := post_loans - pre_loans]

change_l[, bin := cut(running_b, breaks = 10)]
binned_l <- change_l[, .(x = mean(running_b), y = mean(delta_loans) * 100,
                         n = .N), by = bin][!is.na(bin)]

fig3_loans <- ggplot() +
  geom_point(data = binned_l, aes(x = x, y = y, size = n),
             color = "#D55E00", alpha = 0.7, show.legend = FALSE) +
  scale_size_continuous(range = c(3, 10)) +
  geom_vline(xintercept = 0, linetype = "dashed", color = "red", linewidth = 1) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  geom_smooth(data = change_l[running_b < 0],
              aes(x = running_b, y = delta_loans * 100),
              method = "lm", se = TRUE, color = "#D55E00", fill = "#D55E00",
              alpha = 0.15, linewidth = 1.1) +
  geom_smooth(data = change_l[running_b >= 0],
              aes(x = running_b, y = delta_loans * 100),
              method = "lm", se = TRUE, color = "#D55E00", fill = "#D55E00",
              alpha = 0.15, linewidth = 1.1) +
  labs(x = "Uninsured Deposits − $5B ($ Billions)",
       y = "Δ Loan Growth (Post − Pre, pp)",
       title = "Threshold Plot: Loan Growth ($1B–$10B bandwidth)") +
  theme_minimal(base_size = 12)

fig3_loans

ggsave(file.path(results_dir, "fig3_threshold_loans.pdf"),
       fig3_loans, width = 10, height = 6.5)

5 Stock Market Event Study (CARs)

cat("CAR data loaded:", nrow(cars_df), "rows\n")

## CAR data loaded: 874 rows

cat("Events:", paste(unique(cars_df$event), collapse = ", "), "\n")

## Events: board_approval, fed_register, proposed_rule

cat("Treated stocks:", cars_df[treated_bhc == 1, uniqueN(permno)], "\n")

## Treated stocks: 84

5.1 Table 2: CAR Regressions

# Run for each event
car_events <- unique(cars_df$event)
car_models <- list()

for (ev in car_events) {
  ev_data <- cars_df[event == ev & !is.na(CAR_m1_p1) & !is.na(exposure_bhc)]
  if (nrow(ev_data) < 30) next

  m <- lm(CAR_m1_p1 ~ exposure_bhc, data = ev_data)
  car_models[[ev]] <- m

  cat(sprintf("Event: %-25s  N=%d  \u03b2=%.4f  t=%.2f  p=%.3f\n",
              ev, nrow(ev_data),
              coef(m)["exposure_bhc"],
              summary(m)$coefficients["exposure_bhc", "t value"],
              summary(m)$coefficients["exposure_bhc", "Pr(>|t|)"]))
}

## Event: board_approval             N=287  β=0.0705  t=6.43  p=0.000
## Event: fed_register               N=287  β=0.0554  t=4.25  p=0.000
## Event: proposed_rule              N=289  β=0.0086  t=0.45  p=0.653

if (length(car_models) > 0) {
  msummary(car_models,
    stars    = c("*" = .10, "**" = .05, "***" = .01),
    coef_map = c("exposure_bhc" = "Assessment Exposure", "(Intercept)" = "Intercept"),
    gof_map  = c("nobs", "r.squared"),
    title    = "Table 2: Stock Market Reaction — CAR[-1,+1] on Exposure",
    output   = "kableExtra"
  ) %>% kable_styling(full_width = FALSE)

  # ── Save Table 2 ──
  msummary(car_models,
    stars    = c("*" = .10, "**" = .05, "***" = .01),
    coef_map = c("exposure_bhc" = "Assessment Exposure", "(Intercept)" = "Intercept"),
    gof_map  = c("nobs", "r.squared"),
    output   = file.path(results_dir, "table2_cars.tex")
  )
}

5.2 Figure: CAR Scatter

# Pick the event with most observations
best_event <- cars_df[!is.na(CAR_m1_p1) & !is.na(exposure_bhc),
                      .N, by = event][order(-N)][1, event]

scatter_data <- cars_df[event == best_event & !is.na(CAR_m1_p1) &
                        !is.na(exposure_bhc)]

ggplot(scatter_data, aes(x = exposure_bhc, y = CAR_m1_p1 * 100)) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  geom_point(aes(color = factor(treated_bhc)), alpha = 0.6, size = 2.5) +
  geom_smooth(method = "lm", color = "firebrick", se = TRUE, alpha = 0.1) +
  scale_color_manual(values = c("0" = "grey50", "1" = "steelblue"),
                     labels = c("Control", "Treated")) +
  labs(x = "BHC Assessment Exposure", y = "CAR [-1, +1] (%)",
       title = paste("Stock Market Reaction:", best_event),
       color = NULL) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom")

ggsave(file.path(results_dir, "fig_car_scatter.pdf"), width = 9, height = 6)

6 Regression Tables

6.1 Table 4: Baseline DiD — Reciprocal Deposits

fml_base <- as.formula(paste(
  "recip_ratio ~ exposure_post |", "idrssd + period"))
fml_ctrl <- as.formula(paste(
  "recip_ratio ~ exposure_post +", ctrl_formula, "| idrssd + period"))

m4_1 <- feols(fml_base, data = panel, cluster = ~idrssd)
m4_2 <- feols(fml_ctrl, data = panel, cluster = ~idrssd)
m4_3 <- feols(fml_ctrl, data = panel[is_gsib == 0], cluster = ~idrssd)
m4_4 <- feols(fml_ctrl, data = panel[total_asset >= 10000000 & total_asset < 100000000],
              cluster = ~idrssd)

msummary(
  list("(1) No Controls" = m4_1, "(2) Controls" = m4_2,
       "(3) Excl GSIB" = m4_3, "(4) $10B-$100B" = m4_4),
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within", "FE: idrssd", "FE: period"),
  title    = "Table 4: DiD — Reciprocal Deposit Ratio",
  notes    = "Columns (3)-(4) restrict sample by size. SE clustered by bank.",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 4: DiD — Reciprocal Deposit Ratio
	(1) No Controls	(2) Controls	(3) Excl GSIB	(4) $10B-$100B
Exposure × Post	0.030**	0.023	0.017	0.061*
	(0.015)	(0.014)	(0.014)	(0.032)
Num.Obs.	131118	126299	125519	3161
FE: idrssd	X	X	X	X
FE: period	X	X	X	X
* p < 0.1, p < 0.05, * p < 0.01
Columns (3)-(4) restrict sample by size. SE clustered by bank.

# Save LaTeX
msummary(
  list("(1)" = m4_1, "(2)" = m4_2, "(3)" = m4_3, "(4)" = m4_4),
  stars = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"),
  coef_omit = "^L_",
  gof_map = c("nobs", "r.squared.within"),
  output = file.path(results_dir, "table4_did_recip.tex")
)

6.2 Table 5: All Outcomes

outcome_list <- intersect(
  c("recip_ratio", "d_ln_loans", "d_ln_deposits",
    "borrow_ratio", "liquid_ratio", "equity_ratio", "roa"),
  names(panel)
)

outcome_nice <- c(
  recip_ratio = "Recip/Assets", d_ln_loans = "ΔlnLoans",
  d_ln_deposits = "ΔlnDeps", borrow_ratio = "Borrow/Assets",
  liquid_ratio = "Liquid/Assets", equity_ratio = "Equity/Assets",
  roa = "ROA"
)

models_t5 <- lapply(outcome_list, function(v) {
  fml <- as.formula(paste(v, "~ exposure_post +", ctrl_formula,
                          "| idrssd + period"))
  feols(fml, data = panel, cluster = ~idrssd)
})
names(models_t5) <- outcome_nice[outcome_list]

msummary(models_t5,
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within"),
  title    = "Table 5: Assessment Exposure and Bank Outcomes (Full Sample)",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 5: Assessment Exposure and Bank Outcomes (Full Sample)
	Recip/Assets	ΔlnLoans	ΔlnDeps	Liquid/Assets	Equity/Assets	ROA
Exposure × Post	0.023	−0.023***	−0.002	0.036***	0.036	0.272**
	(0.014)	(0.006)	(0.006)	(0.011)	(0.144)	(0.127)
Num.Obs.	126299	126299	126299	126299	126299	126299
* p < 0.1, p < 0.05, * p < 0.01

msummary(models_t5, stars = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"), coef_omit = "^L_",
  gof_map = c("nobs", "r.squared.within"),
  output = file.path(results_dir, "table5_all_outcomes.tex"))

6.3 Table 5b: All Outcomes — Excluding G-SIBs

models_t5b <- lapply(outcome_list, function(v) {
  fml <- as.formula(paste(v, "~ exposure_post +", ctrl_formula,
                          "| idrssd + period"))
  feols(fml, data = panel[is_gsib == 0], cluster = ~idrssd)
})
names(models_t5b) <- paste0(outcome_nice[outcome_list], " (no GSIB)")

msummary(models_t5b,
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within"),
  title    = "Table 5b: Outcomes Excluding G-SIBs (Assets < $250B)",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 5b: Outcomes Excluding G-SIBs (Assets < $250B)
	Recip/Assets (no GSIB)	ΔlnLoans (no GSIB)	ΔlnDeps (no GSIB)	Liquid/Assets (no GSIB)	Equity/Assets (no GSIB)	ROA (no GSIB)
Exposure × Post	0.017	−0.028***	−0.004	0.037***	0.143	0.137
	(0.014)	(0.007)	(0.008)	(0.012)	(0.158)	(0.146)
Num.Obs.	125519	125519	125519	125519	125519	125519
* p < 0.1, p < 0.05, * p < 0.01

msummary(models_t5b, stars = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"), coef_omit = "^L_",
  gof_map = c("nobs", "r.squared.within"),
  output = file.path(results_dir, "table5b_nogsib.tex"))

6.4 Table 6: Anticipation vs Payment

fml_ant <- as.formula(paste(
  "recip_ratio ~ exposure_postnews + exposure_postpay +",
  ctrl_formula, "| idrssd + period"))
fml_ant_loans <- as.formula(paste(
  "d_ln_loans ~ exposure_postnews + exposure_postpay +",
  ctrl_formula, "| idrssd + period"))

m6_1 <- feols(fml_ant,       data = panel, cluster = ~idrssd)
m6_2 <- feols(fml_ant_loans, data = panel, cluster = ~idrssd)
m6_3 <- feols(fml_ant,       data = panel[is_gsib == 0], cluster = ~idrssd)
m6_4 <- feols(fml_ant_loans, data = panel[is_gsib == 0], cluster = ~idrssd)

msummary(
  list("Recip (Full)" = m6_1, "Loans (Full)" = m6_2,
       "Recip (no GSIB)" = m6_3, "Loans (no GSIB)" = m6_4),
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_postnews" = "Exposure × Post-News (2023Q2–Q4)",
               "exposure_postpay"  = "Exposure × Post-Pay (2024Q1+)"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within"),
  title    = "Table 6: Anticipation vs Payment",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 6: Anticipation vs Payment
	Recip (Full)	Loans (Full)	Recip (no GSIB)	Loans (no GSIB)
Exposure × Post-News (2023Q2–Q4)	0.053***	−0.058***	0.066***	−0.063***
	(0.016)	(0.008)	(0.018)	(0.009)
Exposure × Post-Pay (2024Q1+)	0.027*	−0.027***	0.022	−0.031***
	(0.016)	(0.006)	(0.016)	(0.008)
Num.Obs.	126299	126299	125519	125519
* p < 0.1, p < 0.05, * p < 0.01

msummary(list(m6_1, m6_2, m6_3, m6_4),
  stars = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_postnews" = "Exposure × Post-News",
               "exposure_postpay"  = "Exposure × Post-Pay"),
  coef_omit = "^L_",
  output = file.path(results_dir, "table6_anticipation.tex"))

6.5 Table 7: Heterogeneity

fml_cap <- as.formula(paste(
  "recip_ratio ~ exposure_post + expo_post_lowcap +",
  ctrl_formula, "| idrssd + period"))
fml_net <- as.formula(paste(
  "recip_ratio ~ exposure_post + expo_post_nonet +",
  ctrl_formula, "| idrssd + period"))

m7_1 <- feols(fml_cap, data = panel, cluster = ~idrssd)
m7_2 <- feols(fml_net, data = panel, cluster = ~idrssd)
m7_3 <- feols(fml_cap, data = panel[is_gsib == 0], cluster = ~idrssd)
m7_4 <- feols(fml_net, data = panel[is_gsib == 0], cluster = ~idrssd)

msummary(
  list("Low Cap (Full)" = m7_1, "No Net (Full)" = m7_2,
       "Low Cap (no GSIB)" = m7_3, "No Net (no GSIB)" = m7_4),
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post"     = "Exposure × Post",
               "expo_post_lowcap"  = "× Low Capital",
               "expo_post_nonet"   = "× No Network"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within"),
  title    = "Table 7: Heterogeneity (Triple Difference)",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 7: Heterogeneity (Triple Difference)
	Low Cap (Full)	No Net (Full)	Low Cap (no GSIB)	No Net (no GSIB)
Exposure × Post	0.009	0.031*	−0.002	0.025
	(0.018)	(0.017)	(0.016)	(0.016)
× Low Capital	0.039		0.049*
	(0.029)		(0.029)
× No Network		−0.056***		−0.057***
		(0.018)		(0.018)
Num.Obs.	125009	125009	124229	124229
* p < 0.1, p < 0.05, * p < 0.01

msummary(list(m7_1, m7_2, m7_3, m7_4),
  stars = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post",
               "expo_post_lowcap" = "× Low Capital",
               "expo_post_nonet" = "× No Network"),
  coef_omit = "^L_",
  output = file.path(results_dir, "table7_heterogeneity.tex"))

6.6 Table 3: Near-Threshold Regressions

# Prepare threshold regression data for multiple bandwidths
run_threshold <- function(bw_lo, bw_hi, depvar = "recip_ratio",
                          cutoff = THRESHOLD) {
  td <- panel[n_idis_in_org == 1 & !is.na(eud_2022q4) &
              eud_2022q4 >= bw_lo & eud_2022q4 <= bw_hi]
  td[, running_b := (eud_2022q4 - cutoff) / 1e6]
  td[, above := as.integer(eud_2022q4 > cutoff)]
  td[, above_post := above * post]
  td[, running_post := running_b * post]
  td[, above_running := above * running_b]
  td[, above_running_post := above * running_b * post]

  fml <- as.formula(paste(
    depvar, "~ above_post + running_post + above_running + above_running_post +",
    ctrl_formula, "| idrssd + period"))

  tryCatch(
    feols(fml, data = td, cluster = ~idrssd),
    error = function(e) { message("Threshold reg failed: ", e$message); NULL }
  )
}

rd_2_8  <- run_threshold(2000000, 8000000)
rd_3_7  <- run_threshold(3000000, 7000000)
rd_1_10 <- run_threshold(1000000, 10000000)
rd_loans <- run_threshold(2000000, 8000000, "d_ln_loans")

rd_models <- Filter(Negate(is.null),
  list("Recip $2B-$8B" = rd_2_8, "Recip $3B-$7B" = rd_3_7,
       "Recip $1B-$10B" = rd_1_10, "Loans $2B-$8B" = rd_loans))

if (length(rd_models) > 0) {
  msummary(rd_models,
    stars    = c("*" = .10, "**" = .05, "***" = .01),
    coef_map = c("above_post" = "Above $5B × Post"),
    coef_omit = "running|above_running|^L_",
    gof_map  = c("nobs", "r.squared.within"),
    title    = "Table 3: Near-Threshold Difference-in-Discontinuity",
    notes    = "Single-IDI orgs. Linear polynomial in running variable on each side.",
    output   = "kableExtra"
  ) %>% kable_styling(full_width = FALSE)

  msummary(rd_models,
    stars = c("*" = .10, "**" = .05, "***" = .01),
    coef_map = c("above_post" = "Above 5B × Post"),
    coef_omit = "running|above_running|^L_",
    output = file.path(results_dir, "table3_threshold.tex"))
}

7 Robustness

7.1 Table 8: Single-IDI Subsample

single <- panel[n_idis_in_org == 1]
fml_s <- as.formula(paste("recip_ratio ~ exposure_post +",
                          ctrl_formula, "| idrssd + period"))
fml_sl <- as.formula(paste("d_ln_loans ~ exposure_post +",
                           ctrl_formula, "| idrssd + period"))

m8_1 <- feols(fml_s,  data = single, cluster = ~idrssd)
m8_2 <- feols(fml_sl, data = single, cluster = ~idrssd)

msummary(
  list("Recip (Single IDI)" = m8_1, "Loans (Single IDI)" = m8_2),
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within"),
  title    = "Table 8: Single-IDI Organizations Only",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 8: Single-IDI Organizations Only
	Recip (Single IDI)	Loans (Single IDI)
Exposure × Post	0.016	−0.036***
	(0.021)	(0.009)
Num.Obs.	110273	110273
* p < 0.1, p < 0.05, * p < 0.01

7.2 Table 9: Alternative Post Dates & Clustering

# Alt post: 2023Q3 (after proposed rule)
panel[, post_alt1 := as.integer(yq_num >= 20233)]
panel[, expo_post_alt1 := exposure * post_alt1]

# Alt post: 2024Q2 (after first invoice)
panel[, post_alt2 := as.integer(yq_num >= 20242)]
panel[, expo_post_alt2 := exposure * post_alt2]

fml_r <- as.formula(paste("recip_ratio ~ exposure_post +",
                          ctrl_formula, "| idrssd + period"))

m9_base  <- feols(fml_r, data = panel, cluster = ~idrssd)
m9_2way  <- feols(fml_r, data = panel, cluster = ~idrssd + period)
m9_nogsib <- feols(fml_r, data = panel[is_gsib == 0], cluster = ~idrssd)

m9_alt1  <- feols(
  as.formula(paste("recip_ratio ~ expo_post_alt1 +", ctrl_formula,
                   "| idrssd + period")),
  data = panel, cluster = ~idrssd)

m9_alt2  <- feols(
  as.formula(paste("recip_ratio ~ expo_post_alt2 +", ctrl_formula,
                   "| idrssd + period")),
  data = panel, cluster = ~idrssd)

msummary(
  list("Baseline" = m9_base, "2-Way Cluster" = m9_2way,
       "Excl GSIB" = m9_nogsib,
       "Post=2023Q3" = m9_alt1, "Post=2024Q2" = m9_alt2),
  stars    = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post"    = "Exposure × Post",
               "expo_post_alt1"   = "Exposure × Post (2023Q3)",
               "expo_post_alt2"   = "Exposure × Post (2024Q2)"),
  coef_omit = "^L_",
  gof_map  = c("nobs", "r.squared.within"),
  title    = "Table 9: Robustness Checks — Reciprocal Deposit Ratio",
  output   = "kableExtra"
) %>% kable_styling(full_width = FALSE)

Table 9: Robustness Checks — Reciprocal Deposit Ratio
	Baseline	2-Way Cluster	Excl GSIB	Post=2023Q3	Post=2024Q2
Exposure × Post	0.023	0.023	0.017
	(0.014)	(0.016)	(0.014)
Exposure × Post (2023Q3)				0.028*
				(0.015)
Exposure × Post (2024Q2)					0.016
					(0.014)
Num.Obs.	126299	126299	125519	126299	126299
* p < 0.1, p < 0.05, * p < 0.01

msummary(list(m9_base, m9_2way, m9_nogsib, m9_alt1, m9_alt2),
  stars = c("*" = .10, "**" = .05, "***" = .01),
  coef_map = c("exposure_post" = "Exposure × Post",
               "expo_post_alt1" = "Exposure × Post (2023Q3)",
               "expo_post_alt2" = "Exposure × Post (2024Q2)"),
  coef_omit = "^L_",
  output = file.path(results_dir, "table9_robustness.tex"))

7.3 Placebo Thresholds

placebo_results <- list()
for (pt in c(3, 7, 10)) {
  pt_k <- pt * 1e6
  m <- run_threshold(pt_k - 3e6, pt_k + 3e6, cutoff = pt_k)
  if (!is.null(m)) {
    placebo_results[[paste0("$", pt, "B")]] <- m
  }
}

if (length(placebo_results) > 0) {
  msummary(placebo_results,
    stars    = c("*" = .10, "**" = .05, "***" = .01),
    coef_map = c("above_post" = "Above Placebo × Post"),
    coef_omit = "running|above_running|^L_",
    gof_map  = c("nobs", "r.squared.within"),
    title    = "Placebo Threshold Tests (Should Show No Effect)",
    output   = "kableExtra"
  ) %>% kable_styling(full_width = FALSE)
}

Placebo Threshold Tests (Should Show No Effect)
	$3B	$7B	$10B
Above Placebo × Post	−0.014	−0.025	−0.003
	(0.013)	(0.015)	(0.012)
Num.Obs.	108638	1530	659
* p < 0.1, p < 0.05, * p < 0.01

8 Results Summary

8.1 What the Data Shows

cat("
## Key Findings Checklist

Look at the output above and fill in:

| Test | Expected | Actual | Verdict |
|------|----------|--------|---------|
| Fig 1: Treated vs Control diverge after 2024Q1? | Yes | ______ | |
| Fig 1-bis: G-SIBs differ from mid-size? | Likely | ______ | |
| Event Study (full): Post betas positive for recip? | Yes | Negative | ❌ Full sample |
| Event Study (no GSIB): Post betas positive? | Yes | ______ | ← CHECK THIS |
| Event Study (mid-size): Post betas positive? | Yes | ______ | ← CHECK THIS |
| Event Study: Loan growth post betas negative? | Yes | ______ | |
| Threshold: Jump at $5B for recip? | Yes | ______ | |
| Threshold: Jump at $5B for loans? | Yes | ______ | |
| CARs: Exposure predicts CAR? | Yes (negative) | Positive | Reframe as 'better than feared' |
| Table 4 col (4): Mid-size DiD significant? | | ______ | ← KEY |
| Placebo thresholds insignificant? | Yes | ______ | |

## Decision Matrix

**If mid-size event study (no GSIB) shows positive post-betas for reciprocal deposits:**
→ Paper is about heterogeneous responses. G-SIBs absorb the cost; mid-size banks repackage.
→ Title: 'The Price of Uninsured Deposits: Who Repackages and Who Absorbs?'

**If NO subsample shows reciprocal deposit repackaging:**
→ Pivot to real effects (lending, profitability, capital).
→ Title: 'The Real Effects of Pricing Uninsured Deposits'

**If loan growth consistently shows negative post-betas:**
→ Credit supply contraction is the main story.
→ Reciprocal deposits become a footnote (null result = interesting too).
")

8.2 Key Findings Checklist

Look at the output above and fill in:

Test	Expected	Actual	Verdict
Fig 1: Treated vs Control diverge after 2024Q1?	Yes	______
Fig 1-bis: G-SIBs differ from mid-size?	Likely	______
Event Study (full): Post betas positive for recip?	Yes	Negative	❌ Full sample
Event Study (no GSIB): Post betas positive?	Yes	______	← CHECK THIS
Event Study (mid-size): Post betas positive?	Yes	______	← CHECK THIS
Event Study: Loan growth post betas negative?	Yes	______
Threshold: Jump at $5B for recip?	Yes	______
Threshold: Jump at $5B for loans?	Yes	______
CARs: Exposure predicts CAR?	Yes (negative)	Positive	Reframe as ‘better than feared’
Table 4 col (4): Mid-size DiD significant?		______	← KEY
Placebo thresholds insignificant?	Yes	______

8.3 Decision Matrix

If mid-size event study (no GSIB) shows positive post-betas for reciprocal deposits: → Paper is about heterogeneous responses. G-SIBs absorb the cost; mid-size banks repackage. → Title: ‘The Price of Uninsured Deposits: Who Repackages and Who Absorbs?’

If NO subsample shows reciprocal deposit repackaging: → Pivot to real effects (lending, profitability, capital). → Title: ‘The Real Effects of Pricing Uninsured Deposits’

If loan growth consistently shows negative post-betas: → Credit supply contraction is the main story. → Reciprocal deposits become a footnote (null result = interesting too).

8.4 Files Created

all_files <- list.files(results_dir, full.names = FALSE)
cat("Files in", results_dir, ":\n")

## Files in C:/Users/mferdo2/OneDrive - Louisiana State University/Finance_PhD/JMP project/03_code/results :

for (f in sort(all_files)) cat("  ", f, "\n")

##    fig_car_scatter.pdf 
##    fig_event_study_all_nogsib.pdf 
##    fig_event_study_all_outcomes.pdf 
##    fig1_size_split.pdf 
##    fig1_timeseries_panel.pdf 
##    fig3_threshold_improved.pdf 
##    fig3_threshold_loans.pdf 
##    table3_threshold.tex 
##    table4_did_recip.tex 
##    table5_all_outcomes.tex 
##    table5b_nogsib.tex 
##    table6_anticipation.tex 
##    table7_heterogeneity.tex 
##    table9_robustness.tex

cat("\nTotal:", length(all_files), "files\n")

## 
## Total: 14 files

9 Appendix: Regression Details

9.1 Full Regression Output: Baseline DiD

summary(m4_2)

## OLS estimation, Dep. Var.: recip_ratio
## Observations: 126,299
## Fixed-effects: idrssd: 4,819,  period: 27
## Standard-errors: Clustered (idrssd) 
##                     Estimate Std. Error    t value   Pr(>|t|)    
## exposure_post       0.022510   0.014418   1.561313 1.1852e-01    
## L_ln_assets         0.021593   0.002837   7.611048 3.2507e-14 ***
## L_equity_to_asset  -0.000043   0.000158  -0.270172 7.8704e-01    
## L_loan_to_asset     0.000265   0.000052   5.134768 2.9362e-07 ***
## L_deposit_to_asset  0.000093   0.000113   0.821506 4.1140e-01    
## L_nib_share        -0.000728   0.000067 -10.842065  < 2.2e-16 ***
## L_roa              -0.000198   0.000147  -1.347506 1.7788e-01    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## RMSE: 0.023391     Adj. R2: 0.736057
##                  Within R2: 0.051675

9.2 Full Event Study Output

summary(es_recip$model)

## OLS estimation, Dep. Var.: recip_ratio
## Observations: 111,966
## Fixed-effects: idrssd: 4,819,  period: 24
## Standard-errors: Clustered (idrssd) 
##                     Estimate Std. Error    t value   Pr(>|t|)    
## et::-16:exposure   -0.020793   0.018750  -1.108987 2.6749e-01    
## et::-15:exposure   -0.027247   0.018510  -1.472026 1.4108e-01    
## et::-14:exposure   -0.033727   0.018679  -1.805599 7.1043e-02 .  
## et::-13:exposure   -0.038327   0.018815  -2.037071 4.1697e-02 *  
## et::-12:exposure   -0.043394   0.018589  -2.334326 1.9620e-02 *  
## et::-11:exposure   -0.058212   0.016773  -3.470507 5.2403e-04 ***
## et::-10:exposure   -0.068019   0.017117  -3.973649 7.1814e-05 ***
## et::-9:exposure    -0.069844   0.017466  -3.998898 6.4591e-05 ***
## et::-8:exposure    -0.068569   0.017498  -3.918598 9.0300e-05 ***
## et::-7:exposure    -0.063240   0.016077  -3.933528 8.4885e-05 ***
## et::-6:exposure    -0.053464   0.015478  -3.454317 5.5644e-04 ***
## et::-5:exposure    -0.042448   0.014010  -3.029886 2.4594e-03 ** 
## et::-4:exposure    -0.015721   0.012258  -1.282545 1.9971e-01    
## et::-3:exposure     0.022416   0.007065   3.172889 1.5188e-03 ** 
## et::-2:exposure     0.010433   0.004555   2.290288 2.2048e-02 *  
## et::0:exposure     -0.004858   0.003261  -1.489688 1.3637e-01    
## et::1:exposure     -0.001150   0.005367  -0.214232 8.3038e-01    
## et::2:exposure     -0.010627   0.007286  -1.458508 1.4477e-01    
## et::3:exposure     -0.016427   0.008891  -1.847536 6.4731e-02 .  
## et::4:exposure     -0.012732   0.010280  -1.238557 2.1557e-01    
## et::5:exposure     -0.019728   0.011060  -1.783722 7.4532e-02 .  
## et::6:exposure     -0.025720   0.012467  -2.063000 3.9166e-02 *  
## et::7:exposure     -0.023240   0.012621  -1.841326 6.5635e-02 .  
## L_ln_assets         0.022611   0.003219   7.023795 2.4602e-12 ***
## L_equity_to_asset   0.000029   0.000163   0.175729 8.6051e-01    
## L_loan_to_asset     0.000246   0.000056   4.417966 1.0182e-05 ***
## L_deposit_to_asset  0.000154   0.000121   1.272778 2.0316e-01    
## L_nib_share        -0.000755   0.000068 -11.082014  < 2.2e-16 ***
## L_roa              -0.000197   0.000146  -1.347334 1.7794e-01    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## RMSE: 0.022736     Adj. R2: 0.752843
##                  Within R2: 0.054243

10 Descriptive Analysis & Summary Tables

Standard descriptive analysis for the paper. These tables characterize the sample, document balance, and provide the reader with cross-sectional and time-series facts before seeing any causal estimates.

10.1 Table D1: Sample Construction (Attrition)

Shows how the sample narrows from the Call Report universe to the final estimation panel. Reviewers expect this in the appendix.

# ── Build sample attrition log ──
attrition <- data.table(
  Step = character(), Banks = integer(), BankQuarters = integer()
)

# Step 1: Full panel loaded
attrition <- rbind(attrition, data.table(
  Step = "1. Full panel loaded",
  Banks = panel[, uniqueN(idrssd)],
  BankQuarters = nrow(panel)
))

# Step 2: Non-missing exposure
attrition <- rbind(attrition, data.table(
  Step = "2. Non-missing exposure",
  Banks = panel[!is.na(exposure), uniqueN(idrssd)],
  BankQuarters = panel[!is.na(exposure), .N]
))

# Step 3: Non-missing key outcomes
key_out <- c("recip_ratio", "d_ln_loans", "d_ln_deposits")
key_out <- intersect(key_out, names(panel))
if (length(key_out) > 0) {
  has_outcome <- panel[, .(has = rowSums(!is.na(.SD)) > 0), .SDcols = key_out]$has
  attrition <- rbind(attrition, data.table(
    Step = "3. At least one key outcome non-missing",
    Banks = panel[has_outcome, uniqueN(idrssd)],
    BankQuarters = sum(has_outcome)
  ))
}

# Step 4: Non-missing controls
ctrl_names <- intersect(
  c("L_ln_assets", "L_equity_to_asset", "L_loan_to_asset",
    "L_deposit_to_asset", "L_nib_share", "L_roa"),
  names(panel)
)
if (length(ctrl_names) > 0) {
  has_ctrl <- panel[, complete.cases(.SD), .SDcols = ctrl_names]
  attrition <- rbind(attrition, data.table(
    Step = "4. Complete lagged controls",
    Banks = panel[has_ctrl, uniqueN(idrssd)],
    BankQuarters = sum(has_ctrl)
  ))
}

# Step 5: Treated vs control
attrition <- rbind(attrition, data.table(
  Step = "5a. Treated (Exposure > 0)",
  Banks = panel[treated == 1, uniqueN(idrssd)],
  BankQuarters = panel[treated == 1, .N]
))
attrition <- rbind(attrition, data.table(
  Step = "5b. Control (Exposure = 0)",
  Banks = panel[treated == 0, uniqueN(idrssd)],
  BankQuarters = panel[treated == 0, .N]
))

# Step 6: Excluding G-SIBs
attrition <- rbind(attrition, data.table(
  Step = "6. Excluding G-SIBs",
  Banks = panel[is_gsib == 0, uniqueN(idrssd)],
  BankQuarters = panel[is_gsib == 0, .N]
))

# Step 7: Single-IDI orgs
attrition <- rbind(attrition, data.table(
  Step = "7. Single-IDI organizations",
  Banks = panel[n_idis_in_org == 1, uniqueN(idrssd)],
  BankQuarters = panel[n_idis_in_org == 1, .N]
))

kable(attrition, caption = "Table D1: Sample Construction",
      format.args = list(big.mark = ","), align = "lrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE) %>%
  row_spec(0, bold = TRUE)

Table D1: Sample Construction
Step	Banks	BankQuarters
Full panel loaded	4,819	131,118
Non-missing exposure	4,819	131,118
At least one key outcome non-missing	4,819	131,118
Complete lagged controls	4,819	126,299
5a. Treated (Exposure > 0)	160	4,319
5b. Control (Exposure = 0)	4,659	126,799
Excluding G-SIBs	4,790	130,309
Single-IDI organizations	4,160	114,433

# ── Save ──
kable(attrition, format = "latex", caption = "Sample Construction",
      format.args = list(big.mark = ","), booktabs = TRUE) %>%
  writeLines(file.path(results_dir, "table_d1_sample_construction.tex"))

10.2 Table D2: Detailed Summary Statistics (Full Sample)

Full-sample summary with mean, SD, percentiles — the standard “Table 1” that appears in every empirical finance paper.

# ── Variables to summarize ──
sumstat_all_vars <- intersect(
 c("total_asset", "exposure", "eud_2022q4",
    "recip_ratio", "d_ln_loans", "d_ln_deposits",
    "borrow_ratio", "liquid_ratio", "equity_ratio", "roa",
    "L_ln_assets", "L_equity_to_asset", "L_loan_to_asset",
    "L_deposit_to_asset", "L_nib_share", "L_roa"),
  names(panel)
)

# Nice labels
nice_labels <- c(
  total_asset        = "Total Assets ($000s)",
  exposure           = "Assessment Exposure",
  eud_2022q4         = "Est. Uninsured Deposits 2022Q4 ($000s)",
  recip_ratio        = "Reciprocal Deposits / Assets",
  d_ln_loans         = "Δ ln(Loans)",
  d_ln_deposits      = "Δ ln(Deposits)",
  borrow_ratio       = "Borrowings / Assets",
  liquid_ratio       = "Liquid Assets / Assets",
  equity_ratio       = "Equity / Assets",
  roa                = "ROA",
  L_ln_assets        = "Log Assets (lagged)",
  L_equity_to_asset  = "Equity Ratio (lagged)",
  L_loan_to_asset    = "Loan Share (lagged)",
  L_deposit_to_asset = "Deposit Share (lagged)",
  L_nib_share        = "NIB Deposit Share (lagged)",
  L_roa              = "ROA (lagged)"
)

make_full_sumstat <- function(dt, vars) {
  rbindlist(lapply(vars, function(v) {
    x <- dt[[v]][!is.na(dt[[v]])]
    lbl <- ifelse(v %in% names(nice_labels), nice_labels[v], v)
    data.table(
      Variable = lbl, N = length(x),
      Mean = mean(x), SD = sd(x),
      P1 = quantile(x, 0.01), P25 = quantile(x, 0.25),
      Median = median(x), P75 = quantile(x, 0.75),
      P99 = quantile(x, 0.99)
    )
  }))
}

ss_full <- make_full_sumstat(panel, sumstat_all_vars)

kable(ss_full, caption = "Table D2: Summary Statistics — Full Sample",
      digits = 4, format.args = list(big.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 11) %>%
  row_spec(0, bold = TRUE) %>%
  pack_rows("Panel A: Key Variables", 1,
            min(length(sumstat_all_vars), which(sumstat_all_vars == "roa"))) %>%
  pack_rows("Panel B: Lagged Controls",
            min(length(sumstat_all_vars), which(sumstat_all_vars == "roa")) + 1,
            length(sumstat_all_vars))

Table D2: Summary Statistics — Full Sample
Variable	N	Mean	SD	P1	P25	Median	P75	P99
Panel A: Key Variables
Total Assets ($000s)	131,118	4,782,275.6500	7.187918e+07	17,233.5100	133,922.0000	304,366.5000	765,981.7500	4.942246e+07
Assessment Exposure	131,118	0.0067	4.540000e-02	0.0000	0.0000	0.0000	0.0000	2.753000e-01
Est. Uninsured Deposits 2022Q4 ($000s)	129,740	1,652,390.1767	2.597864e+07	0.0000	0.0000	0.0000	0.0000	1.959484e+07
Reciprocal Deposits / Assets	131,118	0.0198	4.640000e-02	0.0000	0.0000	0.0000	0.0140	2.680000e-01
Δ ln(Loans)	126,299	0.0174	4.860000e-02	-0.1131	-0.0068	0.0128	0.0362	2.309000e-01
Δ ln(Deposits)	126,299	0.0184	5.310000e-02	-0.1112	-0.0109	0.0118	0.0404	2.371000e-01
Liquid Assets / Assets	131,118	0.1076	1.149000e-01	0.0086	0.0364	0.0735	0.1372	5.841000e-01
Equity / Assets	131,118	12.0785	9.763800e+00	3.7146	8.6396	10.2341	12.4347	8.473900e+01
ROA	131,118	1.1282	1.092000e+00	-1.5380	0.6420	1.0105	1.4165	8.282600e+00
Panel B: Lagged Controls
Log Assets (lagged)	126,299	12.7823	1.533200e+00	9.7531	11.7988	12.6191	13.5392	1.770330e+01
Equity Ratio (lagged)	126,299	12.1413	1.043520e+01	3.7003	8.6310	10.2270	12.4237	8.481420e+01
Loan Share (lagged)	126,299	62.0762	1.823930e+01	0.0000	52.5090	65.3773	75.4248	8.987210e+01
Deposit Share (lagged)	126,299	83.1027	1.273140e+01	0.0000	81.4788	85.9111	88.9638	9.470620e+01
NIB Deposit Share (lagged)	126,299	23.8843	1.278710e+01	0.0000	16.3094	23.0387	30.4949	6.376380e+01
ROA (lagged)	126,299	1.3604	8.449100e+00	-1.5102	0.6410	1.0088	1.4143	8.280900e+00

# ── Save ──
kable(ss_full, format = "latex",
      caption = "Summary Statistics --- Full Sample",
      digits = 4, booktabs = TRUE,
      format.args = list(big.mark = ",")) %>%
  writeLines(file.path(results_dir, "table_d2_full_sumstats.tex"))

10.3 Table D3: Summary Statistics by Exposure Quartile

Exposure quartiles let the reader see how treated banks differ by intensity — critical for a continuous DiD paper.

# ── Define quartiles among treated banks ──
treated_ids <- panel[treated == 1 & !is.na(exposure), .(
  exposure = exposure[1]
), by = idrssd]

treated_ids[, expo_quartile := cut(
  exposure,
  breaks = quantile(exposure, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE),
  labels = c("Q1 (Low)", "Q2", "Q3", "Q4 (High)"),
  include.lowest = TRUE
)]

# Merge back
panel_q <- merge(panel, treated_ids[, .(idrssd, expo_quartile)],
                 by = "idrssd", all.x = TRUE)
panel_q[treated == 0, expo_quartile := "Control"]
panel_q[, expo_quartile := factor(expo_quartile,
  levels = c("Control", "Q1 (Low)", "Q2", "Q3", "Q4 (High)"))]

# Pre-period stats by quartile
pre_q <- panel_q[event_time < 0 & !is.na(expo_quartile)]

quartile_vars <- intersect(
  c("total_asset", "recip_ratio", "L_equity_to_asset",
    "L_loan_to_asset", "L_deposit_to_asset", "L_nib_share", "L_roa"),
  names(panel_q)
)

# Compute means and SDs per quartile per variable (long format — avoids
# fragile unlist / get() column-name approach)
ss_by_q_long <- rbindlist(lapply(quartile_vars, function(v) {
  pre_q[, .(
    Variable = v,
    Mean     = mean(get(v), na.rm = TRUE),
    SD       = sd(get(v), na.rm = TRUE)
  ), by = expo_quartile]
}))

# N banks per quartile
n_by_q <- pre_q[, .(N_banks = uniqueN(idrssd)), by = expo_quartile]

# Build display rows
q_levels <- levels(panel_q$expo_quartile)

rows <- lapply(quartile_vars, function(v) {
  lbl <- ifelse(v %in% names(nice_labels), nice_labels[v], v)
  vals <- sapply(q_levels, function(q) {
    row <- ss_by_q_long[Variable == v & expo_quartile == q]
    if (nrow(row) == 0) return("")
    sprintf("%.4f\n(%.4f)", row$Mean, row$SD)
  })
  c(Variable = lbl, vals)
})

# Add N row
n_row <- c("N (unique banks)", sapply(q_levels, function(q) {
  n <- n_by_q[expo_quartile == q, N_banks]
  if (length(n) == 0) return("")
  format(n, big.mark = ",")
}))

tbl_q <- as.data.table(do.call(rbind, c(list(n_row), rows)))
setnames(tbl_q, c("Variable", levels(panel_q$expo_quartile)))

kable(tbl_q,
  caption = "Table D3: Pre-Period Means (SD) by Exposure Quartile",
  align = c("l", rep("c", 5))) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 11) %>%
  row_spec(0, bold = TRUE) %>%
  add_header_above(c(" " = 1, "Untreated" = 1, "Treated — Exposure Quartile" = 4))

Table D3: Pre-Period Means (SD) by Exposure Quartile
	Untreated	Treated — Exposure Quartile
Variable	Control	Q1 (Low)	Q2	Q3	Q4 (High)
N (unique banks)	4,659	40	40	40	40
Total Assets ($000s)	753698.2056 (2280897.0847)	20332173.3738 (25958490.2681	23635252.7411 (34336007.920	) \| 64378172.4737 (98683669.07	352144346.4923 (656824523.7
Reciprocal Deposits / Assets	0.0163 (0.0422)	0.0355 (0.0566)	0.0408 (0.0482)	0.0479 (0.0550)	0.0417 (0.0455)
Equity Ratio (lagged)	12.2756 (10.5075)	13.6977 (13.6527)	12.0211 (2.7593)	10.8415 (2.9343)	10.4012 (3.1169)
Loan Share (lagged)	61.3319 (18.2097)	58.2640 (25.0180)	67.2428 (11.8228)	62.6091 (15.2717)	55.2359 (18.9950)
Deposit Share (lagged)	83.3432 (12.6714)	77.0528 (19.6020)	81.0809 (6.7488)	80.9135 (9.6584)	77.8864 (10.4108)
NIB Deposit Share (lagged)	24.3388 (12.8981)	23.4341 (20.7686)	26.2878 (13.3768)	26.2142 (13.3681)	33.2128 (11.9751)
ROA (lagged)	1.3762 (9.0151)	1.9586 (3.5400)	1.1851 (1.4992)	1.1575 (1.3413)	0.9074 (1.2220)

# ── Save ──
kable(tbl_q, format = "latex",
      caption = "Pre-Period Means (SD) by Exposure Quartile",
      booktabs = TRUE, align = c("l", rep("c", 5))) %>%
  writeLines(file.path(results_dir, "table_d3_by_exposure_quartile.tex"))

10.4 Table D4: Covariate Balance (t-tests)

Formal tests for pre-period balance between treated and control.

pre_bal <- panel[event_time < 0]

balance_vars <- intersect(
  c("total_asset", "recip_ratio", "L_ln_assets", "L_equity_to_asset",
    "L_loan_to_asset", "L_deposit_to_asset", "L_nib_share", "L_roa",
    "d_ln_loans", "d_ln_deposits"),
  names(panel)
)

balance_tbl <- rbindlist(lapply(balance_vars, function(v) {
  x_t <- pre_bal[treated == 1, get(v)]
  x_c <- pre_bal[treated == 0, get(v)]
  x_t <- x_t[!is.na(x_t)]
  x_c <- x_c[!is.na(x_c)]

  tt <- tryCatch(t.test(x_t, x_c), error = function(e) NULL)
  lbl <- ifelse(v %in% names(nice_labels), nice_labels[v], v)

  data.table(
    Variable     = lbl,
    Mean_Treated = mean(x_t),
    Mean_Control = mean(x_c),
    Difference   = mean(x_t) - mean(x_c),
    t_stat       = if (!is.null(tt)) tt$statistic else NA_real_,
    p_value      = if (!is.null(tt)) tt$p.value   else NA_real_
  )
}))

balance_tbl[, Stars := fcase(
  p_value < 0.01, "***",
  p_value < 0.05, "**",
  p_value < 0.10, "*",
  default = ""
)]

kable(balance_tbl, caption = "Table D4: Pre-Period Covariate Balance",
      digits = 4, col.names = c("Variable", "Treated", "Control",
                                "Difference", "t-stat", "p-value", "")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE) %>%
  row_spec(0, bold = TRUE) %>%
  footnote(general = "Pre-period (event_time < 0). Two-sample Welch t-test.")

Table D4: Pre-Period Covariate Balance
Variable	Treated	Control	Difference	t-stat	p-value
Total Assets ($000s)	1.142688e+08	753698.2056	1.135151e+08	17.8244	0.0000	***
Reciprocal Deposits / Assets	4.150000e-02	0.0163	2.520000e-02	27.1030	0.0000	***
Log Assets (lagged)	1.702410e+01	12.5719	4.452200e+00	148.3656	0.0000	***
Equity Ratio (lagged)	1.174750e+01	12.2756	-5.281000e-01	-3.7683	0.0002	***
Loan Share (lagged)	6.083620e+01	61.3319	-4.957000e-01	-1.4079	0.1592
Deposit Share (lagged)	7.923050e+01	83.3432	-4.112700e+00	-17.4233	0.0000	***
NIB Deposit Share (lagged)	2.725780e+01	24.3388	2.918900e+00	10.0696	0.0000	***
ROA (lagged)	1.305200e+00	1.3762	-7.100000e-02	-1.4205	0.1555
Δ ln(Loans)	2.030000e-02	0.0183	2.000000e-03	2.1460	0.0319	**
Δ ln(Deposits)	2.440000e-02	0.0207	3.800000e-03	3.4068	0.0007	***
Note:
Pre-period (event_time < 0). Two-sample Welch t-test.

# ── Save ──
kable(balance_tbl, format = "latex",
      caption = "Pre-Period Covariate Balance",
      digits = 4, booktabs = TRUE,
      col.names = c("Variable", "Treated", "Control",
                    "Difference", "t-stat", "p-value", "")) %>%
  writeLines(file.path(results_dir, "table_d4_balance_test.tex"))

10.5 Table D5: Pairwise Correlations

Correlations among key variables help readers understand multicollinearity and cross-sectional variation.

corr_vars <- intersect(
  c("exposure", "recip_ratio", "d_ln_loans", "d_ln_deposits",
    "borrow_ratio", "liquid_ratio", "L_equity_to_asset",
    "L_ln_assets", "L_loan_to_asset", "L_nib_share"),
  names(panel)
)

corr_labels <- c(
  exposure           = "Exposure",
  recip_ratio        = "Recip/Assets",
  d_ln_loans         = "ΔlnLoans",
  d_ln_deposits      = "ΔlnDeps",
  borrow_ratio       = "Borrow/A",
  liquid_ratio       = "Liquid/A",
  L_equity_to_asset  = "Equity(L)",
  L_ln_assets        = "lnAssets(L)",
  L_loan_to_asset    = "Loan/A(L)",
  L_nib_share        = "NIB%(L)"
)

corr_mat <- cor(panel[, ..corr_vars], use = "pairwise.complete.obs")
rownames(corr_mat) <- corr_labels[corr_vars]
colnames(corr_mat) <- corr_labels[corr_vars]

# Lower triangle only
corr_mat[upper.tri(corr_mat)] <- NA

kable(round(corr_mat, 3),
      caption = "Table D5: Pairwise Correlations (Lower Triangle)") %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 10) %>%
  row_spec(0, bold = TRUE, font_size = 9)

Table D5: Pairwise Correlations (Lower Triangle)
	Exposure	Recip/Assets	ΔlnLoans	ΔlnDeps	Liquid/A	Equity(L)	lnAssets(L)	Loan/A(L)	NIB%(L)
Exposure	1.000	NA	NA	NA	NA	NA	NA	NA	NA
Recip/Assets	0.088	1.000	NA	NA	NA	NA	NA	NA	NA
ΔlnLoans	0.004	0.048	1.000	NA	NA	NA	NA	NA	NA
ΔlnDeps	0.009	0.064	0.296	1.000	NA	NA	NA	NA	NA
Liquid/A	-0.008	-0.097	-0.096	0.098	1.000	NA	NA	NA	NA
Equity(L)	-0.019	-0.047	-0.021	0.011	0.380	1.000	NA	NA	NA
lnAssets(L)	0.475	0.239	0.040	0.027	-0.215	-0.219	1.000	NA	NA
Loan/A(L)	-0.023	0.220	0.033	0.105	-0.412	-0.396	0.246	1.00	NA
NIB%(L)	0.048	-0.158	0.017	0.008	0.144	-0.182	0.034	-0.12	1

# ── Save ──
kable(round(corr_mat, 3), format = "latex",
      caption = "Pairwise Correlations (Lower Triangle)",
      booktabs = TRUE) %>%
  writeLines(file.path(results_dir, "table_d5_correlations.tex"))

10.6 Table D6: Panel Composition Over Time

Documents how many banks appear each quarter, helps readers assess panel balance and attrition.

panel_comp <- panel[, .(
  N_Banks     = uniqueN(idrssd),
  N_Treated   = uniqueN(idrssd[treated == 1]),
  N_Control   = uniqueN(idrssd[treated == 0]),
  Pct_Treated = round(100 * uniqueN(idrssd[treated == 1]) / uniqueN(idrssd), 1),
  Mean_Assets = mean(total_asset, na.rm = TRUE),
  Mean_Recip  = mean(recip_ratio, na.rm = TRUE)
), by = .(Quarter = period)]

panel_comp <- panel_comp[order(Quarter)]

kable(panel_comp,
      caption = "Table D6: Panel Composition by Quarter",
      digits = c(0, 0, 0, 0, 1, 0, 4),
      format.args = list(big.mark = ","),
      col.names = c("Quarter", "Total Banks", "Treated", "Control",
                     "% Treated", "Mean Assets ($000s)",
                     "Mean Recip Ratio")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, font_size = 10) %>%
  row_spec(0, bold = TRUE) %>%
  row_spec(which(panel_comp$Quarter == "2024Q1"), bold = TRUE,
           background = "#fff3cd")

Table D6: Panel Composition by Quarter
Quarter	Total Banks	Treated	Control	% Treated	Mean Assets ($000s)	Mean Recip Ratio
2019Q1	4,772	160	4,612	3.4	3,545,162	0.0201
2019Q2	4,778	160	4,618	3.3	3,617,891	0.0196
2019Q3	4,783	160	4,623	3.3	3,665,010	0.0186
2019Q4	4,786	160	4,626	3.3	3,750,838	0.0177
2020Q1	4,788	160	4,628	3.3	4,088,075	0.0175
2020Q2	4,789	160	4,629	3.3	4,273,428	0.0165
2020Q3	4,791	160	4,631	3.3	4,298,944	0.0156
2020Q4	4,794	160	4,634	3.3	4,435,417	0.0146
2021Q1	4,798	160	4,638	3.3	4,569,787	0.0138
2021Q2	4,801	160	4,641	3.3	4,629,431	0.0129
2021Q3	4,805	160	4,645	3.3	4,730,920	0.0124
2021Q4	4,806	160	4,646	3.3	4,863,116	0.0120
2022Q1	4,809	160	4,649	3.3	4,962,602	0.0122
2022Q2	4,811	160	4,651	3.3	4,931,970	0.0129
2022Q3	4,763	160	4,603	3.4	4,959,845	0.0145
2022Q4	4,731	160	4,571	3.4	4,988,089	0.0175
2023Q1	4,703	155	4,548	3.3	5,043,720	0.0208
2023Q2	4,670	151	4,519	3.2	5,024,610	0.0228
2023Q3	4,624	150	4,474	3.2	5,062,676	0.0248
2023Q4	4,613	148	4,465	3.2	5,132,177	0.0258
2024Q1	4,592	148	4,444	3.2	5,218,208	0.0268
2024Q2	4,566	147	4,419	3.2	5,233,309	0.0269
2024Q3	4,546	147	4,399	3.2	5,327,697	0.0275
2024Q4	4,509	147	4,362	3.3	5,346,438	0.0276
2025Q1	4,485	145	4,340	3.2	5,472,592	0.0273
2025Q2	4,439	142	4,297	3.2	5,630,814	0.0271
2025Q3	4,405	140	4,265	3.2	5,703,690	0.0270
2025Q4	4,361	139	4,222	3.2	5,794,243	0.0265

# ── Save ──
kable(panel_comp, format = "latex",
      caption = "Panel Composition by Quarter",
      digits = c(0, 0, 0, 0, 1, 0, 4), booktabs = TRUE,
      format.args = list(big.mark = ","),
      col.names = c("Quarter", "Total Banks", "Treated", "Control",
                    "\\% Treated", "Mean Assets (\\$000s)",
                    "Mean Recip Ratio")) %>%
  writeLines(file.path(results_dir, "table_d6_panel_composition.tex"))

10.7 Figure D1: Distribution of Assessment Exposure

Cross-sectional density of the treatment variable — necessary to show readers there is meaningful variation for identification.

expo_cross <- panel[treated == 1, .(exposure = exposure[1],
  eud = eud_2022q4[1], total_asset = total_asset[1],
  size_cat = size_cat[1], n_idis = n_idis_in_org[1]), by = idrssd]

# Panel A: Histogram / density of exposure
p_hist <- ggplot(expo_cross, aes(x = exposure)) +
  geom_histogram(aes(y = after_stat(density)), bins = 50,
                 fill = "steelblue", alpha = 0.5, color = "white") +
  geom_density(color = "firebrick", linewidth = 1) +
  geom_vline(xintercept = median(expo_cross$exposure, na.rm = TRUE),
             linetype = "dashed", color = "darkgreen", linewidth = 0.8) +
  annotate("text", x = median(expo_cross$exposure, na.rm = TRUE) * 1.1,
           y = Inf, vjust = 2, label = "Median", color = "darkgreen",
           fontface = "italic", size = 3.5) +
  labs(x = "Assessment Exposure (Base / Assets)", y = "Density",
       title = "A. Distribution of Assessment Exposure (Treated Banks)") +
  theme_minimal(base_size = 12)

# Panel B: Exposure by size group
p_box <- ggplot(expo_cross, aes(x = size_cat, y = exposure, fill = size_cat)) +
  geom_boxplot(alpha = 0.6, outlier.alpha = 0.3, outlier.size = 1) +
  scale_fill_brewer(palette = "Set2") +
  labs(x = "Size Category", y = "Assessment Exposure",
       title = "B. Exposure by Bank Size Category") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none")

# Panel C: EUD distribution near $5B threshold (single-IDI)
p_thresh_hist <- ggplot(expo_cross[n_idis == 1 & eud > 0],
  aes(x = eud / 1e6)) +
  geom_histogram(bins = 60, fill = "steelblue", alpha = 0.5, color = "white") +
  geom_vline(xintercept = 5000, linetype = "dashed", color = "red",
             linewidth = 1) +
  annotate("text", x = 5200, y = Inf, vjust = 2, label = "$5B Threshold",
           color = "red", fontface = "bold", size = 3.5) +
  scale_x_continuous(labels = comma_format()) +
  coord_cartesian(xlim = c(0, quantile(expo_cross[n_idis == 1]$eud / 1e6,
                                        0.95, na.rm = TRUE))) +
  labs(x = "Estimated Uninsured Deposits ($M, 2022Q4)",
       y = "Number of Banks",
       title = "C. EUD Distribution — Single-IDI Orgs (near $5B threshold)") +
  theme_minimal(base_size = 12)

(p_hist / p_box / p_thresh_hist)

ggsave(file.path(results_dir, "fig_desc_exposure_distribution.pdf"),
       plot = last_plot(), width = 10, height = 12)

10.8 Figure D2: Binned Scatter — Post-Period Change vs Exposure

Non-parametric visualization of the treatment effect. Each dot is a bin of banks sorted by exposure; the y-axis is the mean change in outcome from pre to post. This is the “scatter” analogue of the DiD.

# Compute pre/post means by bank
bscat <- panel[treated == 1 & !is.na(exposure)]

pre_means <- bscat[event_time < 0, .(
  pre_recip = mean(recip_ratio, na.rm = TRUE),
  pre_loans = mean(d_ln_loans, na.rm = TRUE),
  pre_deps  = mean(d_ln_deposits, na.rm = TRUE)
), by = idrssd]

post_means <- bscat[event_time >= 0, .(
  post_recip = mean(recip_ratio, na.rm = TRUE),
  post_loans = mean(d_ln_loans, na.rm = TRUE),
  post_deps  = mean(d_ln_deposits, na.rm = TRUE)
), by = idrssd]

expo_bank <- bscat[, .(exposure = exposure[1]), by = idrssd]

bscat_merged <- Reduce(function(a, b) merge(a, b, by = "idrssd"),
                       list(expo_bank, pre_means, post_means))
bscat_merged[, `:=`(
  delta_recip = post_recip - pre_recip,
  delta_loans = post_loans - pre_loans,
  delta_deps  = post_deps  - pre_deps
)]

# Create 20 equal-sized bins by exposure
bscat_merged[, expo_bin := cut(exposure,
  breaks = quantile(exposure, probs = seq(0, 1, by = 0.05), na.rm = TRUE),
  include.lowest = TRUE)]

binned_scatter <- bscat_merged[!is.na(expo_bin), .(
  exposure     = mean(exposure),
  delta_recip  = mean(delta_recip, na.rm = TRUE),
  delta_loans  = mean(delta_loans, na.rm = TRUE),
  delta_deps   = mean(delta_deps,  na.rm = TRUE),
  n            = .N
), by = expo_bin]

# Panel A: Reciprocal Deposits
p_bs_recip <- ggplot(binned_scatter, aes(x = exposure, y = delta_recip * 100)) +
  geom_point(aes(size = n), color = "steelblue", alpha = 0.7) +
  geom_smooth(data = bscat_merged, aes(x = exposure, y = delta_recip * 100),
              method = "lm", color = "firebrick", se = TRUE, alpha = 0.1) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  scale_size_continuous(range = c(2, 7), guide = "none") +
  labs(x = "Assessment Exposure", y = "Δ Reciprocal Ratio (pp)",
       title = "A. Change in Reciprocal Deposits vs Exposure") +
  theme_minimal(base_size = 12)

# Panel B: Loan Growth
p_bs_loans <- ggplot(binned_scatter, aes(x = exposure, y = delta_loans * 100)) +
  geom_point(aes(size = n), color = "#D55E00", alpha = 0.7) +
  geom_smooth(data = bscat_merged, aes(x = exposure, y = delta_loans * 100),
              method = "lm", color = "firebrick", se = TRUE, alpha = 0.1) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  scale_size_continuous(range = c(2, 7), guide = "none") +
  labs(x = "Assessment Exposure", y = "Δ Loan Growth (pp)",
       title = "B. Change in Loan Growth vs Exposure") +
  theme_minimal(base_size = 12)

# Panel C: Deposit Growth
p_bs_deps <- ggplot(binned_scatter, aes(x = exposure, y = delta_deps * 100)) +
  geom_point(aes(size = n), color = "#009E73", alpha = 0.7) +
  geom_smooth(data = bscat_merged, aes(x = exposure, y = delta_deps * 100),
              method = "lm", color = "firebrick", se = TRUE, alpha = 0.1) +
  geom_hline(yintercept = 0, linewidth = 0.3) +
  scale_size_continuous(range = c(2, 7), guide = "none") +
  labs(x = "Assessment Exposure", y = "Δ Deposit Growth (pp)",
       title = "C. Change in Deposit Growth vs Exposure") +
  theme_minimal(base_size = 12)

(p_bs_recip / p_bs_loans / p_bs_deps)

ggsave(file.path(results_dir, "fig_desc_binscatter_exposure.pdf"),
       plot = last_plot(), width = 10, height = 12)

10.9 Table D7: Exposure Variable Summary (by Org Type)

Decompose the exposure variable by single-IDI vs multi-IDI organizations, and by size category.

expo_detail <- panel[treated == 1, .(
  exposure = exposure[1], eud = eud_2022q4[1],
  total_asset = total_asset[1], n_idis = n_idis_in_org[1],
  size_cat = size_cat[1]
), by = idrssd]

expo_detail[, org_type := ifelse(n_idis == 1, "Single-IDI", "Multi-IDI")]

# By org type
expo_org <- expo_detail[, .(
  N = .N,
  Mean_Exposure = mean(exposure, na.rm = TRUE),
  SD_Exposure   = sd(exposure, na.rm = TRUE),
  P25           = quantile(exposure, 0.25, na.rm = TRUE),
  Median        = median(exposure, na.rm = TRUE),
  P75           = quantile(exposure, 0.75, na.rm = TRUE),
  Mean_EUD_M    = mean(eud / 1e3, na.rm = TRUE),
  Mean_Assets_M = mean(total_asset / 1e3, na.rm = TRUE)
), by = org_type]

kable(expo_org,
  caption = "Table D7a: Exposure by Organization Type",
  digits = 4, format.args = list(big.mark = ","),
  col.names = c("Org Type", "N", "Mean Exp", "SD Exp", "P25", "Median",
                "P75", "Mean EUD ($M)", "Mean Assets ($M)")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE)

Table D7a: Exposure by Organization Type
Org Type	N	Mean Exp	SD Exp	P25	Median	P75	Mean EUD ($M) </th> <th style="text-align:right;font-weight: bold;"> Mean Assets ($M)
Single-IDI	82	0.1849	0.1463	0.0627	0.1606	0.2724	22,953.21	40,623.17
Multi-IDI	78	0.2262	0.1624	0.0891	0.2048	0.3383	67,859.21	139,630.87

# By size category
expo_size <- expo_detail[, .(
  N = .N,
  Mean_Exposure = mean(exposure, na.rm = TRUE),
  SD_Exposure   = sd(exposure, na.rm = TRUE),
  Median        = median(exposure, na.rm = TRUE)
), by = size_cat]

kable(expo_size,
  caption = "Table D7b: Exposure by Size Category",
  digits = 4, format.args = list(big.mark = ","),
  col.names = c("Size Category", "N", "Mean", "SD", "Median")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE)

Table D7b: Exposure by Size Category
Size Category	N	Mean	SD	Median
$100B-$250B	19	0.3067	0.1360	0.3395
$10B-$100B	73	0.2126	0.1584	0.1783
< $10B	50	0.1238	0.0945	0.1291
> $250B (G-SIB)	18	0.2928	0.1860	0.2982

# ── Save ──
kable(expo_org, format = "latex",
      caption = "Exposure by Organization Type",
      digits = 4, booktabs = TRUE, format.args = list(big.mark = ","),
      col.names = c("Org Type", "N", "Mean Exp", "SD Exp", "P25", "Median",
                    "P75", "Mean EUD (\\$M)", "Mean Assets (\\$M)")) %>%
  writeLines(file.path(results_dir, "table_d7a_exposure_by_org.tex"))
kable(expo_size, format = "latex",
      caption = "Exposure by Size Category",
      digits = 4, booktabs = TRUE, format.args = list(big.mark = ","),
      col.names = c("Size Category", "N", "Mean", "SD", "Median")) %>%
  writeLines(file.path(results_dir, "table_d7b_exposure_by_size.tex"))

10.10 Table D8: Outcome Variable Means by Period

Documents how each outcome evolves in the pre-announcement, anticipation, and post-assessment periods.

panel[, regime := fcase(
  period < "2023Q2",  "Pre (before 2023Q2)",
  period >= "2023Q2" & period < "2024Q1", "Anticipation (2023Q2-Q4)",
  period >= "2024Q1", "Post-Assessment (2024Q1+)"
)]
panel[, regime := factor(regime, levels = c(
  "Pre (before 2023Q2)", "Anticipation (2023Q2-Q4)", "Post-Assessment (2024Q1+)"))]

period_vars <- intersect(
  c("recip_ratio", "d_ln_loans", "d_ln_deposits",
    "borrow_ratio", "liquid_ratio", "equity_ratio", "roa"),
  names(panel)
)

# ── Long-format aggregation (avoids fragile unlist/get pattern) ──
regime_long <- rbindlist(lapply(period_vars, function(v) {
  panel[!is.na(regime), .(
    Variable = v,
    Mean     = mean(get(v), na.rm = TRUE),
    N        = .N
  ), by = .(regime, Group = ifelse(treated == 1, "Treated", "Control"))]
}))

# Add nice labels
regime_long[, Label := ifelse(Variable %in% names(nice_labels),
                              nice_labels[Variable], Variable)]

# Pivot: one row per Variable × regime, columns for Treated / Control / Diff
regime_wide_t <- dcast(regime_long, Label + regime ~ Group, value.var = "Mean")
regime_wide_t[, Diff := Treated - Control]

# Re-order by variable then regime
regime_wide_t[, Label := factor(Label, levels = unique(regime_long$Label))]
setorder(regime_wide_t, Label, regime)

kable(regime_wide_t,
  caption = "Table D8: Outcome Means by Regime and Treatment Status",
  digits = 4,
  col.names = c("Variable", "Regime", "Treated", "Control", "Difference")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 10) %>%
  row_spec(0, bold = TRUE) %>%
  collapse_rows(columns = 1, valign = "top")

Table D8: Outcome Means by Regime and Treatment Status
Variable	Regime	Treated	Control	Difference
Reciprocal Deposits / Assets	Pre (before 2023Q2)	0.0151	0.0381	0.0231
	Anticipation (2023Q2-Q4)	0.0232	0.0618	0.0386
	Post-Assessment (2024Q1+)	0.0261	0.0557	0.0296
Δ ln(Loans)	Pre (before 2023Q2)	0.0174	0.0220	0.0046
	Anticipation (2023Q2-Q4)	0.0236	0.0111	-0.0125
	Post-Assessment (2024Q1+)	0.0148	0.0129	-0.0019
Δ ln(Deposits)	Pre (before 2023Q2)	0.0235	0.0272	0.0037
	Anticipation (2023Q2-Q4)	0.0048	0.0085	0.0036
	Post-Assessment (2024Q1+)	0.0124	0.0124	0.0000
Liquid Assets / Assets	Pre (before 2023Q2)	0.1192	0.0961	-0.0231
	Anticipation (2023Q2-Q4)	0.0870	0.0831	-0.0039
	Post-Assessment (2024Q1+)	0.0911	0.0875	-0.0036
Equity / Assets	Pre (before 2023Q2)	12.3257	11.7965	-0.5292
	Anticipation (2023Q2-Q4)	11.1982	11.3620	0.1638
	Post-Assessment (2024Q1+)	11.8955	11.9545	0.0590
ROA	Pre (before 2023Q2)	1.1295	1.2354	0.1058
	Anticipation (2023Q2-Q4)	1.1367	1.2502	0.1135
	Post-Assessment (2024Q1+)	1.1106	1.1674	0.0569

# ── Save ──
kable(regime_wide_t, format = "latex",
      caption = "Outcome Means by Regime and Treatment Status",
      digits = 4, booktabs = TRUE,
      col.names = c("Variable", "Regime", "Treated", "Control", "Difference")) %>%
  writeLines(file.path(results_dir, "table_d8_outcomes_by_period.tex"))

10.11 Figure D3: Outcome Distributions (Pre vs Post)

Density plots showing how the distribution of key outcomes shifts from pre to post among treated banks — a visual complement to Table D8.

density_vars <- intersect(
  c("recip_ratio", "d_ln_loans", "d_ln_deposits"),
  names(panel)
)
density_labels <- c(
  recip_ratio   = "Reciprocal Deposits / Assets",
  d_ln_loans    = "Δ ln(Loans)",
  d_ln_deposits = "Δ ln(Deposits)"
)

dens_data <- melt(
  panel[treated == 1 & !is.na(regime), c("idrssd", "regime", density_vars),
        with = FALSE],
  id.vars = c("idrssd", "regime"),
  variable.name = "outcome",
  value.name = "value"
)
dens_data[, outcome_label := density_labels[as.character(outcome)]]

ggplot(dens_data[!is.na(value)],
       aes(x = value, fill = regime, color = regime)) +
  geom_density(alpha = 0.25, linewidth = 0.7) +
  facet_wrap(~ outcome_label, scales = "free", ncol = 1) +
  scale_fill_manual(values = c("#2166AC", "#FDAE61", "#B2182B")) +
  scale_color_manual(values = c("#2166AC", "#FDAE61", "#B2182B")) +
  labs(x = "Value", y = "Density", fill = "Period", color = "Period",
       title = "Distribution of Outcomes: Pre vs Anticipation vs Post",
       subtitle = "Treated banks only") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom",
        strip.text = element_text(face = "bold"))

ggsave(file.path(results_dir, "fig_desc_outcome_densities.pdf"),
       plot = last_plot(), width = 10, height = 10)

10.12 Table D9: Top/Bottom Exposure Banks

Useful for understanding which specific banks drive the results.

bank_snap <- panel[period == "2022Q4" & treated == 1, .(
  idrssd, exposure, eud_2022q4, total_asset,
  n_idis_in_org, size_cat, recip_ratio
)]
setorder(bank_snap, -exposure)

cat("── Top 15 Banks by Exposure ──\n")

## ── Top 15 Banks by Exposure ──

kable(head(bank_snap, 15),
  caption = "Top 15 Banks by Assessment Exposure (2022Q4)",
  digits = 4, format.args = list(big.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 10)

Top 15 Banks by Assessment Exposure (2022Q4)
idrssd	exposure	eud_2022q4	total_asset	n_idis_in_org	size_cat	recip_ratio
802,866	0.7013	151,592,000	209,026,000	1	$100B-$250B	0.0000
2,942,690	0.6747	79,458,961	110,363,650	1	$100B-$250B	0.0008
413,208	0.5570	95,476,917	162,436,537	2	> $250B (G-SIB)	0.0808
934,329	0.5534	17,851,000	31,424,000	4	> $250B (G-SIB)	0.0883
35,301	0.5386	165,513,000	298,020,000	3	> $250B (G-SIB)	0.0300
4,114,567	0.5383	119,470,758	212,638,872	1	$100B-$250B	0.0249
214,807	0.5375	26,064,000	39,192,000	4	$10B-$100B	0.0110
541,101	0.5262	175,357,000	324,646,000	4	> $250B (G-SIB)	0.0004
936,855	0.5135	24,657,778	38,279,055	2	$10B-$100B	0.0000
1,842,065	0.4906	29,985,744	50,933,929	2	$10B-$100B	0.0135
60,143	0.4734	45,492,000	85,531,000	2	$10B-$100B	0.0014
63,069	0.4650	49,829,973	96,504,709	2	$10B-$100B	0.0357
75,633	0.4399	82,847,595	176,980,258	2	$100B-$250B	0.0517
12,311	0.4382	84,895,501	182,325,674	1	$100B-$250B	0.0320
940,311	0.4218	28,091,000	56,050,000	2	$10B-$100B	0.0021

# ── Save ──
kable(head(bank_snap, 15), format = "latex",
      caption = "Top 15 Banks by Assessment Exposure (2022Q4)",
      digits = 4, booktabs = TRUE, format.args = list(big.mark = ",")) %>%
  writeLines(file.path(results_dir, "table_d9a_top15_exposure.tex"))

cat("\n── Bottom 15 Treated Banks by Exposure ──\n")

## 
## ── Bottom 15 Treated Banks by Exposure ──

kable(tail(bank_snap, 15),
  caption = "Bottom 15 Treated Banks by Assessment Exposure (2022Q4)",
  digits = 4, format.args = list(big.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 10)

Bottom 15 Treated Banks by Assessment Exposure (2022Q4)
idrssd	exposure	eud_2022q4	total_asset	n_idis_in_org	size_cat	recip_ratio
613,008	0.0214	5,413,004	19,296,982	1	$10B-$100B	0.0050
913,856	0.0210	2,075,214	7,724,198	4	< $10B	0.0000
204,004	0.0209	5,288,473	13,778,066	1	$10B-$100B	0.0136
853,952	0.0206	5,396,960	19,309,880	1	$10B-$100B	0.0001
165,628	0.0203	5,343,989	16,915,645	1	$10B-$100B	0.0438
1,443,266	0.0197	360,000	18,204,000	2	> $250B (G-SIB)	0.0000
561,659	0.0174	281,082	1,264,296	4	< $10B	0.0000
30,810	0.0134	6,738,657	129,592,344	1	$100B-$250B	0.1513
3,594,005	0.0117	2,449,506	6,596,702	2	< $10B	0.0640
673,440	0.0114	2,713,346	7,517,872	2	< $10B	0.0000
2,121,196	0.0104	384,455	35,996,617	5	$10B-$100B	0.0057
2,265,456	0.0049	3,648	691,947	2	< $10B	0.0000
2,502,656	0.0015	10,584	2,349,497	2	< $10B	0.0000
595,270	0.0004	5,014,710	34,681,050	1	$10B-$100B	0.0274
398,668	0.0002	250	1,502,758	4	> $250B (G-SIB)	0.0000

# ── Save ──
kable(tail(bank_snap, 15), format = "latex",
      caption = "Bottom 15 Treated Banks by Assessment Exposure (2022Q4)",
      digits = 4, booktabs = TRUE, format.args = list(big.mark = ",")) %>%
  writeLines(file.path(results_dir, "table_d9b_bottom15_exposure.tex"))

10.13 Table D10: Winsorization / Outlier Diagnostics

Documents the extent of extreme values before any winsorization.

outlier_vars <- intersect(
  c("recip_ratio", "d_ln_loans", "d_ln_deposits",
    "borrow_ratio", "liquid_ratio", "exposure"),
  names(panel)
)

# Manual skewness (no external package needed)
calc_skew <- function(x) {
  n <- length(x); m <- mean(x); s <- sd(x)
  if (n < 3 || s == 0) return(NA_real_)
  (n / ((n - 1) * (n - 2))) * sum(((x - m) / s)^3)
}

outlier_tbl <- rbindlist(lapply(outlier_vars, function(v) {
  x <- panel[[v]][!is.na(panel[[v]])]
  lbl <- ifelse(v %in% names(nice_labels), nice_labels[v], v)
  p01 <- quantile(x, 0.01)
  p99 <- quantile(x, 0.99)
  data.table(
    Variable       = lbl,
    N              = length(x),
    Min            = min(x),
    P1             = p01,
    P99            = p99,
    Max            = max(x),
    Pct_Below_P1   = round(100 * mean(x < p01), 2),
    Pct_Above_P99  = round(100 * mean(x > p99), 2),
    Skewness       = calc_skew(x)
  )
}))

kable(outlier_tbl,
  caption = "Table D10: Outlier Diagnostics (Full Panel)",
  digits = 4, format.args = list(big.mark = ",")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE, font_size = 10) %>%
  row_spec(0, bold = TRUE) %>%
  footnote(general = "% below/above refer to fraction of obs beyond the 1st/99th percentile of the pooled distribution.")

Table D10: Outlier Diagnostics (Full Panel)
Variable	N	Min	P1	P99	Max	Pct_Below_P1	Pct_Above_P99	Skewness
Reciprocal Deposits / Assets	131,118	0.0000	0.0000	0.2680	0.2680	0	1.00	3.2693
Δ ln(Loans)	126,299	-0.1131	-0.1131	0.2309	0.2309	1	1.00	1.1616
Δ ln(Deposits)	126,299	-0.1112	-0.1112	0.2371	0.2371	1	1.00	1.1198
Liquid Assets / Assets	131,118	0.0000	0.0086	0.5841	1.0000	1	1.00	3.2936
Assessment Exposure	131,118	0.0000	0.0000	0.2753	0.7013	0	0.98	8.2154
Note:
% below/above refer to fraction of obs beyond the 1st/99th percentile of the pooled distribution.

# ── Save ──
kable(outlier_tbl, format = "latex",
      caption = "Outlier Diagnostics (Full Panel)",
      digits = 4, booktabs = TRUE,
      format.args = list(big.mark = ",")) %>%
  writeLines(file.path(results_dir, "table_d10_outlier_diagnostics.tex"))

11 Rpubs link : http://rpubs.com/mohua_ferdousi/1411158

The Price of Uninsured Deposits: Evidence from the FDIC Special Assessment

Complete Analysis — Figures, Tables, and Diagnostics

Mohua Ferdousi

2026-03-17