tests/testthat/test-paraboot-parity.R

In fect: Fixed Effects Counterfactual Estimators

## Paraboot parity and bug-fix validation tests
## Generated by tester Phase 1 (StatsClaw run: 2026-04-13-para-boot-refactor)
## Revised §3 tests: 2026-04-14 (revised test-spec.md §3 after planner fix)
##
## Covers: PAR-1 through PAR-7, BUG-1a/2a/3a, BUG-2b, BUG-1c/2c/3c,
##         BUG-4 through BUG-6, GATE-1 through GATE-3,
##         UNIT-1 through UNIT-4, DEAD-1
##
## NOTE on out$D vs out$D.dat:
## The fect() result list stores the treatment matrix as `D.dat` (TT x N matrix).
## `out$D` is a character string (the formula RHS variable name), not the matrix.
## All UNIT-* and valid_controls tests use out$D.dat for colSums() calls.
## valid_controls() accesses out$D internally; the caller passes a stub list
## with D set to the matrix (D.dat).

## ---- helpers ----------------------------------------------------------------

load_baseline <- function() {
  path <- testthat::test_path("fixtures", "paraboot-baseline.rds")
  if (!file.exists(path)) {
    skip("Pre-refactor fixture not found — run fixture capture first")
  }
  readRDS(path)
}

make_fixture_data <- function(seed = 42) {
  set.seed(seed)
  N <- 50; TT <- 20; T0 <- 12; Ntr <- 10
  id   <- rep(1:N, each = TT)
  time <- rep(1:TT, N)
  D    <- as.integer(id <= Ntr & time >= T0)
  alpha_i <- rep(rnorm(N, 0, 1), each = TT)
  xi_t    <- rep(rnorm(TT, 0, 0.5), N)
  Y <- alpha_i + xi_t + 2 * D + rnorm(N * TT, 0, 0.5)
  data.frame(id = id, time = time, Y = Y, D = D)
}

## ---- PAR-1: gsynth+parametric parity ----------------------------------------

test_that("PAR-1: gsynth+parametric parity (byte-identical pre/post refactor)", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  set.seed(2026)
  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "gsynth", r = 1, se = TRUE,
    vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$gsynth_para$att.avg),
    info = "att.avg must be byte-identical")
  expect_true(identical(out$att, baseline$gsynth_para$att),
    info = "att vector must be byte-identical")
  expect_true(identical(out$count, baseline$gsynth_para$count),
    info = "count vector must be byte-identical")
  expect_true(identical(out$r.cv, baseline$gsynth_para$r.cv),
    info = "r.cv must be byte-identical")
  expect_true(identical(out$est.att, baseline$gsynth_para$est.att),
    info = "est.att (SE/CI table) must be byte-identical")
})

## ---- PAR-2: ife+nevertreated+parametric parity ------------------------------

test_that("PAR-2: ife+nevertreated+parametric parity (byte-identical; must equal baseline)", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  set.seed(2026)
  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", time.component.from = "nevertreated",
    r = 1, se = TRUE, vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$ife_nev_para$att.avg))
  expect_true(identical(out$att,     baseline$ife_nev_para$att))
  expect_true(identical(out$count,   baseline$ife_nev_para$count))
  expect_true(identical(out$est.att, baseline$ife_nev_para$est.att))
})

## ---- PAR-3: bootstrap parity — ife+notyettreated ----------------------------

test_that("PAR-3: bootstrap vartype parity — ife+notyettreated", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  set.seed(2026)
  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", r = 1, se = TRUE,
    vartype = "bootstrap", nboots = 50, CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$ife_nt_boot$att.avg))
  expect_true(identical(out$att,     baseline$ife_nt_boot$att))
  expect_true(identical(out$est.att, baseline$ife_nt_boot$est.att))
})

## ---- PAR-4: bootstrap parity — ife+nevertreated -----------------------------

test_that("PAR-4: bootstrap vartype parity — ife+nevertreated", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  set.seed(2026)
  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", time.component.from = "nevertreated",
    r = 1, se = TRUE, vartype = "bootstrap", nboots = 50, CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$ife_nev_boot$att.avg))
  expect_true(identical(out$att,     baseline$ife_nev_boot$att))
  expect_true(identical(out$est.att, baseline$ife_nev_boot$est.att))
})

