#' Safe Numerical Integration Helper
#'
#' Evaluates definite integral of a 1D function safely with error handling and fallback bounds.
#'
#' @param f Function to integrate.
#' @param lower Lower limit of integration.
#' @param upper Upper limit of integration.
#' @param ... Additional arguments passed to \code{f}.
#' @return Numeric scalar representing the integral value.
#' @keywords internal
safe_integrate <- function(f, lower, upper, ...) {
  if (is.na(lower) || is.na(upper)) return(0)
  if (lower >= upper) return(0)
  
  res <- tryCatch({
    stats::integrate(f, lower = lower, upper = upper, ..., stop.on.error = FALSE)$value
  }, error = function(e) {
    # Fallback to Simpson's / trapezoidal rule approximation
    n_pts <- 200
    xs <- seq(lower, upper, length.out = n_pts)
    fs <- sapply(xs, function(val) {
      v <- tryCatch(f(val, ...), error = function(err) NA_real_)
      if (is.na(v) || !is.finite(v)) 0 else v
    })
    dx <- (upper - lower) / (n_pts - 1)
    sum(fs[-1] + fs[-length(fs)]) * dx / 2
  })
  
  if (is.na(res) || !is.finite(res)) return(0)
  res
}

#' Safe Root Finder Helper
#'
#' Solves 1D non-linear equation f(x) = 0 safely within given interval.
#'
#' @param f Objective function.
#' @param interval Numeric vector of length 2 defining search range.
#' @param ... Additional arguments passed to \code{f}.
#' @return Numeric scalar solution.
#' @keywords internal
safe_uniroot <- function(f, interval, ...) {
  if (length(interval) != 2 || interval[1] >= interval[2]) {
    return(mean(interval))
  }
  
  f_l <- tryCatch(f(interval[1], ...), error = function(e) NA_real_)
  f_u <- tryCatch(f(interval[2], ...), error = function(e) NA_real_)
  
  if (is.na(f_l) || is.na(f_u) || !is.finite(f_l) || !is.finite(f_u)) {
    return(mean(interval))
  }
  
  if (f_l * f_u > 0) {
    # Expand interval slightly
    span <- interval[2] - interval[1]
    interval[1] <- interval[1] - span
    interval[2] <- interval[2] + span
  }
  
  res <- tryCatch({
    stats::uniroot(f, interval = interval, ..., extendInt = "yes")$root
  }, error = function(e) {
    mean(interval)
  })
  
  if (is.na(res) || !is.finite(res)) return(mean(interval))
  res
}

#' Define a Process Distribution
#'
#' Constructor to define a probability distribution for process capability analysis.
#' 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 numerically derived.
#'
#' @param name Character string naming the distribution.
#' @param pdf Function representing the probability density function (PDF/PMF) \code{function(x, ...)}.
#' @param cdf Function representing the cumulative distribution function (CDF) \code{function(x, ...)}.
#' @param sf Function representing the survival function (SF = 1 - CDF) \code{function(x, ...)}.
#' @param quantile Function representing the quantile function \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 support (default \code{c(-Inf, Inf)}).
#' @return An object of class \code{gpci_dist}.
#' @export
#' @examples
#' dist_norm <- define_distribution(
#'   name = "Normal",
#'   pdf = function(x, mean = 0, sd = 1) dnorm(x, mean, sd),
#'   cdf = function(x, mean = 0, sd = 1) pnorm(x, mean, sd),
#'   params = list(mean = 0, sd = 1),
#'   support = c(-Inf, Inf)
#' )
define_distribution <- 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].")
  }
  
  if (is.null(cdf) && !is.null(sf)) {
    cdf <- function(x, ...) 1 - sf(x, ...)
  }
  
  derived_sf <- sf
  if (is.null(derived_sf) && !is.null(cdf)) {
    derived_sf <- function(x, ...) 1 - cdf(x, ...)
  }
  
  derived_pdf <- pdf
  derived_cdf <- cdf
  derived_quantile <- quantile
  
  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(function(v) pdf(v, ...), lower = support[1], upper = val)
      })
    }
  }
  
  if (is.null(derived_quantile) && !is.null(derived_cdf)) {
    derived_quantile <- function(p, ...) {
      sapply(p, function(prob) {
        if (prob <= 0) return(if (is.finite(support[1])) support[1] else -1e5)
        if (prob >= 1) return(if (is.finite(support[2])) support[2] else 1e5)
        safe_uniroot(function(v) derived_cdf(v, ...) - prob, interval = c(-1e4, 1e4))
      })
    }
  }
  
  if (is.null(derived_pdf) && !is.null(derived_cdf)) {
    derived_pdf <- function(x, ...) {
      eps <- 1e-5
      sapply(x, function(val) {
        (derived_cdf(val + eps, ...) - derived_cdf(val - eps, ...)) / (2 * eps)
      })
    }
  }
  
  structure(
    list(
      name = name,
      pdf = derived_pdf,
      cdf = derived_cdf,
      sf = derived_sf,
      quantile = derived_quantile,
      params = params,
      support = support
    ),
    class = "gpci_dist"
  )
}

