library(testthat)
library(smsncut)

# ---- smsn_density -------------------------------------------

test_that("smsn_density returns positive finite values for SN", {
  theta <- c(0, log(1), 1.5)
  d   <- smsn_density(c(-2, 0, 2), theta, "SN")
  expect_true(all(is.finite(d)))
  expect_true(all(d > 0))
})

test_that("smsn_density returns positive finite values for ST", {
  theta <- c(0, log(1), 1.5, log(6))
  d   <- smsn_density(c(-2, 0, 2), theta, "ST")
  expect_true(all(is.finite(d)))
  expect_true(all(d > 0))
})

test_that("smsn_density integrates to ~1 for SN", {
  theta <- c(0, log(1), 1.5)
  g   <- seq(-10, 10, length.out = 5000)
  expect_equal(sum(smsn_density(g, theta, "SN")) * (g[2] - g[1]),
               1, tolerance = 1e-3)
})

test_that("smsn_density integrates to ~1 for ST", {
  theta <- c(0, log(1), 1.5, log(6))
  g   <- seq(-15, 15, length.out = 10000)
  expect_equal(sum(smsn_density(g, theta, "ST")) * (g[2] - g[1]),
               1, tolerance = 1e-2)
})

test_that("smsn_density errors on wrong theta length", {
  expect_error(smsn_density(0, c(0, 1), "SN"))
  expect_error(smsn_density(0, c(0, 1, 2), "ST"))
})

# ---- smsn_cdf -----------------------------------------------

test_that("smsn_cdf is monotone and in [0,1] for SN", {
  theta <- c(0, log(1), 1.5)
  F   <- smsn_cdf(seq(-5, 5, by = 0.5), theta, "SN")
  expect_true(all(F >= 0) && all(F <= 1) && all(diff(F) >= 0))
})

test_that("smsn_cdf is monotone and in [0,1] for ST", {
  theta <- c(0, log(1), 1.5, log(6))
  F   <- smsn_cdf(seq(-10, 10, by = 1), theta, "ST")
  expect_true(all(F >= 0) && all(F <= 1) && all(diff(F) >= 0))
})

# ---- smsn_quantile ------------------------------------------

test_that("smsn_quantile is inverse of smsn_cdf for SN", {
  theta  <- c(0.5, log(1.2), 1.5)
  prob <- c(0.1, 0.25, 0.5, 0.75, 0.9)
  q    <- smsn_quantile(prob, theta, "SN")
  expect_true(all(is.finite(q)))
  expect_equal(smsn_cdf(q, theta, "SN"), prob, tolerance = 1e-4)
})

test_that("smsn_quantile is inverse of smsn_cdf for ST", {
  theta  <- c(0, log(1), 1.5, log(6))
  prob <- c(0.1, 0.5, 0.9)
  q    <- smsn_quantile(prob, theta, "ST")
  expect_true(all(is.finite(q)))
  expect_equal(smsn_cdf(q, theta, "ST"), prob, tolerance = 1e-3)
})

# ---- smsn_rdist ---------------------------------------------

test_that("smsn_rdist returns correct number of finite values for SN", {
  set.seed(1)
  theta <- c(0, log(1), 1.5)
  x   <- smsn_rdist(100L, theta, "SN")
  expect_length(x, 100L)
  expect_true(all(is.finite(x)))
})

test_that("smsn_rdist returns correct number of finite values for ST", {
  set.seed(2)
  theta <- c(0, log(1), 1.5, log(6))
  x   <- smsn_rdist(80L, theta, "ST")
  expect_length(x, 80L)
  expect_true(all(is.finite(x)))
})

# ---- smsn_fit -----------------------------------------------