## ---- PAR-5: bootstrap parity — gsynth ---------------------------------------

test_that("PAR-5: bootstrap vartype parity — gsynth", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  set.seed(2026)
  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "gsynth", r = 1, se = TRUE,
    vartype = "bootstrap", nboots = 50, CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$gsynth_boot$att.avg))
  expect_true(identical(out$att,     baseline$gsynth_boot$att))
  expect_true(identical(out$est.att, baseline$gsynth_boot$est.att))
})

## ---- PAR-6: jackknife parity — ife+notyettreated ----------------------------

test_that("PAR-6: jackknife parity — ife+notyettreated", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", r = 1, se = TRUE,
    vartype = "jackknife", CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$ife_jk$att.avg))
  expect_true(identical(out$att,     baseline$ife_jk$att))
  expect_true(identical(out$est.att, baseline$ife_jk$est.att))
})

## ---- PAR-7: jackknife parity — gsynth ----------------------------------------

test_that("PAR-7: jackknife parity — gsynth", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "gsynth", r = 1, se = TRUE,
    vartype = "jackknife", CV = FALSE, parallel = FALSE
  )))

  expect_true(identical(out$att.avg, baseline$gsynth_jk$att.avg))
  expect_true(identical(out$att,     baseline$gsynth_jk$att))
  expect_true(identical(out$est.att, baseline$gsynth_jk$est.att))
})

## ---- BUG-1a: ife+notyettreated+parametric est.att changed from pre-fix ------

test_that("BUG-1a: ife+notyettreated+parametric now errors via notyettreated gate", {
  skip_on_cran()
  d <- make_fixture_data()
  expect_error(
    suppressWarnings(suppressMessages(fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "ife", r = 1, se = TRUE,
      vartype = "parametric", nboots = 50,
      CV = FALSE, parallel = FALSE
    ))),
    regexp = "parametric",
    ignore.case = TRUE
  )
})

## ---- BUG-2a: cfe+nevertreated+parametric est.att changed from pre-fix -------

test_that("BUG-2a: cfe+nevertreated+parametric: est.att changed from pre-fix baseline", {
  skip_on_cran()
  baseline <- load_baseline()
  d <- make_fixture_data()

  set.seed(2026)
  out_post <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "cfe", time.component.from = "nevertreated",
    r = 1, se = TRUE, vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))

  expect_true(
    isTRUE(all.equal(out_post$att.avg, baseline$cfe_nev_para$att.avg, tolerance = 1e-10)),
    info = "att.avg must be unchanged by Loop 2 fix"
  )
  expect_false(
    identical(out_post$est.att, baseline$cfe_nev_para$est.att),
    info = "est.att must differ from pre-fix baseline: Loop 2 was calling fect_nevertreated(ife) instead of fect_nevertreated(cfe)"
  )
})

## ---- BUG-3a: cfe+notyettreated+parametric est.att changed from pre-fix ------

test_that("BUG-3a: cfe+notyettreated+parametric now errors via notyettreated gate", {
  skip_on_cran()
  d <- make_fixture_data()
  expect_error(
    suppressWarnings(suppressMessages(fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "cfe", r = 0, se = TRUE,
      vartype = "parametric", nboots = 50,
      CV = FALSE, parallel = FALSE
    ))),
    regexp = "parametric",
    ignore.case = TRUE
  )
})

## ---- BUG-2b: cfe+nevertreated no longer byte-identical to gsynth ------------

test_that("BUG-2b: cfe+nevertreated+parametric no longer byte-identical to gsynth+parametric", {
  skip_on_cran()
  d <- make_fixture_data()

  set.seed(2026)
  out_cfe_nev <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "cfe", time.component.from = "nevertreated",
    r = 1, se = TRUE, vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))

  set.seed(2026)
  out_gsynth <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "gsynth", r = 1, se = TRUE,
    vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))

  expect_false(
    identical(out_cfe_nev$est.att, out_gsynth$est.att),
    info = paste(
      "Pre-fix: cfe+nevertreated and gsynth had identical est.att (both used fect_nevertreated(ife) in Loop 2).",
      "Post-fix: cfe+nevertreated uses fect_nevertreated(cfe) in Loop 2; the two bootstrap distributions must differ."
    )
  )
})

