#' Maximum Likelihood Estimation under Adaptive Type-I Progressive Hybrid Censoring
#'
#' Computes Maximum Likelihood Estimates (MLE) under the Adaptive Type-I Progressive Hybrid Censoring Scheme
#' using various optimization algorithms ("NR", "BFGS", "BFGSR", "BHHH", "SANN", "CG", "NM").
#'
#' @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 start Numeric vector, initial parameter guesses.
#' @param method Optimization method: "NR", "BFGS", "BFGSR", "BHHH", "SANN", "CG", or "NM" (case-insensitive, default "NR").
#' @param lower Numeric vector (optional), lower bounds for parameters.
#' @param upper Numeric vector (optional), upper bounds for parameters.
#' @param max_iter Maximum iterations for optimization algorithm (default 500).
#' @param ... Additional arguments passed to optimization routines.
#'
#' @return An S3 object of class \code{mle_adapt_fit} containing estimates, standard errors, log-likelihood, Hessian, covariance matrix, and model info.
#' @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])
#' 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
#' fit <- mle_adapt1_phcs(
#'   data = dat, n = 20, m = 12,
#'   T_thresh = 2.5, R = R_plan,
#'   pdf = my_pdf, cdf = my_cdf,
#'   surf = my_surf, start = c(rate = 1.0),
#'   method = "BFGS"
#' )
#' summary(fit)
mle_adapt1_phcs <- function(data, n, m, T_thresh, R, pdf, cdf = NULL, surf = NULL, start, method = "NR", lower = NULL, upper = NULL, max_iter = 500, ...) {
  if (is.null(surf) && !is.null(cdf)) {
    surf <- function(x, par) pmax(1e-12, 1 - cdf(x, par))
  } else if (is.null(surf) && is.null(cdf)) {
    stop("Either cdf or surf must be provided.")
  }
  
  d <- length(data)
  data_sorted <- sort(data)
  
  loglik_fn <- function(par) {
    if (!is.null(lower) && any(par <= lower)) return(-1e12)
    if (!is.null(upper) && any(par >= upper)) return(-1e12)
    
    dens <- suppressWarnings(pdf(data_sorted, par))
    if (any(is.na(dens)) || any(is.nan(dens)) || any(dens <= 0)) return(-1e12)
    
    if (d >= m) {
      s_vals <- suppressWarnings(surf(data_sorted[1:(m - 1)], par))
      if (any(is.na(s_vals)) || any(is.nan(s_vals)) || any(s_vals <= 0)) return(-1e12)
      s_T <- suppressWarnings(surf(T_thresh, par))
      if (is.na(s_T) || is.nan(s_T) || s_T <= 0) return(-1e12)
      
      rem_cens <- n - d - sum(R[1:(m - 1)])
      val <- sum(log(dens)) + sum(R[1:(m - 1)] * log(s_vals)) + rem_cens * log(s_T)
    } else {
      s_vals <- suppressWarnings(surf(data_sorted, par))
      if (any(is.na(s_vals)) || any(is.nan(s_vals)) || any(s_vals <= 0)) return(-1e12)
      s_T <- suppressWarnings(surf(T_thresh, par))
      if (is.na(s_T) || is.nan(s_T) || s_T <= 0) return(-1e12)
      
      rem_cens <- n - d - sum(R[1:d])
      val <- sum(log(dens)) + sum(R[1:d] * log(s_vals)) + rem_cens * log(s_T)
    }
    return(val)
  }
  
  ind_loglik_fn <- function(par) {
    dens <- suppressWarnings(pdf(data_sorted, par))
    dens[is.na(dens) | is.nan(dens) | dens <= 0] <- 1e-12
    if (d >= m) {
      s_vals <- suppressWarnings(surf(data_sorted, par))
      s_vals[is.na(s_vals) | is.nan(s_vals) | s_vals <= 0] <- 1e-12
      s_T <- max(suppressWarnings(surf(T_thresh, par)), 1e-12)
      if (is.na(s_T) || is.nan(s_T)) s_T <- 1e-12
      r_vec <- c(R[1:(m - 1)], rep(0, d - m + 1))
      rem_cens <- max(0, n - d - sum(R[1:(m - 1)]))
      res <- log(dens) + r_vec * log(s_vals) + (rem_cens / d) * log(s_T)
    } else {
      s_vals <- suppressWarnings(surf(data_sorted, par))
      s_vals[is.na(s_vals) | is.nan(s_vals) | s_vals <= 0] <- 1e-12
      s_T <- max(suppressWarnings(surf(T_thresh, par)), 1e-12)
      if (is.na(s_T) || is.nan(s_T)) s_T <- 1e-12
      rem_cens <- max(0, n - d - sum(R[1:d]))
      res <- log(dens) + R[1:d] * log(s_vals) + (rem_cens / max(1, d)) * log(s_T)
    }
    return(res)
  }
  
  opt <- .fit_optimizer(loglik_fn, ind_loglik_fn, start, method, lower, upper, max_iter, ...)
  
  fit <- list(
    par = opt$par,
    stdEr = opt$stdEr,
    vcov = opt$vcov,
    logLik = opt$value,
    counts = opt$counts,
    convergence = opt$convergence,
    message = opt$message,
    method = toupper(method),
    scheme = "Adaptive Type-I PHCS",
    data = data_sorted,
    n = n,
    m = m,
    T_thresh = T_thresh,
    R = R,
    pdf = pdf,
    cdf = cdf,
    surf = surf
  )
  class(fit) <- "mle_adapt_fit"
  return(fit)
}