test_that("smsn_fit recovers SN parameters and returns Richardson Hessian", {
  set.seed(42)
  theta_true <- c(1, log(1.5), 2)
  x   <- sn::rsn(500, xi = theta_true[1], omega = exp(theta_true[2]),
                  alpha = theta_true[3])
  fit <- smsn_fit(x, "SN")
  expect_equal(fit$convergence, 0)
  expect_equal(fit$par[1], theta_true[1], tolerance = 0.2)
  expect_length(fit$par, 3)
  expect_true(is.matrix(fit$hessian) && nrow(fit$hessian) == 3)
  # Hessian must be positive definite (all eigenvalues > 0)
  expect_true(all(eigen(fit$hessian, only.values = TRUE)$values > 0))
})

test_that("smsn_fit works for ST and returns 4x4 Hessian", {
  set.seed(7)
  x   <- sn::rst(300, xi = 0, omega = 1, alpha = 1.5, nu = 8)
  fit <- smsn_fit(x, "ST")
  expect_equal(fit$convergence, 0)
  expect_length(fit$par, 4)
  expect_equal(dim(fit$hessian), c(4, 4))
})

# ---- cutoff_phi ---------------------------------------------

test_that("cutoff_phi is zero at the optimal cutoff (SN)", {
  theta0 <- c(0, log(1), 1)
  theta1 <- c(2, log(1), 1.5)
  res  <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)
  expect_equal(
    cutoff_phi(res$cutoff, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5),
    0, tolerance = 1e-6
  )
})

test_that("cutoff_phi changes sign across optimal cutoff", {
  theta0   <- c(0, log(1), 1)
  theta1   <- c(2, log(1), 1.5)
  c_star <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)$cutoff
  expect_lt(cutoff_phi(c_star - 0.5, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5), 0)
  expect_gt(cutoff_phi(c_star + 0.5, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5), 0)
})

# ---- cutoff_boundary_check ----------------------------------

test_that("cutoff_boundary_check reports satisfied = TRUE on good interval", {
  theta0 <- c(0, log(1), 1)
  theta1 <- c(2, log(1), 1.5)
  ab   <- cutoff_admissible_interval(theta0, theta1, "SN", "SN")
  bc   <- cutoff_boundary_check(ab["a"], ab["b"], theta0, theta1, "SN", "SN",
                                 1, 1, 0.5, 0.5)
  expect_true(bc$satisfied && bc$cond_a && bc$cond_b)
  expect_equal(bc$target_ratio, 1, tolerance = 1e-10)
})

# ---- cutoff_build_interval ----------------------------------

test_that("cutoff_build_interval returns finite interval", {
  theta <- c(0, log(1), 1, 2, log(1), 1.5)
  ab    <- cutoff_build_interval(theta, "SN", "SN")
  expect_true(all(is.finite(ab)))
  expect_lt(ab["a"], ab["b"])
})

test_that("cutoff_build_interval expands with positive pad", {
  theta  <- c(0, log(1), 1, 2, log(1), 1.5)
  ab0    <- cutoff_build_interval(theta, "SN", "SN", pad = 0)
  ab_pad <- cutoff_build_interval(theta, "SN", "SN", pad = 0.5)
  expect_lt(ab_pad["a"], ab0["a"])
  expect_gt(ab_pad["b"], ab0["b"])
})

# ---- cutoff_expand_interval_until_valid ---------------------

test_that("cutoff_expand_interval_until_valid finds satisfying interval", {
  theta <- c(0, log(1), 1, 2, log(1), 1.5)
  info  <- cutoff_expand_interval_until_valid(
    theta, "SN", "SN", 1, 1, 0.5, 0.5
  )
  expect_true(isTRUE(info$ok))
  expect_true(is.finite(info$a) && is.finite(info$b))
  expect_equal(info$iter, 0)  # SN1 scenario: initial interval already valid
})

# ---- cutoff_optimal -----------------------------------------

test_that("cutoff_optimal returns finite risk-minimising cutoff (SN)", {
  theta0 <- c(0, log(1), 1)
  theta1 <- c(2, log(1), 1.5)
  res  <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)
  expect_true(is.finite(res$cutoff) && res$risk > 0)
})