## ---- BUG-1c: ife+notyettreated att.avg stability ----------------------------

test_that("BUG-1c: ife+notyettreated+parametric (se=TRUE) now errors via notyettreated gate", {
  skip_on_cran()
  d <- make_fixture_data()
  ## se=FALSE still works
  out_no_se <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", r = 1, se = FALSE, CV = FALSE, parallel = FALSE
  )))
  expect_s3_class(out_no_se, "fect")
  ## se=TRUE, vartype="parametric" + default factors.from now errors
  expect_error(
    suppressWarnings(suppressMessages(fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "ife", r = 1, se = TRUE,
      vartype = "parametric", nboots = 50,
      CV = FALSE, parallel = FALSE
    ))),
    regexp = "parametric",
    ignore.case = TRUE
  )
})

## ---- BUG-2c: cfe+nevertreated att.avg stability -----------------------------

test_that("BUG-2c: cfe+nevertreated att.avg unchanged between se=FALSE and se=TRUE (parametric)", {
  skip_on_cran()
  d <- make_fixture_data()

  out_no_se <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "cfe", time.component.from = "nevertreated",
    r = 1, se = FALSE, CV = FALSE, parallel = FALSE
  )))

  set.seed(2026)
  out_with_se <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "cfe", time.component.from = "nevertreated",
    r = 1, se = TRUE, vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))

  expect_true(
    isTRUE(all.equal(out_with_se$att.avg, out_no_se$att.avg, tolerance = 1e-10)),
    info = "att.avg must be identical whether se=FALSE or se=TRUE"
  )
})

## ---- BUG-3c: cfe+notyettreated att.avg stability ----------------------------

test_that("BUG-3c: cfe+notyettreated+parametric (se=TRUE) now errors via notyettreated gate", {
  skip_on_cran()
  d <- make_fixture_data()
  ## se=FALSE still works
  out_no_se <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "cfe", r = 0, se = FALSE, CV = FALSE, parallel = FALSE
  )))
  expect_s3_class(out_no_se, "fect")
  ## se=TRUE, vartype="parametric" + default factors.from now errors
  expect_error(
    suppressWarnings(suppressMessages(fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "cfe", r = 0, se = TRUE,
      vartype = "parametric", nboots = 50,
      CV = FALSE, parallel = FALSE
    ))),
    regexp = "parametric",
    ignore.case = TRUE
  )
})

## ---- BUG-4: ife+notyettreated+parametric SE smoke test -----------------------

test_that("BUG-4: ife+notyettreated+parametric now errors via notyettreated gate", {
  skip_on_cran()
  d <- make_fixture_data()
  expect_error(
    suppressWarnings(suppressMessages(fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "ife", r = 1, se = TRUE,
      vartype = "parametric", nboots = 50,
      CV = FALSE, parallel = FALSE
    ))),
    regexp = "parametric",
    ignore.case = TRUE
  )
})

## ---- BUG-5: cfe+nevertreated+parametric SE smoke test -----------------------

test_that("BUG-5: cfe+nevertreated+parametric produces non-degenerate SE post-fix", {
  skip_on_cran()
  d <- make_fixture_data()
  set.seed(2026)
  out <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "cfe", time.component.from = "nevertreated",
    r = 1, se = TRUE, vartype = "parametric", nboots = 50,
    CV = FALSE, parallel = FALSE
  )))
  expect_s3_class(out, "fect")
  expect_true(!is.null(out$est.att))
})

## ---- BUG-6: cfe+notyettreated+parametric SE smoke test ----------------------

