eval_func <- function(fn, x, params) {
  if (is.null(fn)) return(NULL)
  if (is.null(params) || length(params) == 0) {
    res <- tryCatch(fn(x), error = function(e) NULL)
    if (!is.null(res)) return(res)
  }
  res <- tryCatch(fn(x, params), error = function(e) NULL)
  if (!is.null(res) && !any(is.na(res)) && length(res) == length(x)) {
    return(res)
  }
  res2 <- tryCatch(do.call(fn, c(list(x), params)), error = function(e) NULL)
  if (!is.null(res2) && !any(is.na(res2)) && length(res2) == length(x)) {
    return(res2)
  }
  stop("Failed to evaluate function with supplied parameters.")
}

#' Maximum Likelihood Estimation for Type-II Censored Samples
#'
#' Estimates distribution parameters under Type-II right- or left-censoring.
#'
#' @param data Numeric vector of length \code{r}, sorted ascending.
#' @param n Total sample size (\code{n >= r}).
#' @param pdf Probability density function.
#' @param cdf Cumulative distribution function.
#' @param sf Survival function. If \code{NULL}, computed as \code{1 - cdf(x, params)}.
#' @param params Named list or vector of starting parameter values.
#' @param censoring Type of censoring: \code{"right"} or \code{"left"}.
#' @param optim_control Optional control list passed to \code{\link[stats]{optim}}.
#'
#' @return A list containing \code{par} (estimated parameters), \code{value} (negative log-likelihood),
#' \code{convergence} status code, and \code{message}.
#' @export
#'
#' @examples
#' data_exp <- c(0.1, 0.2, 0.3, 0.4, 0.7, 1.0, 1.4)
#' fit <- fit_mle(
#'   data = data_exp, n = 20,
#'   pdf = function(x, p) dexp(x, rate = p$rate),
#'   cdf = function(x, p) pexp(x, rate = p$rate),
#'   params = list(rate = 0.1),
#'   censoring = "right"
#' )
#' fit$par
fit_mle <- function(data,
                    n,
                    pdf,
                    cdf,
                    sf = NULL,
                    params,
                    censoring = c("right", "left"),
                    optim_control = list()) {
  censoring <- match.arg(censoring)
  if (!is.numeric(data) || length(data) == 0) {
    stop("`data` must be a non-empty numeric vector.")
  }
  if (is.unsorted(data)) {
    stop("`data` must be sorted ascending.")
  }
  r <- length(data)
  if (!is.numeric(n) || length(n) != 1 || n < r) {
    stop("`n` must be an integer >= length(data).")
  }
  if (!is.function(pdf) || !is.function(cdf)) {
    stop("`pdf` and `cdf` must be functions.")
  }
  if (is.null(sf)) {
    sf <- function(x, p = NULL) 1 - eval_func(cdf, x, p)
  }
  if (is.null(params) || length(params) == 0) {
    stop("`params` must be a non-empty list or vector of parameter values.")
  }

  par_names <- names(params)
  if (is.null(par_names) || any(par_names == "")) {
    stop("`params` must be named.")
  }
  start_vec <- unlist(params)

  eps <- .Machine$double.eps^0.5

  nll <- function(par) {
    p_list <- as.list(par)
    names(p_list) <- par_names

    dens <- tryCatch(eval_func(pdf, data, p_list), error = function(e) rep(NA_real_, r))
    if (any(is.na(dens)) || any(dens <= 0)) {
      return(.Machine$double.xmax)
    }

    if (censoring == "right") {
      surv_r <- tryCatch(eval_func(sf, data[r], p_list), error = function(e) NA_real_)
      if (is.na(surv_r) || surv_r <= 0) {
        return(.Machine$double.xmax)
      }
      surv_r <- max(surv_r, eps)
      dens <- pmax(dens, eps)
      log_lik <- sum(log(dens)) + (n - r) * log(surv_r)
    } else {
      cdf_1 <- tryCatch(eval_func(cdf, data[1], p_list), error = function(e) NA_real_)
      if (is.na(cdf_1) || cdf_1 <= 0) {
        return(.Machine$double.xmax)
      }
      cdf_1 <- max(cdf_1, eps)
      dens <- pmax(dens, eps)
      log_lik <- (n - r) * log(cdf_1) + sum(log(dens))
    }

    if (!is.finite(log_lik)) {
      return(.Machine$double.xmax)
    }
    return(-log_lik)
  }

  opt <- stats::optim(par = start_vec, fn = nll, control = optim_control)

  if (opt$convergence != 0) {
    warning("MLE optimization did not converge (convergence code: ", opt$convergence, ").")
  }

  res_par <- as.list(opt$par)
  names(res_par) <- par_names

  list(
    par = res_par,
    value = opt$value,
    convergence = opt$convergence,
    message = opt$message
  )
}