test_that("cutoff_optimal coincides with Youden in symmetric setting", {
  theta0 <- c(0, log(1), 1)
  theta1 <- c(2, log(1), 1.5)
  expect_equal(
    cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)$cutoff,
    cutoff_youden(theta0, theta1, "SN", "SN"),
    tolerance = 1e-3
  )
})

test_that("cutoff_optimal shifts right when lambda0*pi0 > lambda1*pi1", {
  theta0  <- c(0, log(1), 1)
  theta1  <- c(2, log(1), 1.5)
  c_Y   <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)$cutoff
  c_asym <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.9, 0.1)$cutoff
  expect_gt(c_asym, c_Y)
})

test_that("cutoff_optimal errors on invalid cost/prevalence inputs", {
  theta0 <- c(0, log(1), 1); theta1 <- c(2, log(1), 1.5)
  expect_error(cutoff_optimal(theta0, theta1, "SN", "SN", -1, 1, 0.5, 0.5))
  expect_error(cutoff_optimal(theta0, theta1, "SN", "SN",  1, 1, 0.6, 0.6))
})

# ---- cutoff_risk monotonicity -------------------------------

test_that("risk is minimised at c_star (SN)", {
  theta0  <- c(0, log(1), 1)
  theta1  <- c(2, log(1), 1.5)
  res   <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)
  grid  <- seq(res$interval["a"], res$interval["b"], length.out = 200)
  risks <- vapply(grid, function(c)
    cutoff_risk(c, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5), numeric(1))
  expect_true(all(risks >= res$risk - 1e-8))
})

# ---- cutoff_youden ------------------------------------------

test_that("cutoff_youden returns finite value and maximises J(c)", {
  theta0 <- c(0, log(1), 1)
  theta1 <- c(2, log(1), 1.5)
  c_Y  <- cutoff_youden(theta0, theta1, "SN", "SN")
  expect_true(is.finite(c_Y))
  J_Y  <- smsn_cdf(c_Y, theta0, "SN") - smsn_cdf(c_Y, theta1, "SN")
  grid <- seq(c_Y - 1, c_Y + 1, length.out = 200)
  Js   <- vapply(grid, function(c)
    smsn_cdf(c, theta0, "SN") - smsn_cdf(c, theta1, "SN"), numeric(1))
  expect_true(all(Js <= J_Y + 1e-8))
})

# ---- cutoff_identifiability ---------------------------------

test_that("cutoff_identifiability returns positive finite value", {
  theta0   <- c(0, log(1), 1)
  theta1   <- c(2, log(1), 1.5)
  c_star <- cutoff_optimal(theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)$cutoff
  diag   <- cutoff_identifiability(c_star, theta0, theta1, "SN", "SN",
                                   1, 1, 0.5, 0.5)
  expect_true(is.finite(diag) && diag > 0)
})

# ---- cutoff_variance ----------------------------------------

test_that("cutoff_variance returns positive finite value with Richardson Hessian", {
  set.seed(1)
  x0   <- sn::rsn(200, xi = 0, omega = 1, alpha = 1)
  x1   <- sn::rsn(200, xi = 2, omega = 1, alpha = 1.5)
  fit0 <- smsn_fit(x0, "SN")
  fit1 <- smsn_fit(x1, "SN")
  res  <- cutoff_optimal(fit0$par, fit1$par, "SN", "SN", 1, 1, 0.5, 0.5)
  V    <- cutoff_variance(res$cutoff, fit0$par, fit1$par, "SN", "SN",
                          1, 1, 0.5, 0.5,
                          fit0$hessian, fit1$hessian, 200L, 200L)
  expect_true(is.finite(V) && V > 0)
})

# ---- cutoff_ci ----------------------------------------------

