## Tests for twoPhaseSPML() and print.twoPhaseSPML()
## -------------------------------------------------------
## These tests use a small, reproducible dataset generated by
## DataGeneration_TPD() so that they run quickly without network access.

# ---- Shared fixture --------------------------------------------------------

make_test_data <- function(seed = 1, n2 = 350, N = 500) {
  set.seed(seed)
  data <- DataGeneration_TPD(N = N, Beta1 = 0.5, LD.r = 0.75,
                              P_g = 0.20, P_z = 0.30)
  R <- rep(0L, nrow(data))
  R[sample(nrow(data), n2)] <- 1L
  data[R == 0L, c("G1")] <- NA
  list(
    data = data
  )
}

# ---- DataGeneration_TPD() --------------------------------------------------

test_that("DataGeneration_TPD returns a data frame with expected columns", {
  set.seed(1)
  d <- DataGeneration_TPD(N = 500)
  expect_s3_class(d, "data.frame")
  expect_true(all(c("Y", "G1", "Z", "S") %in% names(d)))
  expect_equal(nrow(d), 500L)
})

test_that("DataGeneration_TPD is reproducible with set.seed", {
  set.seed(99)
  d1 <- DataGeneration_TPD(N = 300)
  set.seed(99)
  d2 <- DataGeneration_TPD(N = 300)
  expect_equal(d1, d2)
})

# ---- twoPhaseSPML() — return value -----------------------------------------

test_that("twoPhaseSPML returns an object of class 'twoPhaseSPML'", {
  td <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data   = td$data)
  expect_s3_class(res, "twoPhaseSPML")
})

test_that("null model result has expected components", {
  td <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data   = td$data)
  expect_true(res$null.model)
  expect_named(res$theta, c("(Intercept)", "Z"))
  expect_true(!is.null(res$Sobs))
  expect_true(!is.null(res$Sexp))
  expect_null(res$Wobs)   # Wobs absent from null model
  expect_type(res$ll, "double")
  expect_true(is.numeric(res$iter) && res$iter >= 1L)
  expect_s3_class(res$qGZ, "data.frame")
  expect_true("G1" %in% names(res$qGZ))
  expect_true("q" %in% names(res$qGZ))
})

test_that("alternative model result has expected components", {
  td <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z + G1,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data   = td$data)
  expect_false(res$null.model)
  expect_named(res$theta, c("(Intercept)", "Z", "G1"), ignore.order = TRUE)
  expect_true(!is.null(res$Wobs))
  expect_true(!is.null(res$Wexp))
  expect_null(res$Sobs)   # Sobs absent from alternative model
  expect_type(res$var_theta, "double")
  expect_length(res$var_theta, length(res$theta))
})

test_that("stored formula and family are preserved", {
  td <- make_test_data()
  fm <- Y ~ Z + G1
  res <- twoPhaseSPML(formula = fm,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      family  = gaussian,
                      data   = td$data)
  expect_equal(deparse(res$formula), deparse(fm))
  expect_equal(res$family$family, "gaussian")
})

test_that("dispersion is positive for Gaussian family", {
  td <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z + G1,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data   = td$data)
  expect_gt(res$dispersion, 0)
})

test_that("log-likelihood is finite and negative", {
  td <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z + G1,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data   = td$data)
  expect_true(is.finite(res$ll))
  expect_lt(res$ll, 0)
})

test_that("df equals number of miscov variables", {
  td <- make_test_data()
  res_Ho <- twoPhaseSPML(formula = Y ~ Z,
                         miscov  = ~ G1,
                         auxvar  = ~ Z,
                         data   = td$data)
  res_Ha <- twoPhaseSPML(formula = Y ~ Z + G1,
                         miscov  = ~ G1,
                         auxvar  = ~ Z,
                         data  = td$data)
  expect_equal(res_Ho$df, 1L)
  expect_equal(res_Ha$df, 1L)
})

test_that("invalid family raises an error", {
  td <- make_test_data()
  expect_error(
    twoPhaseSPML(formula = Y ~ Z,
                 miscov  = ~ G1,
                 auxvar  = ~ Z,
                 family  = "not_a_family",
                 data = td$data),
    regexp = "not found|family"
  )
})

# ---- print.twoPhaseSPML() --------------------------------------------------

test_that("print.twoPhaseSPML returns x invisibly", {
  td  <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data = td$data)
  out <- withVisible(print(res))
  expect_false(out$visible)
  expect_identical(out$value, res)
})

test_that("print.twoPhaseSPML produces output for null model", {
  td  <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data = td$data)
  out <- capture.output(print(res))
  expect_true(any(grepl("Call", out)))
  expect_true(any(grepl("Coefficients", out)))
  expect_true(any(grepl("Sobs|score", out, ignore.case = TRUE)))
  expect_true(any(grepl("Log-likelihood", out)))
})

