#' Compute Process Capability Indices for Interval-Censored Data
#'
#' Computes classical and generalized Process Capability Indices (PCIs) for interval-censored data.
#'
#' @param data_left Numeric vector of left interval bounds for interval-censored data.
#' @param data_right Numeric vector of right interval bounds for interval-censored data.
#' @param distribution A \code{gpci_dist_censor} distribution object.
#' @param USL Numeric value of the Upper Specification Limit.
#' @param LSL Numeric value of the Lower Specification Limit.
#' @param target Numeric value of the process target (defaults to the midpoint of USL and LSL).
#' @param indices Character vector of indices to compute. Choices include Vännman's classical family
#'   (\code{"Cp"}, \code{"Cpk"}, \code{"Cpl"}, \code{"Cpu"}, \code{"Cpm"}, \code{"Cpmk"}, \code{"Cp_uv"})
#'   and their quantile analogs (\code{"Cp_q"}, \code{"Cpk_q"}, \code{"Cpl_q"}, \code{"Cpu_q"}, \code{"CNpk"}, \code{"Cpm_q"}, \code{"Cpmk_q"}, \code{"CNp_uv"}),
#'   as well as generalized indices from literature (\code{"Cpy"}, \code{"CpTk"}, \code{"Spmk"}, \code{"Cpc"}, \code{"CNpmc"}, \code{"CNpmkc"}).
#' @param u Parameter \code{u} for the generalized \code{Cp(u, v)} family (default is 1).
#' @param v Parameter \code{v} for the generalized \code{Cp(u, v)} family (default is 1).
#' @param mode Mode of computation: \code{"moments"} (uses mean and variance) or \code{"quantile"} (uses robust quantiles).
#' @param fit Logical. If \code{TRUE} (default) and data is supplied, parameter values of the distribution are estimated from interval-censored data via MLE.
#' @param C0,C1,C2 Coefficients for the tolerance cost function in \code{CNpmc} and \code{CNpmkc} (defaults: \code{C0 = 1, C1 = 0, C2 = 1}).
#' @param tolerance_t Process tolerance \code{t} for the tolerance cost function (defaults to \code{USL - LSL}).
#' @param P0 Desirable yield for the \code{Cpc} and \code{Cpy} indices (default is 0.9973002).
#' @param LDL,UDL Lower and Upper Desired Limits for the \code{CpTk} index (default to \code{LSL} and \code{USL} respectively).
#' @return An object of class \code{"gpcifit_censor"} containing raw data, specification limits, fitted parameters, and computed indices.
#' @export
#' @examples
#' \dontrun{
#' dist_norm <- dist_normal()
#' left <- c(9.5, 10.2, 8.8, 11.1, 9.9)
#' right <- c(10.5, 11.2, 9.8, 12.1, 10.9)
#' capability_censor(
#'   data_left = left, data_right = right,
#'   distribution = dist_norm,
#'   USL = 13, LSL = 7, target = 10,
#'   indices = c("Cpy", "Cp", "Cpk", "Cpm", "Cpmk"),
#'   mode = "moments"
#' )
#' }
capability_censor <- function(data_left = NULL, data_right = NULL, distribution, USL, LSL, target = (USL + LSL)/2,
                               indices = c("Cpy", "Cp", "Cpk", "Cpu", "Cpl", "Cpm", "Cpmk"),
                               u = 1, v = 1, mode = c("moments", "quantile"),
                               fit = TRUE,
                               C0 = 1, C1 = 0, C2 = 1, tolerance_t = USL - LSL,
                               P0 = 0.9973002, LDL = LSL, UDL = USL) {
  mode <- match.arg(mode)
  
  if (!inherits(distribution, "gpci_dist_censor")) {
    stop("distribution must be of class 'gpci_dist_censor'")
  }
  
  if (missing(USL) || missing(LSL)) {
    stop("Both USL and LSL must be specified.")
  }
  
  if (LSL >= USL) {
    stop("LSL must be less than USL.")
  }
  
  if (LSL < distribution$support[1] || USL > distribution$support[2]) {
    warning("Specification limits exceed the support of the distribution.")
  }
  
  dist_fitted <- distribution
  if (fit && !is.null(data_left) && !is.null(data_right)) {
    dist_fitted <- fit_distribution_censor(data_left, data_right, distribution)
  }
  
  moments <- compute_theoretical_moments_censor(dist_fitted)
  mu <- moments$mean
  sigma <- sqrt(moments$var)
  
  if (is.na(mu) || !is.finite(mu)) mu <- mean(unlist(dist_fitted$params))
  if (is.na(sigma) || !is.finite(sigma) || sigma <= 0) sigma <- 1
  
  q_00135 <- tryCatch(do.call(dist_fitted$quantile, c(list(0.00135), dist_fitted$params)), error = function(e) mu - 3*sigma)
  q_05 <- tryCatch(do.call(dist_fitted$quantile, c(list(0.5), dist_fitted$params)), error = function(e) mu)
  q_99865 <- tryCatch(do.call(dist_fitted$quantile, c(list(0.99865), dist_fitted$params)), error = function(e) mu + 3*sigma)
  
  q_00135[is.na(q_00135) | !is.finite(q_00135)] <- mu - 3*sigma
  q_05[is.na(q_05) | !is.finite(q_05)] <- mu
  q_99865[is.na(q_99865) | !is.finite(q_99865)] <- mu + 3*sigma
  
  d <- (USL - LSL) / 2
  M_mid <- (USL + LSL) / 2
  
  CM_t <- C0 + C1 * exp(-C2 * tolerance_t)
  if (is.na(CM_t) || !is.finite(CM_t)) CM_t <- 1
  
  F_USL <- tryCatch(do.call(dist_fitted$cdf, c(list(USL), dist_fitted$params)), error = function(e) 0.99)
  F_LSL <- tryCatch(do.call(dist_fitted$cdf, c(list(LSL), dist_fitted$params)), error = function(e) 0.01)
  
  F_USL[is.na(F_USL) | !is.finite(F_USL)] <- 0.99
  F_LSL[is.na(F_LSL) | !is.finite(F_LSL)] <- 0.01
  F_USL <- max(0, min(1, F_USL))
  F_LSL <- max(0, min(1, F_LSL))
  
  yield <- F_USL - F_LSL
  yield <- max(1e-12, min(1 - 1e-12, yield))
  p_hat <- 1 - yield
  
  estimates <- numeric(0)
  
  mu_mode <- if (mode == "moments") mu else q_05
  sigma_mode <- if (mode == "moments") sigma else (q_99865 - q_00135) / 6
  if (is.na(sigma_mode) || !is.finite(sigma_mode) || sigma_mode <= 0) sigma_mode <- sigma
  
  for (idx in indices) {
    val <- tryCatch(switch(idx,
      "Cpy" = yield / P0,
      "Cp" = d / (3 * sigma_mode),
      "Cpk" = min(USL - mu_mode, mu_mode - LSL) / (3 * sigma_mode),
      "Cpu" = (USL - mu_mode) / (3 * sigma_mode),
      "Cpl" = (mu_mode - LSL) / (3 * sigma_mode),
      "Cpm" = d / (3 * sqrt(sigma_mode^2 + (mu_mode - target)^2)),
      "Cpmk" = min(USL - mu_mode, mu_mode - LSL) / (3 * sqrt(sigma_mode^2 + (mu_mode - target)^2)),
      "Cp_uv" = (d - u * abs(mu_mode - M_mid)) / (3 * sqrt(sigma_mode^2 + v * (mu_mode - target)^2)),
      
      # Quantile analogs
      "Cp_q" = (USL - LSL) / max(q_99865 - q_00135, 1e-10),
      "Cpl_q" = (q_05 - LSL) / max(q_05 - q_00135, 1e-10),
      "Cpu_q" = (USL - q_05) / max(q_99865 - q_05, 1e-10),
      "Cpk_q" = min((USL - q_05) / max(q_99865 - q_05, 1e-10), (q_05 - LSL) / max(q_05 - q_00135, 1e-10)),
      "CNpk" = (d - abs(q_05 - M_mid)) / max((q_99865 - q_00135) / 2, 1e-10),
      "CNp_uv" = (d - u * abs(q_05 - M_mid)) / (3 * sqrt(max(((q_99865 - q_00135) / 6)^2 + v * (q_05 - target)^2, 1e-10))),
      "Cpm_q" = (USL - LSL) / (6 * sqrt(max(((q_99865 - q_00135) / 6)^2 + (q_05 - target)^2, 1e-10))),
      "Cpmk_q" = (d - abs(q_05 - M_mid)) / (3 * sqrt(max(((q_99865 - q_00135) / 6)^2 + (q_05 - target)^2, 1e-10))),
      
      # Generalized Indices from literature
      "CpTk" = {
        F_T <- tryCatch(do.call(dist_fitted$cdf, c(list(target), dist_fitted$params)), error = function(e) 0.5)
        alpha1 <- tryCatch(do.call(dist_fitted$cdf, c(list(LDL), dist_fitted$params)), error = function(e) 0.01)
        alpha2 <- 1 - tryCatch(do.call(dist_fitted$cdf, c(list(UDL), dist_fitted$params)), error = function(e) 0.99)
        
        den2 <- 0.5 - alpha2
        den1 <- 0.5 - alpha1
        term2 <- if (den2 > 1e-10) (F_USL - F_T) / den2 else 1e5
        term1 <- if (den1 > 1e-10) (F_T - F_LSL) / den1 else 1e5
        min(term2, term1)
      },
      "Spmk" = {
        val_inside <- (1 + F_USL - F_LSL) / 2
        val_inside <- max(1e-9, min(1 - 1e-9, val_inside))
        qnorm_val <- tryCatch(stats::qnorm(val_inside), error = function(e) 0)
        qnorm_val / (3 * sqrt(max(1 + ((mu - target) / sigma)^2, 1e-10)))
      },
      "Cpc" = {
        if (yield >= 1) 1e5 else (1 - P0) / max(1e-9, 1 - yield)
      },
      "CNpmc" = {
        (USL - LSL) / (6 * sqrt(max(((q_99865 - q_00135) / 6)^2 + (q_05 - target)^2 + CM_t, 1e-10)))
      },
      "CNpmkc" = {
        psi <- sqrt(max(((q_99865 - q_00135) / 6)^2 + (q_05 - target)^2, 1e-10))
        cn_u <- (USL - M_mid) / (3 * sqrt(max(psi^2 + CM_t, 1e-10)))
        cn_l <- (M_mid - LSL) / (3 * sqrt(max(psi^2 + CM_t, 1e-10)))
        min(cn_u, cn_l)
      },
      0
    ), error = function(e) 0)
    
    if (is.na(val) || !is.finite(val)) val <- 0
    estimates[idx] <- val
  }
  
  structure(
    list(
      data_left = data_left,
      data_right = data_right,
      distribution = dist_fitted,
      USL = USL,
      LSL = LSL,
      target = target,
      indices = indices,
      estimates = estimates,
      p_hat = p_hat,
      mode = mode,
      options = list(
        u = u, v = v, C0 = C0, C1 = C1, C2 = C2,
        tolerance_t = tolerance_t, P0 = P0, LDL = LDL, UDL = UDL
      )
    ),
    class = "gpcifit_censor"
  )
}

