# Card (1993) Table 3 – reduced-form and IV estimates (Panels A and B).
library(tidyverse)
library(here)
library(gt)
library(AER)
source(here("04-topics/rep-card1993/Rcode/card1993-data-prep.R"))
source(here("04-topics/rep-card1993/Rcode/card1993-gt-quarto.R"))

data <- load_card93_data()
wage <- card93_wage_sample(data)

base_x <- card93_x_base
full_x <- c(card93_x_base, card93_fb_full)

run_rf <- function(y, xvars, panel = "A") {
  rhs <- c("nearc4", card93_exp, xvars)
  if (panel == "A") {
    card93_coef_se(card93_ols(wage, y, rhs), "nearc4")
  } else {
    card93_coef_se(card93_rf_panel_b(wage, y, xvars), "nearc4")
  }
}

run_panel_a_iv <- function(with_fb) {
  x <- if (with_fb) full_x else base_x
  fml <- as.formula(
    paste(
      "lwage76 ~ ed76 + exp76 + exp2 +", paste(x, collapse = " + "),
      "| nearc4 + exp76 + exp2 +", paste(x, collapse = " + ")
    )
  )
  card93_coef_se(ivreg(fml, data = wage), "ed76")
}

run_panel_b_iv <- function(with_fb) {
  x <- if (with_fb) full_x else base_x
  card93_coef_se(
    card93_iv_panel_b(wage, "lwage76", "ed76", "nearc4", x),
    "ed76"
  )
}

run_block <- function(panel) {
  fb_flags <- c(FALSE, TRUE)
  rf_ed <- purrr::map(
    fb_flags,
    ~ run_rf("ed76", if (.) full_x else base_x, panel)
  )
  rf_wage <- purrr::map(
    fb_flags,
    ~ run_rf("lwage76", if (.) full_x else base_x, panel)
  )
  iv_ed <- if (panel == "A") {
    purrr::map(fb_flags, run_panel_a_iv)
  } else {
    purrr::map(fb_flags, run_panel_b_iv)
  }
  list(rf_ed = rf_ed, rf_wage = rf_wage, iv_ed = iv_ed)
}

panel_a <- run_block("A")
panel_b <- run_block("B")

cell <- function(x) card93_coef_cell(x$estimate, x$std.error)

paper_targets <- tribble(
  ~panel, ~col, ~metric, ~value,
  "A", 1L, "nearc_ed", 0.320,
  "A", 2L, "nearc_ed", 0.322,
  "A", 1L, "nearc_wage", 0.042,
  "A", 2L, "nearc_wage", 0.045,
  "A", 5L, "iv_ed", 0.132,
  "A", 6L, "iv_ed", 0.140,
  "B", 1L, "nearc_ed", 0.382,
  "B", 2L, "nearc_ed", 0.365,
  "B", 5L, "iv_ed", 0.122,
  "B", 6L, "iv_ed", 0.132
)

replication <- tribble(
  ~panel, ~col, ~nearc_ed, ~nearc_wage, ~iv_ed,
  "A", 1L, panel_a$rf_ed[[1]]$estimate, panel_a$rf_wage[[1]]$estimate, panel_a$iv_ed[[1]]$estimate,
  "A", 2L, panel_a$rf_ed[[2]]$estimate, panel_a$rf_wage[[2]]$estimate, panel_a$iv_ed[[2]]$estimate,
  "B", 1L, panel_b$rf_ed[[1]]$estimate, panel_b$rf_wage[[1]]$estimate, panel_b$iv_ed[[1]]$estimate,
  "B", 2L, panel_b$rf_ed[[2]]$estimate, panel_b$rf_wage[[2]]$estimate, panel_b$iv_ed[[2]]$estimate
)

message("Table III replication (selected coefficients):")
print(replication)
print(paper_targets)

panel_row <- function(label) {
  tibble(
    stub = label,
    `(1)` = " ", `(2)` = " ", `(3)` = " ", `(4)` = " ",
    `(5)` = " ", `(6)` = " ",
    is_header = TRUE
  )
}

