# ============================================================
# smsncut: Core functions
# ============================================================

# Internal helpers ---------------------------------------------------------

.check_family <- function(family) {
  match.arg(family, c("SN", "ST"))
}

.check_theta <- function(theta, family) {
  family <- .check_family(family)
  expected <- if (family == "SN") 3L else 4L
  if (length(theta) != expected) {
    stop(sprintf(
      "For family = '%s', theta must have length %d (got %d).",
      family, expected, length(theta)
    ))
  }
  invisible(theta)
}

.theta_to_natural <- function(theta, family) {
  list(
    xi    = theta[1],
    omega = exp(theta[2]),
    alpha = theta[3],
    nu    = if (family == "ST") 2 + exp(theta[4]) else NA_real_
  )
}

# ---- Density, CDF, quantile, random -------------------------

#' Density of an SMSN distribution
#'
#' Evaluates the density of a skew-normal (SN) or skew-t (ST) distribution
#' at the unconstrained parametrisation \eqn{\theta = (\xi, \log\omega, \alpha)}
#' for SN, or \eqn{\theta = (\xi, \log\omega, \alpha, \log(\nu-2))} for ST.
#'
#' @param x Numeric vector of evaluation points.
#' @param theta Numeric vector of unconstrained parameters. Length 3 for SN,
#'   length 4 for ST.
#' @param family Character string, either \code{"SN"} or \code{"ST"}.
#'
#' @return Numeric vector of density values.
#' @export
#' @examples
#' theta_sn <- c(0, log(1), 1.5)
#' smsn_density(c(-1, 0, 1, 2), theta_sn, "SN")
#'
#' theta_st <- c(0, log(1), 1.5, log(8 - 2))
#' smsn_density(c(-1, 0, 1, 2), theta_st, "ST")
smsn_density <- function(x, theta, family = c("SN", "ST")) {
  family <- .check_family(family)
  .check_theta(theta, family)
  p <- .theta_to_natural(theta, family)
  
  if (family == "SN") {
    return(sn::dsn(x, xi = p$xi, omega = p$omega, alpha = p$alpha))
  }
  sn::dst(x, xi = p$xi, omega = p$omega, alpha = p$alpha, nu = p$nu)
}

#' CDF of an SMSN distribution
#'
#' Evaluates the cumulative distribution function of a skew-normal (SN) or
#' skew-t (ST) distribution at the unconstrained parametrisation
#' \eqn{\theta = (\xi, \log\omega, \alpha)} for SN, or
#' \eqn{\theta = (\xi, \log\omega, \alpha, \log(\nu-2))} for ST.
#'
#' @inheritParams smsn_density
#' @return Numeric vector of CDF values in \eqn{[0,1]}.
#' @export
#' @examples
#' theta_sn <- c(0, log(1), 1.5)
#' smsn_cdf(c(-1, 0, 1, 2), theta_sn, "SN")
smsn_cdf <- function(x, theta, family = c("SN", "ST")) {
  family <- .check_family(family)
  .check_theta(theta, family)
  p <- .theta_to_natural(theta, family)
  
  if (family == "SN") {
    return(sn::psn(x, xi = p$xi, omega = p$omega, alpha = p$alpha))
  }
  sn::pst(x, xi = p$xi, omega = p$omega, alpha = p$alpha, nu = p$nu)
}

#' Quantile function of an SMSN distribution
#'
#' Returns quantiles of a skew-normal (SN) or skew-t (ST) distribution at
#' the unconstrained parametrisation \eqn{\theta = (\xi, \log\omega, \alpha)}
#' for SN, or \eqn{\theta = (\xi, \log\omega, \alpha, \log(\nu-2))} for ST.
#'
#' @param prob Numeric vector of probabilities in \eqn{(0,1)}.
#' @inheritParams smsn_density
#' @return Numeric vector of quantiles.
#' @export
#' @examples
#' theta_sn <- c(0, log(1), 1.5)
#' smsn_quantile(c(0.025, 0.5, 0.975), theta_sn, "SN")
smsn_quantile <- function(prob, theta, family = c("SN", "ST")) {
  family <- .check_family(family)
  .check_theta(theta, family)
  p <- .theta_to_natural(theta, family)
  
  if (family == "SN") {
    out <- tryCatch(
      sn::qsn(prob, xi = p$xi, omega = p$omega, alpha = p$alpha),
      error = function(e) NA_real_
    )
    if (!all(is.finite(out))) {
      out <- tryCatch(
        sn::qsn(prob, xi = p$xi, omega = p$omega, alpha = p$alpha, solver = "RFB"),
        error = function(e) NA_real_
      )
    }
    return(out)
  }
  
  tryCatch(
    sn::qst(prob, xi = p$xi, omega = p$omega, alpha = p$alpha, nu = p$nu),
    error = function(e) NA_real_
  )
}