#' Standard Pre-defined Normal Distribution
#'
#' @param mean Distribution mean (default is 0).
#' @param sd Distribution standard deviation (default is 1).
#' @return A \code{gpci_dist} object.
#' @export
#' @examples
#' d_norm <- dist_normal(mean = 10, sd = 2)
dist_normal <- function(mean = 0, sd = 1) {
  define_distribution(
    name = "Normal",
    pdf = function(x, mean = 0, sd = 1) stats::dnorm(x, mean = mean, sd = sd),
    cdf = function(x, mean = 0, sd = 1) stats::pnorm(x, mean = mean, sd = sd),
    sf = function(x, mean = 0, sd = 1) stats::pnorm(x, mean = mean, sd = sd, lower.tail = FALSE),
    quantile = function(p, mean = 0, sd = 1) stats::qnorm(p, mean = mean, sd = sd),
    params = list(mean = mean, sd = sd),
    support = c(-Inf, Inf)
  )
}

#' Standard Pre-defined Exponential Distribution
#'
#' @param rate Rate parameter (default is 1).
#' @return A \code{gpci_dist} object.
#' @export
#' @examples
#' d_exp <- dist_exponential(rate = 0.5)
dist_exponential <- function(rate = 1) {
  define_distribution(
    name = "Exponential",
    pdf = function(x, rate = 1) stats::dexp(x, rate = rate),
    cdf = function(x, rate = 1) stats::pexp(x, rate = rate),
    sf = function(x, rate = 1) stats::pexp(x, rate = rate, lower.tail = FALSE),
    quantile = function(p, rate = 1) stats::qexp(p, rate = rate),
    params = list(rate = rate),
    support = c(0, Inf)
  )
}

#' Standard Pre-defined Weibull Distribution
#'
#' @param shape Shape parameter (default is 1).
#' @param scale Scale parameter (default is 1).
#' @return A \code{gpci_dist} object.
#' @export
#' @examples
#' d_weib <- dist_weibull(shape = 2, scale = 5)
dist_weibull <- function(shape = 1, scale = 1) {
  define_distribution(
    name = "Weibull",
    pdf = function(x, shape = 1, scale = 1) stats::dweibull(x, shape = shape, scale = scale),
    cdf = function(x, shape = 1, scale = 1) stats::pweibull(x, shape = shape, scale = scale),
    sf = function(x, shape = 1, scale = 1) stats::pweibull(x, shape = shape, scale = scale, lower.tail = FALSE),
    quantile = function(p, shape = 1, scale = 1) stats::qweibull(p, shape = shape, scale = scale),
    params = list(shape = shape, scale = scale),
    support = c(0, Inf)
  )
}

