#' Importance Sampling Estimation under Adaptive Type-I PHCS
#'
#' Estimates parameters and posterior expectations via Importance Sampling under Adaptive Type-I PHCS.
#'
#' @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 (optional), user-supplied prior density function log_prior(par).
#' @param start Numeric vector, center for proposal distribution (e.g., MLE or initial guess).
#' @param proposal_cov Matrix (optional), covariance matrix for Gaussian proposal distribution.
#' @param N_samples Integer, number of importance samples (default 5000).
#' @param lower Numeric vector (optional), lower parameter bounds.
#' @param upper Numeric vector (optional), upper parameter bounds.
#'
#' @return A list containing estimated posterior mean, standard error, effective sample size (ESS), and importance weights.
#' @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
#' is_res <- is_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.5), N_samples = 1000
#' )
#' print(is_res$summary)
is_adapt1_phcs <- function(data, n, m, T_thresh, R, pdf, cdf = NULL, surf = NULL, prior = NULL, start, proposal_cov = NULL, N_samples = 5000, 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_cov)) proposal_cov <- diag((abs(start) * 0.1 + 1e-3)^2, 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)
  }
  
  L_mat <- tryCatch(chol(proposal_cov), error = function(e) diag(sqrt(diag(proposal_cov)), p_len))
  Z <- matrix(stats::rnorm(N_samples * p_len), nrow = N_samples, ncol = p_len)
  samples <- t(start + t(Z %*% L_mat))
  if (!is.null(names(start))) colnames(samples) <- names(start)
  
  log_weights <- numeric(N_samples)
  inv_cov <- tryCatch(solve(proposal_cov), error = function(e) diag(1 / diag(proposal_cov), p_len))
  det_cov <- det(proposal_cov)
  
  for (k in seq_len(N_samples)) {
    p_k <- samples[k, ]
    lp_k <- log_post(p_k)
    if (is.finite(lp_k)) {
      diff_p <- p_k - start
      log_q_k <- -0.5 * (p_len * log(2 * pi) + log(max(1e-12, det_cov)) + sum(diff_p %*% inv_cov * diff_p))
      log_weights[k] <- lp_k - log_q_k
    } else {
      log_weights[k] <- -Inf
    }
  }
  
  max_lw <- max(log_weights[is.finite(log_weights)])
  w <- exp(log_weights - max_lw)
  w[is.na(w) | is.nan(w)] <- 0
  
  sum_w <- sum(w)
  if (sum_w <= 0) stop("Importance sampling failed: all proposed points have zero weight.")
  
  W <- w / sum_w
  ESS <- 1 / sum(W^2)
  
  est_mean <- colSums(samples * W)
  est_se <- sqrt(colSums(t((t(samples) - est_mean)^2) * W))
  
  sum_table <- cbind(Estimate = est_mean, `Std. Error` = est_se)
  
  return(list(
    summary = sum_table,
    ESS = ESS,
    weights = W,
    samples = samples,
    scheme = "Adaptive Type-I PHCS"
  ))
}

#' Importance Sampling Estimation under Adaptive Type-II PHCS
#'
#' Estimates parameters and posterior expectations via Importance Sampling under Adaptive Type-II PHCS.
#'
#' @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 (optional), user-supplied prior density function log_prior(par).
#' @param start Numeric vector, center for proposal distribution (e.g., MLE or initial guess).
#' @param proposal_cov Matrix (optional), covariance matrix for Gaussian proposal distribution.
#' @param N_samples Integer, number of importance samples (default 5000).
#' @param lower Numeric vector (optional), lower parameter bounds.
#' @param upper Numeric vector (optional), upper parameter bounds.
#'
#' @return A list containing estimated posterior mean, standard error, effective sample size (ESS), and importance weights.
#' @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
#' is_res <- is_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.5), N_samples = 1000
#' )
#' print(is_res$summary)
is_adapt2_phcs <- function(data, n, m, T_thresh, R, pdf, cdf = NULL, surf = NULL, prior = NULL, start, proposal_cov = NULL, N_samples = 5000, 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_cov)) proposal_cov <- diag((abs(start) * 0.1 + 1e-3)^2, 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)
  }
  
  L_mat <- tryCatch(chol(proposal_cov), error = function(e) diag(sqrt(diag(proposal_cov)), p_len))
  Z <- matrix(stats::rnorm(N_samples * p_len), nrow = N_samples, ncol = p_len)
  samples <- t(start + t(Z %*% L_mat))
  if (!is.null(names(start))) colnames(samples) <- names(start)
  
  log_weights <- numeric(N_samples)
  inv_cov <- tryCatch(solve(proposal_cov), error = function(e) diag(1 / diag(proposal_cov), p_len))
  det_cov <- det(proposal_cov)
  
  for (k in seq_len(N_samples)) {
    p_k <- samples[k, ]
    lp_k <- log_post(p_k)
    if (is.finite(lp_k)) {
      diff_p <- p_k - start
      log_q_k <- -0.5 * (p_len * log(2 * pi) + log(max(1e-12, det_cov)) + sum(diff_p %*% inv_cov * diff_p))
      log_weights[k] <- lp_k - log_q_k
    } else {
      log_weights[k] <- -Inf
    }
  }
  
  max_lw <- max(log_weights[is.finite(log_weights)])
  w <- exp(log_weights - max_lw)
  w[is.na(w) | is.nan(w)] <- 0
  
  sum_w <- sum(w)
  if (sum_w <= 0) stop("Importance sampling failed: all proposed points have zero weight.")
  
  W <- w / sum_w
  ESS <- 1 / sum(W^2)
  
  est_mean <- colSums(samples * W)
  est_se <- sqrt(colSums(t((t(samples) - est_mean)^2) * W))
  
  sum_table <- cbind(Estimate = est_mean, `Std. Error` = est_se)
  
  return(list(
    summary = sum_table,
    ESS = ESS,
    weights = W,
    samples = samples,
    scheme = "Adaptive Type-II PHCS"
  ))
}