#' Random generation from an SMSN distribution
#'
#' Generates random observations from a skew-normal (SN) or skew-t (ST)
#' distribution under the unconstrained parametrisation
#' \eqn{\theta = (\xi, \log\omega, \alpha)} for SN, or
#' \eqn{\theta = (\xi, \log\omega, \alpha, \log(\nu-2))} for ST.
#'
#' @param n Integer. Number of observations.
#' @inheritParams smsn_density
#' @return Numeric vector of length \code{n}.
#' @export
#' @examples
#' set.seed(1)
#' theta_sn <- c(0, log(1), 1.5)
#' x <- smsn_rdist(100L, theta_sn, "SN")
#' hist(x, breaks = 20, main = "SN sample")
smsn_rdist <- function(n, theta, family = c("SN", "ST")) {
  family <- .check_family(family)
  .check_theta(theta, family)
  p <- .theta_to_natural(theta, family)
  
  if (family == "SN") {
    return(sn::rsn(n, xi = p$xi, omega = p$omega, alpha = p$alpha))
  }
  sn::rst(n, xi = p$xi, omega = p$omega, alpha = p$alpha, nu = p$nu)
}

# ---- MLE fitting --------------------------------------------

#' Fit an SMSN model by maximum likelihood
#'
#' Fits a skew-normal (SN) or skew-t (ST) distribution to a univariate
#' sample by maximising the log-likelihood, using the unconstrained
#' parametrisation \eqn{\theta = (\xi, \log\omega, \alpha)} for SN or
#' \eqn{\theta = (\xi, \log\omega, \alpha, \log(\nu-2))} for ST.
#'
#' The observed Fisher information matrix is computed via Richardson
#' extrapolation as implemented in \code{numDeriv::hessian()}, which is
#' critical for the reliability of the plug-in variance estimator
#' \eqn{\hat{V}} in heavy-tailed models (de Paula et al., 2026, Section 6.2).
#'
#' @param x Numeric vector of observations. Non-finite values are removed.
#' @param family Character string, either \code{"SN"} (default) or \code{"ST"}.
#' @param maxit Integer. Maximum number of iterations for \code{optim}.
#'   Default 4000.
#' @param reltol Numeric. Relative convergence tolerance. Default \code{1e-10}.
#'
#' @return A list with components:
#'   \item{par}{MLE in unconstrained parametrisation \eqn{\theta}.}
#'   \item{hessian}{Hessian of the negative log-likelihood at the MLE,
#'     computed by Richardson extrapolation.}
#'   \item{logLik}{Maximised log-likelihood.}
#'   \item{family}{Fitted family (\code{"SN"} or \code{"ST"}).}
#'   \item{convergence}{Convergence code from \code{optim} (0 = success).}
#'
#' @references
#' de Paula, R., Mouriño, H., and Dias Domingues, T. (2026).
#' Parametric ROC analysis and optimal cutoff selection under scale mixtures
#' of skew-normal distributions: a decision-theoretic framework with
#' asymptotic inference. \emph{arXiv:2605.07829}.
#' \doi{10.48550/arXiv.2605.07829}.
#'
#' @export
#' @examples
#' set.seed(1)
#' x <- sn::rsn(200, xi = 0, omega = 1, alpha = 2)
#' fit <- smsn_fit(x, family = "SN")
#' fit$par
#' fit$convergence
smsn_fit <- function(x, family = c("SN", "ST"), maxit = 4000L, reltol = 1e-10) {
  family <- .check_family(family)
  x <- as.numeric(x)
  x <- x[is.finite(x)]
  if (length(x) < 4L) stop("At least 4 finite observations are required.")
  
  s       <- stats::sd(x)
  if (!is.finite(s) || s <= 0) s <- 1
  med     <- stats::median(x)
  sk_raw  <- mean((x - mean(x))^3)
  a_start <- if (is.finite(sk_raw) && sk_raw != 0) sign(sk_raw) else 0
  
  start <- if (family == "SN") c(med, log(s), a_start) else
    c(med, log(s), a_start, log(6))
  
  nll <- function(theta) {
    dens <- smsn_density(x, theta, family)
    if (any(!is.finite(dens)) || any(dens <= 0)) return(1e12)
    -sum(log(dens))
  }
  
  fit <- tryCatch(
    stats::optim(
      par = start,
      fn = nll,
      method = "BFGS",
      hessian = FALSE,
      control = list(maxit = maxit, reltol = reltol)
    ),
    error = function(e) NULL
  )
  
  if (is.null(fit)) stop("Optimisation failed to run.")
  if (fit$convergence != 0) {
    warning(sprintf("optim returned convergence code %d.", fit$convergence))
  }
  

  # Step 2: precise Hessian via Richardson extrapolation
  # Section 6.2 of de Paula et al. (2026): critical for V_hat reliability
  hess <- tryCatch(
    numDeriv::hessian(nll, fit$par, method = "Richardson"),
    error = function(e) {
      warning("numDeriv::hessian failed; using finite-difference fallback.")
      fit2 <- tryCatch(
        stats::optim(fit$par, nll, method = "BFGS",
                     hessian = TRUE, control = list(maxit = 200L)),
        error = function(e2) NULL
      )
      if (!is.null(fit2)) fit2$hessian else diag(length(fit$par)) * 1e6
    }
  )
  list(
    par = fit$par,
    hessian = hess,
    logLik = -fit$value,
    family = family,
    convergence = fit$convergence
  )
}