test_that("BUG-6: cfe+notyettreated+parametric now errors via notyettreated gate", {
  skip_on_cran()
  d <- make_fixture_data()
  expect_error(
    suppressWarnings(suppressMessages(fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "cfe", r = 0, se = TRUE,
      vartype = "parametric", nboots = 50,
      CV = FALSE, parallel = FALSE
    ))),
    regexp = "parametric",
    ignore.case = TRUE
  )
})

## ---- GATE-1: hasRevs+parametric errors --------------------------------------

test_that("GATE-1: vartype='parametric' with treatment reversals errors with clear message", {
  skip_on_cran()
  N <- 30; TT <- 20
  set.seed(99)
  id   <- rep(1:N, each = TT)
  time <- rep(1:TT, N)
  D <- ifelse(id <= 10 & time >= 10 & time <= 15, 1, 0)
  Y <- rnorm(N * TT)
  d_rev <- data.frame(id = id, time = time, Y = Y, D = D)

  expect_error(
    suppressMessages(fect(
      Y ~ D, data = d_rev, index = c("id", "time"),
      method = "ife", r = 0, se = TRUE,
      vartype = "parametric", nboots = 30,
      CV = FALSE, parallel = FALSE
    )),
    regexp = "reversal|Parametric bootstrap is not valid",
    info = "Error message must mention treatment reversal"
  )
})

## ---- GATE-2: no reversals does NOT error ------------------------------------

test_that("GATE-2: vartype='parametric' without reversals does NOT error", {
  skip_on_cran()
  d <- make_fixture_data()
  expect_no_error(suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "gsynth", r = 1, se = TRUE,
    vartype = "parametric", nboots = 20,
    CV = FALSE, parallel = FALSE
  ))))
})

## ---- GATE-3: mc+parametric still errors -------------------------------------

test_that("GATE-3: vartype='parametric' with method='mc' still errors (Phase 3 scope unchanged)", {
  skip_on_cran()
  d <- make_fixture_data()
  expect_error(
    fect(
      Y ~ D, data = d, index = c("id", "time"),
      method = "mc", se = TRUE,
      vartype = "parametric", nboots = 30,
      CV = FALSE, parallel = FALSE
    ),
    regexp = "parametric"
  )
})

## ---- UNIT-1: impute_Y0 dispatches to fect_nevertreated for gsynth -----------

test_that("UNIT-1: impute_Y0 dispatches to fect_nevertreated for gsynth", {
  skip_on_cran()
  d <- make_fixture_data()
  out0 <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "gsynth", r = 1, se = FALSE, CV = FALSE, parallel = FALSE
  )))
  D_mat   <- out0$D.dat
  id.tr  <- which(colSums(D_mat) > 0)
  id.co  <- which(colSums(D_mat) == 0)
  id.boot <- c(id.tr, id.co)
  Y.boot  <- out0$Y.ct[, id.boot]; Y.boot[out0$I[, id.boot] == 0] <- 0
  result <- fect:::impute_Y0(
    method = "gsynth", predictive = "nevertreated",
    Y = Y.boot, X = NULL, D = D_mat[, id.boot],
    W = NULL, I = out0$I[, id.boot], II = out0$II[, id.boot],
    T.on = out0$T.on[, id.boot],
    tuning = out0$r.cv, boot = 1,
    force = out0$force, hasRevs = out0$hasRevs,
    tol = 1e-3, max.iteration = 1000
  )
  expect_true(is.list(result))
  expect_true("eff.tr" %in% names(result))
  expect_true("att.avg" %in% names(result))
})

## ---- UNIT-2: impute_Y0 dispatches to fect_fe for ife+notyettreated ----------

test_that("UNIT-2: impute_Y0 dispatches to fect_fe for ife+notyettreated", {
  skip_on_cran()
  d <- make_fixture_data()
  out0 <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", r = 1, se = FALSE, CV = FALSE, parallel = FALSE
  )))
  D_mat   <- out0$D.dat
  id.tr  <- which(colSums(D_mat) > 0)
  id.co  <- which(colSums(D_mat) == 0)
  id.boot <- c(id.tr, id.co)
  Y.boot  <- out0$Y.ct[, id.boot]; Y.boot[out0$I[, id.boot] == 0] <- 0
  result <- fect:::impute_Y0(
    method = "ife", predictive = "notyettreated",
    Y = Y.boot, X = NULL, D = D_mat[, id.boot],
    W = NULL, I = out0$I[, id.boot], II = out0$II[, id.boot],
    T.on = out0$T.on[, id.boot],
    tuning = out0$r.cv, boot = 1,
    force = out0$force, hasRevs = out0$hasRevs,
    tol = 1e-3, max.iteration = 1000
  )
  expect_true(is.list(result))
  expect_true("eff.tr" %in% names(result))
  expect_true("att.avg" %in% names(result))
})

