#' Define a Process Distribution for Interval-Censored Data
#'
#' Constructor to define a probability distribution for process capability analysis
#' under interval-censored data. The distribution can be defined by specifying any one
#' (or more) of its PDF/PMF, CDF, Survival Function (SF), or quantile function.
#' Missing functions are derived numerically.
#'
#' @param name Character string naming the distribution.
#' @param pdf Function representing the probability density function (PDF/PMF). Must be of the form \code{function(x, ...)}.
#' @param cdf Function representing the cumulative distribution function (CDF). Must be of the form \code{function(x, ...)}.
#' @param sf Function representing the survival function (SF = 1 - CDF). Must be of the form \code{function(x, ...)}.
#' @param quantile Function representing the quantile function. Must be of the form \code{function(p, ...)}.
#' @param params Named list of parameters for the distribution.
#' @param support Vector of length 2 defining the lower and upper bounds of the support of the distribution (default is \code{c(-Inf, Inf)}).
#' @return An object of class \code{gpci_dist_censor} representing the completed distribution.
#' @export
#' @examples
#' # Define custom Weibull distribution using only the survival function
#' custom_weib <- define_distribution_censor(
#'   name = "custom_weibull",
#'   sf = function(x, shape, scale) pweibull(x, shape, scale, lower.tail = FALSE),
#'   params = list(shape = 2, scale = 10),
#'   support = c(0, Inf)
#' )
define_distribution_censor <- function(name, pdf = NULL, cdf = NULL, sf = NULL, quantile = NULL, params = list(), support = c(-Inf, Inf)) {
  if (is.null(pdf) && is.null(cdf) && is.null(sf) && is.null(quantile)) {
    stop("At least one of 'pdf', 'cdf', 'sf', or 'quantile' function must be supplied.")
  }
  
  if (length(support) != 2 || support[1] >= support[2]) {
    stop("Invalid support limits. Must be a numeric vector of length 2 where support[1] < support[2].")
  }
  
  # Derive CDF from SF if CDF is missing
  if (is.null(cdf) && !is.null(sf)) {
    cdf <- function(x, ...) {
      1 - sf(x, ...)
    }
  }
  
  # Derive SF from CDF if SF is missing
  derived_sf <- sf
  if (is.null(derived_sf) && !is.null(cdf)) {
    derived_sf <- function(x, ...) {
      1 - cdf(x, ...)
    }
  }
  
  # Helper to find bracket for root-finding when support is infinite
  find_bracket <- function(cdf_fn, p, support_limits, ...) {
    lower <- support_limits[1]
    upper <- support_limits[2]
    if (is.na(lower) || is.infinite(lower)) lower <- -10
    if (is.na(upper) || is.infinite(upper)) upper <- 10
    
    iter <- 0
    while (iter < 30) {
      val_l <- tryCatch(do.call(cdf_fn, c(list(lower), list(...))), error = function(e) NA)
      if (!is.na(val_l[1]) && is.finite(val_l[1]) && val_l[1] < p) break
      lower <- lower * 2 - 10
      iter <- iter + 1
    }
    iter <- 0
    while (iter < 30) {
      val_u <- tryCatch(do.call(cdf_fn, c(list(upper), list(...))), error = function(e) NA)
      if (!is.na(val_u[1]) && is.finite(val_u[1]) && val_u[1] > p) break
      upper <- upper * 2 + 10
      iter <- iter + 1
    }
    if (is.na(lower) || !is.finite(lower)) lower <- -1e3
    if (is.na(upper) || !is.finite(upper)) upper <- 1e3
    if (lower >= upper) {
      lower <- -1e3
      upper <- 1e3
    }
    c(lower, upper)
  }
  
  derived_pdf <- pdf
  derived_cdf <- cdf
  derived_quantile <- quantile
  
  # Case A: PDF only is supplied
  if (!is.null(pdf) && is.null(cdf) && is.null(quantile)) {
    derived_cdf <- function(x, ...) {
      sapply(x, function(val) {
        if (val <= support[1]) return(0)
        if (val >= support[2]) return(1)
        safe_integrate_censor(function(v) pdf(v, ...), lower = support[1], upper = val)
      })
    }
    derived_quantile <- function(p, ...) {
      sapply(p, function(prob) {
        if (prob <= 0) return(support[1])
        if (prob >= 1) return(support[2])
        brac <- find_bracket(derived_cdf, prob, support, ...)
        safe_uniroot_censor(function(v) derived_cdf(v, ...) - prob, interval = brac)
      })
    }
  }
  
  # Case B: CDF only is supplied
  else if (is.null(pdf) && !is.null(cdf) && is.null(quantile)) {
    derived_pdf <- function(x, ...) {
      sapply(x, function(val) {
        if (val < support[1] || val > support[2]) return(0)
        max(0, safe_deriv_censor(function(v) cdf(v, ...), val))
      })
    }
    derived_quantile <- function(p, ...) {
      sapply(p, function(prob) {
        if (prob <= 0) return(support[1])
        if (prob >= 1) return(support[2])
        brac <- find_bracket(cdf, prob, support, ...)
        safe_uniroot_censor(function(v) cdf(v, ...) - prob, interval = brac)
      })
    }
  }
  
  # Case C: Quantile only is supplied
  else if (is.null(pdf) && is.null(cdf) && !is.null(quantile)) {
    derived_cdf <- function(x, ...) {
      sapply(x, function(val) {
        if (val <= support[1]) return(0)
        if (val >= support[2]) return(1)
        safe_uniroot_censor(function(p) quantile(p, ...) - val, interval = c(1e-9, 1 - 1e-9))
      })
    }
    derived_pdf <- function(x, ...) {
      sapply(x, function(val) {
        if (val < support[1] || val > support[2]) return(0)
        p <- derived_cdf(val, ...)
        if (p <= 1e-3 || p >= 1 - 1e-3) {
          return(max(0, safe_deriv_censor(function(v) derived_cdf(v, ...), val)))
        }
        dq <- safe_deriv_censor(function(prob) {
          prob_clamped <- max(1e-12, min(1 - 1e-12, prob))
          quantile(prob_clamped, ...)
        }, p)
        if (is.finite(dq) && dq > 1e-12) {
          return(1 / dq)
        } else {
          return(max(0, safe_deriv_censor(function(v) derived_cdf(v, ...), val)))
        }
      })
    }
  }
  
  # Case D: PDF and CDF supplied
  else if (!is.null(pdf) && !is.null(cdf) && is.null(quantile)) {
    derived_quantile <- function(p, ...) {
      sapply(p, function(prob) {
        if (prob <= 0) return(support[1])
        if (prob >= 1) return(support[2])
        brac <- find_bracket(cdf, prob, support, ...)
        safe_uniroot_censor(function(v) cdf(v, ...) - prob, interval = brac)
      })
    }
  }
  
  # Case E: CDF and Quantile supplied
  else if (is.null(pdf) && !is.null(cdf) && !is.null(quantile)) {
    derived_pdf <- function(x, ...) {
      sapply(x, function(val) {
        if (val < support[1] || val > support[2]) return(0)
        p <- cdf(val, ...)
        if (p <= 1e-3 || p >= 1 - 1e-3) {
          return(max(0, safe_deriv_censor(function(v) cdf(v, ...), val)))
        }
        dq <- safe_deriv_censor(function(prob) {
          prob_clamped <- max(1e-12, min(1 - 1e-12, prob))
          quantile(prob_clamped, ...)
        }, p)
        if (is.finite(dq) && dq > 1e-12) {
          return(1 / dq)
        } else {
          return(max(0, safe_deriv_censor(function(v) cdf(v, ...), val)))
        }
      })
    }
  }
  
  # Case F: PDF and Quantile supplied
  else if (!is.null(pdf) && is.null(cdf) && !is.null(quantile)) {
    derived_cdf <- function(x, ...) {
      sapply(x, function(val) {
        if (val <= support[1]) return(0)
        if (val >= support[2]) return(1)
        safe_uniroot_censor(function(p) quantile(p, ...) - val, interval = c(1e-9, 1 - 1e-9))
      })
    }
  }
  
  if (is.null(derived_sf)) {
    derived_sf <- function(x, ...) {
      1 - derived_cdf(x, ...)
    }
  }
  
  structure(
    list(
      name = name,
      pdf = derived_pdf,
      cdf = derived_cdf,
      sf = derived_sf,
      quantile = derived_quantile,
      params = params,
      support = support
    ),
    class = "gpci_dist_censor"
  )
}