# ---- Core decision-theoretic functions ----------------------

#' Estimating equation phi(c, theta)
#'
#' Computes the derivative of the weighted misclassification risk with respect
#' to the threshold (equation (15) of de Paula et al., 2026):
#' \deqn{\varphi(c, \theta) = \lambda_1 \pi_1 f_1(c; \theta_1) -
#'   \lambda_0 \pi_0 f_0(c; \theta_0).}
#' An interior minimiser satisfies \eqn{\varphi(c^*, \theta) = 0}, equivalently
#' \eqn{\Lambda(c^*;\theta) = \lambda_0\pi_0/(\lambda_1\pi_1)}.
#'
#' @param c Numeric scalar. Threshold value.
#' @param theta0 Numeric vector. Unconstrained parameters for group 0.
#' @param theta1 Numeric vector. Unconstrained parameters for group 1.
#' @param family0 Character. Family for group 0 (\code{"SN"} or \code{"ST"}).
#' @param family1 Character. Family for group 1 (\code{"SN"} or \code{"ST"}).
#' @param lambda0 Positive numeric. Cost of a false positive.
#' @param lambda1 Positive numeric. Cost of a false negative.
#' @param pi0 Numeric in \eqn{(0,1)}. Prevalence of non-diseased.
#' @param pi1 Numeric in \eqn{(0,1)}. Prevalence of diseased.
#'
#' @return Numeric scalar.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' cutoff_phi(1.6, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)
cutoff_phi <- function(c, theta0, theta1, family0, family1,
                       lambda0, lambda1, pi0, pi1) {
  lambda1 * pi1 * smsn_density(c, theta1, family1) -
    lambda0 * pi0 * smsn_density(c, theta0, family0)
}

#' Weighted misclassification risk
#'
#' Computes the expected weighted misclassification risk at threshold \eqn{c}
#' (equation (13) of de Paula et al., 2026):
#' \deqn{R(c; \theta) = \lambda_1 \pi_1 F_1(c; \theta_1) +
#'   \lambda_0 \pi_0 [1 - F_0(c; \theta_0)].}
#'
#' @inheritParams cutoff_phi
#' @return Numeric scalar.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' cutoff_risk(1.5, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)
cutoff_risk <- function(c, theta0, theta1, family0, family1,
                        lambda0, lambda1, pi0, pi1) {
  lambda1 * pi1 * smsn_cdf(c, theta1, family1) +
    lambda0 * pi0 * (1 - smsn_cdf(c, theta0, family0))
}

# ---- Admissible interval and boundary check -----------------

