#' Bayesian MCMC Estimation under Improved Adaptive Type-II Progressive Censoring Scheme
#'
#' Performs MCMC Bayesian estimation for Improved Adaptive Type-II Progressive Censored (IAT-II PCS) data using Metropolis-Hastings within Gibbs sampling under Squared Error Loss (SEL) and LINEX Loss (LL) functions.
#'
#' @param data Numeric vector of observed failure times, or an object of class \code{"impadapt2_sample"}.
#' @param n Integer, total number of units placed on test. Required if data is a numeric vector.
#' @param m Integer, pre-fixed target number of failures. Required if data is a numeric vector.
#' @param T1 Numeric, first threshold time point T1. Required if data is a numeric vector.
#' @param T2 Numeric or NULL, second threshold time point T2 (T2 > T1). Required if data is a numeric vector.
#' @param R Numeric vector of length m, pre-fixed progressive censoring scheme. Required if data is a numeric vector.
#' @param pdf Function (optional), user-supplied probability density function pdf(x, par).
#' @param cdf Function (optional), user-supplied cumulative distribution function cdf(x, par).
#' @param start Numeric vector of initial parameter values.
#' @param prior_mean Optional numeric vector of prior means for parameters.
#' @param prior_sd Optional numeric vector of prior standard deviations for parameters.
#' @param loss Character vector specifying loss function(s) to compute: \code{"squared"} (Squared Error Loss) and/or \code{"linex"} (LINEX Loss).
#' @param c_linex Numeric, shape parameter c for LINEX loss function (default 1.0).
#' @param n_iter Integer, total number of MCMC iterations (default 5000).
#' @param burn_in Integer, number of initial burn-in iterations to discard (default 1000).
#' @param thin Integer, thinning interval (default 1).
#' @param conf_level Numeric, credible level for HPD intervals (default 0.95).
#' @param eval_time Optional numeric, time point t > 0 for calculating reliability S(t) and hazard rate h(t).
#' @param seed Optional integer, seed for random number generation.
#' @param proposal_sd Optional numeric vector of proposal standard deviations for Metropolis-Hastings steps.
#'
#' @return An object of class \code{"impadapt2_bayes"} containing:
#' \item{bayes_sel}{Bayes point estimates under Squared Error Loss.}
#' \item{bayes_linex}{Bayes point estimates under LINEX Loss.}
#' \item{post_sd}{Posterior standard deviations of parameters.}
#' \item{hpd_interval}{Matrix of Highest Posterior Density (HPD) credible intervals for parameters.}
#' \item{chain}{Matrix of retained MCMC posterior samples.}
#' \item{rel_est}{Bayes estimates, SD, and HPD interval for Reliability S(t) if eval_time is provided.}
#' \item{haz_est}{Bayes estimates, SD, and HPD interval for Hazard rate h(t) if eval_time is provided.}
#' \item{acceptance_rate}{Acceptance rate of the Metropolis-Hastings MCMC sampler.}
#' \item{case}{Realized censoring scenario ("Case I", "Case II", or "Case III").}
#'
#' @references
#' Dev, S. S., & Chacko, M. (2026). Statistical inference for generalized exponential distribution under improved adaptive Type-II progressive censoring.
#' \emph{Journal of the Iranian Statistical Society}, 25(2), 1-29. \doi{10.22034/jirss.2026.2077492.1165}.
#'
#' @export
#' @examples
#' set.seed(123)
#' ge_cdf <- function(x, par) (1 - exp(-par[2] * x))^par[1]
#' ge_pdf <- function(x, par) par[1] * par[2] * exp(-par[2] * x) * (1 - exp(-par[2] * x))^(par[1] - 1)
#' ge_qdf <- function(p, par) - (1 / par[2]) * log(1 - p^(1 / par[1]))
#'
#' samp <- r_impadapt2_censor(
#'   n = 20, m = 10, T1 = 0.8, T2 = 2.0,
#'   R = c(rep(1, 10)),
#'   pdf = ge_pdf, cdf = ge_cdf, qdf = ge_qdf,
#'   par = c(1.5, 0.8)
#' )
#'
#' fit_bayes <- bayes_impadapt2_censor(
#'   data = samp, pdf = ge_pdf, cdf = ge_cdf,
#'   start = c(1.2, 0.7), n_iter = 1000, burn_in = 200, eval_time = 0.5
#' )
#' summary(fit_bayes)
bayes_impadapt2_censor <- function(data, n = NULL, m = NULL, T1 = NULL, T2 = NULL, R = NULL,
                                   pdf = NULL, cdf = NULL, start = NULL,
                                   prior_mean = NULL, prior_sd = NULL,
                                   loss = c("squared", "linex"), c_linex = 1,
                                   n_iter = 5000, burn_in = 1000, thin = 1,
                                   conf_level = 0.95, eval_time = NULL, seed = NULL,
                                   proposal_sd = NULL) {
  if (!is.null(seed)) set.seed(seed)
  
  if (inherits(data, "impadapt2_sample")) {
    obs_x <- data$data
    n <- data$n
    m <- data$m
    T1 <- data$T1
    T2 <- data$T2
    R <- data$R_initial
  } else {
    obs_x <- as.numeric(data)
    if (is.null(n) || is.null(m) || is.null(T1) || is.null(R)) {
      stop("When 'data' is a numeric vector, 'n', 'm', 'T1', and 'R' must be specified.")
    }
  }
  
  if (is.null(T2)) T2 <- Inf
  
  if (is.null(pdf) && is.null(cdf)) {
    pdf <- .ge_pdf
    cdf <- .ge_cdf
  } else if (is.null(pdf) || is.null(cdf)) {
    stop("Both 'pdf' and 'cdf' functions must be provided.")
  }
  
  if (is.null(start)) stop("Initial parameter vector 'start' must be specified.")
  
  obs_x <- sort(obs_x)
  D2 <- length(obs_x)
  d1 <- sum(obs_x <= T1)
  
  if (D2 == m && obs_x[m] < T1) {
    case_type <- "Case I"
    D1 <- m
    R_star <- R[m]
    T_star <- obs_x[m]
  } else if (D2 == m && obs_x[m] < T2) {
    case_type <- "Case II"
    D1 <- d1
    R_star <- n - m - sum(if (d1 > 0) R[seq_len(d1)] else 0)
    T_star <- obs_x[m]
  } else {
    case_type <- "Case III"
    D1 <- d1
    R_star <- n - D2 - sum(if (d1 > 0) R[seq_len(d1)] else 0)
    T_star <- T2
  }
  
  n_par <- length(start)
  if (is.null(prior_mean)) prior_mean <- start
  if (is.null(prior_sd)) prior_sd <- rep(10.0, n_par)
  if (is.null(proposal_sd)) proposal_sd <- pmax(start * 0.1, 0.05)
  
  loglik_fn <- function(par) {
    if (any(par <= 0) || any(is.nan(par)) || any(is.na(par))) return(-Inf)
    if (D2 == 0) return(-Inf)
    dens_vals <- pdf(obs_x, par)
    if (any(dens_vals <= 0 | is.na(dens_vals))) return(-Inf)
    
    cdf_vals <- cdf(obs_x, par)
    surv_vals <- pmax(pmin(1 - cdf_vals, 1 - 1e-15), 1e-15)
    surv_Tstar <- pmax(pmin(1 - cdf(T_star, par), 1 - 1e-15), 1e-15)
    
    t1 <- sum(log(dens_vals))
    t2 <- if (D1 > 0) sum(R[seq_len(D1)] * log(surv_vals[seq_len(D1)])) else 0
    t3 <- R_star * log(surv_Tstar)
    return(t1 + t2 + t3)
  }
  
  logprior_fn <- function(par) {
    if (any(par <= 0)) return(-Inf)
    sum(stats::dnorm(par, mean = prior_mean, sd = prior_sd, log = TRUE))
  }
  
  logpost_fn <- function(par) {
    lp <- logprior_fn(par)
    if (is.infinite(lp)) return(-Inf)
    ll <- loglik_fn(par)
    if (is.infinite(ll)) return(-Inf)
    return(lp + ll)
  }
  
  chain_mat <- matrix(0, nrow = n_iter, ncol = n_par)
  colnames(chain_mat) <- if (!is.null(names(start))) names(start) else paste0("par", seq_len(n_par))
  
  curr_par <- start
  curr_logpost <- logpost_fn(curr_par)
  accepted <- 0
  
  for (iter in seq_len(n_iter)) {
    for (j in seq_len(n_par)) {
      prop_par <- curr_par
      prop_par[j] <- stats::rnorm(1, mean = curr_par[j], sd = proposal_sd[j])
      
      if (prop_par[j] > 0) {
        prop_logpost <- logpost_fn(prop_par)
        log_alpha <- prop_logpost - curr_logpost
        if (log(stats::runif(1)) < log_alpha) {
          curr_par <- prop_par
          curr_logpost <- prop_logpost
          accepted <- accepted + 1
        }
      }
    }
    chain_mat[iter, ] <- curr_par
  }
  
  acc_rate <- accepted / (n_iter * n_par)
  
  keep_indices <- seq(burn_in + 1, n_iter, by = thin)
  post_chain <- chain_mat[keep_indices, , drop = FALSE]
  
  bayes_sel <- colMeans(post_chain)
  post_sd <- apply(post_chain, 2, stats::sd)
  
  bayes_linex <- numeric(n_par)
  names(bayes_linex) <- colnames(post_chain)
  for (j in seq_len(n_par)) {
    mean_exp <- mean(exp(-c_linex * post_chain[, j]))
    bayes_linex[j] <- - (1 / c_linex) * log(max(mean_exp, 1e-15))
  }
  
  hpd_mat <- matrix(0, nrow = n_par, ncol = 2)
  rownames(hpd_mat) <- colnames(post_chain)
  colnames(hpd_mat) <- c("Lower", "Upper")
  for (j in seq_len(n_par)) {
    hpd_mat[j, ] <- .compute_hpd(post_chain[, j], prob = conf_level)
  }
  
  rel_bayes <- NULL
  haz_bayes <- NULL
  if (!is.null(eval_time) && eval_time > 0) {
    n_post <- nrow(post_chain)
    s_draws <- numeric(n_post)
    h_draws <- numeric(n_post)
    for (i in seq_len(n_post)) {
      p_i <- post_chain[i, ]
      s_v <- pmax(1 - cdf(eval_time, p_i), 1e-15)
      s_draws[i] <- s_v
      d_v <- pdf(eval_time, p_i)
      h_draws[i] <- d_v / s_v
    }
    
    s_sel <- mean(s_draws)
    s_linex <- - (1 / c_linex) * log(max(mean(exp(-c_linex * s_draws)), 1e-15))
    s_sd <- stats::sd(s_draws)
    s_hpd <- .compute_hpd(s_draws, prob = conf_level)
    rel_bayes <- list(eval_time = eval_time, sel = s_sel, linex = s_linex, sd = s_sd, hpd = s_hpd)
    
    h_sel <- mean(h_draws)
    h_linex <- - (1 / c_linex) * log(max(mean(exp(-c_linex * h_draws)), 1e-15))
    h_sd <- stats::sd(h_draws)
    h_hpd <- .compute_hpd(h_draws, prob = conf_level)
    haz_bayes <- list(eval_time = eval_time, sel = h_sel, linex = h_linex, sd = h_sd, hpd = h_hpd)
  }
  
  res <- list(
    bayes_sel = bayes_sel,
    bayes_linex = bayes_linex,
    post_sd = post_sd,
    hpd_interval = hpd_mat,
    chain = post_chain,
    rel_est = rel_bayes,
    haz_est = haz_bayes,
    c_linex = c_linex,
    conf_level = conf_level,
    acceptance_rate = acc_rate,
    case = case_type,
    data = obs_x,
    pdf = pdf,
    cdf = cdf,
    n = n,
    m = m,
    T1 = T1,
    T2 = T2,
    R = R
  )
  class(res) <- "impadapt2_bayes"
  return(res)
}

