
#' Likelihood ratio test for \code{twoPhaseSPML} models
#'
#' Compares two nested \code{\link{twoPhaseSPML}} models via a likelihood ratio
#' test (LRT), mirroring the interface of \code{lmtest::lrtest()}.
#'
#' @param object a fitted object of class \code{"twoPhaseSPML"} representing
#'   the \emph{smaller} (null / restricted) model.
#' @param object2 a fitted object of class \code{"twoPhaseSPML"} representing
#'   the \emph{larger} (alternative / unrestricted) model.  The two models
#'   must have been fitted to the same data and with the same \code{miscov},
#'   \code{auxvar}, and \code{family}.  The larger model must have at least
#'   as many parameters as the smaller one.
#' @param \dots further arguments, currently unused.
#'
#' @details
#' The test statistic is
#' \deqn{LRT = -2 \bigl(\ell_0 - \ell_1\bigr),}
#' where \eqn{\ell_0} and \eqn{\ell_1} are the maximised log-likelihoods of
#' the smaller and larger models, respectively.  Under the null hypothesis
#' that the additional parameters are zero, \eqn{LRT} follows a
#' \eqn{\chi^2} distribution with degrees of freedom equal to the difference
#' in the number of estimated regression coefficients between the two models.
#'
#' The function determines model order automatically: whichever of
#' \code{object} and \code{object2} has fewer regression coefficients is
#' treated as the null model, regardless of the order in which they are
#' supplied.
#'
#' @return An object of class \code{"lrtest.twoPhaseSPML"}, which is a
#'   \code{data.frame} with one row per model and the following columns:
#'   \describe{
#'     \item{\code{#Df}}{number of estimated regression coefficients.}
#'     \item{\code{LogLik}}{maximised log-likelihood.}
#'     \item{\code{Df}}{change in degrees of freedom relative to the
#'       previous row (\code{NA} for the first row).}
#'     \item{\code{Chisq}}{LRT statistic (\code{NA} for the first row).}
#'     \item{\code{Pr(>Chisq)}}{two-sided \eqn{p}-value from the
#'       \eqn{\chi^2} distribution (\code{NA} for the first row).}
#'   }
#'   The object also carries a \code{"heading"} attribute (a character vector)
#'   and is printed via \code{\link{print.lrtest.twoPhaseSPML}}.
#'
#' @seealso \code{\link{twoPhaseSPML}}, \code{\link{print.lrtest.twoPhaseSPML}}
#'
#' @examples
#' data.table::setDTthreads(1)
#' data <- DataGeneration_TPD(N=200)
#' set.seed(1)
#' R <- rep(0L, nrow(data))
#' R[sample(nrow(data), 175)] <- 1L
#' data[R == 0L, c("G1")] <- NA
#'
#' # Null model (no G1)
#' res_Ho <- twoPhaseSPML(
#'   formula = Y ~ Z,
#'   miscov  = ~ G1,
#'   auxvar  = ~ Z,
#'   data   = data
#' )
#'
#' # Alternative model (with G1)
#' res_Ha <- twoPhaseSPML(
#'   formula = Y ~ Z + G1,
#'   miscov  = ~ G1,
#'   auxvar  = ~ Z,
#'   data   = data
#' )
#'
#' lrtest(res_Ho, res_Ha)
#'
#' @export
#' @importFrom stats pchisq
lrtest <- function(object, object2, ...) {
  UseMethod("lrtest")
}


#' @rdname lrtest
#' @export
lrtest.twoPhaseSPML <- function(object, object2, ...) {

  # ---- Input validation ----------------------------------------------------
  if (!inherits(object, "twoPhaseSPML"))
    stop("'object' must be of class \"twoPhaseSPML\".")
  if (!inherits(object2, "twoPhaseSPML"))
    stop("'object2' must be of class \"twoPhaseSPML\".")

  if (object$family$family != object2$family$family ||
      object$family$link   != object2$family$link)
    stop("Both models must use the same family and link function.")

  if (deparse(object$miscov) != deparse(object2$miscov))
    warning("The two models have different 'miscov' formulas; ",
            "ensure they are truly nested.")

  # ---- Identify null vs alternative by number of regression parameters -----
  np1 <- length(object$theta)
  np2 <- length(object2$theta)

  if (np1 == np2)
    warning("Both models have the same number of parameters (", np1, "); ",
            "the LRT statistic may not be meaningful.")

  # Smaller model = null, larger model = alternative
  if (np1 <= np2) {
    mod0 <- object;  lab0 <- deparse(object$formula)
    mod1 <- object2; lab1 <- deparse(object2$formula)
  } else {
    mod0 <- object2; lab0 <- deparse(object2$formula)
    mod1 <- object;  lab1 <- deparse(object$formula)
  }

  ll0 <- mod0$ll;  npar0 <- length(mod0$theta)
  ll1 <- mod1$ll;  npar1 <- length(mod1$theta)

  # ---- Test statistic -------------------------------------------------------
  delta_df  <- npar1 - npar0
  lrt_stat  <- -2 * (ll0 - ll1)

  if (lrt_stat < 0) {
    warning("LRT statistic is negative (", round(lrt_stat, 4), "). ",
            "This can occur when the 'larger' model has a lower log-likelihood ",
            "than the 'smaller' model, which may indicate non-convergence or ",
            "numerical instability.")
  }

  pval <- pchisq(lrt_stat, df = delta_df, lower.tail = FALSE)

  # ---- Assemble output data frame ------------------------------------------
  out <- data.frame(
    `#Df`      = c(npar0,  npar1),
    LogLik     = c(ll0,    ll1),
    Df         = c(NA_real_,         as.numeric(delta_df)),
    Chisq      = c(NA_real_,         lrt_stat),
    `Pr(>Chisq)` = c(NA_real_,       pval),
    check.names = FALSE,
    stringsAsFactors = FALSE
  )
  rownames(out) <- c("Model 1", "Model 2")

  attr(out, "heading") <- c(
    "Likelihood ratio test\n",
    paste0("Model 1: ", lab0),
    paste0("Model 2: ", lab1)
  )
  class(out) <- c("lrtest.twoPhaseSPML", "data.frame")
  out
}


#' Print method for \code{lrtest.twoPhaseSPML} objects
#'
#' @param x an object of class \code{"lrtest.twoPhaseSPML"}, as returned by
#'   \code{\link{lrtest.twoPhaseSPML}}.
#' @param digits integer; number of significant digits. Defaults to
#'   \code{max(3L, getOption("digits") - 3L)}.
#' @param \dots further arguments passed to \code{\link{printCoefmat}}.
#'
#' @return \code{x} is returned invisibly.
#'
#' @seealso \code{\link{lrtest.twoPhaseSPML}}
#'
#' @export
print.lrtest.twoPhaseSPML <- function(x,
                                      digits = max(3L, getOption("digits") - 3L),
                                      ...) {
  # Print heading lines
  heading <- attr(x, "heading")
  if (!is.null(heading))
    cat(paste(heading, collapse = "\n"), "\n\n", sep = "")

  # Build a printable matrix
  mat <- as.matrix(x)
  # Format Chisq and p-value rows nicely
  out_mat <- format(x, digits = digits)

  # Use printCoefmat for the bottom row (contains the test result)
  printCoefmat(x,
               digits    = digits,
               na.print  = "",
               has.Pvalue = TRUE,
               ...)

  invisible(x)
}