## ---- UNIT-3: impute_Y0 errors for mc+any ------------------------------------

test_that("UNIT-3: impute_Y0 errors for mc+any", {
  skip_on_cran()
  d <- make_fixture_data()
  out0 <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", r = 1, se = FALSE, CV = FALSE, parallel = FALSE
  )))
  D_mat    <- out0$D.dat
  Y_mat    <- out0$Y.dat
  I_mat    <- out0$I
  II_mat   <- out0$II
  T_on_mat <- out0$T.on
  id.boot  <- 1:ncol(D_mat)
  expect_error(
    fect:::impute_Y0(
      method = "mc", predictive = "notyettreated",
      Y = Y_mat[, id.boot], X = NULL, D = D_mat[, id.boot],
      W = NULL, I = I_mat[, id.boot], II = II_mat[, id.boot],
      T.on = T_on_mat[, id.boot],
      tuning = 0, boot = 1,
      force = out0$force, hasRevs = out0$hasRevs,
      tol = 1e-3, max.iteration = 1000
    ),
    info = "impute_Y0 must error for mc method (Phase 4 not implemented)"
  )
})

## ---- UNIT-4: valid_controls returns non-empty subset for valid dataset -------

test_that("UNIT-4: valid_controls returns non-empty subset for valid dataset", {
  skip_on_cran()
  d <- make_fixture_data()
  out0 <- suppressWarnings(suppressMessages(fect(
    Y ~ D, data = d, index = c("id", "time"),
    method = "ife", r = 1, se = FALSE, CV = FALSE, parallel = FALSE
  )))
  ## valid_controls uses out$D internally as the treatment matrix.
  ## Build a stub with D = out0$D.dat (the TT x N matrix).
  out_stub <- list(
    D    = out0$D.dat,
    I    = out0$I,
    r.cv = out0$r.cv
  )
  vc <- fect:::valid_controls(out_stub, method = "ife", predictive = "notyettreated", force = 0)
  expect_true(is.integer(vc) || is.numeric(vc))
  expect_true(length(vc) > 0)
  id.co <- which(colSums(out0$D.dat) == 0)
  expect_true(all(vc %in% id.co))
})

## ---- DEAD-1: Branch B is absent from boot.R source -------------------------

test_that("DEAD-1: Branch B parametric block is absent from boot.R source", {
  ## Prefer system.file; fall back to source repo path
  boot_path <- system.file("R", "boot.R", package = "fect")
  if (!nzchar(boot_path)) {
    ## Installed package uses compiled .rdb — read source directly
    src_path <- file.path(find.package("fect"), "..", "..", "..", "fect", "R", "boot.R")
    if (!file.exists(src_path)) {
      ## Try the known source repo path
      src_path <- "/Users/xyq/GitHub/statsclaw/.repos/fect/R/boot.R"
    }
    if (!file.exists(src_path)) {
      skip("Could not locate boot.R source")
    }
    boot_path <- src_path
  }
  boot_src <- readLines(boot_path)
  branch_b_lines <- grep(
    'method.*%in%.*c.*"ife".*"mc".*vartype.*==.*"parametric"',
    boot_src
  )
  expect_equal(
    length(branch_b_lines), 0L,
    info = "Branch B gate (ife/mc + parametric) must be absent from boot.R post-refactor"
  )
})

## ---- DEAD-2: package loads without error ------------------------------------

test_that("DEAD-2: R CMD check meta — package loads without error", {
  skip_on_cran()
  expect_true(requireNamespace("fect", quietly = TRUE))
})