#' @export
print.impadapt2_bayes <- function(x, ...) {
  cat("Bayesian MCMC Estimation under IAT-II PCS\n")
  cat("----------------------------------------\n")
  cat("Realized Scenario :", x$case, "\n")
  cat("Acceptance Rate   :", round(x$acceptance_rate * 100, 2), "%\n")
  cat("LINEX Shape (c)   :", x$c_linex, "\n\n")
  cat("Posterior Estimates & 95% HPD Intervals:\n")
  mat <- cbind(SEL = x$bayes_sel, LINEX = x$bayes_linex, PostSD = x$post_sd, x$hpd_interval)
  print(round(mat, 4))
  
  if (!is.null(x$rel_est)) {
    cat("\nReliability Function S(t =", x$rel_est$eval_time, "):\n")
    cat("SEL:", round(x$rel_est$sel, 4), "| LINEX:", round(x$rel_est$linex, 4),
        "| SD:", round(x$rel_est$sd, 4), "| HPD: [", round(x$rel_est$hpd[1], 4), ",", round(x$rel_est$hpd[2], 4), "]\n")
  }
  if (!is.null(x$haz_est)) {
    cat("Hazard Rate Function h(t =", x$haz_est$eval_time, "):\n")
    cat("SEL:", round(x$haz_est$sel, 4), "| LINEX:", round(x$haz_est$linex, 4),
        "| SD:", round(x$haz_est$sd, 4), "| HPD: [", round(x$haz_est$hpd[1], 4), ",", round(x$haz_est$hpd[2], 4), "]\n")
  }
  invisible(x)
}

#' @export
summary.impadapt2_bayes <- function(object, ...) {
  res <- list(
    bayes_sel = object$bayes_sel,
    bayes_linex = object$bayes_linex,
    post_sd = object$post_sd,
    hpd_interval = object$hpd_interval,
    rel_est = object$rel_est,
    haz_est = object$haz_est,
    acceptance_rate = object$acceptance_rate,
    case = object$case,
    c_linex = object$c_linex
  )
  class(res) <- "summary.impadapt2_bayes"
  return(res)
}

#' @export
print.summary.impadapt2_bayes <- function(x, ...) {
  cat("Summary of Bayesian MCMC Estimation (IAT-II PCS)\n")
  cat("================================================\n")
  cat("Realized Scenario :", x$case, "\n")
  cat("Acceptance Rate   :", round(x$acceptance_rate * 100, 2), "%\n\n")
  cat("Parameter Posterior Summaries:\n")
  mat <- cbind(SEL = x$bayes_sel, LINEX = x$bayes_linex, PostSD = x$post_sd, x$hpd_interval)
  print(round(mat, 4))
  invisible(x)
}
