#' Generic Standard Error Function
#'
#' @param object An object of class \code{mle_adapt_fit}.
#' @param ... Additional arguments.
#' @return A numeric vector of standard errors.
#' @export
stdEr <- function(object, ...) {
  UseMethod("stdEr")
}

#' Generic AIC Function for mle_adapt_fit
#'
#' @param object An object of class \code{mle_adapt_fit}.
#' @param ... Additional arguments.
#' @param k Penalty parameter, default is 2.
#' @return A numeric value representing AIC.
#' @importFrom stats AIC
#' @export
AIC.mle_adapt_fit <- function(object, ..., k = 2) {
  if (is.null(object$logLik) || is.na(object$logLik)) return(NA_real_)
  p <- length(object$par)
  return(-2 * object$logLik + k * p)
}


# Helper: Compute numerical gradient of a function
.num_grad <- function(func, par, eps = 1e-6, ...) {
  p <- length(par)
  g <- numeric(p)
  for (i in seq_len(p)) {
    p1 <- par; p1[i] <- p1[i] + eps
    p2 <- par; p2[i] <- p2[i] - eps
    g[i] <- (func(p1, ...) - func(p2, ...)) / (2 * eps)
  }
  return(g)
}

# Helper: Compute numerical Hessian of a function
.num_hessian <- function(func, par, eps = 1e-5, ...) {
  p <- length(par)
  H <- matrix(0, nrow = p, ncol = p)
  f0 <- func(par, ...)
  for (i in seq_len(p)) {
    for (j in seq_len(p)) {
      if (i == j) {
        p1 <- par; p1[i] <- p1[i] + eps
        p2 <- par; p2[i] <- p2[i] - eps
        H[i, j] <- (func(p1, ...) - 2 * f0 + func(p2, ...)) / (eps^2)
      } else {
        p11 <- par; p11[i] <- p11[i] + eps; p11[j] <- p11[j] + eps
        p12 <- par; p12[i] <- p12[i] + eps; p12[j] <- p12[j] - eps
        p21 <- par; p21[i] <- p21[i] - eps; p21[j] <- p21[j] + eps
        p22 <- par; p22[i] <- p22[i] - eps; p22[j] <- p22[j] - eps
        H[i, j] <- (func(p11, ...) - func(p12, ...) - func(p21, ...) + func(p22, ...)) / (4 * eps^2)
      }
    }
  }
  return((H + t(H)) / 2)
}

# Helper: Solve Quantile function given CDF function via uniroot
.solve_quantile <- function(cdf_fn, p, par, lower_bound = 1e-7, upper_bound = 1e5) {
  if (p <= 0) return(lower_bound)
  if (p >= 1) return(upper_bound)
  target_fn <- function(x) cdf_fn(x, par) - p
  
  ub <- upper_bound
  val_ub <- suppressWarnings(target_fn(ub))
  count <- 0
  while ((is.na(val_ub) || val_ub < 0) && count < 20) {
    ub <- ub * 5
    val_ub <- suppressWarnings(target_fn(ub))
    count <- count + 1
  }
  
  lb <- lower_bound
  val_lb <- suppressWarnings(target_fn(lb))
  count <- 0
  while ((is.na(val_lb) || val_lb > 0) && count < 20) {
    lb <- lb / 5
    val_lb <- suppressWarnings(target_fn(lb))
    count <- count + 1
  }
  
  if (is.na(val_lb) || is.na(val_ub) || val_lb * val_ub > 0) {
    grid <- seq(lb, ub, length.out = 1000)
    vals <- sapply(grid, function(gx) suppressWarnings(target_fn(gx)))
    vals[is.na(vals)] <- 1e6
    idx <- which.min(abs(vals))
    return(grid[idx])
  }
  
  res <- stats::uniroot(target_fn, interval = c(lb, ub), extendInt = "yes")
  return(res$root)
}