#' Construct the admissible interval [a, b]
#'
#' Builds a compact admissible interval for cutoff optimisation from the
#' \eqn{(\alpha/2, 1-\alpha/2)} quantiles of the fitted SMSN distributions
#' (method \code{"effective_support"}) or from extreme quantiles of the pooled
#' observed sample (method \code{"pooled_quantile"}).
#'
#' @param theta0 Numeric vector. Parameters for group 0.
#' @param theta1 Numeric vector. Parameters for group 1.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param method Character. \code{"effective_support"} (default) or
#'   \code{"pooled_quantile"}.
#' @param alpha Numeric in \eqn{(0,1)}. Tail probability. Default \code{0.01}.
#' @param x0 Numeric vector. Group-0 data (required for
#'   \code{"pooled_quantile"}).
#' @param x1 Numeric vector. Group-1 data (required for
#'   \code{"pooled_quantile"}).
#' @param probs Numeric vector of length 2. Quantile probabilities for
#'   \code{"pooled_quantile"}. Default \code{c(0.005, 0.995)}.
#'
#' @return Named numeric vector \code{c(a = ..., b = ...)}.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' cutoff_admissible_interval(theta0, theta1, "SN", "SN")
cutoff_admissible_interval <- function(theta0, theta1, family0, family1,
                                       method = c("effective_support",
                                                  "pooled_quantile"),
                                       alpha = 0.01,
                                       x0 = NULL, x1 = NULL,
                                       probs = c(0.005, 0.995)) {
  method <- match.arg(method)
  
  if (method == "effective_support") {
    q0_lo <- smsn_quantile(alpha / 2,     theta0, family0)
    q0_hi <- smsn_quantile(1 - alpha / 2, theta0, family0)
    q1_lo <- smsn_quantile(alpha / 2,     theta1, family1)
    q1_hi <- smsn_quantile(1 - alpha / 2, theta1, family1)
    
    qs <- c(q0_lo, q0_hi, q1_lo, q1_hi)
    if (any(!is.finite(qs))) stop("Non-finite quantiles.")
    
    a <- min(q0_lo, q1_lo)
    b <- max(q0_hi, q1_hi)
  } else {
    if (is.null(x0) || is.null(x1)) {
      stop("x0 and x1 must be provided for pooled quantiles.")
    }
    pooled <- c(x0, x1)
    qs <- stats::quantile(pooled, probs = probs, na.rm = TRUE, names = FALSE)
    a <- qs[1]
    b <- qs[2]
  }
  
  if (!is.finite(b - a) || b <= a) {
    stop("Invalid admissible interval.")
  }
  
  c(a = a, b = b)
}

#' Verify boundary conditions of Proposition 5.7
#'
#' Checks whether \eqn{\varphi(a;\theta) < 0} and
#' \eqn{\varphi(b;\theta) > 0}, which guarantees that the estimating equation
#' \eqn{\varphi(c,\theta)=0} has a root inside \eqn{(a,b)}.
#'
#' @param a Numeric. Left endpoint of the admissible interval.
#' @param b Numeric. Right endpoint.
#' @inheritParams cutoff_phi
#'
#' @return A list with components \code{phi_a}, \code{phi_b},
#'   \code{target_ratio}, \code{cond_a}, \code{cond_b}, \code{satisfied}.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' ab   <- cutoff_admissible_interval(theta0, theta1, "SN", "SN")
#' cutoff_boundary_check(ab["a"], ab["b"], theta0, theta1, "SN", "SN",
#'                       1, 1, 0.5, 0.5)
cutoff_boundary_check <- function(a, b, theta0, theta1, family0, family1,
                                  lambda0, lambda1, pi0, pi1) {
  phi_a <- cutoff_phi(a, theta0, theta1, family0, family1, lambda0, lambda1, pi0, pi1)
  phi_b <- cutoff_phi(b, theta0, theta1, family0, family1, lambda0, lambda1, pi0, pi1)
  
  list(
    phi_a = phi_a,
    phi_b = phi_b,
    target_ratio = (lambda0 * pi0) / (lambda1 * pi1),
    cond_a = is.finite(phi_a) && (phi_a < 0),
    cond_b = is.finite(phi_b) && (phi_b > 0),
    satisfied = is.finite(phi_a) && is.finite(phi_b) &&
      (phi_a < 0) && (phi_b > 0)
  )
}