#' @rdname define_distribution_censor
#' @export
gpci_dist_censor <- define_distribution_censor

# --- Built-in Distribution Constructors ---

#' Built-in Process Distributions for Interval-Censored Analysis
#'
#' Convenience constructors for standard process probability distributions.
#'
#' @param mean,sd Mean and standard deviation parameters for normal distribution.
#' @param meanlog,sdlog Mean and standard deviation of the distribution on the log scale.
#' @param shape,scale Shape and scale parameters.
#' @param shape1,shape2 Non-negative parameters of the Beta distribution.
#' @name builtin_dist
NULL

#' @rdname builtin_dist
#' @export
dist_normal <- function(mean = 0, sd = 1) {
  define_distribution_censor(
    name = "normal",
    pdf = function(x, mean, sd) stats::dnorm(x, mean, sd),
    cdf = function(x, mean, sd) stats::pnorm(x, mean, sd),
    sf = function(x, mean, sd) stats::pnorm(x, mean, sd, lower.tail = FALSE),
    quantile = function(p, mean, sd) stats::qnorm(p, mean, sd),
    params = list(mean = mean, sd = sd),
    support = c(-Inf, Inf)
  )
}

#' @rdname builtin_dist
#' @export
dist_lognormal <- function(meanlog = 0, sdlog = 1) {
  define_distribution_censor(
    name = "lognormal",
    pdf = function(x, meanlog, sdlog) stats::dlnorm(x, meanlog, sdlog),
    cdf = function(x, meanlog, sdlog) stats::plnorm(x, meanlog, sdlog),
    sf = function(x, meanlog, sdlog) stats::plnorm(x, meanlog, sdlog, lower.tail = FALSE),
    quantile = function(p, meanlog, sdlog) stats::qlnorm(p, meanlog, sdlog),
    params = list(meanlog = meanlog, sdlog = sdlog),
    support = c(0, Inf)
  )
}