#' Maximum Likelihood Estimation under Adaptive Type-II Progressive Hybrid Censoring
#'
#' Computes Maximum Likelihood Estimates (MLE) under the Adaptive Type-II Progressive Hybrid Censoring Scheme
#' using various optimization algorithms ("NR", "BFGS", "BFGSR", "BHHH", "SANN", "CG", "NM").
#'
#' @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 start Numeric vector, initial parameter guesses.
#' @param method Optimization method: "NR", "BFGS", "BFGSR", "BHHH", "SANN", "CG", or "NM" (case-insensitive, default "NR").
#' @param lower Numeric vector (optional), lower bounds for parameters.
#' @param upper Numeric vector (optional), upper bounds for parameters.
#' @param max_iter Maximum iterations for optimization algorithm (default 500).
#' @param ... Additional arguments passed to optimization routines.
#'
#' @return An S3 object of class \code{mle_adapt_fit} containing estimates, standard errors, log-likelihood, Hessian, covariance matrix, and model info.
#' @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])
#' 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
#' fit <- mle_adapt2_phcs(
#'   data = dat, n = 20, m = 12,
#'   T_thresh = 2.5, R = R_plan,
#'   pdf = my_pdf, cdf = my_cdf,
#'   surf = my_surf, start = c(rate = 1.0),
#'   method = "BFGS"
#' )
#' summary(fit)
mle_adapt2_phcs <- function(data, n, m, T_thresh, R, pdf, cdf = NULL, surf = NULL, start, method = "NR", lower = NULL, upper = NULL, max_iter = 500, ...) {
  if (is.null(surf) && !is.null(cdf)) {
    surf <- function(x, par) pmax(1e-12, 1 - cdf(x, par))
  } else if (is.null(surf) && is.null(cdf)) {
    stop("Either cdf or surf must be provided.")
  }
  
  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))
  }
  
  loglik_fn <- function(par) {
    if (!is.null(lower) && any(par <= lower)) return(-1e12)
    if (!is.null(upper) && any(par >= upper)) return(-1e12)
    
    dens <- suppressWarnings(pdf(data_sorted, par))
    if (any(is.na(dens)) || any(is.nan(dens)) || any(dens <= 0)) return(-1e12)
    
    s_vals <- suppressWarnings(surf(data_sorted, par))
    if (any(is.na(s_vals)) || any(is.nan(s_vals)) || any(s_vals <= 0)) return(-1e12)
    
    val <- sum(log(dens)) + sum(R_eff * log(s_vals))
    return(val)
  }
  
  ind_loglik_fn <- function(par) {
    dens <- suppressWarnings(pdf(data_sorted, par))
    dens[is.na(dens) | is.nan(dens) | dens <= 0] <- 1e-12
    s_vals <- suppressWarnings(surf(data_sorted, par))
    s_vals[is.na(s_vals) | is.nan(s_vals) | s_vals <= 0] <- 1e-12
    return(log(dens) + R_eff * log(s_vals))
  }
  
  opt <- .fit_optimizer(loglik_fn, ind_loglik_fn, start, method, lower, upper, max_iter, ...)
  
  fit <- list(
    par = opt$par,
    stdEr = opt$stdEr,
    vcov = opt$vcov,
    logLik = opt$value,
    counts = opt$counts,
    convergence = opt$convergence,
    message = opt$message,
    method = toupper(method),
    scheme = "Adaptive Type-II PHCS",
    data = data_sorted,
    n = n,
    m = m,
    T_thresh = T_thresh,
    R = R,
    R_effective = R_eff,
    pdf = pdf,
    cdf = cdf,
    surf = surf
  )
  class(fit) <- "mle_adapt_fit"
  return(fit)
}