#' Build a padded search interval for cutoff root-finding
#'
#' Constructs an interval \eqn{[a - \delta \cdot w,\; b + \delta \cdot w]}
#' where \eqn{[a,b]} is the 0.5th--99.5th percentile effective support of the
#' two fitted distributions and \eqn{w = b - a} is its width. This mirrors the
#' interval construction in the Monte Carlo study of de Paula et al. (2026).
#'
#' @param theta Numeric vector: \code{c(theta0, theta1)}.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param pad Non-negative numeric. Relative expansion factor \eqn{\delta}.
#'   Default \code{0}.
#'
#' @return Named numeric vector \code{c(a = ..., b = ...)}, or
#'   \code{c(a = NA, b = NA)} if quantiles are non-finite.
#' @export
#' @examples
#' theta <- c(0, log(1), 1, 2, log(1), 1.5)  # theta0 then theta1, both SN
#' cutoff_build_interval(theta, "SN", "SN")
#' cutoff_build_interval(theta, "SN", "SN", pad = 0.5)
cutoff_build_interval <- function(theta, family0, family1, pad = 0.50) {
  family0 <- .check_family(family0)
  family1 <- .check_family(family1)
  
  p0 <- if (family0 == "SN") 3L else 4L
  p1 <- if (family1 == "SN") 3L else 4L
  
  theta0 <- theta[seq_len(p0)]
  theta1 <- theta[p0 + seq_len(p1)]
  
  mu0 <- theta0[1]
  mu1 <- theta1[1]
  sd0 <- exp(theta0[2])
  sd1 <- exp(theta1[2])
  
  center <- (mu0 + mu1) / 2
  spread <- max(sd0, sd1, abs(mu1 - mu0), 1)
  
  a <- center - (1 + pad) * spread
  b <- center + (1 + pad) * spread
  
  c(a = a, b = b)
}

#' Expand the search interval until boundary conditions hold
#'
#' Implements the additive interval-expansion strategy of de Paula et al.
#' (2026, Section 6.1.1): starting from \code{pad = pad_init}, the padding
#' is incremented by \code{pad_step} at each iteration until the boundary
#' conditions \eqn{\varphi(a)<0} and \eqn{\varphi(b)>0} are satisfied, or
#' \code{max_iter} attempts are exhausted.
#'
#' @param theta Numeric vector: \code{c(theta0, theta1)}.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param lambda0 Positive numeric. Cost of a false positive.
#' @param lambda1 Positive numeric. Cost of a false negative.
#' @param pi0 Numeric in \eqn{(0,1)}. Prevalence of non-diseased.
#' @param pi1 Numeric in \eqn{(0,1)}. Prevalence of diseased.
#' @param pad_init Initial padding. Default \code{0}.
#' @param pad_step Additive padding increment. Default \code{0.20}.
#' @param max_iter Maximum expansion attempts. Default \code{20}.
#'
#' @return The output of \code{\link{cutoff_boundary_check}} for the final
#'   interval, augmented with \code{a}, \code{b}, \code{ok}, \code{pad},
#'   and \code{iter}.
#' @export
#' @examples
#' theta <- c(0, log(1), 1, 2, log(1), 1.5)
#' cutoff_expand_interval_until_valid(theta, "SN", "SN",
#'                                    lambda0 = 1, lambda1 = 1,
#'                                    pi0 = 0.5, pi1 = 0.5)
cutoff_expand_interval_until_valid <- function(theta, family0, family1,
                                               lambda0, lambda1, pi0, pi1,
                                               pad_init = 0,
                                               pad_step = 0.20,
                                               max_iter = 20L) {
  family0 <- .check_family(family0)
  family1 <- .check_family(family1)
  
  p0 <- if (family0 == "SN") 3L else 4L
  p1 <- if (family1 == "SN") 3L else 4L
  theta0 <- theta[seq_len(p0)]
  theta1 <- theta[p0 + seq_len(p1)]
  
  last_chk <- NULL
  pad <- pad_init
  
  for (iter in seq_len(max_iter)) {
    interval <- cutoff_build_interval(theta, family0, family1, pad = pad)
    
    chk <- cutoff_boundary_check(
      a = interval[1], b = interval[2],
      theta0 = theta0, theta1 = theta1,
      family0 = family0, family1 = family1,
      lambda0 = lambda0, lambda1 = lambda1,
      pi0 = pi0, pi1 = pi1
    )
    
    chk$a <- interval[1]
    chk$b <- interval[2]
    chk$ok <- chk$satisfied
    chk$pad <- pad
    chk$iter <- iter
    
    last_chk <- chk
    if (isTRUE(chk$ok)) return(chk)
    
    pad <- pad + pad_step
  }
  
  last_chk
}

# ---- Cutoff estimation --------------------------------------