test_that("cutoff_ci returns correct structure", {
  ci <- cutoff_ci(c_star = 1.6, V = 0.81, n = 400, conf_level = 0.95)
  expect_named(ci, c("lower", "upper", "length"))
  expect_equal(ci["length"], ci["upper"] - ci["lower"], tolerance = 1e-10)
  expect_lt(ci["lower"], 1.6)
  expect_gt(ci["upper"], 1.6)
})

test_that("cutoff_ci length decreases with n", {
  expect_lt(cutoff_ci(1.6, 0.81, 1000)["length"],
            cutoff_ci(1.6, 0.81,  200)["length"])
})

test_that("cutoff_ci errors on non-positive V", {
  expect_error(cutoff_ci(1.6, -1, 400))
  expect_error(cutoff_ci(1.6,  0, 400))
})

# ---- smsn_roc -----------------------------------------------

test_that("smsn_roc is non-decreasing and in [0,1]", {
  theta0 <- c(0, log(1), 1)
  theta1 <- c(2, log(1), 1.5)
  r    <- seq(0.01, 0.99, by = 0.01)
  tpr  <- smsn_roc(r, theta0, theta1, "SN", "SN")
  expect_true(all(tpr >= -1e-8) && all(tpr <= 1 + 1e-8))
  expect_true(all(diff(tpr) >= -1e-6))
})

test_that("smsn_roc exceeds 0.5 at r=0.5 when groups are separated", {
  expect_gt(
    smsn_roc(0.5, c(0, log(1), 0), c(2, log(1), 0), "SN", "SN"),
    0.5
  )
})

# ---- smsn_auc -----------------------------------------------

test_that("smsn_auc exceeds 0.5 for well-separated groups", {
  auc <- smsn_auc(c(0, log(1), 0), c(2, log(1), 0), "SN", "SN")
  expect_gt(auc, 0.5)
  expect_lt(auc, 1)
})

test_that("smsn_auc is ~0.5 for identical groups", {
  theta <- c(0, log(1), 0)
  expect_equal(smsn_auc(eta, theta, "SN", "SN"), 0.5, tolerance = 1e-3)
})

# ---- mc_one_rep ---------------------------------------------

test_that("mc_one_rep ok=TRUE returns all expected components", {
  set.seed(99)
  rep <- mc_one_rep(
    ththeta0_true = c(0, log(1), 1), ththeta1_true = c(2, log(1), 1.5),
    family0 = "SN", family1 = "SN", c_true = 1.6101,
    lambda0 = 1, lambda1 = 1, pi0 = 0.5, pi1 = 0.5,
    n0 = 150L, n1 = 150L
  )
  expect_true(rep$ok)
  expect_named(rep, c("ok", "reason", "c_hat", "V_hat", "dphi_dc",
                      "wald_lower", "wald_upper", "wald_length",
                      "wald_cover", "initial_bracket", "boundary_ok"))
  expect_true(is.finite(rep$c_hat))
  expect_true(is.finite(rep$V_hat) && rep$V_hat > 0)
  expect_true(is.logical(rep$wald_cover))
  expect_true(is.logical(rep$initial_bracket))
})

test_that("mc_one_rep ok=FALSE always contains ok, reason, initial_bracket, boundary_ok", {
  set.seed(42)
  # Force an mle_fail by passing degenerate data (only 3 obs)
  rep <- tryCatch(
    mc_one_rep(
      ththeta0_true = c(0, log(1), 1), ththeta1_true = c(2, log(1), 1.5),
      family0 = "SN", family1 = "SN", c_true = 1.6101,
      lambda0 = 1, lambda1 = 1, pi0 = 0.5, pi1 = 0.5,
      n0 = 2L, n1 = 2L
    ),
    error = function(e) list(ok = FALSE, reason = "error",
                              initial_bracket = NA, boundary_ok = NA)
  )
  expect_false(rep$ok)
  expect_true(all(c("ok", "reason", "initial_bracket", "boundary_ok") %in%
                    names(rep)))
})
