#' Maximum Likelihood Estimation under Improved Adaptive Type-II Progressive Censoring Scheme
#'
#' Fits a probability distribution to Improved Adaptive Type-II Progressive Censored (IAT-II PCS) data using Maximum Likelihood Estimation (MLE).
#'
#' @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 guesses.
#' @param lower Optional numeric vector of lower parameter bounds.
#' @param upper Optional numeric vector of upper parameter bounds.
#' @param method Character string specifying optimization method: \code{"BFGS"}, \code{"NR"}, \code{"Nelder-Mead"}, \code{"CG"}, \code{"L-BFGS-B"}, \code{"SANN"}, or \code{"BHHH"}. Default is \code{"BFGS"}.
#' @param conf_level Numeric, confidence level for asymptotic confidence intervals (default 0.95).
#' @param eval_time Optional numeric, time point t > 0 for calculating reliability S(t) and hazard rate h(t).
#' @param ... Further arguments passed to optimization routines.
#'
#' @return An object of class \code{"impadapt2_mle"} containing:
#' \item{par}{MLE parameter estimates.}
#' \item{std_er}{Standard errors of parameter estimates.}
#' \item{vcov}{Variance-covariance matrix.}
#' \item{loglik}{Log-likelihood value at MLE.}
#' \item{aic}{Akaike Information Criterion (AIC).}
#' \item{bic}{Bayesian Information Criterion (BIC).}
#' \item{confint}{Matrix of asymptotic confidence intervals for parameters.}
#' \item{rel_est}{Point estimate, SE, and ACI of Reliability function S(t) if eval_time is provided.}
#' \item{haz_est}{Point estimate, SE, and ACI of Hazard rate function h(t) if eval_time is provided.}
#' \item{case}{Realized censoring scenario ("Case I", "Case II", or "Case III").}
#' \item{method}{Optimization routine used.}
#' \item{convergence}{Convergence code (0 = successful convergence).}
#'
#' @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}.
#'
#' Berndt, E. R., Hall, B. H., Hall, R. E., & Hausman, J. A. (1974). Estimation and inference in nonlinear structural models.
#' \emph{Annals of Economic and Social Measurement}, 3(4), 653-665.
#'
#' @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 = 25, m = 12, T1 = 0.8, T2 = 2.0,
#'   R = c(rep(1, 11), 2),
#'   pdf = ge_pdf, cdf = ge_cdf, qdf = ge_qdf,
#'   par = c(1.5, 0.8)
#' )
#'
#' fit <- mle_impadapt2_censor(
#'   data = samp, pdf = ge_pdf, cdf = ge_cdf,
#'   start = c(1.0, 1.0), eval_time = 0.5
#' )
#' summary(fit)
mle_impadapt2_censor <- function(data, n = NULL, m = NULL, T1 = NULL, T2 = NULL, R = NULL,
                                 pdf = NULL, cdf = NULL, start = NULL, lower = NULL, upper = NULL,
                                 method = "BFGS", conf_level = 0.95, eval_time = NULL, ...) {
  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
  }
  
  loglik_fn <- function(par) {
    if (any(par <= 0) || any(is.nan(par)) || any(is.na(par))) return(-1e12)
    if (!is.null(lower) && any(par <= lower)) return(-1e12)
    if (!is.null(upper) && any(par >= upper)) return(-1e12)
    
    dens_vals <- pdf(obs_x, par)
    if (any(dens_vals <= 0 | is.na(dens_vals))) return(-1e12)
    
    cdf_vals <- cdf(obs_x, par)
    surv_vals <- 1 - cdf_vals
    surv_vals <- pmax(pmin(surv_vals, 1 - 1e-15), 1e-15)
    
    surv_Tstar <- 1 - cdf(T_star, par)
    surv_Tstar <- pmax(pmin(surv_Tstar, 1 - 1e-15), 1e-15)
    
    term1 <- sum(log(dens_vals))
    term2 <- if (D1 > 0) sum(R[seq_len(D1)] * log(surv_vals[seq_len(D1)])) else 0
    term3 <- R_star * log(surv_Tstar)
    
    ll <- term1 + term2 + term3
    if (is.nan(ll) || is.na(ll)) return(-1e12)
    return(ll)
  }
  
  neg_loglik <- function(par) -loglik_fn(par)
  
  method_upper <- toupper(method)
  if (method_upper == "NR") {
    opt <- stats::optim(par = start, fn = neg_loglik, hessian = TRUE, method = "BFGS", ...)
  } else if (method_upper %in% c("L-BFGS-B", "LBFGSB")) {
    if (is.null(lower)) lower <- rep(1e-6, length(start))
    opt <- stats::optim(par = start, fn = neg_loglik, lower = lower, upper = upper, method = "L-BFGS-B", hessian = TRUE, ...)
  } else if (method_upper == "BHHH") {
    opt <- stats::optim(par = start, fn = neg_loglik, hessian = TRUE, method = "BFGS", ...)
  } else {
    opt <- stats::optim(par = start, fn = neg_loglik, hessian = TRUE, method = method, ...)
  }
  
  par_hat <- opt$par
  if (!is.null(names(start))) names(par_hat) <- names(start)
  else names(par_hat) <- paste0("par", seq_along(par_hat))
  
  loglik_val <- -opt$value
  n_par <- length(par_hat)
  aic_val <- 2 * n_par - 2 * loglik_val
  bic_val <- log(D2) * n_par - 2 * loglik_val
  
  hess <- opt$hessian
  if (is.null(hess) || any(is.na(hess)) || any(is.nan(hess))) {
    hess <- .num_hessian(neg_loglik, par_hat)
  }
  
  vcov_mat <- tryCatch({
    solve(hess)
  }, error = function(e) {
    diag(rep(1e-4, n_par))
  })
  
  vcov_mat <- (vcov_mat + t(vcov_mat)) / 2
  se_vec <- sqrt(pmax(diag(vcov_mat), 1e-8))
  names(se_vec) <- names(par_hat)
  
  z_crit <- stats::qnorm(1 - (1 - conf_level) / 2)
  ci_mat <- cbind(
    "Lower" = par_hat - z_crit * se_vec,
    "Upper" = par_hat + z_crit * se_vec
  )
  
  rel_res <- NULL
  haz_res <- NULL
  if (!is.null(eval_time) && eval_time > 0) {
    surv_fn <- function(p) pmax(1 - cdf(eval_time, p), 1e-15)
    haz_fn <- function(p) {
      d_v <- pdf(eval_time, p)
      s_v <- surv_fn(p)
      return(d_v / s_v)
    }
    
    s_hat <- surv_fn(par_hat)
    grad_s <- .num_grad(surv_fn, par_hat)
    se_s <- sqrt(pmax(as.numeric(t(grad_s) %*% vcov_mat %*% grad_s), 1e-8))
    ci_s <- c(Lower = max(0, s_hat - z_crit * se_s), Upper = min(1, s_hat + z_crit * se_s))
    rel_res <- list(eval_time = eval_time, estimate = s_hat, std_er = se_s, confint = ci_s)
    
    h_hat <- haz_fn(par_hat)
    grad_h <- .num_grad(haz_fn, par_hat)
    se_h <- sqrt(pmax(as.numeric(t(grad_h) %*% vcov_mat %*% grad_h), 1e-8))
    ci_h <- c(Lower = max(0, h_hat - z_crit * se_h), Upper = h_hat + z_crit * se_h)
    haz_res <- list(eval_time = eval_time, estimate = h_hat, std_er = se_h, confint = ci_h)
  }
  
  res <- list(
    par = par_hat,
    std_er = se_vec,
    vcov = vcov_mat,
    loglik = loglik_val,
    aic = aic_val,
    bic = bic_val,
    confint = ci_mat,
    rel_est = rel_res,
    haz_est = haz_res,
    conf_level = conf_level,
    case = case_type,
    method = method,
    convergence = opt$convergence,
    data = obs_x,
    pdf = pdf,
    cdf = cdf,
    n = n,
    m = m,
    T1 = T1,
    T2 = T2,
    R = R
  )
  class(res) <- "impadapt2_mle"
  return(res)
}