#' Optimal diagnostic cutoff under SMSN distributions
#'
#' Estimates the decision-theoretic optimal cutoff \eqn{c^*} as the minimiser
#' of the weighted misclassification risk \eqn{R(c;\theta)} over the admissible
#' interval \eqn{[a,b]} (Theorem 5.13 of de Paula et al., 2026). Under the
#' monotone likelihood ratio condition, \eqn{c^*} is the unique root of
#' \eqn{\varphi(c,\theta)=0}, found by grid search followed by
#' \code{uniroot}. If no root is found, \code{optimize} on \eqn{R} is used
#' as fallback.
#'
#' @param theta0 Numeric vector. MLE for group 0.
#' @param theta1 Numeric vector. MLE for group 1.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param lambda0 Positive numeric. Cost of a false positive.
#' @param lambda1 Positive numeric. Cost of a false negative.
#' @param pi0 Numeric in \eqn{(0,1)}. Prevalence of non-diseased.
#' @param pi1 Numeric in \eqn{(0,1)}. Prevalence of diseased.
#' @param interval Numeric vector \code{c(a, b)}. If \code{NULL}, computed
#'   via \code{\link{cutoff_admissible_interval}}.
#' @param grid_length Integer. Grid resolution for sign-change search.
#'   Default \code{5000}.
#'
#' @return A list with \code{cutoff}, \code{risk}, \code{interval},
#'   and \code{boundary}.
#' @export
#' @examples
#' 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)
#' res$cutoff
cutoff_optimal <- function(theta0, theta1, family0, family1,
                           lambda0, lambda1, pi0, pi1,
                           interval = NULL,
                           grid_length = 5000L) {
  family0 <- .check_family(family0)
  family1 <- .check_family(family1)
  
  if (lambda0 <= 0 || lambda1 <= 0) stop("lambda0 and lambda1 must be positive.")
  if (pi0 <= 0 || pi1 <= 0 || abs(pi0 + pi1 - 1) > 1e-8) {
    stop("pi0 and pi1 must be positive and sum to 1.")
  }
  
  if (is.null(interval)) {
    interval <- cutoff_admissible_interval(theta0, theta1, family0, family1)
  }
  a <- interval[1]
  b <- interval[2]
  
  bc <- cutoff_boundary_check(a, b, theta0, theta1, family0, family1,
                              lambda0, lambda1, pi0, pi1)
  
  phi_vec <- function(c) cutoff_phi(c, theta0, theta1, family0, family1,
                                    lambda0, lambda1, pi0, pi1)
  
  grid <- seq(a, b, length.out = grid_length)
  vals <- vapply(grid, phi_vec, numeric(1))
  
  roots <- numeric(0)
  for (i in seq_len(length(grid) - 1L)) {
    v1 <- vals[i]
    v2 <- vals[i + 1L]
    if (!is.finite(v1) || !is.finite(v2)) next
    if (abs(v1) < .Machine$double.eps) {
      roots <- c(roots, grid[i])
    } else if (v1 * v2 < 0) {
      r <- tryCatch(
        stats::uniroot(phi_vec, lower = grid[i], upper = grid[i + 1L])$root,
        error = function(e) NA_real_
      )
      if (is.finite(r)) roots <- c(roots, r)
    }
  }
  
  if (length(roots) > 1L) {
    tol <- 1e-6
    roots_u <- roots[1L]
    for (r in roots[-1L]) {
      if (min(abs(r - roots_u)) > tol) roots_u <- c(roots_u, r)
    }
    roots <- roots_u
  }
  
  risk_at <- function(c) cutoff_risk(c, theta0, theta1, family0, family1,
                                     lambda0, lambda1, pi0, pi1)
  
  if (length(roots) == 0L) {
    opt <- tryCatch(
      stats::optimize(risk_at, interval = c(a, b)),
      error = function(e) NULL
    )
    c_star <- if (!is.null(opt)) opt$minimum else NA_real_
  } else {
    risks <- vapply(roots, risk_at, numeric(1))
    ok <- is.finite(risks)
    if (!any(ok)) {
      c_star <- NA_real_
    } else {
      c_star <- roots[ok][which.min(risks[ok])]
    }
  }
  
  list(
    cutoff = c_star,
    risk = if (is.finite(c_star)) risk_at(c_star) else NA_real_,
    interval = c(a = a, b = b),
    boundary = bc
  )
}