#' @rdname builtin_dist
#' @export
dist_gamma <- function(shape = 1, scale = 1) {
  define_distribution_censor(
    name = "gamma",
    pdf = function(x, shape, scale) stats::dgamma(x, shape = shape, scale = scale),
    cdf = function(x, shape, scale) stats::pgamma(x, shape = shape, scale = scale),
    sf = function(x, shape, scale) stats::pgamma(x, shape = shape, scale = scale, lower.tail = FALSE),
    quantile = function(p, shape, scale) stats::qgamma(p, shape = shape, scale = scale),
    params = list(shape = shape, scale = scale),
    support = c(0, Inf)
  )
}

#' @rdname builtin_dist
#' @export
dist_weibull <- function(shape = 1, scale = 1) {
  define_distribution_censor(
    name = "weibull",
    pdf = function(x, shape, scale) stats::dweibull(x, shape = shape, scale = scale),
    cdf = function(x, shape, scale) stats::pweibull(x, shape = shape, scale = scale),
    sf = function(x, shape, scale) stats::pweibull(x, shape = shape, scale = scale, lower.tail = FALSE),
    quantile = function(p, shape, scale) stats::qweibull(p, shape = shape, scale = scale),
    params = list(shape = shape, scale = scale),
    support = c(0, Inf)
  )
}