#' Dispatcher for Single Index Computation under Interval Censoring
#'
#' @param fit A \code{gpcifit_censor} object.
#' @param index Name of index to compute.
#' @return Numeric value of the specified index.
#' @export
gpci_index <- function(fit, index) {
  if (!inherits(fit, "gpcifit_censor")) stop("fit must be of class 'gpcifit_censor'")
  if (index %in% names(fit$estimates)) {
    return(fit$estimates[[index]])
  }
  cap <- capability_censor(
    data_left = fit$data_left, data_right = fit$data_right,
    distribution = fit$distribution,
    USL = fit$USL, LSL = fit$LSL, target = fit$target,
    indices = index, u = fit$options$u, v = fit$options$v,
    mode = fit$mode, fit = FALSE,
    C0 = fit$options$C0, C1 = fit$options$C1, C2 = fit$options$C2,
    tolerance_t = fit$options$tolerance_t, P0 = fit$options$P0,
    LDL = fit$options$LDL, UDL = fit$options$UDL
  )
  cap$estimates[[index]]
}

#' Print Method for gpcifit_censor
#'
#' @param x An object of class \code{gpcifit_censor}.
#' @param ... Additional print arguments.
#' @export
print.gpcifit_censor <- function(x, ...) {
  cat("--- Process Capability Analysis for Interval-Censored Data ---\n")
  cat("Distribution: ", x$distribution$name, "\n")
  cat("Parameters:   ", paste(names(x$distribution$params), "=", round(unlist(x$distribution$params), 4), collapse = ", "), "\n")
  cat("Spec Limits:  LSL =", x$LSL, ", USL =", x$USL, ", Target =", x$target, "\n")
  cat("Mode:         ", x$mode, "\n")
  cat("Expected Nonconforming (p_hat): ", round(x$p_hat * 100, 4), "%\n\n")
  cat("Point Estimates of Capability Indices:\n")
  print(round(x$estimates, 4))
  invisible(x)
}

