# tests/testthat/test-glm-numerical.R
#
# Oracle tests: survey_glm() vs survey::svyglm()
# Covers: all 5 design classes × Gaussian family, all 8 GLM families
# (Taylor only), programmatic interface identity, .degf() oracle,
# PSD check, and CI oracle.
#
# All blocks use skip_if_not_installed("survey") at the block level.
# Tolerances: coef 1e-10, SE 1e-8, CI 1e-6, degf 1e-10.
#
# Spec: plans/spec-phase-2.md §9.1
# Handoff: plans/handoff-pr6-glm-numerical-tests.md

skip_on_cran()

# ===========================================================================
# Section 1: Gaussian oracle — all 5 design classes
# ===========================================================================

test_that("Gaussian oracle: Taylor design (gss_2024) — coef and SE match survey::svyglm", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, age ~ educ + sex)
  fit_sv <- survey::svyglm(age ~ educ + sex, design = d_sv)

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Gaussian oracle: Replicate BRR design (mse=FALSE) — coef and SE match survey::svrepdesign", {
  skip_if_not_installed("survey")
  df_rep <- make_survey_data(design = "replicate", type = "BRR", seed = 42)
  repwt_cols <- grep("^repwt_", names(df_rep), value = TRUE)

  d_sc <- as_survey_replicate(
    df_rep,
    weights = wt,
    repweights = tidyselect::all_of(repwt_cols),
    type = "BRR",
    mse = FALSE
  )
  # survey::svrepdesign() defaults to mse = FALSE — matches our d_sc
  d_sv <- survey::svrepdesign(
    data = df_rep,
    weights = ~wt,
    repweights = df_rep[, repwt_cols],
    type = "BRR"
  )
  fit_sc <- survey_glm(d_sc, y1 ~ y2 + y3)
  fit_sv <- survey::svyglm(y1 ~ y2 + y3, design = d_sv)

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Gaussian oracle: SRS design (no FPC) — coef and SE match survey::svydesign", {
  skip_if_not_installed("survey")
  df <- make_survey_data(seed = 42)

  d_sc <- as_survey(df, weights = wt)
  d_sv <- survey::svydesign(ids = ~1, weights = ~wt, data = df)

  fit_sc <- survey_glm(d_sc, y1 ~ y2 + y3)
  fit_sv <- survey::svyglm(y1 ~ y2 + y3, design = d_sv)

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Gaussian oracle: Twophase design — runs without error and SEs are positive finite [RELAXED]", {
  # SE oracle skipped — known twophase variance underestimation (~sqrt(2)x)
  # tracked in plans/investigation-twophase-variance.md
  skip_if_not_installed("survey")
  df_p <- make_survey_data(design = "twophase", seed = 42)
  ph1 <- as_survey(
    df_p,
    ids = psu,
    weights = wt,
    strata = strata,
    fpc = fpc,
    nest = TRUE
  )
  d_sc <- as_survey_twophase(ph1, subset = subset, method = "approx")
  fit_sc <- survey_glm(d_sc, y1 ~ y2 + y3)

  se_sc <- sqrt(diag(vcov(fit_sc)))
  expect_true(all(is.finite(se_sc)))
  expect_true(all(se_sc > 0))
  expect_named(coef(fit_sc), c("(Intercept)", "y2", "y3"))
})

test_that("Gaussian oracle: Calibrated design — runs without error and SEs are positive finite [RELAXED]", {
  # Conservative SRS approximation; exact SE match not expected.
  skip_if_not_installed("survey")
  df_cal <- make_survey_data(seed = 42)
  d_sc <- as_survey_nonprob(df_cal, weights = wt)
  fit_sc <- survey_glm(d_sc, y1 ~ y2 + y3)

  se_sc <- sqrt(diag(vcov(fit_sc)))
  expect_true(all(is.finite(se_sc)))
  expect_true(all(se_sc > 0))
})

# ===========================================================================
# Section 2: Family oracle — Taylor design (gss_2024)
# ===========================================================================

