# Helper to compute Highest Posterior Density (HPD) interval
.hpd_interval <- function(samples, prob = 0.95) {
  s_sorted <- sort(samples)
  n <- length(s_sorted)
  num_to_keep <- ceiling(prob * n)
  if (num_to_keep >= n) return(c(lower = s_sorted[1], upper = s_sorted[n]))
  
  width <- s_sorted[(1 + num_to_keep):n] - s_sorted[1:(n - num_to_keep)]
  best_idx <- which.min(width)
  return(c(lower = s_sorted[best_idx], upper = s_sorted[best_idx + num_to_keep]))
}

#' Bayesian Estimation via Metropolis-Hastings MCMC under Adaptive Type-I PHCS
#'
#' Performs Bayesian parameter estimation under Adaptive Type-I Progressive Hybrid Censoring
#' using Metropolis-Hastings / Gibbs MCMC sampling.
#'
#' @param data Numeric vector of observed failure times.
#' @param n Integer, total initial sample size placed on test.
#' @param m Integer, pre-fixed target number of failures.
#' @param T_thresh Numeric, pre-fixed time threshold T > 0.
#' @param R Numeric vector of length m, progressive censoring scheme.
#' @param pdf Function, user-supplied probability density function pdf(x, par).
#' @param cdf Function (optional), user-supplied cumulative distribution function cdf(x, par).
#' @param surf Function (optional), user-supplied survival function surf(x, par).
#' @param prior Function, user-supplied prior density function log_prior(par). Default is flat prior.
#' @param start Numeric vector, initial parameter values.
#' @param N_iter Integer, total number of MCMC iterations (default 5000).
#' @param burn_in Integer, burn-in iterations to discard (default 1000).
#' @param proposal_sd Numeric vector, standard deviations for random-walk proposal.
#' @param lower Numeric vector (optional), lower parameter constraints.
#' @param upper Numeric vector (optional), upper parameter constraints.
#'
#' @return A list containing posterior means, medians, modes, standard deviations, HPD credible intervals, and parameter chain samples.
#' @export
#' @examples
#' set.seed(123)
#' my_cdf <- function(x, par) pexp(x, rate = par[1])
#' my_pdf <- function(x, par) dexp(x, rate = par[1])
#' my_surf <- function(x, par) 1 - pexp(x, rate = par[1])
#' flat_prior <- function(par) ifelse(par[1] > 0, 0, -Inf)
#' R_plan <- c(rep(1, 8), rep(0, 4))
#' dat <- r_adapt1_phcs(
#'   n = 20, m = 12, T_thresh = 2.5,
#'   R = R_plan, pdf = my_pdf,
#'   cdf = my_cdf, par = 0.5
#' )$data
#' bayes_res <- bayes_adapt1_phcs(
#'   data = dat, n = 20, m = 12,
#'   T_thresh = 2.5, R = R_plan,
#'   pdf = my_pdf, cdf = my_cdf,
#'   surf = my_surf, prior = flat_prior,
#'   start = c(rate = 0.8), N_iter = 1000,
#'   burn_in = 200
#' )
#' print(bayes_res$summary)
bayes_adapt1_phcs <- function(data, n, m, T_thresh, R, pdf, cdf = NULL, surf = NULL, prior = NULL, start, N_iter = 5000, burn_in = 1000, proposal_sd = NULL, lower = NULL, upper = NULL) {
  if (is.null(surf) && !is.null(cdf)) {
    surf <- function(x, par) pmax(1e-12, 1 - cdf(x, par))
  }
  if (is.null(prior)) {
    prior <- function(par) 0
  }
  
  p_len <- length(start)
  if (is.null(proposal_sd)) proposal_sd <- rep(0.05, p_len)
  
  d <- length(data)
  data_sorted <- sort(data)
  
  log_post <- function(par) {
    if (!is.null(lower) && any(par <= lower)) return(-Inf)
    if (!is.null(upper) && any(par >= upper)) return(-Inf)
    
    pr_val <- prior(par)
    if (is.na(pr_val) || is.nan(pr_val) || is.infinite(pr_val)) return(-Inf)
    
    dens <- pdf(data_sorted, par)
    if (any(dens <= 0) || any(is.na(dens)) || any(is.nan(dens))) return(-Inf)
    
    if (d >= m) {
      s_vals <- surf(data_sorted[1:(m - 1)], par)
      if (any(s_vals <= 0) || any(is.na(s_vals))) return(-Inf)
      s_T <- surf(T_thresh, par)
      if (s_T <= 0 || is.na(s_T)) return(-Inf)
      
      rem_cens <- n - d - sum(R[1:(m - 1)])
      ll <- sum(log(dens)) + sum(R[1:(m - 1)] * log(s_vals)) + rem_cens * log(s_T)
    } else {
      s_vals <- surf(data_sorted, par)
      if (any(s_vals <= 0) || any(is.na(s_vals))) return(-Inf)
      s_T <- surf(T_thresh, par)
      if (s_T <= 0 || is.na(s_T)) return(-Inf)
      
      rem_cens <- n - d - sum(R[1:d])
      ll <- sum(log(dens)) + sum(R[1:d] * log(s_vals)) + rem_cens * log(s_T)
    }
    return(ll + pr_val)
  }
  
  chain <- matrix(0, nrow = N_iter, ncol = p_len)
  if (!is.null(names(start))) colnames(chain) <- names(start)
  
  curr_par <- start
  curr_lp <- log_post(curr_par)
  
  accepted <- 0
  for (iter in seq_len(N_iter)) {
    cand_par <- curr_par + stats::rnorm(p_len, mean = 0, sd = proposal_sd)
    cand_lp <- log_post(cand_par)
    
    if (is.finite(cand_lp) && log(stats::runif(1)) < (cand_lp - curr_lp)) {
      curr_par <- cand_par
      curr_lp <- cand_lp
      accepted <- accepted + 1
    }
    chain[iter, ] <- curr_par
  }
  
  post_samples <- chain[(burn_in + 1):N_iter, , drop = FALSE]
  
  means <- colMeans(post_samples)
  medians <- apply(post_samples, 2, stats::median)
  sds <- apply(post_samples, 2, stats::sd)
  
  modes <- numeric(p_len)
  hpd_mat <- matrix(0, nrow = p_len, ncol = 2, dimnames = list(colnames(post_samples), c("HPD_Lower", "HPD_Upper")))
  eq_mat <- matrix(0, nrow = p_len, ncol = 2, dimnames = list(colnames(post_samples), c("2.5%", "97.5%")))
  
  for (j in seq_len(p_len)) {
    d_est <- stats::density(post_samples[, j])
    modes[j] <- d_est$x[which.max(d_est$y)]
    hpd_mat[j, ] <- .hpd_interval(post_samples[, j])
    eq_mat[j, ] <- stats::quantile(post_samples[, j], probs = c(0.025, 0.975))
  }
  
  sum_table <- cbind(Mean = means, Median = medians, Mode = modes, SD = sds, eq_mat, hpd_mat)
  
  return(list(
    summary = sum_table,
    chain = post_samples,
    full_chain = chain,
    accept_rate = accepted / N_iter,
    scheme = "Adaptive Type-I PHCS"
  ))
}

