R/summary_NBKP.R

In NBKP: Beta Kernel Process Modeling with Negative Binomial Response

#' @rdname summary.NBKP
#' @title Summary of a Fitted NBKP Model
#'
#' @description Provides a structured summary of a fitted Negative Binomial Kernel Process
#' (NBKP) model. This function reports the model configuration, prior specification,
#' kernel settings, and key posterior quantities, giving users a concise overview
#' of the fitting results.
#'
#' @param object An object of class \code{"NBKP"} from \code{\link{fit_NBKP}}.
#' @param ... Additional arguments passed to the generic \code{summary} method
#'   (currently not used).
#'
#' @return A list containing key summaries of the fitted model:
#' \describe{
#'   \item{\code{n_obs}}{Number of training observations.}
#'   \item{\code{input_dim}}{Input dimensionality (number of columns in X).}
#'   \item{\code{kernel}}{Kernel type used in the model.}
#'   \item{\code{theta_opt}}{Estimated kernel hyperparameters.}
#'   \item{\code{loss}}{Loss function type used in the model.}
#'   \item{\code{loss_min}}{Minimum value of the loss function achieved.}
#'   \item{\code{prior}}{Prior type used (e.g., "noninformative", "fixed", "adaptive").}
#'   \item{\code{r0}}{Prior precision parameter.}
#'   \item{\code{mu0}}{Prior mean parameter (for fixed prior).}
#'   \item{\code{phi}}{Negative‑binomial dispersion parameter.}
#'   \item{\code{post_mean}}{Posterior mean count estimates at training points.}
#'   \item{\code{post_var}}{Posterior variance estimates of latent mean counts.}
#' }
#'
#' @seealso \code{\link{fit_NBKP}} for model fitting.
#'
#' @references Zhao J, Qing K, Xu J (2025). \emph{BKP: An R Package for Beta
#'   Kernel Process Modeling}. arXiv. https://doi.org/10.48550/arxiv.2508.10447.
#'
#' @keywords NBKP
#'
#' @examples
#' \donttest{
#' set.seed(123)
#'
#' # Define true mean function
#' true_mu_fun <- function(x) {
#'   exp(sin(x) + 0.5)
#' }
#'
#' n <- 30
#' Xbounds <- matrix(c(-2, 2), nrow = 1)
#' X <- tgp::lhs(n = n, rect = Xbounds)
#' true_mu <- true_mu_fun(X)
#' y <- rnbinom(n, size = 1, mu = true_mu)
#'
#' # Fit NBKP model
#' model1 <- fit_NBKP(X, y, Xbounds = Xbounds)
#' summary(model1)
#'
#' # 2D Example
#' set.seed(123)
#' true_mu_fun <- function(X) {
#'   if(is.null(nrow(X))) X <- matrix(X, nrow=1)
#'   x1 <- 4*X[,1] - 2
#'   x2 <- 4*X[,2] - 2
#'   f <- sin(2*pi*x1) * cos(2*pi*x2)
#'   return(exp(f))
#' }
#' n <- 100
#' Xbounds <- matrix(c(0, 0, 1, 1), nrow = 2)
#' X <- tgp::lhs(n = n, rect = Xbounds)
#' true_mu <- true_mu_fun(X)
#' y <- rnbinom(n, size = 0.5, mu = true_mu)
#' model2 <- fit_NBKP(X, y, Xbounds = Xbounds)
#' summary(model2)
#' }
#'
#' @export
#' @method summary NBKP
summary.NBKP <- function(object, ...) {
  # Extract information from the NBKP object
  n_obs <- nrow(object$X)
  d     <- ncol(object$X)

  # Posterior summaries at training points (Gamma distribution)
  post_mean <- object$alpha_n / object$beta_n
  post_var  <- object$alpha_n / (object$beta_n^2)

  res <- list(
    n_obs     = n_obs,
    input_dim = d,
    kernel    = object$kernel,
    theta_opt = object$theta_opt,
    loss      = object$loss,
    loss_min  = object$loss_min,
    prior     = object$prior,
    r0        = object$r0,
    mu0       = object$mu0,
    phi       = object$phi,
    post_mean = post_mean,
    post_var  = post_var
  )

  class(res) <- "summary_NBKP"
  return(res)
}