#' Parametric Youden cutoff under SMSN distributions
#'
#' Estimates the Youden cutoff \eqn{c_Y} as the maximiser of
#' \eqn{J(c;\theta) = F_0(c;\theta_0) - F_1(c;\theta_1)} over the admissible
#' interval (equation (9) of de Paula et al., 2026), implemented via
#' \code{optimize} on \eqn{J(c)} directly.
#'
#' @param theta0 Numeric vector. Parameters for group 0.
#' @param theta1 Numeric vector. Parameters for group 1.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param interval Numeric vector of length 2. If \code{NULL}, computed
#'   automatically.
#' @param grid_length Number of grid points used in the search.
#'
#' @return Numeric scalar. The estimated Youden cutoff.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' cutoff_youden(theta0, theta1, "SN", "SN")
cutoff_youden <- function(theta0, theta1, family0, family1,
                          interval = NULL,
                          grid_length = 5000L) {
  family0 <- .check_family(family0)
  family1 <- .check_family(family1)
  
  if (is.null(interval)) {
    interval <- cutoff_admissible_interval(theta0, theta1, family0, family1)
  }
  
  res <- cutoff_optimal(
    theta0, theta1, family0, family1,
    lambda0 = 1, lambda1 = 1,
    pi0 = 0.5, pi1 = 0.5,
    interval = interval,
    grid_length = grid_length
  )
  res$cutoff
}

# ---- Asymptotic inference -----------------------------------

#' Local identifiability diagnostic
#'
#' Computes \eqn{|\partial_c\varphi(c^*, \theta^*)|} at the optimal cutoff
#' (Remark 5.14 of de Paula et al., 2026). Small values indicate a locally
#' flat estimating equation, inflated asymptotic variance, and suggest using
#' bootstrap confidence intervals instead of Wald intervals.
#'
#' @param c_star Numeric. The optimal cutoff.
#' @inheritParams cutoff_phi
#'
#' @return Positive numeric scalar.
#' @export
#' @examples
#' 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
#' cutoff_identifiability(c_star, theta0, theta1, "SN", "SN", 1, 1, 0.5, 0.5)
cutoff_identifiability <- function(c_star, theta0, theta1, family0, family1,
                                   lambda0, lambda1, pi0, pi1) {
  phi_c <- function(c) {
    cutoff_phi(c, theta0, theta1, family0, family1, lambda0, lambda1, pi0, pi1)
  }
  abs(numDeriv::grad(phi_c, c_star))
}

#' Asymptotic variance of the plug-in cutoff estimator
#'
#' Computes the closed-form plug-in asymptotic variance of \eqn{\hat{c}}
#' under separate SMSN maximum-likelihood fits (Theorem 5.13 and
#' Proposition 5.15 of de Paula et al., 2026):
#' \deqn{V = \frac{[\nabla_\theta\varphi]^\top \Sigma_{\mathrm{sep}}
#'   [\nabla_\theta\varphi]}{[\partial_c\varphi]^2},}
#' where \eqn{\Sigma_{\mathrm{sep}} = n \cdot
#' \mathrm{blockdiag}(H_0^{-1}, H_1^{-1})} and \eqn{H_k} is the Hessian
#' of the negative log-likelihood for group \eqn{k} (equation (26)).
#'
#' @param c_star Numeric. The plug-in optimal cutoff.
#' @param theta0 Numeric vector. MLE for group 0.
#' @param theta1 Numeric vector. MLE for group 1.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param lambda0 Positive numeric. Cost of a false positive.
#' @param lambda1 Positive numeric. Cost of a false negative.
#' @param pi0 Numeric in \eqn{(0,1)}. Prevalence of non-diseased.
#' @param pi1 Numeric in \eqn{(0,1)}. Prevalence of diseased.
#' @param hess0 Numeric matrix. Hessian of the negative log-likelihood for
#'   group 0 at the MLE (from \code{\link{smsn_fit}}).
#' @param hess1 Numeric matrix. Hessian for group 1.
#' @param n0 Integer. Group-0 sample size.
#' @param n1 Integer. Group-1 sample size.
#' @param ridge Numeric. Ridge added to each Hessian diagonal for numerical
#'   stability. Default \code{1e-6}.
#'
#' @return Numeric scalar. The asymptotic variance \eqn{V}.
#' @export
cutoff_variance <- function(c_star, theta0, theta1, family0, family1,
                            lambda0, lambda1, pi0, pi1,
                            hess0, hess1, n0, n1,
                            ridge = 1e-6) {
  .safe_inv <- function(H) {
    H <- as.matrix(H)
    H_reg <- H + diag(ridge, nrow(H))
    tryCatch(solve(H_reg), error = function(e) NULL)
  }
  
  I0_inv <- .safe_inv(hess0)
  I1_inv <- .safe_inv(hess1)
  if (is.null(I0_inv) || is.null(I1_inv)) {
    stop("Hessian inversion failed.")
  }
  
  n <- n0 + n1
  p0 <- length(theta0)
  p1 <- length(theta1)
  
  Sigma <- matrix(0, p0 + p1, p0 + p1)
  Sigma[1:p0, 1:p0] <- n * I0_inv
  Sigma[(p0 + 1):(p0 + p1), (p0 + 1):(p0 + p1)] <- n * I1_inv
  
  phi_th <- function(th) {
    t0 <- th[1:p0]
    t1 <- th[(p0 + 1):(p0 + p1)]
    cutoff_phi(c_star, t0, t1, family0, family1, lambda0, lambda1, pi0, pi1)
  }
  g_theta <- numDeriv::grad(phi_th, c(theta0, theta1))
  
  g_c <- numDeriv::grad(
    function(c) cutoff_phi(c, theta0, theta1, family0, family1,
                           lambda0, lambda1, pi0, pi1),
    c_star
  )
  
  if (!is.finite(g_c) || abs(g_c) < 1e-10) {
    stop("Partial derivative with respect to c is too small or non-finite.")
  }
  
  num <- as.numeric(t(g_theta) %*% Sigma %*% g_theta)
  num / g_c^2
}