#' Standard Pre-defined Gamma Distribution
#'
#' @param shape Shape parameter (default is 1).
#' @param rate Rate parameter (default is 1).
#' @return A \code{gpci_dist} object.
#' @export
#' @examples
#' d_gam <- dist_gamma(shape = 2, rate = 1)
dist_gamma <- function(shape = 1, rate = 1) {
  define_distribution(
    name = "Gamma",
    pdf = function(x, shape = 1, rate = 1) stats::dgamma(x, shape = shape, rate = rate),
    cdf = function(x, shape = 1, rate = 1) stats::pgamma(x, shape = shape, rate = rate),
    sf = function(x, shape = 1, rate = 1) stats::pgamma(x, shape = shape, rate = rate, lower.tail = FALSE),
    quantile = function(p, shape = 1, rate = 1) stats::qgamma(p, shape = shape, rate = rate),
    params = list(shape = shape, rate = rate),
    support = c(0, Inf)
  )
}

#' Pre-defined Logistic-Exponential Distribution
#'
#' @param alpha Scale/shape parameter (default is 1).
#' @param lambda Scale/shape parameter (default is 1).
#' @return A \code{gpci_dist} object.
#' @export
#' @examples
#' d_le <- dist_logistic_exponential(alpha = 1, lambda = 1)
dist_logistic_exponential <- function(alpha = 1, lambda = 1) {
  pdf_le <- function(x, alpha = 1, lambda = 1) {
    ifelse(x <= 0, 0, (alpha * lambda * exp(lambda * x) * (exp(lambda * x) - 1)^(alpha - 1)) /
             (1 + (exp(lambda * x) - 1)^alpha)^2)
  }
  cdf_le <- function(x, alpha = 1, lambda = 1) {
    ifelse(x <= 0, 0, ((exp(lambda * x) - 1)^alpha) / (1 + (exp(lambda * x) - 1)^alpha))
  }
  sf_le <- function(x, alpha = 1, lambda = 1) {
    ifelse(x <= 0, 1, 1 / (1 + (exp(lambda * x) - 1)^alpha))
  }
  q_le <- function(p, alpha = 1, lambda = 1) {
    p <- pmax(1e-10, pmin(1 - 1e-10, p))
    (1 / lambda) * log(1 + (p / (1 - p))^(1 / alpha))
  }
  
  define_distribution(
    name = "Logistic-Exponential",
    pdf = pdf_le,
    cdf = cdf_le,
    sf = sf_le,
    quantile = q_le,
    params = list(alpha = alpha, lambda = lambda),
    support = c(0, Inf)
  )
}

#' Theoretical Moments Computation for Process Distribution
#'
#' Computes numerical or analytical mean and variance for a \code{gpci_dist} object.
#'
#' @param distribution A \code{gpci_dist} distribution object.
#' @return A list with \code{mean} and \code{var}.
#' @export
#' @examples
#' compute_theoretical_moments(dist_normal(mean = 5, sd = 2))
compute_theoretical_moments <- function(distribution) {
  params <- distribution$params
  name <- distribution$name
  
  if (name == "Normal") {
    return(list(mean = params$mean, var = params$sd^2))
  } else if (name == "Exponential") {
    return(list(mean = 1 / params$rate, var = 1 / params$rate^2))
  } else if (name == "Gamma") {
    return(list(mean = params$shape / params$rate, var = params$shape / params$rate^2))
  } else if (name == "Weibull") {
    m <- params$scale * gamma(1 + 1 / params$shape)
    v <- params$scale^2 * (gamma(1 + 2 / params$shape) - (gamma(1 + 1 / params$shape))^2)
    return(list(mean = m, var = v))
  }
  
  # Numerical fallback integration
  pdf_fn <- function(x) do.call(distribution$pdf, c(list(x), params))
  l <- if (is.finite(distribution$support[1])) distribution$support[1] else -1e3
  u <- if (is.finite(distribution$support[2])) distribution$support[2] else 1e3
  
  m <- safe_integrate(function(x) x * pdf_fn(x), lower = l, upper = u)
  ex2 <- safe_integrate(function(x) (x^2) * pdf_fn(x), lower = l, upper = u)
  v <- max(1e-8, ex2 - m^2)
  
  list(mean = m, var = v)
}