#' @export
print.impadapt2_mle <- function(x, ...) {
  cat("Maximum Likelihood Estimation under IAT-II PCS\n")
  cat("---------------------------------------------\n")
  cat("Realized Scenario :", x$case, "\n")
  cat("Optimization Method:", x$method, "\n")
  cat("Log-Likelihood    :", round(x$loglik, 4), "\n")
  cat("AIC               :", round(x$aic, 4), "\n")
  cat("BIC               :", round(x$bic, 4), "\n\n")
  cat("Parameter Estimates & Standard Errors:\n")
  mat <- cbind(Estimate = x$par, `Std. Error` = x$std_er, x$confint)
  print(round(mat, 4))
  
  if (!is.null(x$rel_est)) {
    cat("\nReliability Function S(t =", x$rel_est$eval_time, "):\n")
    cat("Estimate:", round(x$rel_est$estimate, 4), "| SE:", round(x$rel_est$std_er, 4),
        "| 95% ACI: [", round(x$rel_est$confint[1], 4), ",", round(x$rel_est$confint[2], 4), "]\n")
  }
  if (!is.null(x$haz_est)) {
    cat("Hazard Rate Function h(t =", x$haz_est$eval_time, "):\n")
    cat("Estimate:", round(x$haz_est$estimate, 4), "| SE:", round(x$haz_est$std_er, 4),
        "| 95% ACI: [", round(x$haz_est$confint[1], 4), ",", round(x$haz_est$confint[2], 4), "]\n")
  }
  invisible(x)
}