data_row <- function(label, v1, v2, v3, v4, v5, v6) {
  tibble(
    stub = label,
    `(1)` = v1, `(2)` = v2, `(3)` = v3, `(4)` = v4, `(5)` = v5, `(6)` = v6,
    is_header = FALSE
  )
}

col_names <- paste0("(", 1:6, ")")
table_data <- bind_rows(
  panel_row("Panel A: Treat experience and experience squared as exogenous"),
  data_row(
    "Live Near College in 1966",
    cell(panel_a$rf_ed[[1]]), cell(panel_a$rf_ed[[2]]),
    cell(panel_a$rf_wage[[1]]), cell(panel_a$rf_wage[[2]]), "--", "--"
  ),
  data_row("Education", "--", "--", "--", "--",
           cell(panel_a$iv_ed[[1]]), cell(panel_a$iv_ed[[2]])),
  data_row("Family Background variables", "no", "yes", "no", "yes", "no", "yes"),
  panel_row("Panel B: Treat experience and experience squared as endogenous"),
  data_row(
    "Live Near College in 1966",
    cell(panel_b$rf_ed[[1]]), cell(panel_b$rf_ed[[2]]),
    cell(panel_b$rf_wage[[1]]), cell(panel_b$rf_wage[[2]]), "--", "--"
  ),
  data_row("Education", "--", "--", "--", "--",
           cell(panel_b$iv_ed[[1]]), cell(panel_b$iv_ed[[2]])),
  data_row("Family Background Variables", "no", "yes", "no", "yes", "no", "yes")
)

header_rows <- which(table_data$is_header)

table_data <- ak91_quarto_blank_df(table_data |> select(stub, all_of(col_names), is_header))

gt_tbl <- table_data |>
  gt() |>
  cols_hide(columns = is_header) |>
  tab_spanner(label = "Reduced Education", columns = c(`(1)`, `(2)`)) |>
  tab_spanner(label = "Models: Earnings", columns = c(`(3)`, `(4)`)) |>
  tab_spanner(label = "Structural Models of Earnings", columns = c(`(5)`, `(6)`))

gt_tbl <- card93_gt_standard(
  gt_tbl,
  stub_col = "stub",
  data_cols = col_names,
  header_rows = header_rows
)

fb_rows <- card93_stub_rows(
  table_data,
  c("Family Background variables", "Family Background Variables")
)

gt_tbl <- gt_tbl |>
  card93_gt_source_notes(
    c(
      paste(
        "**Notes:** Standard errors in parentheses. Sample size is 3010.",
        "Dependent variable in columns (1)–2): completed education in 1976",
        "(mean 13.263, SD 2.677). Dependent variable in columns (3)–6):",
        "log hourly wages in 1976 (mean 6.262, SD 0.444). All models include",
        "black, 1976 South/SMSA, 1966 region/SMSA, experience and experience-squared."
      ),
      paste(
        "**Replication:** Panel A IV columns (5)–6) use Wald ratios of reduced-form",
        "coefficients. Panel B column (6) with full family background is the baseline",
        "IV specification for Table 4 row 1."
      )
    )
  ) |>
  tab_footnote(
    footnote = md(paste(
      "Fourteen family-background controls: parental education (years and missing",
      "indicators), eight `famed` interaction classes, and two family-structure",
      "indicators (`card93_fb_full`)."
    )),
    locations = cells_body(columns = stub, rows = fb_rows)
  ) |>
  card93_gt_stub_footnote(
    table_data,
    "Panel B: Treat experience and experience squared as endogenous",
    paste(
      "Experience and experience-squared are endogenous; instruments are `age76`",
      "and `age2` (= age76$^2$/100). Reduced-form equations use `ivreg` with",
      "experience instrumented by age."
    )
  )

gt_tbl <- card93_gt_finalize(gt_tbl)

save(
  table_data, gt_tbl, replication, paper_targets, panel_a, panel_b,
  file = here("04-topics/rep-card1993/Rcode/Table_III.RData")
)