test_that("print.twoPhaseSPML produces output for alternative model", {
  td  <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z + G1,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data = td$data)
  out <- capture.output(print(res))
  expect_true(any(grepl("Wobs|Wald", out, ignore.case = TRUE)))
  expect_true(any(grepl("Std\\. Error", out)))
  expect_true(any(grepl("p-value", out, ignore.case = TRUE)))
})

test_that("print.twoPhaseSPML digits argument is respected", {
  td  <- make_test_data()
  res <- twoPhaseSPML(formula = Y ~ Z + G1,
                      miscov  = ~ G1,
                      auxvar  = ~ Z,
                      data = td$data)
  # Should not error with different digits values
  expect_no_error(capture.output(print(res, digits = 2L)))
  expect_no_error(capture.output(print(res, digits = 8L)))
})

# ---- start.values ----------------------------------------------------------

test_that("start.values$betas is accepted without error", {
  td <- make_test_data()
  # Fit null first, use its theta as start
  res0 <- twoPhaseSPML(formula = Y ~ Z,
                       miscov  = ~ G1,
                       auxvar  = ~ Z,
                       data = td$data)
  expect_no_error(
    twoPhaseSPML(formula      = Y ~ Z,
                 miscov       = ~ G1,
                 auxvar       = ~ Z,
                 data        = td$data,
                 start.values = list(betas = res0$theta))
  )
})

# ---- lrtest.twoPhaseSPML() -------------------------------------------------

test_that("lrtest returns correct class and structure", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  expect_s3_class(lrt, "lrtest.twoPhaseSPML")
  expect_s3_class(lrt, "data.frame")
  expect_equal(nrow(lrt), 2L)
  expect_true(all(c("#Df", "LogLik", "Df", "Chisq", "Pr(>Chisq)") %in% names(lrt)))
})

test_that("lrtest model order is automatic (smaller model always first)", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)

  lrt_fwd <- lrtest(Ho, Ha)
  lrt_rev <- lrtest(Ha, Ho)  # reversed input order

  expect_equal(lrt_fwd$LogLik, lrt_rev$LogLik)
  expect_equal(lrt_fwd$Chisq,  lrt_rev$Chisq)
})

test_that("lrtest #Df column equals number of regression coefficients", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  expect_equal(lrt[["#Df"]][1], length(Ho$theta))
  expect_equal(lrt[["#Df"]][2], length(Ha$theta))
})

test_that("lrtest Df change equals parameter count difference", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  expect_equal(lrt[["Df"]][2], length(Ha$theta) - length(Ho$theta))
})

test_that("lrtest Chisq equals -2 * (ll0 - ll1)", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  expected_chisq <- -2 * (Ho$ll - Ha$ll)
  expect_equal(lrt[["Chisq"]][2], expected_chisq)
})

test_that("lrtest p-value is in [0, 1]", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  pv <- lrt[["Pr(>Chisq)"]][2]
  expect_gte(pv, 0)
  expect_lte(pv, 1)
})

test_that("lrtest first row has NA for test columns", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  expect_true(is.na(lrt[["Df"]][1]))
  expect_true(is.na(lrt[["Chisq"]][1]))
  expect_true(is.na(lrt[["Pr(>Chisq)"]][1]))
})

test_that("lrtest LogLik matches stored ll values", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  expect_equal(lrt[["LogLik"]][1], Ho$ll)
  expect_equal(lrt[["LogLik"]][2], Ha$ll)
})

test_that("print.lrtest.twoPhaseSPML returns x invisibly and produces output", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  lrt <- lrtest(Ho, Ha)

  vis <- withVisible(print(lrt))
  expect_false(vis$visible)
  expect_identical(vis$value, lrt)

  out <- capture.output(print(lrt))
  expect_true(any(grepl("Likelihood ratio", out, ignore.case = TRUE)))
  expect_true(any(grepl("Chisq",            out, ignore.case = TRUE)))
})

test_that("lrtest errors on non-twoPhaseSPML input", {
  td <- make_test_data()
  Ho <- twoPhaseSPML(Y~Z, ~G1, ~Z, data = td$data)
  expect_error(lrtest(Ho, list(ll=0, theta=1:2)), class = "simpleError")
  expect_error(lrtest(lm(1~1), Ho),               class = "simpleError")
})

test_that("lrtest warns on different families", {
  td  <- make_test_data()
  Ho  <- twoPhaseSPML(Y~Z,    ~G1, ~Z, data = td$data)
  Ha  <- twoPhaseSPML(Y~Z+G1, ~G1, ~Z, data = td$data)
  # Manually tamper with family to trigger the check
  Ha_tampered        <- Ha
  Ha_tampered$family <- binomial()
  expect_error(lrtest(Ho, Ha_tampered))
})