#' Summary Method for gpcifit_censor
#'
#' @param object An object of class \code{gpcifit_censor}.
#' @param ... Additional arguments.
#' @export
summary.gpcifit_censor <- function(object, ...) {
  print(object, ...)
  invisible(object)
}

#' Coef Method for gpcifit_censor
#'
#' Extract point estimates of capability indices or fitted distribution parameters.
#'
#' @param object An object of class \code{gpcifit_censor}.
#' @param what Character string: \code{"indices"} (default) or \code{"parameters"}.
#' @param ... Additional arguments.
#' @export
coef.gpcifit_censor <- function(object, what = c("indices", "parameters"), ...) {
  what <- match.arg(what)
  if (what == "indices") {
    object$estimates
  } else {
    unlist(object$distribution$params)
  }
}

#' Vcov Method for gpcifit_censor
#'
#' Extract asymptotic variance-covariance matrix of fitted parameters.
#'
#' @param object An object of class \code{gpcifit_censor}.
#' @param ... Additional arguments.
#' @export
vcov.gpcifit_censor <- function(object, ...) {
  v <- attr(object$distribution, "vcov")
  if (is.null(v)) {
    warning("Variance-covariance matrix not available for this fit.")
    return(NULL)
  }
  v
}

#' Confint Method for gpcifit_censor
#'
#' Calculate confidence intervals for capability indices via bootstrap at specified significance levels (90%, 95%, 99%).
#'
#' @param object An object of class \code{gpcifit_censor}.
#' @param parm Optional vector of index names.
#' @param level Confidence level (default is 0.95; can be 0.90, 0.95, 0.99 or a vector).
#' @param B Number of bootstrap replicates (default 1000).
#' @param method Bootstrap CI method (\code{"percentile"}, \code{"normal"}, \code{"basic"}, \code{"BCa"}, \code{"BCp"}, \code{"studentized"}).
#' @param ... Additional arguments.
#' @export
confint.gpcifit_censor <- function(object, parm = NULL, level = 0.95, B = 1000, method = "percentile", ...) {
  alpha_val <- 1 - level
  ci_res <- boot_ci_censor(fit = object, B = B, alpha = alpha_val, method = method, ...)
  tbl <- ci_res$ci_table
  if (!is.null(parm)) {
    tbl <- tbl[tbl$index %in% parm, ]
  }
  res_mat <- as.matrix(tbl[, c("lower", "upper")])
  rownames(res_mat) <- paste(tbl$index, paste0("(alpha=", tbl$alpha, ")"))
  colnames(res_mat) <- c("Lower CI", "Upper CI")
  res_mat
}