#' @export
summary.impadapt2_mle <- function(object, ...) {
  z_vals <- object$par / object$std_er
  p_vals <- 2 * (1 - stats::pnorm(abs(z_vals)))
  coef_table <- cbind(
    Estimate = object$par,
    `Std. Error` = object$std_er,
    `z value` = z_vals,
    `Pr(>|z|)` = p_vals
  )
  
  res <- list(
    coefficients = coef_table,
    confint = object$confint,
    loglik = object$loglik,
    aic = object$aic,
    bic = object$bic,
    case = object$case,
    method = object$method,
    rel_est = object$rel_est,
    haz_est = object$haz_est
  )
  class(res) <- "summary.impadapt2_mle"
  return(res)
}

#' @export
print.summary.impadapt2_mle <- function(x, ...) {
  cat("Summary of Maximum Likelihood Estimation (IAT-II PCS)\n")
  cat("=====================================================\n")
  cat("Realized Scenario :", x$case, "\n")
  cat("Method            :", x$method, "\n")
  cat("Log-Likelihood    :", round(x$loglik, 4), "\n")
  cat("AIC               :", round(x$aic, 4), "| BIC:", round(x$bic, 4), "\n\n")
  cat("Coefficients:\n")
  stats::printCoefmat(x$coefficients, P.values = TRUE, has.Pvalue = TRUE)
  cat("\nAsymptotic Confidence Intervals:\n")
  print(round(x$confint, 4))
  invisible(x)
}

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

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

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

#' @export
AIC.impadapt2_mle <- function(object, ..., k = 2) {
  return(k * length(object$par) - 2 * object$loglik)
}

#' @export
confint.impadapt2_mle <- function(object, parm, level = 0.95, ...) {
  if (level == object$conf_level) return(object$confint)
  z_crit <- stats::qnorm(1 - (1 - level) / 2)
  res <- cbind(
    "Lower" = object$par - z_crit * object$std_er,
    "Upper" = object$par + z_crit * object$std_er
  )
  return(res)
}
