#' Highest Posterior Density (HPD) Interval Calculation
#'
#' Computes the Highest Posterior Density (HPD) interval for MCMC posterior samples
#' at specified confidence / significance levels (e.g., 90\%, 95\%, 99\%).
#'
#' @param x Numeric vector of sample draws.
#' @param prob Credibility level (1 - significance level). Default is 0.95.
#' @return A named numeric vector of length 2 containing \code{lower} and \code{upper} bounds.
#' @export
#' @examples
#' samples <- rnorm(1000, mean = 5, sd = 1)
#' hpd_interval(samples, prob = 0.95)
hpd_interval <- function(x, prob = 0.95) {
  x <- x[is.finite(x)]
  n <- length(x)
  if (n == 0) return(c(lower = NA_real_, upper = NA_real_))
  
  vals <- sort(x)
  n_include <- max(1, min(n, ceiling(prob * n)))
  
  if (n_include == n) {
    return(c(lower = vals[1], upper = vals[n]))
  }
  
  n_intervals <- n - n_include + 1
  widths <- vals[n_include:n] - vals[1:n_intervals]
  best_idx <- which.min(widths)
  
  c(lower = unname(vals[best_idx]), upper = unname(vals[best_idx + n_include - 1]))
}

#' Heidelberger and Welch's MCMC Convergence Diagnostic
#'
#' Conducts stationarity and relative half-width tests under Heidelberger and Welch's
#' MCMC convergence diagnostic, returning test statistics, status, and convergence probability.
#'
#' @param x Numeric vector representing an MCMC chain.
#' @param alpha Significance level for the test (default is 0.05).
#' @param eps Target maximum ratio of half-width to sample mean (default is 0.1).
#' @return A list containing Cramér-von Mises statistic (\code{stat}), p-value (\code{pvalue}),
#'   stationarity test status (\code{passed}), half-width test status (\code{hw_passed}),
#'   half-width statistic (\code{hw_stat}), and convergence probability (\code{convergence_prob}).
#' @export
#' @examples
#' samples <- rnorm(1000)
#' heidelberger_welch(samples)
heidelberger_welch <- function(x, alpha = 0.05, eps = 0.1) {
  x <- x[is.finite(x)]
  n <- length(x)
  if (n < 10) {
    return(list(
      stat = 0, pvalue = 1, passed = TRUE,
      hw_stat = 0, hw_passed = TRUE, convergence_prob = 1
    ))
  }
  
  cvm_stat <- function(series) {
    N <- length(series)
    if (N < 5) return(list(stat = 0, pval = 1))
    mean_val <- mean(series)
    S <- cumsum(series - mean_val)
    
    b <- max(1, floor(sqrt(N)))
    a <- floor(N / b)
    if (a < 2) a <- 2
    b <- floor(N / a)
    batch_means <- sapply(1:a, function(i) mean(series[((i - 1) * b + 1):(i * b)]))
    s0 <- b * stats::var(batch_means)
    if (is.na(s0) || s0 <= 1e-12) s0 <- max(1e-8, stats::var(series))
    
    stat <- sum(S^2) / (N^2 * s0)
    pval <- if (stat < 0.347) 0.50 else if (stat < 0.461) 0.10 else if (stat < 0.743) 0.05 else 0.01
    list(stat = stat, pval = pval)
  }
  
  trim_pcts <- c(0, 0.1, 0.2, 0.3, 0.4, 0.5)
  passed <- FALSE
  best_res <- cvm_stat(x)
  best_trim <- 0
  
  for (pct in trim_pcts) {
    start_idx <- floor(pct * n) + 1
    sub_x <- x[start_idx:n]
    res <- cvm_stat(sub_x)
    if (res$stat <= 0.461) {
      passed <- TRUE
      best_res <- res
      best_trim <- pct
      break
    }
  }
  
  stat_x <- x[(floor(best_trim * n) + 1):n]
  mean_x <- mean(stat_x)
  var_x <- stats::var(stat_x)
  N_stat <- length(stat_x)
  
  z_crit <- stats::qnorm(1 - alpha / 2)
  half_width <- z_crit * sqrt(var_x / N_stat)
  hw_stat <- if (abs(mean_x) > 1e-12) half_width / abs(mean_x) else half_width
  hw_passed <- (hw_stat <= eps)
  
  list(
    stat = best_res$stat,
    pvalue = best_res$pval,
    passed = passed,
    hw_stat = hw_stat,
    hw_passed = hw_passed,
    convergence_prob = best_res$pval
  )
}