# S3 Methods for mle_adapt_fit

#' S3 Methods for mle_adapt_fit Objects
#'
#' @rdname mle_adapt1_phcs
#' @param x An object of class \code{mle_adapt_fit}.
#' @param object An object of class \code{mle_adapt_fit}.
#' @param ... Additional arguments.
#' @return Methods return printed summary, coefficients, variance-covariance matrix, log-likelihood, standard errors, or AIC.
#' @export
print.mle_adapt_fit <- function(x, ...) {
  cat("\n=== Maximum Likelihood Estimation (", x$scheme, ") ===\n", sep = "")
  cat("Optimization Method:", x$method, "\n")
  cat("Log-Likelihood:", round(x$logLik, 4), "\n\n")
  cat("Estimated Coefficients:\n")
  print(round(x$par, 4))
  cat("\nStandard Errors:\n")
  print(round(x$stdEr, 4))
  cat("\n")
  invisible(x)
}

#' @rdname mle_adapt1_phcs
#' @importFrom stats AIC
#' @export
summary.mle_adapt_fit <- function(object, ...) {
  se <- object$stdEr
  est <- object$par
  z_val <- est / se
  p_val <- 2 * (1 - stats::pnorm(abs(z_val)))
  
  coef_table <- cbind(Estimate = est, `Std. Error` = se, `z value` = z_val, `Pr(>|z|)` = p_val)
  
  res <- list(
    scheme = object$scheme,
    method = object$method,
    coefficients = coef_table,
    logLik = object$logLik,
    AIC = stats::AIC(object),
    vcov = object$vcov,
    n = object$n,
    m = object$m,
    T_thresh = object$T_thresh
  )
  class(res) <- "summary.mle_adapt_fit"
  return(res)
}

#' @rdname mle_adapt1_phcs
#' @export
print.summary.mle_adapt_fit <- function(x, ...) {
  cat("\n===========================================================\n")
  cat("  MLE Summary under", x$scheme, "\n")
  cat("===========================================================\n")
  cat("Optimization Routine :", x$method, "\n")
  cat("Sample Size (n)      :", x$n, "\n")
  cat("Target Failures (m)  :", x$m, "\n")
  cat("Time Threshold (T)   :", x$T_thresh, "\n")
  cat("Log-Likelihood       :", round(x$logLik, 4), "\n")
  cat("AIC                  :", round(x$AIC, 4), "\n\n")
  cat("Coefficients:\n")
  stats::printCoefmat(x$coefficients, P.values = TRUE, has.Pvalue = TRUE)
  cat("===========================================================\n\n")
  invisible(x)
}

#' @rdname mle_adapt1_phcs
#' @export
coef.mle_adapt_fit <- function(object, ...) {
  return(object$par)
}

#' @rdname mle_adapt1_phcs
#' @export
vcov.mle_adapt_fit <- function(object, ...) {
  return(object$vcov)
}

#' @rdname mle_adapt1_phcs
#' @export
logLik.mle_adapt_fit <- function(object, ...) {
  val <- object$logLik
  attr(val, "df") <- length(object$par)
  attr(val, "nobs") <- length(object$data)
  class(val) <- "logLik"
  return(val)
}

#' @rdname mle_adapt1_phcs
#' @export
stdEr.mle_adapt_fit <- function(object, ...) {
  return(object$stdEr)
}