#' @rdname builtin_dist
#' @export
dist_beta <- function(shape1 = 1, shape2 = 1) {
  define_distribution_censor(
    name = "beta",
    pdf = function(x, shape1, shape2) stats::dbeta(x, shape1, shape2),
    cdf = function(x, shape1, shape2) stats::pbeta(x, shape1, shape2),
    sf = function(x, shape1, shape2) stats::pbeta(x, shape1, shape2, lower.tail = FALSE),
    quantile = function(p, shape1, shape2) stats::qbeta(p, shape1, shape2),
    params = list(shape1 = shape1, shape2 = shape2),
    support = c(0, 1)
  )
}

#' @rdname builtin_dist
#' @export
dist_logistic_exponential <- function(shape = 1, scale = 1) {
  define_distribution_censor(
    name = "logistic_exponential",
    pdf = function(x, shape, scale) {
      ex <- exp(scale * x)
      num <- shape * scale * ex * (ex - 1)^(shape - 1)
      den <- (1 + (ex - 1)^shape)^2
      res <- num / den
      res[is.nan(res) | !is.finite(res)] <- 0
      res
    },
    cdf = function(x, shape, scale) {
      ex <- exp(scale * x)
      1 - 1 / (1 + (ex - 1)^shape)
    },
    sf = function(x, shape, scale) {
      ex <- exp(scale * x)
      1 / (1 + (ex - 1)^shape)
    },
    quantile = function(p, shape, scale) {
      (1 / scale) * log(1 + (p / (1 - p))^(1 / shape))
    },
    params = list(shape = shape, scale = scale),
    support = c(0, Inf)
  )
}

#' Compute Theoretical Moments of an Interval-Censored Distribution
#'
#' Computes the theoretical mean and variance of a \code{gpci_dist_censor} object using numerical integration.
#'
#' @param dist A \code{gpci_dist_censor} object.
#' @return A list with \code{mean} and \code{var}.
#' @export
compute_theoretical_moments_censor <- function(dist) {
  lower <- dist$support[1]
  upper <- dist$support[2]
  
  mean_fn <- function(x) {
    pdf_val <- tryCatch(do.call(dist$pdf, c(list(x), dist$params)), error = function(e) 0)
    if (is.na(pdf_val) || !is.finite(pdf_val)) pdf_val <- 0
    x * pdf_val
  }
  
  mean_val <- tryCatch({
    safe_integrate_censor(mean_fn, lower, upper)
  }, error = function(e) NA)
  
  if (is.na(mean_val) || !is.finite(mean_val)) {
    sim <- tryCatch({
      do.call(dist$quantile, c(list(runif(5000)), dist$params))
    }, error = function(e) {
      rep(mean(unlist(dist$params)), 5000)
    })
    sim[is.na(sim) | !is.finite(sim)] <- 0
    mean_val <- mean(sim)
    var_val <- stats::var(sim)
    return(list(mean = mean_val, var = max(var_val, 1e-10)))
  }
  
  var_fn <- function(x) {
    pdf_val <- tryCatch(do.call(dist$pdf, c(list(x), dist$params)), error = function(e) 0)
    if (is.na(pdf_val) || !is.finite(pdf_val)) pdf_val <- 0
    (x - mean_val)^2 * pdf_val
  }
  
  var_val <- tryCatch({
    safe_integrate_censor(var_fn, lower, upper)
  }, error = function(e) NA)
  
  if (is.na(var_val) || !is.finite(var_val) || var_val < 0) {
    sim <- tryCatch({
      do.call(dist$quantile, c(list(runif(5000)), dist$params))
    }, error = function(e) {
      rep(mean(unlist(dist$params)), 5000)
    })
    sim[is.na(sim) | !is.finite(sim)] <- 0
    var_val <- stats::var(sim)
  }
  
  var_val <- max(var_val, 1e-10)
  list(mean = mean_val, var = var_val)
}
