#' Importance Sampling MCMC Chain Generator for Process Capability Indices
#'
#' Generates posterior parameter draws and Generalized Process Capability Index (GPCI)
#' chains using Importance Sampling (Sampling Importance Resampling, SIR) for uncensored data.
#'
#' @param data Numeric vector of uncensored process data.
#' @param distribution A \code{gpci_dist} object.
#' @param prior Function representing the joint log-prior density \code{function(params)} or a list of prior hyperparameters.
#'   Default assumes non-informative flat or conjugate log-priors.
#' @param chain_length Desired length of final retained MCMC chain after burn-in and thinning. Default is 1000.
#' @param burn_in Number of initial burn-in samples to discard. Default is 200.
#' @param thinning Thinning interval for sampling. Default is 1 (no thinning).
#' @param USL Upper Specification Limit.
#' @param LSL Lower Specification Limit.
#' @param target Process target value (defaults to midpoint of USL and LSL).
#' @param indices Character vector of GPCI names to evaluate. Default computes all 13+ indices.
#' @param u,v Vännman's parameters for \code{Cp(u,v)} family (default 1).
#' @param C0,C1,C2 Parameters for tolerance loss function (defaults: 1, 0, 1).
#' @param P0 Desirable yield baseline (default 0.9973002).
#' @return A list of class \code{"gpciImpSam"} containing:
#'   \item{param_chain}{Matrix of retained MCMC parameter draws.}
#'   \item{gpci_chain}{Matrix or data frame of retained GPCI draws.}
#'   \item{point_estimates}{Point estimates of GPCIs based on uncensored data MLE.}
#'   \item{specs}{Specification limits and setup options.}
#' @export
#' @examples
#' data_x <- rnorm(50, mean = 10, sd = 1)
#' dist_norm <- dist_normal()
#' fit_imp <- impsam_gpci(
#'   data = data_x,
#'   distribution = dist_norm,
#'   chain_length = 500,
#'   burn_in = 100,
#'   thinning = 1,
#'   USL = 13, LSL = 7
#' )
impsam_gpci <- function(data, distribution, prior = NULL,
                        chain_length = 1000, burn_in = 200, thinning = 1,
                        USL, LSL, target = (USL + LSL) / 2,
                        indices = NULL,
                        u = 1, v = 1, C0 = 1, C1 = 0, C2 = 1, P0 = 0.9973002) {
  if (is.null(indices)) {
    indices <- c("Cpy", "Cp", "Cpk", "Cpu", "Cpl", "Cpm", "Cpmk",
                 "CpTk", "Spmk", "Cpc", "CNpk", "CNpmc", "CNpmkc", "Cp_uv")
  }
  
  data <- data[is.finite(data)]
  if (length(data) < 3) {
    stop("Insufficient data points supplied.")
  }
  
  if (missing(USL) || missing(LSL)) {
    stop("Both USL and LSL must be specified.")
  }
  
  # Step 1: Initial Point Estimate via MLE
  dist_mle <- fit_distribution(data, distribution, method = "mle")
  mle_params <- dist_mle$params
  
  if (length(mle_params) == 0 && !is.null(dist_mle$pdf)) {
    f_args <- formals(dist_mle$pdf)
    f_args <- f_args[!names(f_args) %in% c("x", "p", "...")]
    param_list <- list()
    for (nm in names(f_args)) {
      val <- tryCatch(eval(f_args[[nm]]), error = function(e) 1)
      if (!is.numeric(val) || length(val) != 1 || is.na(val)) val <- 1
      param_list[[nm]] <- val
    }
    if (length(param_list) > 0) {
      dist_mle$params <- param_list
      mle_params <- param_list
    }
  }
  
  param_names <- names(mle_params)
  num_params <- length(param_names)
  if (num_params == 0) {
    param_names <- c("theta")
    mle_params <- list(theta = 1)
    num_params <- 1
  }
  
  # Default Log Prior Function
  if (is.null(prior)) {
    prior <- function(p_list) {
      # Proper flat or mildly informative log prior
      log_p <- 0
      for (nm in param_names) {
        val <- p_list[[nm]]
        if (nm %in% c("sd", "rate", "shape", "scale", "alpha", "lambda")) {
          if (val <= 1e-8) return(-1e10)
          log_p <- log_p + stats::dgamma(val, shape = 1.01, rate = 0.01, log = TRUE)
        } else {
          log_p <- log_p + stats::dnorm(val, mean = 0, sd = 100, log = TRUE)
        }
      }
      log_p
    }
  } else if (is.list(prior) && !is.function(prior)) {
    # Convert hyperparameter list to prior function
    prior_params <- prior
    prior <- function(p_list) {
      log_p <- 0
      for (nm in param_names) {
        val <- p_list[[nm]]
        if (nm %in% names(prior_params)) {
          hp <- prior_params[[nm]]
          if (is.list(hp) && !is.null(hp$type)) {
            if (hp$type == "gamma") {
              if (val <= 1e-8) return(-1e10)
              log_p <- log_p + stats::dgamma(val, shape = hp$shape, rate = hp$rate, log = TRUE)
            } else if (hp$type == "normal") {
              log_p <- log_p + stats::dnorm(val, mean = hp$mean, sd = hp$sd, log = TRUE)
            }
          }
        }
      }
      log_p
    }
  }
  
  # Log Likelihood Function
  log_lik <- function(p_vec) {
    p_list <- as.list(p_vec)
    names(p_list) <- param_names
    for (nm in param_names) {
      if (nm %in% c("sd", "rate", "shape", "scale", "alpha", "lambda") && p_list[[nm]] <= 1e-8) {
        return(-1e10)
      }
    }
    dens <- tryCatch({
      do.call(distribution$pdf, c(list(data), p_list))
    }, error = function(e) rep(0, length(data)))
    dens <- pmax(1e-12, dens)
    sum(log(dens))
  }
  
  # Target Log Posterior Function
  log_posterior <- function(p_vec) {
    p_list <- as.list(p_vec)
    names(p_list) <- param_names
    ll <- log_lik(p_vec)
    lp <- tryCatch(prior(p_list), error = function(e) -1e10)
    if (is.na(ll) || is.na(lp) || !is.finite(ll) || !is.finite(lp)) return(-1e10)
    ll + lp
  }
  
  # Hessian & Proposal Distribution Matrix
  init_vec <- as.numeric(unlist(mle_params[param_names]))
  names(init_vec) <- param_names
  opt <- tryCatch({
    stats::optim(init_vec, function(v) -log_posterior(v), hessian = TRUE, control = list(maxit = 1000))
  }, error = function(e) NULL)
  
  mode_vec <- init_vec
  cov_mat <- diag(0.01 * (abs(init_vec) + 0.1)^2, nrow = num_params)
  
  if (!is.null(opt) && !is.null(opt$hessian)) {
    mode_vec <- opt$par
    cov_inv <- tryCatch(solve(opt$hessian), error = function(e) NULL)
    if (!is.null(cov_inv) && all(eigen(cov_inv)$values > 0)) {
      cov_mat <- cov_inv
    }
  }
  
  # Importance Sampling Generation
  total_samples <- (chain_length + burn_in) * thinning
  
  # Sample candidate parameters from Multivariate Normal proposal
  proposal_draws <- matrix(0, nrow = total_samples, ncol = num_params)
  colnames(proposal_draws) <- param_names
  
  L_mat <- tryCatch(t(chol(cov_mat)), error = function(e) diag(sqrt(diag(cov_mat)), nrow = num_params))
  
  for (i in 1:total_samples) {
    z <- stats::rnorm(num_params)
    draw <- mode_vec + as.vector(L_mat %*% z)
    # Ensure positive parameter constraints
    for (j in 1:num_params) {
      if (param_names[j] %in% c("sd", "rate", "shape", "scale", "alpha", "lambda")) {
        draw[j] <- abs(draw[j]) + 1e-4
      }
    }
    proposal_draws[i, ] <- draw
  }
  
  # Compute Log Proposal Densities and Log Target Densities
  log_target_vals <- numeric(total_samples)
  log_prop_vals <- numeric(total_samples)
  
  for (i in 1:total_samples) {
    p_v <- proposal_draws[i, ]
    log_target_vals[i] <- log_posterior(p_v)
    
    # Gaussian proposal density
    diff_v <- p_v - mode_vec
    cov_inv <- solve(cov_mat)
    log_prop_vals[i] <- -0.5 * num_params * log(2 * pi) - 0.5 * log(det(cov_mat)) -
      0.5 * as.numeric(t(diff_v) %*% cov_inv %*% diff_v)
  }
  
  # Calculate Importance Weights
  log_weights <- log_target_vals - log_prop_vals
  log_weights[!is.finite(log_weights)] <- -1e10
  max_lw <- max(log_weights)
  weights <- exp(log_weights - max_lw)
  sum_w <- sum(weights)
  if (sum_w <= 0) weights <- rep(1 / total_samples, total_samples) else weights <- weights / sum_w
  
  # Sampling Importance Resampling (SIR)
  resampled_indices <- sample.int(total_samples, size = total_samples, replace = TRUE, prob = weights)
  sir_param_matrix <- proposal_draws[resampled_indices, , drop = FALSE]
  
  # Apply Burn-in and Thinning
  burn_end <- burn_in * thinning
  if (burn_end >= total_samples) burn_end <- floor(total_samples / 2)
  retained_seq <- seq(from = burn_end + 1, to = total_samples, by = thinning)
  if (length(retained_seq) > chain_length) retained_seq <- retained_seq[1:chain_length]
  
  final_param_chain <- sir_param_matrix[retained_seq, , drop = FALSE]
  
  # Compute GPCI Chain for retained parameter draws
  num_retained <- nrow(final_param_chain)
  gpci_matrix <- matrix(0, nrow = num_retained, ncol = length(indices))
  colnames(gpci_matrix) <- indices
  
  for (i in 1:num_retained) {
    p_draw <- as.list(final_param_chain[i, ])
    names(p_draw) <- param_names
    dist_i <- distribution
    dist_i$params <- p_draw
    
    g_vals <- capability(
      distribution = dist_i,
      USL = USL, LSL = LSL, target = target,
      indices = indices, u = u, v = v,
      fit = FALSE, C0 = C0, C1 = C1, C2 = C2, P0 = P0
    )
    gpci_matrix[i, ] <- g_vals
  }
  
  # Initial Point Estimates under MLE
  point_est <- capability(
    data = data, distribution = distribution,
    USL = USL, LSL = LSL, target = target,
    indices = indices, u = u, v = v,
    fit = TRUE, fit_method = "mle",
    C0 = C0, C1 = C1, C2 = C2, P0 = P0
  )
  
  out <- list(
    param_chain = final_param_chain,
    gpci_chain = as.data.frame(gpci_matrix),
    point_estimates = point_est,
    specs = list(
      data = data,
      distribution = distribution,
      USL = USL, LSL = LSL, target = target,
      indices = indices, u = u, v = v,
      chain_length = chain_length, burn_in = burn_in, thinning = thinning
    )
  )
  class(out) <- "gpciImpSam"
  out
}