#' Summary and Diagnostics for gpciImpSam Objects
#'
#' Computes estimated value, bias, MSE, Risk value, HPD intervals at 90\%, 95\%, and 99\% significance levels,
#' Heidelberger and Welch MCMC convergence diagnostic, and convergence probability.
#'
#' @param object An object of class \code{"gpciImpSam"}.
#' @param ... Additional arguments.
#' @return A data frame containing diagnostic metrics for each evaluated GPCI.
#' @export
#' @examples
#' data_x <- rnorm(40, mean = 10, sd = 1)
#' fit_imp <- impsam_gpci(data = data_x, distribution = dist_normal(), USL = 13, LSL = 7)
#' summary(fit_imp)
summary.gpciImpSam <- function(object, ...) {
  gpci_chain <- object$gpci_chain
  point_est <- object$point_estimates
  indices <- colnames(gpci_chain)
  
  rows <- list()
  
  for (idx in indices) {
    chain <- gpci_chain[[idx]]
    chain <- chain[is.finite(chain)]
    
    pt_val <- point_est[[idx]]
    if (is.null(pt_val) || is.na(pt_val)) pt_val <- mean(chain)
    
    est_val <- mean(chain)
    bias <- est_val - pt_val
    mse <- mean((chain - pt_val)^2)
    
    # Risk value under Linex Loss (a = 0.5) and SEL
    a_linex <- 0.5
    risk_linex <- (2 / a_linex^2) * (exp(a_linex * bias) - a_linex * bias - 1)
    risk_val <- mse + risk_linex
    
    # HPD intervals at 90%, 95%, 99%
    hpd90 <- hpd_interval(chain, prob = 0.90)
    hpd95 <- hpd_interval(chain, prob = 0.95)
    hpd99 <- hpd_interval(chain, prob = 0.99)
    
    # Heidelberger and Welch Diagnostic
    hw_res <- heidelberger_welch(chain)
    
    rows[[idx]] <- data.frame(
      Index = idx,
      Point_Estimate = pt_val,
      Posterior_Mean = est_val,
      Bias = bias,
      MSE = mse,
      Risk_Value = risk_val,
      HPD90_Lower = hpd90["lower"],
      HPD90_Upper = hpd90["upper"],
      HPD95_Lower = hpd95["lower"],
      HPD95_Upper = hpd95["upper"],
      HPD99_Lower = hpd99["lower"],
      HPD99_Upper = hpd99["upper"],
      HW_Stat = hw_res$stat,
      HW_Pvalue = hw_res$pvalue,
      HW_Passed = hw_res$passed,
      Convergence_Prob = hw_res$convergence_prob,
      stringsAsFactors = FALSE
    )
  }
  
  res_df <- do.call(rbind, rows)
  rownames(res_df) <- NULL
  res_df
}

#' High-Level User Interface Function for Importance Sampling GPCIs
#'
#' Main user interface to fit uncensored data under Importance Sampling and evaluate GPCIs,
#' returning point estimates, parameter chains, GPCI chains, HPD intervals, and convergence diagnostics.
#'
#' @param data Numeric vector of process observations.
#' @param pdf Custom PDF/PMF function \code{function(x, ...)}.
#' @param cdf Custom CDF function \code{function(x, ...)}.
#' @param sf Custom Survival Function \code{function(x, ...)}.
#' @param prior Prior distribution hyperparameters list or log-prior function.
#' @param chain_length MCMC chain length (default 1000).
#' @param burn_in MCMC burn-in iterations (default 200).
#' @param thinning Thinning interval (default 1).
#' @param USL Upper Specification Limit.
#' @param LSL Lower Specification Limit.
#' @param target Target process value.
#' @param indices GPCI names to evaluate.
#' @return A list of class \code{"gpciImpSam"} with full summary results.
#' @export
#' @examples
#' gpci_impsam(
#'   data = rnorm(50, 10, 1),
#'   pdf = function(x, mean = 0, sd = 1) dnorm(x, mean, sd),
#'   cdf = function(x, mean = 0, sd = 1) pnorm(x, mean, sd),
#'   chain_length = 300, burn_in = 50,
#'   USL = 13, LSL = 7
#' )
gpci_impsam <- function(data, pdf = NULL, cdf = NULL, sf = NULL, prior = NULL,
                        chain_length = 1000, burn_in = 200, thinning = 1,
                        USL, LSL, target = (USL + LSL) / 2,
                        indices = NULL) {
  if (is.null(indices)) {
    indices <- c("Cpy", "Cp", "Cpk", "Cpu", "Cpl", "Cpm", "Cpmk",
                 "CpTk", "Spmk", "Cpc", "CNpk", "CNpmc", "CNpmkc", "Cp_uv")
  }
  dist_obj <- define_distribution(
    name = "Custom",
    pdf = pdf, cdf = cdf, sf = sf,
    support = c(-Inf, Inf)
  )
  
  fit_res <- impsam_gpci(
    data = data,
    distribution = dist_obj,
    prior = prior,
    chain_length = chain_length,
    burn_in = burn_in,
    thinning = thinning,
    USL = USL, LSL = LSL, target = target,
    indices = indices
  )
  
  fit_res
}
