#' Fit Distribution Parameters under Interval-Censored Data
#'
#' Fits the parameters of a \code{gpci_dist_censor} distribution to interval-censored data
#' using Maximum Likelihood Estimation (MLE) via the MleCensoR package.
#'
#' @param data_left Numeric vector of left interval bounds for interval-censored data.
#' @param data_right Numeric vector of right interval bounds for interval-censored data.
#'   For exact observations, data_left = data_right.
#' @param dist A \code{gpci_dist_censor} distribution object with initial parameters.
#' @param start Optional named list of starting parameter values.
#' @return A new \code{gpci_dist_censor} object containing fitted parameters and variance-covariance attribute \code{"vcov"}.
#' @export
#' @examples
#' \dontrun{
#' dist_norm <- dist_normal()
#' left <- c(9.5, 10.2, 8.8, 11.1, 9.9)
#' right <- c(10.5, 11.2, 9.8, 12.1, 10.9)
#' fit <- fit_distribution_censor(left, right, dist_norm)
#' }
fit_distribution_censor <- function(data_left, data_right, dist, start = NULL) {
  if (!inherits(dist, "gpci_dist_censor")) {
    stop("dist must be of class 'gpci_dist_censor'")
  }
  
  if (length(data_left) != length(data_right)) {
    stop("data_left and data_right must have the same length")
  }
  
  if (is.null(start)) {
    start <- dist$params
  }
  
  if (length(start) == 0) {
    return(dist)
  }
  
  start_vec <- unlist(start)
  param_names <- names(start)
  
  # Prepare wrapper functions for MleCensoR::mle_interval
  pdf_wrapper <- function(x, theta) {
    names(theta) <- param_names
    par_list <- as.list(theta)
    vals <- tryCatch(do.call(dist$pdf, c(list(x), par_list)), error = function(e) rep(0, length(x)))
    vals[is.na(vals) | !is.finite(vals)] <- 0
    vals
  }
  
  cdf_wrapper <- function(x, theta) {
    names(theta) <- param_names
    par_list <- as.list(theta)
    vals <- tryCatch(do.call(dist$cdf, c(list(x), par_list)), error = function(e) rep(0, length(x)))
    vals[is.na(vals) | !is.finite(vals)] <- 0
    vals
  }
  
  surv_wrapper <- function(x, theta) {
    names(theta) <- param_names
    par_list <- as.list(theta)
    vals <- tryCatch(do.call(dist$sf, c(list(x), par_list)), error = function(e) rep(0, length(x)))
    vals[is.na(vals) | !is.finite(vals)] <- 0
    vals
  }
  
  # Primary estimation via MleCensoR::mle_interval
  mle_fit <- tryCatch({
    MleCensoR::mle_interval(
      l = data_left,
      r = data_right,
      pdf = pdf_wrapper,
      cdf = cdf_wrapper,
      surv = surv_wrapper,
      start = start_vec
    )
  }, error = function(e) {
    NULL
  })
  
  fitted_params <- NULL
  vcov_mat <- NULL
  conv_code <- 0
  
  if (!is.null(mle_fit) && !is.null(mle_fit$estimate) && all(is.finite(mle_fit$estimate))) {
    fitted_vec <- mle_fit$estimate
    names(fitted_vec) <- param_names
    fitted_params <- as.list(fitted_vec)
    
    if (!is.null(mle_fit$hessian) && is.matrix(mle_fit$hessian) && all(is.finite(mle_fit$hessian))) {
      vcov_mat <- tryCatch(solve(-mle_fit$hessian), error = function(e) NULL)
    }
  }
  
  # Fallback to internal robust MLE optimization if MleCensoR did not return valid estimates
  if (is.null(fitted_params)) {
    neg_log_lik <- function(par) {
      names(par) <- param_names
      par_list <- as.list(par)
      
      if (any(names(par) %in% c("sd", "scale", "shape", "shape1", "shape2", "sdlog") & par <= 0)) {
        return(1e10)
      }
      if (any(is.na(par) | !is.finite(par))) {
        return(1e10)
      }
      
      log_lik <- 0
      for (i in seq_along(data_left)) {
        L <- data_left[i]
        R <- data_right[i]
        
        if (is.na(L) || is.na(R) || !is.finite(L) || !is.finite(R)) return(1e10)
        
        if (L == R) {
          pdf_val <- tryCatch(do.call(dist$pdf, c(list(L), par_list)), error = function(e) 0)
          if (is.na(pdf_val) || !is.finite(pdf_val) || pdf_val <= 0) return(1e10)
          log_lik <- log_lik + log(max(pdf_val, 1e-300))
        } else {
          cdf_L <- tryCatch(do.call(dist$cdf, c(list(L), par_list)), error = function(e) 0)
          cdf_R <- tryCatch(do.call(dist$cdf, c(list(R), par_list)), error = function(e) 1)
          if (is.na(cdf_L) || !is.finite(cdf_L)) cdf_L <- 0
          if (is.na(cdf_R) || !is.finite(cdf_R)) cdf_R <- 1
          prob <- cdf_R - cdf_L
          if (is.na(prob) || !is.finite(prob) || prob <= 0) return(1e10)
          log_lik <- log_lik + log(max(prob, 1e-300))
        }
      }
      -log_lik
    }
    
    opt <- tryCatch({
      stats::optim(par = start_vec, fn = neg_log_lik, method = "Nelder-Mead", hessian = TRUE, control = list(maxit = 1000))
    }, error = function(e) {
      tryCatch({
        stats::optim(par = start_vec, fn = neg_log_lik, method = "BFGS", hessian = TRUE, control = list(maxit = 1000))
      }, error = function(e2) {
        res_nl <- stats::nlminb(start = start_vec, objective = neg_log_lik)
        hess <- tryCatch(numDeriv::hessian(neg_log_lik, res_nl$par), error = function(e3) diag(length(start_vec)))
        list(par = res_nl$par, hessian = hess, convergence = res_nl$convergence)
      })
    })
    
    fitted_params <- as.list(opt$par)
    names(fitted_params) <- param_names
    conv_code <- opt$convergence
    
    if (is.null(vcov_mat)) {
      vcov_mat <- tryCatch({
        solve(opt$hessian)
      }, error = function(e) {
        matrix(0, nrow = length(start), ncol = length(start), dimnames = list(param_names, param_names))
      })
    }
  }
  
  # Ensure fitted parameters are valid and positive where required
  for (pname in names(fitted_params)) {
    if (is.na(fitted_params[[pname]]) || !is.finite(fitted_params[[pname]])) {
      fitted_params[[pname]] <- start[[pname]]
    }
    if (pname %in% c("sd", "scale", "shape", "shape1", "shape2", "sdlog")) {
      fitted_params[[pname]] <- max(fitted_params[[pname]], 1e-6)
    }
  }
  
  if (is.null(vcov_mat) || any(is.na(vcov_mat)) || any(!is.finite(vcov_mat))) {
    vcov_mat <- matrix(0, nrow = length(start), ncol = length(start), dimnames = list(param_names, param_names))
  }
  
  res_dist <- define_distribution_censor(
    name = dist$name,
    pdf = dist$pdf,
    cdf = dist$cdf,
    sf = dist$sf,
    quantile = dist$quantile,
    params = fitted_params,
    support = dist$support
  )
  
  attr(res_dist, "vcov") <- vcov_mat
  attr(res_dist, "convergence") <- conv_code
  attr(res_dist, "data_left") <- data_left
  attr(res_dist, "data_right") <- data_right
  
  return(res_dist)
}

#' @rdname fit_distribution_censor
#' @export
gpci_fit_censor <- fit_distribution_censor