test_that("Family oracle: gaussian(identity) on age ~ educ + sex — coef and SE match", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, age ~ educ + sex, family = gaussian())
  fit_sv <- survey::svyglm(age ~ educ + sex, design = d_sv, family = gaussian())

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: binomial(logit) on I(happy==1) — coef and SE match quasibinomial oracle", {
  # surveycore: binomial(); survey: quasibinomial() — coef and SE are identical
  # since the Binder sandwich does not depend on the dispersion parameter.
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, I(happy == 1) ~ educ + sex, family = binomial())
  fit_sv <- survey::svyglm(
    I(happy == 1) ~ educ + sex,
    design = d_sv,
    family = quasibinomial()
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: Gamma(inverse) on age ~ educ + sex — coef and SE match", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, age ~ educ + sex, family = Gamma(link = "inverse"))
  fit_sv <- survey::svyglm(
    age ~ educ + sex,
    design = d_sv,
    family = Gamma(link = "inverse")
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: inverse.gaussian(1/mu^2) on age ~ educ + sex — coef and SE match", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- suppressWarnings(
    survey_glm(
      d_sc,
      age ~ educ + sex,
      family = inverse.gaussian(link = "1/mu^2")
    )
  )
  fit_sv <- suppressWarnings(
    survey::svyglm(
      age ~ educ + sex,
      design = d_sv,
      family = inverse.gaussian(link = "1/mu^2")
    )
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: quasi(identity, constant) on age ~ educ + sex — coef and SE match", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(
    d_sc,
    age ~ educ + sex,
    family = quasi(link = "identity", variance = "constant")
  )
  fit_sv <- survey::svyglm(
    age ~ educ + sex,
    design = d_sv,
    family = quasi(link = "identity", variance = "constant")
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: quasibinomial(logit) on I(happy==1) — coef and SE match", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(
    d_sc,
    I(happy == 1) ~ educ + sex,
    family = quasibinomial()
  )
  fit_sv <- survey::svyglm(
    I(happy == 1) ~ educ + sex,
    design = d_sv,
    family = quasibinomial()
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: poisson(log) on count response — coef and SE match", {
  # Synthetic count response: y_count ~ Poisson(exp(0.3*y2 + 0.5))
  skip_if_not_installed("survey")
  df <- make_survey_data(n = 300, seed = 42)
  set.seed(42)
  df$y_count <- rpois(nrow(df), lambda = exp(0.3 * df$y2 + 0.5))

  d_sc <- as_survey(
    df,
    ids = psu,
    weights = wt,
    strata = strata,
    fpc = fpc,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~psu,
    weights = ~wt,
    strata = ~strata,
    fpc = ~fpc,
    data = df,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, y_count ~ y2 + y3, family = poisson())
  fit_sv <- survey::svyglm(
    y_count ~ y2 + y3,
    design = d_sv,
    family = quasipoisson()
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

test_that("Family oracle: quasipoisson(log) on count response — coef and SE match", {
  skip_if_not_installed("survey")
  df <- make_survey_data(n = 300, seed = 42)
  set.seed(42)
  df$y_count <- rpois(nrow(df), lambda = exp(0.3 * df$y2 + 0.5))

  d_sc <- as_survey(
    df,
    ids = psu,
    weights = wt,
    strata = strata,
    fpc = fpc,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~psu,
    weights = ~wt,
    strata = ~strata,
    fpc = ~fpc,
    data = df,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, y_count ~ y2 + y3, family = quasipoisson())
  fit_sv <- survey::svyglm(
    y_count ~ y2 + y3,
    design = d_sv,
    family = quasipoisson()
  )

  expect_equal(coef(fit_sc), coef(fit_sv), tolerance = 1e-10)
  expect_equal(
    unname(sqrt(diag(vcov(fit_sc)))),
    as.numeric(survey::SE(fit_sv)),
    tolerance = 1e-8
  )
})

# ===========================================================================
# Section 3: Programmatic interface identity
# ===========================================================================

test_that("Programmatic interface: response/predictors produces identical coef and vcov to formula", {
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  fit_formula <- survey_glm(d_sc, age ~ educ + sex)
  fit_programmatic <- survey_glm(
    d_sc,
    response = "age",
    predictors = c("educ", "sex")
  )

  expect_equal(coef(fit_formula), coef(fit_programmatic), tolerance = 1e-15)
  expect_equal(vcov(fit_formula), vcov(fit_programmatic), tolerance = 1e-15)
})

# ===========================================================================
# Section 4: .degf() oracle — all 5 design classes
# ===========================================================================

test_that(".degf() oracle: Taylor design matches survey::degf()", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  expect_equal(.degf(d_sc), survey::degf(d_sv), tolerance = 1e-10)
})

test_that(".degf() oracle: Replicate BRR design matches survey::degf()", {
  skip_if_not_installed("survey")
  df_rep <- make_survey_data(design = "replicate", type = "BRR", seed = 42)
  repwt_cols <- grep("^repwt_", names(df_rep), value = TRUE)
  d_sc <- as_survey_replicate(
    df_rep,
    weights = wt,
    repweights = tidyselect::all_of(repwt_cols),
    type = "BRR",
    mse = FALSE
  )
  d_sv <- survey::svrepdesign(
    data = df_rep,
    weights = ~wt,
    repweights = df_rep[, repwt_cols],
    type = "BRR"
  )
  expect_equal(.degf(d_sc), survey::degf(d_sv), tolerance = 1e-10)
})

test_that(".degf() oracle: SRS design matches survey::degf()", {
  skip_if_not_installed("survey")
  df <- make_survey_data(seed = 42)
  d_sc <- as_survey(df, weights = wt)
  d_sv <- survey::svydesign(ids = ~1, weights = ~wt, data = df)
  expect_equal(.degf(d_sc), survey::degf(d_sv), tolerance = 1e-10)
})

test_that(".degf() oracle: Twophase design returns positive value [RELAXED — known mismatch]", {
  # surveycore twophase degf uses phase-1 Taylor formula on the phase-2 subset;
  # survey::degf() for twophase returns full-sample PSU count. These differ.
  # Relaxed test: just verify .degf() returns a positive integer.
  df_p <- make_survey_data(design = "twophase", seed = 42)
  ph1 <- as_survey(
    df_p,
    ids = psu,
    weights = wt,
    strata = strata,
    fpc = fpc,
    nest = TRUE
  )
  d_sc <- as_survey_twophase(ph1, subset = subset, method = "approx")
  expect_gt(.degf(d_sc), 0)
})

test_that(".degf() oracle: Calibrated design matches survey::degf() for plain weighted design", {
  skip_if_not_installed("survey")
  df <- make_survey_data(seed = 42)
  d_sc <- as_survey_nonprob(df, weights = wt)
  # Reference: survey::svydesign with ids=~1 gives degf = n - 1, same as our formula
  d_sv <- survey::svydesign(ids = ~1, weights = ~wt, data = df)
  expect_equal(.degf(d_sc), survey::degf(d_sv), tolerance = 1e-10)
})

# ===========================================================================
# Section 5: PSD check — Taylor, SRS, Replicate
# ===========================================================================

test_that("PSD check: Taylor vcov is positive semi-definite", {
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, age ~ educ + sex)
  ev <- eigen(vcov(fit_sc))$values
  expect_true(all(ev >= -1e-10))
})

test_that("PSD check: SRS vcov is positive semi-definite", {
  df <- make_survey_data(seed = 42)
  d_sc <- as_survey(df, weights = wt)
  fit_sc <- survey_glm(d_sc, y1 ~ y2 + y3)
  ev <- eigen(vcov(fit_sc))$values
  expect_true(all(ev >= -1e-10))
})

test_that("PSD check: Replicate BRR vcov is positive semi-definite", {
  df_rep <- make_survey_data(design = "replicate", type = "BRR", seed = 42)
  repwt_cols <- grep("^repwt_", names(df_rep), value = TRUE)
  d_sc <- as_survey_replicate(
    df_rep,
    weights = wt,
    repweights = tidyselect::all_of(repwt_cols),
    type = "BRR",
    mse = FALSE
  )
  fit_sc <- survey_glm(d_sc, y1 ~ y2 + y3)
  ev <- eigen(vcov(fit_sc))$values
  expect_true(all(ev >= -1e-10))
})

# ===========================================================================
# Section 6: CI oracle — Taylor design
# ===========================================================================

test_that("CI oracle: confint() bounds match survey::svyglm confint() within 1e-6", {
  skip_if_not_installed("survey")
  d_sc <- as_survey(
    gss_2024,
    ids = vpsu,
    weights = wtssps,
    strata = vstrat,
    nest = TRUE
  )
  d_sv <- survey::svydesign(
    ids = ~vpsu,
    weights = ~wtssps,
    strata = ~vstrat,
    data = gss_2024,
    nest = TRUE
  )
  fit_sc <- survey_glm(d_sc, age ~ educ + sex)
  fit_sv <- survey::svyglm(age ~ educ + sex, design = d_sv)

  ci_sc <- confint(fit_sc)
  ci_sv <- confint(fit_sv)

  expect_equal(ci_sc, ci_sv, tolerance = 1e-6)
})