#' Wald confidence interval for the optimal cutoff
#'
#' Constructs a Wald-type \eqn{(1-\alpha)} confidence interval for
#' \eqn{c^*} (equation (31) of de Paula et al., 2026):
#' \deqn{\hat{c} \pm z_{1-\alpha/2}\sqrt{\hat{V}/n}.}
#'
#' @param c_star Numeric. The plug-in optimal cutoff.
#' @param V Numeric. Asymptotic variance from \code{\link{cutoff_variance}}.
#' @param n Integer. Total sample size \eqn{n = n_0 + n_1}.
#' @param conf_level Numeric in \eqn{(0,1)}. Default \code{0.95}.
#'
#' @return Named numeric vector \code{c(lower, upper, length)}.
#' @export
#' @examples
#' cutoff_ci(c_star = 1.6, V = 0.81, n = 400, conf_level = 0.95)
cutoff_ci <- function(c_star, V, n, conf_level = 0.95) {
  if (V <= 0) stop("V must be positive.")
  z <- stats::qnorm(1 - (1 - conf_level) / 2)
  se <- sqrt(V / n)
  lo <- c_star - z * se
  hi <- c_star + z * se
  c(lower = lo, upper = hi, length = hi - lo)
}

# ---- ROC and AUC --------------------------------------------

#' Parametric ROC curve under SMSN distributions
#'
#' Evaluates the parametric ROC curve at false positive rates \eqn{r}
#' (equation (6) of de Paula et al., 2026):
#' \deqn{\mathrm{ROC}(r;\theta) = 1 - F_1(Q_0(1-r;\theta_0);\theta_1).}
#'
#' @param r Numeric vector of false positive rates in \eqn{(0,1)}.
#' @param theta0 Numeric vector. Parameters for group 0.
#' @param theta1 Numeric vector. Parameters for group 1.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#'
#' @return Numeric vector of true positive rates.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' r    <- seq(0.01, 0.99, by = 0.01)
#' plot(r, smsn_roc(r, theta0, theta1, "SN", "SN"), type = "l",
#'      xlab = "FPR", ylab = "TPR")
#' abline(0, 1, lty = 2)
smsn_roc <- function(r, theta0, theta1, family0, family1) {
  c_vals <- smsn_quantile(1 - r, theta0, family0)
  1 - smsn_cdf(c_vals, theta1, family1)
}

#' Plug-in AUC estimator under SMSN distributions
#'
#' Approximates the AUC by the trapezoidal rule with \code{h} grid points
#' (equation (13) of de Paula et al., 2026). The approximation error is
#' \eqn{O(h^{-2})}; the default \eqn{h = 1000} gives error \eqn{\approx 10^{-6}}.
#'
#' @param theta0 Numeric vector. Parameters for group 0.
#' @param theta1 Numeric vector. Parameters for group 1.
#' @param family0 Character. Family for group 0.
#' @param family1 Character. Family for group 1.
#' @param h Integer. Number of grid points. Default \code{1000}.
#'
#' @return Numeric scalar in \eqn{[0,1]}.
#' @export
#' @examples
#' theta0 <- c(0, log(1), 1)
#' theta1 <- c(2, log(1), 1.5)
#' smsn_auc(theta0, theta1, "SN", "SN")
smsn_auc <- function(theta0, theta1, family0, family1, h = 1000L) {
  u <- seq(1 / h, 1 - 1 / h, length.out = h - 1L)
  tpr <- 1 - smsn_cdf(smsn_quantile(u, theta0, family0), theta1, family1)
  (0.5 + sum(tpr)) / h
}