# Helper: Unified Optimizer for NR, BFGS, BFGSR, BHHH, SANN, CG, NM
.fit_optimizer <- function(loglik_fn, ind_loglik_fn, start, method, lower_par = NULL, upper_par = NULL, max_iter = 500, ...) {
  method_upper <- toupper(method)
  p_len <- length(start)
  
  fn_min <- function(p) {
    val <- suppressWarnings(loglik_fn(p))
    if (!is.finite(val) || is.nan(val) || is.na(val)) return(1e12)
    return(-val)
  }
  
  opt_res <- list(par = start, value = fn_min(start), counts = c(0, 0), convergence = 1, message = "Not run")
  
  if (method_upper %in% c("BFGS", "BFGSR")) {
    if (!is.null(lower_par) && !is.null(upper_par)) {
      opt_res <- stats::optim(par = start, fn = fn_min, method = "L-BFGS-B", lower = lower_par, upper = upper_par, control = list(maxit = max_iter), ...)
    } else {
      opt_res <- stats::optim(par = start, fn = fn_min, method = "BFGS", control = list(maxit = max_iter), ...)
    }
  } else if (method_upper == "CG") {
    opt_res <- stats::optim(par = start, fn = fn_min, method = "CG", control = list(maxit = max_iter), ...)
  } else if (method_upper == "SANN") {
    opt_res <- stats::optim(par = start, fn = fn_min, method = "SANN", control = list(maxit = max_iter), ...)
  } else if (method_upper == "NM") {
    if (p_len == 1) {
      # Nelder-Mead on 1D functions generates R warning, use BFGS fallback cleanly for 1D
      opt_res <- stats::optim(par = start, fn = fn_min, method = "BFGS", control = list(maxit = max_iter), ...)
    } else {
      opt_res <- stats::optim(par = start, fn = fn_min, method = "Nelder-Mead", control = list(maxit = max_iter), ...)
    }
  } else if (method_upper == "NR") {
    curr_par <- start
    iter <- 0
    conv <- 1
    while (iter < max_iter) {
      iter <- iter + 1
      g <- .num_grad(loglik_fn, curr_par)
      H <- .num_hessian(loglik_fn, curr_par)
      
      eig <- tryCatch(eigen(H, symmetric = TRUE), error = function(e) NULL)
      if (is.null(eig) || any(is.na(eig$values))) break
      
      if (any(eig$values >= 0)) {
        H <- H - diag(max(eig$values) + 1e-4, p_len)
      }
      
      step <- tryCatch(solve(H, g), error = function(e) NULL)
      if (is.null(step) || any(is.na(step))) break
      
      new_par <- curr_par - step
      if (!is.null(lower_par)) new_par <- pmax(new_par, lower_par + 1e-6)
      if (!is.null(upper_par)) new_par <- pmin(new_par, upper_par - 1e-6)
      
      if (max(abs(new_par - curr_par)) < 1e-6) {
        conv <- 0
        curr_par <- new_par
        break
      }
      curr_par <- new_par
    }
    opt_res <- list(par = curr_par, value = fn_min(curr_par), counts = c(iter, iter), convergence = conv, message = if(conv==0) "NR Converged" else "NR Max Iter")
  } else if (method_upper == "BHHH") {
    curr_par <- start
    iter <- 0
    conv <- 1
    while (iter < max_iter) {
      iter <- iter + 1
      ind_g <- matrix(0, nrow = length(ind_loglik_fn(curr_par)), ncol = p_len)
      for (k in seq_len(p_len)) {
        p1 <- curr_par; p1[k] <- p1[k] + 1e-6
        p2 <- curr_par; p2[k] <- p2[k] - 1e-6
        ind_g[, k] <- (suppressWarnings(ind_loglik_fn(p1)) - suppressWarnings(ind_loglik_fn(p2))) / 2e-6
      }
      ind_g[is.na(ind_g) | is.nan(ind_g)] <- 0
      
      B_mat <- t(ind_g) %*% ind_g
      total_g <- colSums(ind_g)
      
      step <- tryCatch(solve(B_mat + diag(1e-5, p_len), total_g), error = function(e) NULL)
      if (is.null(step) || any(is.na(step))) break
      
      new_par <- curr_par + step
      if (!is.null(lower_par)) new_par <- pmax(new_par, lower_par + 1e-6)
      if (!is.null(upper_par)) new_par <- pmin(new_par, upper_par - 1e-6)
      
      if (max(abs(new_par - curr_par)) < 1e-6) {
        conv <- 0
        curr_par <- new_par
        break
      }
      curr_par <- new_par
    }
    opt_res <- list(par = curr_par, value = fn_min(curr_par), counts = c(iter, iter), convergence = conv, message = if(conv==0) "BHHH Converged" else "BHHH Max Iter")
  } else {
    stop(paste("Unsupported optimization method:", method))
  }
  
  if (is.null(names(opt_res$par)) && !is.null(names(start))) {
    names(opt_res$par) <- names(start)
  }
  
  hess <- .num_hessian(loglik_fn, opt_res$par)
  vcov_mat <- tryCatch(solve(-hess), error = function(e) matrix(NA_real_, p_len, p_len))
  if (any(is.na(vcov_mat)) || any(diag(vcov_mat) <= 0)) {
    vcov_mat <- diag(abs(opt_res$par) * 0.05 + 1e-4, p_len)
  }
  se <- sqrt(pmax(diag(vcov_mat), 1e-8))
  if (!is.null(names(start))) {
    rownames(vcov_mat) <- colnames(vcov_mat) <- names(start)
    names(se) <- names(start)
  }
  
  return(list(
    par = opt_res$par,
    value = -opt_res$value,
    counts = opt_res$counts,
    convergence = opt_res$convergence,
    message = opt_res$message,
    hessian = hess,
    vcov = vcov_mat,
    stdEr = se
  ))
}