#' Bayesian Estimation via Metropolis-Hastings MCMC under Adaptive Type-II PHCS
#'
#' Performs Bayesian parameter estimation under Adaptive Type-II Progressive Hybrid Censoring
#' using Metropolis-Hastings / Gibbs MCMC sampling.
#'
#' @param data Numeric vector of m observed failure times.
#' @param n Integer, total initial sample size placed on test.
#' @param m Integer, pre-fixed target number of failures.
#' @param T_thresh Numeric, pre-fixed time threshold T > 0.
#' @param R Numeric vector of length m, progressive censoring scheme.
#' @param pdf Function, user-supplied probability density function pdf(x, par).
#' @param cdf Function (optional), user-supplied cumulative distribution function cdf(x, par).
#' @param surf Function (optional), user-supplied survival function surf(x, par).
#' @param prior Function, user-supplied prior density function log_prior(par). Default is flat prior.
#' @param start Numeric vector, initial parameter values.
#' @param N_iter Integer, total number of MCMC iterations (default 5000).
#' @param burn_in Integer, burn-in iterations to discard (default 1000).
#' @param proposal_sd Numeric vector, standard deviations for random-walk proposal.
#' @param lower Numeric vector (optional), lower parameter constraints.
#' @param upper Numeric vector (optional), upper parameter constraints.
#'
#' @return A list containing posterior means, medians, modes, standard deviations, HPD credible intervals, and parameter chain samples.
#' @export
#' @examples
#' set.seed(123)
#' my_cdf <- function(x, par) pexp(x, rate = par[1])
#' my_pdf <- function(x, par) dexp(x, rate = par[1])
#' my_surf <- function(x, par) 1 - pexp(x, rate = par[1])
#' flat_prior <- function(par) ifelse(par[1] > 0, 0, -Inf)
#' R_plan <- c(rep(1, 8), rep(0, 4))
#' dat <- r_adapt2_phcs(
#'   n = 20, m = 12, T_thresh = 2.5,
#'   R = R_plan, pdf = my_pdf,
#'   cdf = my_cdf, par = 0.5
#' )$data
#' bayes_res <- bayes_adapt2_phcs(
#'   data = dat, n = 20, m = 12,
#'   T_thresh = 2.5, R = R_plan,
#'   pdf = my_pdf, cdf = my_cdf,
#'   surf = my_surf, prior = flat_prior,
#'   start = c(rate = 0.8), N_iter = 1000,
#'   burn_in = 200
#' )
#' print(bayes_res$summary)
bayes_adapt2_phcs <- function(data, n, m, T_thresh, R, pdf, cdf = NULL, surf = NULL, prior = NULL, start, N_iter = 5000, burn_in = 1000, proposal_sd = NULL, lower = NULL, upper = NULL) {
  if (is.null(surf) && !is.null(cdf)) {
    surf <- function(x, par) pmax(1e-12, 1 - cdf(x, par))
  }
  if (is.null(prior)) {
    prior <- function(par) 0
  }
  
  p_len <- length(start)
  if (is.null(proposal_sd)) proposal_sd <- rep(0.05, p_len)
  
  data_sorted <- sort(data)
  m_obs <- length(data_sorted)
  
  J <- sum(data_sorted <= T_thresh)
  if (J >= m_obs - 1) {
    R_eff <- R
  } else {
    R_eff <- c(if(J > 0) R[1:J] else numeric(0), rep(0, m_obs - J - 1), n - m_obs - sum(if(J > 0) R[1:J] else 0))
  }
  
  log_post <- function(par) {
    if (!is.null(lower) && any(par <= lower)) return(-Inf)
    if (!is.null(upper) && any(par >= upper)) return(-Inf)
    
    pr_val <- prior(par)
    if (is.na(pr_val) || is.nan(pr_val) || is.infinite(pr_val)) return(-Inf)
    
    dens <- pdf(data_sorted, par)
    if (any(dens <= 0) || any(is.na(dens)) || any(is.nan(dens))) return(-Inf)
    
    s_vals <- surf(data_sorted, par)
    if (any(s_vals <= 0) || any(is.na(s_vals))) return(-Inf)
    
    ll <- sum(log(dens)) + sum(R_eff * log(s_vals))
    return(ll + pr_val)
  }
  
  chain <- matrix(0, nrow = N_iter, ncol = p_len)
  if (!is.null(names(start))) colnames(chain) <- names(start)
  
  curr_par <- start
  curr_lp <- log_post(curr_par)
  
  accepted <- 0
  for (iter in seq_len(N_iter)) {
    cand_par <- curr_par + stats::rnorm(p_len, mean = 0, sd = proposal_sd)
    cand_lp <- log_post(cand_par)
    
    if (is.finite(cand_lp) && log(stats::runif(1)) < (cand_lp - curr_lp)) {
      curr_par <- cand_par
      curr_lp <- cand_lp
      accepted <- accepted + 1
    }
    chain[iter, ] <- curr_par
  }
  
  post_samples <- chain[(burn_in + 1):N_iter, , drop = FALSE]
  
  means <- colMeans(post_samples)
  medians <- apply(post_samples, 2, stats::median)
  sds <- apply(post_samples, 2, stats::sd)
  
  modes <- numeric(p_len)
  hpd_mat <- matrix(0, nrow = p_len, ncol = 2, dimnames = list(colnames(post_samples), c("HPD_Lower", "HPD_Upper")))
  eq_mat <- matrix(0, nrow = p_len, ncol = 2, dimnames = list(colnames(post_samples), c("2.5%", "97.5%")))
  
  for (j in seq_len(p_len)) {
    d_est <- stats::density(post_samples[, j])
    modes[j] <- d_est$x[which.max(d_est$y)]
    hpd_mat[j, ] <- .hpd_interval(post_samples[, j])
    eq_mat[j, ] <- stats::quantile(post_samples[, j], probs = c(0.025, 0.975))
  }
  
  sum_table <- cbind(Mean = means, Median = medians, Mode = modes, SD = sds, eq_mat, hpd_mat)
  
  return(list(
    summary = sum_table,
    chain = post_samples,
    full_chain = chain,
    accept_rate = accepted / N_iter,
    scheme = "Adaptive Type-II PHCS"
  ))
}
