#' Fit a Sinh-Arcsinh (shash) Regression Model for Continuous Norming
#'
#' This function fits a Sinh-Arcsinh (shash; Jones & Pewsey, 2009) regression model for continuous norm
#' score modeling, where the distribution parameters vary smoothly as polynomial functions of age or other
#' predictors. The shash distribution is well-suited for psychometric data as it can flexibly model
#' skewness and tail weight independently, making it ideal for handling floor effects, ceiling effects,
#' and varying degrees of individual differences across age groups. In a simulation study (Lenhard et
#' al, 2019), the shash model demonstrated superior performance compared to other parametric approaches
#' from the Box Cox family of functions. In contrast to Box Cox, Sinh-Arcsinh can model distributions
#' including zero and negative values.
#'
#'
#' @param age A numeric vector of predictor values (typically age, but can be any continuous predictor).
#' @param score A numeric vector of response values (raw test scores). Must be the same length as age.
#'   The value range is unrestricted and it can include zeros and negative values.
#' @param weights An optional numeric vector of weights for each observation.
#'   Useful for incorporating sampling weights. If NULL (default), all observations are weighted equally.
#' @param mu_degree Integer specifying the degree of the polynomial for modeling the location parameter mu(age).
#'   Default is 3. Higher degrees allow more flexible modeling of how the central tendency changes with age,
#'   but may lead to overfitting with small samples. Common choices:
#'   \itemize{
#'     \item 1: Linear change with age
#'     \item 2: Quadratic change (allows one inflection point)
#'     \item 3: Cubic change (allows two inflection points, suitable for most developmental curves)
#'     \item 4+: Higher-order changes (use cautiously, mainly for large samples)
#'   }
#' @param sigma_degree Integer specifying the degree of the polynomial for modeling the scale parameter sigma(age).
#'   Default is 2. This controls how the variability (spread) of scores changes with age.
#'   Lower degrees are often sufficient as variability typically changes more smoothly than location.
#'
#' @param epsilon_degree Integer specifying the degree of the polynomial for modeling the skewness parameter epsilon(age).
#'   Default is 2. This controls how the asymmetry of the distribution changes with age.
#'
#' @param delta_degree Integer specifying the degree of the polynomial for modeling the tail weight parameter delta(age).
#'   Default is 1. The tail weight can be fixed as well in case of numerical instability. In that case, set
#'   \code{delta_degree} to NULL and specify a value for \code{delta} instead. Recommendation: Keep
#'   \code{delta_degree} low to avoid overfitting.
#'
#' @param delta Fixed tail weight parameter (must be > 0). Default is 1. This parameter controls the
#'   heaviness of the distribution tails and is kept constant across all ages when \code{delta_degree}
#'   is set to NULL. Common values:
#'   \itemize{
#'     \item delta = 1: Normal-like tail behavior (baseline)
#'     \item delta < 1: Heavier tails, higher kurtosis (more extreme scores than normal distribution)
#'     \item delta > 1: Lighter tails, lower kurtosis (fewer extreme scores than normal distribution)
#'   }
#'
#' @param control An optional list of control parameters passed to the \code{optim} function for
#'   maximum likelihood estimation. Any parameters not specified are filled with sensible defaults
#'   based on the model complexity. Common parameters to adjust:
#'   \itemize{
#'     \item \code{factr}: Controls precision of optimization (default: 1e-8)
#'     \item \code{maxit}: Maximum number of iterations (default: n_parameters * 200)
#'     \item \code{lmm}: Memory limit for L-BFGS-B (default: min(n_parameters, 20))
#'   }
#'   Increase \code{maxit} or decrease \code{factr} if optimization fails to converge.
#'
#' @param scale Character string or numeric vector specifying the type of norm scale for output.
#'   This affects the scaling of derived norm scores but does not influence model fitting:
#'   \itemize{
#'     \item "T": T-scores (mean = 50, SD = 10) - default
#'     \item "IQ": IQ-like scores (mean = 100, SD = 15)
#'     \item "z": z-scores (mean = 0, SD = 1)
#'     \item c(M, SD): Custom scale with specified mean M and standard deviation SD
#'   }
#'
#' @param plot Logical indicating whether to automatically display a diagnostic plot of the fitted model.
#'   Default is TRUE.
#'
#' @return An object of class "cnormShash" containing the fitted model results. This is a list with components:
#'   \item{mu_est}{Numeric vector of estimated coefficients for the location parameter mu(age).
#'     The first coefficient is the intercept, subsequent coefficients correspond to polynomial terms.}
#'   \item{sigma_est}{Numeric vector of estimated coefficients for the scale parameter log(sigma(age)).
#'     Note: These are coefficients for log(sigma) to ensure sigma > 0.}
#'   \item{epsilon_est}{Numeric vector of estimated coefficients for the skewness parameter epsilon(age).}
#'   \item{delta}{The fixed tail weight parameter value used in fitting (relevant if \code{delta_degree} is NULL).}
#'   \item{delta_est}{Numeric vector of estimated coefficients for log(delta(age)) -
#'      in case a degree has been set, otherwise NULL.}
#'   \item{se}{Numeric vector of standard errors for all estimated coefficients (if Hessian computation succeeds).}
#'   \item{mu_degree, sigma_degree, epsilon_degree}{The polynomial degrees used for each parameter.}
#'   \item{delta_degree}{The polynomial degree used for delta, or NULL if delta was fixed.}
#'   \item{result}{Complete output from the \code{optim} function, including convergence information,
#'     log-likelihood value, and other optimization details.}
#'
#' @details
#' This implementation uses the Jones & Pewsey (2009) parameterization of the Sinh-Arcsinh distribution.
#' Parameters are estimated using maximum likelihood via the L-BFGS-B algorithm with analytic
#' gradients. In case optimization fails, try reducing model complexity by reducing polynomial
#' degrees or fixing the delta parameter.
#'
#' \subsection{The Sinh-Arcsinh Distribution}{
#' The shash distribution is defined by the transformation:
#' \deqn{X = \mu + \sigma \cdot \sinh\left(\frac{\text{arcsinh}(Y) - \epsilon}{\delta}\right)}
#' where Y is a standard normal variable, Y ~ N(0,1).
#'
#' This transformation provides:
#' \itemize{
#'   \item mu: Location parameter (similar to mean)
#'   \item sigma: Scale parameter (similar to standard deviation)
#'   \item epsilon: Skewness parameter (epsilon = 0 for symmetry)
#'   \item delta: Tail weight parameter (delta = 1 for normal-like tails)
#' }
#' }
#'
#' \subsection{Model Selection}{
#' Choose polynomial degrees based on:
#' \itemize{
#'   \item Sample size (higher degrees need more data)
#'   \item Theoretical expectations about developmental trajectories
#'   \item Model comparison criteria (AIC, BIC)
#'   \item Visual inspection of fitted curves
#' }
#'
#' For most applications, mu_degree = 3, sigma_degree = 2, epsilon_degree = 2, delta_degree = 1 provides
#' a good balance of flexibility and parsimony.
#' }
#'
#' @note
#' \itemize{
#'   \item The function requires the input data to have sufficient variability. Very small datasets
#'     or datasets with little age spread may cause convergence problems.
#'   \item Polynomial models can exhibit edge effects at the boundaries of the age range.
#'     Predictions outside the observed age range should be made cautiously.
#'   \item If convergence fails, try: (1) reducing polynomial degrees, (2) adjusting the delta parameter,
#'     (3) providing custom control parameters, or (4) checking for data quality issues.
#'   \item If parameters end up at their box constraints, the reported standard errors and
#'     Wald tests for these parameters are not valid; a warning is issued in this case.
#' }
#'
#' @seealso
#' \code{\link{plot}} for plotting fitted models,
#' \code{\link{predict}} for generating predictions,
#' \code{\link{cnorm.betabinomial2}} for discrete beta-binomial alternative
#'
#' @examples
#' \dontrun{
#' # Basic usage with default settings
#' model <- cnorm.shash(age = children$age, score = children$raw_score)
#'
#' # Custom polynomial degrees for complex developmental pattern
#' model_complex <- cnorm.shash(
#'   age = adolescents$age,
#'   score = adolescents$vocabulary_score,
#'   mu_degree = 4,         # Complex mean trajectory
#'   sigma_degree = 3,      # Changing variability pattern
#'   epsilon_degree = 2,    # Skewness shifts
#'   delta_degree = NULL,   # set to NULL to activate fixed delta
#'   delta = 0.8            # Slightly heavy tails
#' )
#'
#' # With sampling weights
#' model_weighted <- cnorm.shash(
#'   age = survey$age,
#'   score = survey$score,
#'   weights = survey$sample_weight
#' )
#'
#' # Custom optimization control for difficult convergence
#' model_robust <- cnorm.shash(
#'   age = mixed$age,
#'   score = mixed$score,
#'   control = list(factr = 1e-6, maxit = 2000),
#'   delta = 1.5
#' )
#'
#' # Compare model fit
#' compare(model, model_complex)
#' }
#'
#' @author Wolfgang Lenhard
#' @references
#' Jones, M. C., & Pewsey, A. (2009). Sinh-arcsinh distributions. *Biometrika*, 96(4), 761-780.
#'
#' Lenhard, A., Lenhard, W., Gary, S. (2019). Continuous norming of psychometric tests: A
#' simulation study of parametric and semi-parametric approaches. *PLoS ONE*, 14(9), e0222279.
#' https://doi.org/10.1371/journal.pone.0222279
#'
#' @export
cnorm.shash <- function(age,
                        score,
                        weights = NULL,
                        mu_degree = 3,
                        sigma_degree = 2,
                        epsilon_degree = 2,
                        delta_degree = 1,
                        delta = 1,
                        control = NULL,
                        scale = "T",
                        plot = TRUE) {
  # Input validation
  if (length(age) != length(score)) {
    stop("Length of 'age' and 'score' must be the same.")
  }

  if (!is.null(weights) && length(age) != length(weights)) {
    stop("Length of 'weights' must match length of 'age' and 'score'.")
  }

  # ensure positivity of delta
  if (delta <= 0) {
    stop("Delta parameter must be positive.")
  }

  # validate 'scale' early with explicit errors. Accepts integer vectors as well.
  if (is.numeric(scale) && length(scale) == 2) {
    scaleM <- scale[1]
    scaleSD <- scale[2]
  } else if (is.character(scale) && length(scale) == 1) {
    scaleM <- switch(scale,
                     "T" = 50,
                     "IQ" = 100,
                     "z" = 0,
                     stop("Unknown scale '", scale,
                          "'. Use 'T', 'IQ', 'z', or a numeric vector c(M, SD)."))
    scaleSD <- switch(scale, "T" = 10, "IQ" = 15, "z" = 1)
  } else {
    stop("'scale' must be 'T', 'IQ', 'z', or a numeric vector c(M, SD).")
  }

  # Prepare vectors
  vectors_to_check <- list(age = age, score = score)
  if (!is.null(weights)) {
    vectors_to_check$weights <- weights
  }

  # Check if filtering needed
  needs_filtering <- any(sapply(vectors_to_check, function(x)
    any(!is.finite(x))))

  if (needs_filtering) {
    message("Vector(s) contained non-finite values (NA, NaN, Inf). These cases will be removed.")
    tmp <- do.call(filter_complete, c(vectors_to_check, verbose = FALSE))
    age <- tmp[[1]]
    score <- tmp[[2]]
    if (!is.null(weights))
      weights <- tmp[[3]]
  }

  # Standardize age
  age_std <- standardize(age)

  # Create design matrices
  X_mu <- cbind(1, poly(age_std, degree = mu_degree, raw = TRUE))
  X_sigma <- cbind(1, poly(age_std, degree = sigma_degree, raw = TRUE))
  X_epsilon <- cbind(1, poly(age_std, degree = epsilon_degree, raw = TRUE))

  # In case, delta polynomials are used as well
  if (!is.null(delta_degree)) {
    X_delta <- cbind(1, poly(age_std, degree = delta_degree, raw = TRUE))
    use_varying_delta <- TRUE
  } else {
    X_delta <- NULL
    use_varying_delta <- FALSE
  }

  # Calculate initial parameter values
  initial_mu <- mean(score)
  initial_sigma <- sd(score)
  initial_epsilon <- 0  # Start with symmetric distribution

  # Guard against degenerate input (zero/undefined variance)
  if (!is.finite(initial_sigma) || initial_sigma <= 0) {
    stop("'score' has zero or undefined variance. The model cannot be fitted.")
  }

  # Initial parameter vectors
  initial_params <- c(
    c(initial_mu, rep(0, mu_degree)),
    # mu parameters
    c(log(initial_sigma), rep(0, sigma_degree)),
    # sigma parameters
    c(initial_epsilon, rep(0, epsilon_degree))   # epsilon parameters
  )

  if (use_varying_delta) {
    initial_params <- c(initial_params, c(log(delta), rep(0, delta_degree))) # delta parameters
  }

  n_param <- length(initial_params)
  control_defaults <- list(factr = 1e-8,
                           maxit = n_param * 200,
                           lmm = min(n_param, 20))
  control <- if (is.null(control))
    control_defaults
  else
    utils::modifyList(control_defaults, control)

  # Parameter bounds
  n_params <- length(initial_params)
  lower_bounds <- rep(-Inf, n_params)
  upper_bounds <- rep(Inf, n_params)

  # Bounds for sigma parameters (keep log_sigma reasonable)
  sigma_start <- ncol(X_mu) + 1
  sigma_end <- sigma_start + ncol(X_sigma) - 1
  lower_bounds[sigma_start:sigma_end] <- -10
  upper_bounds[sigma_start:sigma_end] <- 10

  # Bounds for epsilon parameters
  epsilon_start <- sigma_end + 1
  epsilon_end   <- epsilon_start + ncol(X_epsilon) - 1
  lower_bounds[epsilon_start:epsilon_end] <- -10
  upper_bounds[epsilon_start:epsilon_end] <- 10

  if (use_varying_delta) {
    delta_start <- epsilon_end + 1
    delta_end   <- delta_start + ncol(X_delta) - 1
    lower_bounds[delta_start:delta_end] <- -2
    upper_bounds[delta_start:delta_end] <- 2
  }

  # Optimization (with analytic gradient)
  result <- tryCatch({
    optim(
      initial_params,
      log_likelihood_shash,
      gr = gradient_shash,
      X_mu = X_mu,
      X_sigma = X_sigma,
      X_epsilon = X_epsilon,
      X_delta = X_delta,
      y = score,
      weights = weights,
      fixed_delta = if (!use_varying_delta)
        delta
      else
        NULL,
      method = "L-BFGS-B",
      lower = lower_bounds,
      upper = upper_bounds,
      hessian = TRUE,
      control = control
    )
  }, error = function(e) {
    message("First optimization attempt failed. Trying with different parameters...")

    # Try with different, more robust initial values
    initial_params[1] <- median(score)

    # mad(score) can be 0 with strong floor/ceiling effects
    # (> 50% identical scores); fall back to sd in that case.
    s_robust <- mad(score)
    if (!is.finite(s_robust) || s_robust <= 0)
      s_robust <- sd(score)
    initial_params[ncol(X_mu) + 1] <- log(s_robust)

    # guard against missing list entries when mutating a
    # user-supplied control list (NULL * 10 == numeric(0)).
    control$factr <- if (is.null(control$factr)) 1e-7 else control$factr * 10
    control$maxit <- if (is.null(control$maxit)) 1000 else control$maxit * 2

    optim(
      initial_params,
      log_likelihood_shash,
      gr = gradient_shash,
      X_mu = X_mu,
      X_sigma = X_sigma,
      X_epsilon = X_epsilon,
      X_delta = X_delta,
      y = score,
      weights = weights,
      fixed_delta = if (!use_varying_delta)
        delta
      else
        NULL,
      method = "L-BFGS-B",
      lower = lower_bounds,
      upper = upper_bounds,
      hessian = TRUE,
      control = control
    )
  })

  # Check convergence
  if (result$convergence != 0) {
    warning(
      "Optimization did not converge (code: ",
      result$convergence,
      "). Consider adjusting control parameters or degrees of the polynomials. Check percentile curves for plausibility."
    )
  }

  # Warn when parameters sit at their box constraints; SEs and Wald
  # tests are invalid there.
  at_bound <- is.finite(lower_bounds) &
    (result$par <= lower_bounds + 1e-6 | result$par >= upper_bounds - 1e-6)
  if (any(at_bound)) {
    warning(
      "Parameter(s) at index ",
      paste(which(at_bound), collapse = ", "),
      " reached their bounds. Standard errors and Wald tests for these ",
      "parameters are not valid. Consider reducing model complexity."
    )
  }

  # Extract parameter estimates
  n_mu <- ncol(X_mu)
  n_sigma <- ncol(X_sigma)
  n_epsilon <- ncol(X_epsilon)

  mu_est <- result$par[1:n_mu]
  sigma_est <- result$par[(n_mu + 1):(n_mu + n_sigma)]
  epsilon_est <- result$par[(n_mu + n_sigma + 1):(n_mu + n_sigma + n_epsilon)]

  if (use_varying_delta) {
    n_delta <- ncol(X_delta)
    delta_est <- result$par[(n_mu + n_sigma + n_epsilon + 1):(n_mu + n_sigma + n_epsilon + n_delta)]
  } else {
    delta_est <- NULL
  }

  # Guarded SE computation. solve() on an indefinite Hessian could otherwise
  # either error or silently produced NaN via sqrt of negative diagonals.
  se <- tryCatch({
    h_inv <- solve(result$hessian)
    d <- diag(h_inv)
    if (any(d < 0, na.rm = TRUE)) {
      warning("Hessian is not positive definite; standard errors are set to NA where invalid.")
      d[d < 0] <- NA
    }
    sqrt(d)
  }, error = function(e) {
    warning("Could not compute standard errors: Hessian matrix issue")
    rep(NA_real_, length(result$par))
  })

  # Store attributes
  attr(result, "age_mean") <- mean(age)
  attr(result, "age_sd") <- sd(age)
  attr(result, "ageMin") <- min(age)
  attr(result, "ageMax") <- max(age)
  attr(result, "score_mean") <- mean(score)
  attr(result, "score_sd") <- sd(score)
  attr(result, "max") <- max(score)
  attr(result, "min") <- min(score)
  attr(result, "N") <- length(score)
  attr(result, "scaleMean") <- scaleM
  attr(result, "scaleSD") <- scaleSD
  attr(result, "delta") <- delta

  # Create model object
  model <- list(
    mu_est = mu_est,
    sigma_est = sigma_est,
    epsilon_est = epsilon_est,
    delta_est = delta_est,
    delta = delta,
    se = se,
    mu_degree = mu_degree,
    sigma_degree = sigma_degree,
    epsilon_degree = epsilon_degree,
    delta_degree = delta_degree,
    result = result
  )

  class(model) <- "cnormShash"

  if (plot) {
    p <- plot.cnormShash(model, age, score, weights = weights)
    print(p)
  }

  return(model)
}



#' Sinh-Arcsinh (shash) Distribution
#'
#' Density, distribution function, quantile function and random generation
#' for the Sinh-Arcsinh distribution with location parameter \code{mu},
#' scale parameter \code{sigma}, skewness parameter \code{epsilon}, and
#' tail weight parameter \code{delta}.
#'
#' @name shash
#' @aliases dshash pshash qshash rshash
#'
#' @param x,q vector of quantiles
#' @param p vector of probabilities
#' @param n number of observations. If \code{length(n) > 1}, the length is
#'   taken to be the number required.
#' @param mu location parameter (default: 0)
#' @param sigma scale parameter (must be > 0, default: 1)
#' @param epsilon skewness parameter (default: 0, symmetric distribution)
#' @param delta tail weight parameter (must be > 0, default: 1 for normal-like
#'   tails; \code{delta < 1} gives heavier tails, \code{delta > 1} gives
#'   lighter tails)
#' @param log,log.p logical; if TRUE, probabilities p are given as log(p)
#' @param lower.tail logical; if TRUE (default), probabilities are P[X <= x]
#'   otherwise, P[X > x]
#'
#' @details
#' The Sinh-Arcsinh distribution (Jones & Pewsey, 2009) is defined by the transformation:
#' \deqn{X = \mu + \sigma \cdot \sinh\left(\frac{\text{asinh}(Z) - \epsilon}{\delta}\right)}
#' where \eqn{Z \sim N(0,1)} is a standard normal variable.
#'
#' The four parameters control:
#' \itemize{
#'   \item \code{mu}: Location (similar to mean)
#'   \item \code{sigma}: Scale (similar to standard deviation)
#'   \item \code{epsilon}: Skewness (\code{epsilon = 0} gives symmetry)
#'   \item \code{delta}: Tail weight (\code{delta = 1} gives normal-like tails,
#'         \code{delta < 1} gives heavier tails, \code{delta > 1} gives
#'         lighter tails)
#' }
#'
#' @return
#' \code{dshash} gives the density, \code{pshash} gives the distribution
#' function, \code{qshash} gives the quantile function, and \code{rshash}
#' generates random deviates.
#'
#' The length of the result is determined by \code{n} for \code{rshash}, and
#' is the maximum of the lengths of the numerical arguments for the other functions.
#'
#' @references
#' Jones, M. C., & Pewsey, A. (2009). Sinh-arcsinh distributions.
#' \emph{Biometrika}, 96(4), 761-780. \doi{10.1093/biomet/asp053}
#'
#' @seealso
#' \link[stats]{Normal} for the normal distribution.
#'
#' @examples
#' # Generate random samples
#' x <- rshash(1000, mu = 0, sigma = 1, epsilon = 0.5, delta = 1.2)
#'
#' # Density
#' plot(density(x))
#' curve(dshash(x, mu = 0, sigma = 1, epsilon = 0.5, delta = 1.2),
#'       add = TRUE, col = "red")
#'
#' # Cumulative probability
#' pshash(0, mu = 0, sigma = 1, epsilon = 0.5, delta = 1.2)
#'
#' # Quantiles
#' qshash(c(0.025, 0.5, 0.975), mu = 0, sigma = 1, epsilon = 0.5, delta = 1.2)
#'
#' # Compare with normal distribution (epsilon = 0, delta = 1)
#' oldpar <- par(mfrow = c(2, 2))
#' x_vals <- seq(-4, 4, length.out = 200)
#' plot(x_vals, dshash(x_vals), type = "l", main = "Symmetric (like normal)")
#' plot(x_vals, dshash(x_vals, epsilon = 1), type = "l", main = "Right skewed")
#' plot(x_vals, dshash(x_vals, delta = 0.5), type = "l", main = "Heavy tails")
#' plot(x_vals, dshash(x_vals, delta = 2), type = "l", main = "Light tails")
#' par(oldpar)
#'
#' @export
#' @rdname shash
dshash <- function(x,
                   mu = 0,
                   sigma = 1,
                   epsilon = 0,
                   delta = 1,
                   log = FALSE) {
  z <- (x - mu) / sigma

  # Use builtin asinh() -- the manual log(z + sqrt(z^2 + 1)) suffers
  # catastrophic cancellation for large negative z and is slower.
  arg <- delta * asinh(z) + epsilon
  abs_arg <- pmin.int(abs(arg), 350)

  # log(cosh(a)) = |a| + log1p(exp(-2|a|)) - log(2), stable for all a
  log_cosh <- abs_arg + log1p(exp(-2 * abs_arg)) - 0.6931471805599453  # log(2)

  # sinh(arg)^2 == sinh(|arg|)^2
  S <- sinh(abs_arg)

  logdens <- log(delta) - log(sigma) - 0.918938533204673 -  # log(sqrt(2*pi))
    0.5 * log1p(z * z) - 0.5 * S * S + log_cosh

  # Safety net: any residual numerical NaN from extreme (but valid) inputs
  # corresponds to density 0. Genuine NaN/NA inputs are propagated.
  nan_idx <- is.nan(logdens) & !is.nan(x + mu + sigma + epsilon + delta)
  if (any(nan_idx)) {
    logdens[nan_idx] <- -Inf
  }

  if (log)
    return(logdens)
  else
    return(exp(logdens))
}

#' @export
#' @rdname shash
pshash <- function(q,
                   mu = 0,
                   sigma = 1,
                   epsilon = 0,
                   delta = 1,
                   lower.tail = TRUE,
                   log.p = FALSE) {
  z <- (q - mu) / sigma
  u <- sinh(delta * asinh(z) + epsilon)

  p <- pnorm(u, lower.tail = lower.tail, log.p = log.p)
  return(p)
}

#' @export
#' @rdname shash
qshash <- function(p,
                   mu = 0,
                   sigma = 1,
                   epsilon = 0,
                   delta = 1,
                   lower.tail = TRUE,
                   log.p = FALSE) {
  # Delegate lower.tail/log.p to qnorm() instead of computing
  # exp(p) and 1 - p manually, which loses precision in the tails.
  u <- qnorm(p, lower.tail = lower.tail, log.p = log.p)
  z <- sinh((asinh(u) - epsilon) / delta)
  x <- mu + sigma * z

  return(x)
}

#' @export
#' @rdname shash
rshash <- function(n,
                   mu = 0,
                   sigma = 1,
                   epsilon = 0,
                   delta = 1) {
  u <- rnorm(n)
  z <- sinh((asinh(u) - epsilon) / delta)
  x <- mu + sigma * z

  return(x)
}

#' Calculate the negative log-likelihood for a shash regression model
#'
#' This function computes the negative log-likelihood for a Sinh-Arcsinh regression model
#' where the location, scale, skewness, and (optionally) tail weight parameters
#' are modeled as functions of predictors.
#'
#' @param params A numeric vector containing all model parameters
#' @param X_mu Design matrix for location parameter
#' @param X_sigma Design matrix for scale parameter
#' @param X_epsilon Design matrix for skewness parameter
#' @param X_delta Design matrix for tail weight parameter (or NULL for fixed delta)
#' @param fixed_delta If not NULL, the delta parameter is fixed to this value
#' @param y Response vector
#' @param weights Observation weights
#'
#' @return The negative log-likelihood of the model
#'
#' @keywords internal
log_likelihood_shash <- function(params,
                                 X_mu,
                                 X_sigma,
                                 X_epsilon,
                                 X_delta = NULL,
                                 y,
                                 weights = NULL,
                                 fixed_delta = NULL) {
  n_mu <- ncol(X_mu)
  n_sigma <- ncol(X_sigma)
  n_epsilon <- ncol(X_epsilon)
  n_delta <- if (!is.null(X_delta))
    ncol(X_delta)
  else
    0

  # Extract coefficients
  mu_coef <- params[seq_len(n_mu)]
  sigma_coef <- params[n_mu + seq_len(n_sigma)]
  epsilon_coef <- params[n_mu + n_sigma + seq_len(n_epsilon)]

  # Compute parameters with efficient matrix operations
  mu <- drop(X_mu %*% mu_coef)
  log_sigma <- pmin.int(pmax.int(drop(X_sigma %*% sigma_coef), -10), 10)
  sigma <- exp(log_sigma)
  epsilon <- pmin.int(pmax.int(drop(X_epsilon %*% epsilon_coef), -10), 10)

  if (!is.null(X_delta)) {
    delta_coef <- params[n_mu + n_sigma + n_epsilon + seq_len(n_delta)]
    log_delta <- pmin.int(pmax.int(drop(X_delta %*% delta_coef), -2), 2)
    delta <- exp(log_delta)
  } else {
    delta <- fixed_delta
  }

  if (is.null(weights)) {
    weights <- 1  # Will broadcast in multiplication
  }

  log_densities <- dshash(y, mu, sigma, epsilon, delta, log = TRUE)
  bad <- !is.finite(log_densities)
  if (any(bad)) {
    if (anyNA(log_densities))
      return(1e10)
    log_densities[bad] <- -1e6
  }

  loglik <- sum(weights * log_densities)

  if (!is.finite(loglik))
    return(1e10)

  return(-loglik)
}

#' Analytic gradient of the negative log-likelihood for a shash regression model
#'
#' Computes the exact gradient of \code{\link{log_likelihood_shash}} with
#' respect to all regression coefficients. Supplying this gradient to
#' \code{\link[stats]{optim}} (method \code{"L-BFGS-B"}) avoids costly and
#' noisy finite-difference approximations, typically yielding a speedup
#' and more reliable convergence.
#'
#' @details
#' With \eqn{z = (y - \mu)/\sigma} and \eqn{A = \delta \, \mathrm{asinh}(z) + \epsilon},
#' the per-observation log-density is
#' \deqn{\ell = \log\delta - \log\sigma - \tfrac{1}{2}\log(2\pi)
#'   - \tfrac{1}{2}\log(1+z^2) - \tfrac{1}{2}\sinh^2(A) + \log\cosh(A).}
#' The gradient uses the chain rule through the linear predictors:
#' \deqn{\partial\ell/\partial A = \tanh(A) - \sinh(A)\cosh(A)}
#' \deqn{\partial\ell/\partial z = -z/(1+z^2) + (\partial\ell/\partial A)\,\delta/\sqrt{1+z^2}}
#' \deqn{\partial\ell/\partial\mu = -(\partial\ell/\partial z)/\sigma}
#' \deqn{\partial\ell/\partial\log\sigma = -1 - z\,(\partial\ell/\partial z)}
#' \deqn{\partial\ell/\partial\epsilon = \partial\ell/\partial A}
#' \deqn{\partial\ell/\partial\log\delta = 1 + (\partial\ell/\partial A)\,\delta\,\mathrm{asinh}(z)}
#' Coefficient gradients follow as \eqn{-X^\top (w \cdot \partial\ell/\partial\eta)}
#' for the negative log-likelihood. Contributions of observations whose linear
#' predictor is clamped (see \code{log_likelihood_shash}) are zeroed, which is
#' the exact subgradient of the clamped objective. In extreme regions where
#' \eqn{\sinh(A)\cosh(A)} would overflow, the gradient magnitude is capped at
#' a large finite value; these regions coincide with the penalty branch of the
#' objective, so the capped direction remains correct.
#'
#' @inheritParams log_likelihood_shash
#'
#' @return Numeric vector: gradient of the negative log-likelihood with
#'   respect to \code{params}.
#'
#' @keywords internal
gradient_shash <- function(params,
                           X_mu,
                           X_sigma,
                           X_epsilon,
                           X_delta = NULL,
                           y,
                           weights = NULL,
                           fixed_delta = NULL) {
  n_mu <- ncol(X_mu)
  n_sigma <- ncol(X_sigma)
  n_epsilon <- ncol(X_epsilon)
  n_delta <- if (!is.null(X_delta))
    ncol(X_delta)
  else
    0

  # Extract coefficients
  mu_coef <- params[seq_len(n_mu)]
  sigma_coef <- params[n_mu + seq_len(n_sigma)]
  epsilon_coef <- params[n_mu + n_sigma + seq_len(n_epsilon)]

  # Linear predictors with clamping identical to log_likelihood_shash;
  # indicator vectors record where the clamp is inactive (gradient nonzero)
  mu <- drop(X_mu %*% mu_coef)

  eta_sigma <- drop(X_sigma %*% sigma_coef)
  sigma_free <- (eta_sigma > -10) & (eta_sigma < 10)
  sigma <- exp(pmin.int(pmax.int(eta_sigma, -10), 10))

  eta_epsilon <- drop(X_epsilon %*% epsilon_coef)
  epsilon_free <- (eta_epsilon > -10) & (eta_epsilon < 10)
  epsilon <- pmin.int(pmax.int(eta_epsilon, -10), 10)

  if (!is.null(X_delta)) {
    delta_coef <- params[n_mu + n_sigma + n_epsilon + seq_len(n_delta)]
    eta_delta <- drop(X_delta %*% delta_coef)
    delta_free <- (eta_delta > -2) & (eta_delta < 2)
    delta <- exp(pmin.int(pmax.int(eta_delta, -2), 2))
  } else {
    delta <- fixed_delta
  }

  if (is.null(weights)) {
    weights <- 1
  }

  # Core quantities
  z <- (y - mu) / sigma
  asinh_z <- asinh(z)
  A <- delta * asinh_z + epsilon

  # Overflow guard: sinh(a)*cosh(a) = 0.5*sinh(2a) overflows for |a| > ~355.
  # Cap at 350 (product ~ 2.5e303, still finite), then bound the magnitude.
  A_c <- pmin.int(pmax.int(A, -350), 350)
  S <- sinh(A_c)
  C <- cosh(A_c)

  gA <- tanh(A) - S * C
  gA <- pmin.int(pmax.int(gA, -1e10), 1e10)

  r <- 1 / sqrt(1 + z * z)            # d asinh(z) / dz
  gz <- -z * r * r + gA * delta * r   # dl/dz

  d_mu   <- -gz / sigma               # dl/dmu
  d_lsig <- -1 - gz * z               # dl/d(log sigma)
  d_eps  <- gA                        # dl/depsilon

  # Zero out contributions from numerically failed observations
  # (consistent with the constant penalty branch of the objective)
  ok <- is.finite(d_mu) & is.finite(d_lsig) & is.finite(d_eps)

  if (!is.null(X_delta)) {
    d_ldel <- 1 + gA * delta * asinh_z  # dl/d(log delta)
    ok <- ok & is.finite(d_ldel)
    d_ldel[!ok] <- 0
    d_ldel <- d_ldel * delta_free
  }

  d_mu[!ok] <- 0
  d_lsig[!ok] <- 0
  d_eps[!ok] <- 0

  # Apply clamp subgradients
  d_lsig <- d_lsig * sigma_free
  d_eps <- d_eps * epsilon_free

  # Gradient of the NEGATIVE weighted log-likelihood w.r.t. coefficients
  w <- weights
  grad <- c(
    -drop(crossprod(X_mu, w * d_mu)),
    -drop(crossprod(X_sigma, w * d_lsig)),
    -drop(crossprod(X_epsilon, w * d_eps)),
    if (!is.null(X_delta)) -drop(crossprod(X_delta, w * d_ldel)) else NULL
  )

  # Final safety: L-BFGS-B cannot handle non-finite gradients
  grad[!is.finite(grad)] <- 0

  return(grad)
}


#' Predict parameters for a shash regression model
#'
#' @param model An object of class "cnormShash"
#' @param ages A numeric vector of age points for prediction
#'
#' @return A data frame with predicted parameters and statistics
#'
#' @keywords internal
predictCoefficients_shash <- function(model, ages) {
  if (!isSHASH(model)) {
    stop("Wrong object. Please provide object from class 'cnormShash'.")
  }

  # Standardize new ages
  ages_std <- (ages - attr(model$result, "age_mean")) / attr(model$result, "age_sd")

  # Create design matrices
  X_mu_new <- cbind(1, poly(ages_std, degree = model$mu_degree, raw = TRUE))
  X_sigma_new <- cbind(1, poly(ages_std, degree = model$sigma_degree, raw = TRUE))
  X_epsilon_new <- cbind(1, poly(ages_std, degree = model$epsilon_degree, raw = TRUE))

  if (!is.null(model$delta_degree)) {
    X_delta_new <- cbind(1, poly(ages_std, degree = model$delta_degree, raw = TRUE))
  }

  # Predict parameters
  mu <- X_mu_new %*% model$mu_est
  log_sigma <- X_sigma_new %*% model$sigma_est
  sigma <- exp(log_sigma)
  epsilon <- X_epsilon_new %*% model$epsilon_est

  if (!is.null(model$delta_degree)) {
    log_delta <- X_delta_new %*% model$delta_est
    delta <- exp(log_delta)
  } else {
    delta <- rep(model$delta, length(ages))
  }

  predicted <- data.frame(
    age = ages,
    mu = as.vector(mu),
    sigma = as.vector(sigma),
    epsilon = as.vector(epsilon),
    delta = as.vector(delta)
  )

  return(predicted)
}

#' Plot Sinh-Arcsinh Model with Data and Percentile Lines
#'
#' @param x A fitted model object of class "cnormShash"
#' @param ... Additional arguments including age, score, weights, percentiles, points
#'
#' @return A ggplot object
#'
#' @export
plot.cnormShash <- function(x, ...) {
  model <- x
  args <- list(...)

  if ("age" %in% names(args)) {
    age <- args$age
  } else {
    if (length(args) > 0)
      age <- args[[1]]
    else
      age <- NULL
  }
  if ("score" %in% names(args)) {
    score <- args$score
  } else {
    if (length(args) > 1)
      score <- args[[2]]
    else
      score <- NULL
  }
  if ("weights" %in% names(args)) {
    weights <- args$weights
  } else {
    weights <- NULL
  }
  if ("percentiles" %in% names(args)) {
    percentiles <- args$percentiles
  } else {
    percentiles <- c(0.025, 0.1, 0.25, 0.5, 0.75, 0.9, 0.975)
  }
  if ("points" %in% names(args)) {
    points <- args$points
  } else {
    points <- TRUE
  }

  if (is.null(age) || is.null(score))
    stop("Please provide 'age' and 'score' vectors.")

  if (!isSHASH(model)) {
    stop("Wrong object. Please provide object from class 'cnormShash'.")
  }

  if (length(age) != length(score)) {
    stop("Length of 'age' and 'score' must be the same.")
  }

  if (!is.null(weights) && length(weights) != length(age)) {
    stop("Length of 'weights' must match length of 'age' and 'score'.")
  }

  # Generate prediction points
  n_points <- 100
  data <- data.frame(age = age, score = score)
  if (!is.null(weights)) {
    data$w <- weights
  } else {
    data$w <- rep(1, nrow(data))
  }

  age_range <- range(age)
  pred_ages <- seq(age_range[1], age_range[2], length.out = n_points)

  # Get predictions
  preds <- predictCoefficients_shash(model, pred_ages)

  # Calculate percentile lines using shash quantiles
  percentile_lines <- lapply(percentiles, function(p) {
    qshash(
      p,
      mu = preds$mu,
      sigma = preds$sigma,
      epsilon = preds$epsilon,
      delta = preds$delta
    )
  })

  percentile_data <- do.call(cbind, percentile_lines)
  colnames(percentile_data) <- paste0("P", percentiles * 100)

  plot_data <- data.frame(
    age = pred_ages,
    mu = preds$mu,
    sigma = preds$sigma,
    epsilon = preds$epsilon,
    percentile_data
  )

  # Create the plot
  p <- ggplot()

  if (points)
    p <- p + geom_point(
      data = data,
      aes(x = age, y = score),
      alpha = 0.2,
      size = 0.6
    )

  # Calculate manifest percentiles
  if (length(age) / length(unique(age)) > 50 &&
      min(table(data$age)) > 30) {
    data$group <- age
  } else {
    data$group <- getGroups(age)
  }

  # Limit to max 30 groups for better visibility
  if (length(unique(data$group)) > 30) {
    data$group <- getGroups(age, n = 30)
  }

  # Get actual percentiles
  NAMES <- paste("PR", percentiles * 100, sep = "")
  percentile.actual <- as.data.frame(do.call("rbind", lapply(split(data, data$group), function(df) {
    c(age = mean(df$age),
      weighted.quantile(df$score, probs = percentiles, weights = df$w))
  })))
  colnames(percentile.actual) <- c("age", NAMES)
  manifest_data <- percentile.actual

  # Add percentile lines and points
  for (i in seq_along(percentiles)) {
    p <- p +
      geom_line(
        data = plot_data,
        aes(
          x = .data$age,
          y = .data[[paste0("P", percentiles[i] * 100)]],
          color = !!NAMES[i]
        ),
        linewidth = 0.6
      ) +
      geom_point(
        data = manifest_data,
        aes(
          x = .data$age,
          y = .data[[NAMES[i]]],
          color = !!NAMES[i]
        ),
        size = 2,
        shape = 18
      )
  }

  # Customize the plot
  p <- p +
    theme_minimal() +
    labs(
      title = "Percentile Plot (Sinh-Arcsinh Model)",
      x = "Age",
      y = "Score",
      color = "Percentile"
    ) +
    scale_color_manual(
      values = setNames(rainbow(length(percentiles)), NAMES),
      breaks = NAMES,
      labels = paste0(percentiles * 100, "%")
    ) +
    guides(color = guide_legend(override.aes = list(
      linetype = rep("solid", length(NAMES)),
      shape = rep(18, length(NAMES))
    )))

  p <- p +
    theme(
      plot.title = element_text(
        hjust = 0.5,
        size = 16,
        face = "bold"
      ),
      plot.subtitle = element_text(hjust = 0.5, size = 12),
      axis.title = element_text(size = 12, face = "bold"),
      axis.title.x = element_text(margin = margin(t = 10)),
      axis.title.y = element_text(margin = margin(r = 10)),
      axis.text = element_text(size = 10),
      legend.position = "right",
      legend.title = element_text(size = 12, face = "bold"),
      legend.text = element_text(size = 10),
      panel.grid.major = element_line(color = "gray90"),
      panel.grid.minor = element_line(color = "gray95")
    )

  return(p)
}

#' Print method for Sinh-Arcsinh objects
#'
#' @param x A cnormShash object
#' @param ... Additional arguments
#' @export
print.cnormShash <- function(x, ...) {
  cat("SinH-ArcSinH Regression Model for Continuous Norming\n")
  cat("====================================================\n\n")

  cat("Model Parameters:\n")
  cat("- Location (mu) polynomial degree:", x$mu_degree, "\n")
  cat("- Scale (sigma) polynomial degree:", x$sigma_degree, "\n")
  cat("- Skewness (epsilon) polynomial degree:",
      x$epsilon_degree,
      "\n")
  if (!is.null(x$delta_degree)) {
    cat("- Tail weight (delta): Polynomial degree",
        x$delta_degree,
        "\n\n")
  } else {
    cat("- Tail weight (delta): Fixed at", x$delta, "\n\n")
  }

  cat("Sample size:", attr(x$result, "N"), "\n")
  cat("Age range:",
      attr(x$result, "ageMin"),
      "to",
      attr(x$result, "ageMax"),
      "\n")
  cat("Score range:",
      attr(x$result, "min"),
      "to",
      attr(x$result, "max"),
      "\n\n")

  cat("Optimization:\n")
  cat("- Convergence:",
      ifelse(x$result$convergence == 0, "Successful", "Failed"),
      "\n")
  cat("- Log-likelihood:", -x$result$value, "\n")
  cat("- AIC:", 2 * length(x$result$par) + 2 * x$result$value, "\n")
}

#' Automatic model selection for SinH-ArcSinH continuous norming via BIC
#'
#' Selects the polynomial degrees for the four components of a
#' \code{\link{cnorm.shash}} model (\eqn{\mu}, \eqn{\sigma}, \eqn{\epsilon},
#' \eqn{\delta}) by minimizing BIC over a full grid.
#'
#' A degree of \code{0} for \eqn{\delta} is interpreted as a **fixed**
#' \eqn{\delta} (passed to \code{\link{cnorm.shash}} as \code{delta_degree = NULL})
#' with value taken from the \code{delta} argument. This allows the grid
#' search to choose between a fixed and a varying tail-weight model.
#'
#' Parallel execution is attempted by default. If the workers cannot access
#' the \pkg{cNORM} namespace, the function transparently falls
#' back to sequential execution.
#'
#' @param age,score Numeric vectors of predictor and response values.
#' @param weights Optional numeric vector of observation weights.
#' @param max_mu,max_sigma,max_epsilon,max_delta Maximum polynomial degrees for
#'   the four shash parameters. Defaults: \code{4, 3, 3, 1}.
#' @param min_mu,min_sigma,min_epsilon Minimum polynomial degrees (default 1).
#' @param min_delta Minimum degree for \eqn{\delta}. \code{0} (default) means
#'   the fixed-delta variant is included in the search.
#' @param delta Value of \eqn{\delta} used whenever the candidate uses
#'   \code{delta_degree = 0} (i.e. fixed delta). Default 1.
#' @param control Optional control list passed to \code{\link[stats]{optim}}.
#' @param scale Norm scale (default \code{"T"}).
#' @param parallel Logical; attempt parallel execution. Default \code{TRUE}.
#' @param n_cores Number of cores. Defaults to all logical cores.
#' @param plot Logical; plot the selected model. Default \code{TRUE}.
#' @param verbose Logical; print progress. Default \code{TRUE}.
#'
#' @return The selected fitted \code{cnormShash} model with an additional
#'   element \code{$selection} containing:
#'   \itemize{
#'     \item \code{evaluated}: data frame of every combination tried, sorted by BIC.
#'     \item \code{selected}: list with the chosen degrees and BIC.
#'   }
#'
#' @examples
#' \dontrun{
#' m <- autoselect.shash(elfe$group, elfe$raw)
#' m$selection$evaluated
#' summary(m, age = elfe$group, score = elfe$raw)
#' }
#'
#' @seealso \code{\link{cnorm.shash}}, \code{\link{autoselect.betabinomial}}
#' @export
autoselect.shash <- function(age,
                             score,
                             weights      = NULL,
                             max_mu       = 4,
                             max_sigma    = 3,
                             max_epsilon  = 3,
                             max_delta    = 1,
                             min_mu       = 1,
                             min_sigma    = 1,
                             min_epsilon  = 1,
                             min_delta    = 0,
                             delta        = 1,
                             control      = NULL,
                             scale        = "T",
                             parallel     = TRUE,
                             n_cores      = NULL,
                             plot         = TRUE,
                             verbose      = TRUE) {

  # ---- Input validation -------------------------------------------------
  if (length(age) != length(score))
    stop("Length of 'age' and 'score' must be the same.")
  if (!is.null(weights) && length(weights) != length(age))
    stop("Length of 'weights' must match length of 'age' and 'score'.")
  if (max_mu      < min_mu)      stop("'max_mu' must be >= 'min_mu'.")
  if (max_sigma   < min_sigma)   stop("'max_sigma' must be >= 'min_sigma'.")
  if (max_epsilon < min_epsilon) stop("'max_epsilon' must be >= 'min_epsilon'.")
  if (max_delta   < min_delta)   stop("'max_delta' must be >= 'min_delta'.")
  if (min_mu < 1 || min_sigma < 1 || min_epsilon < 1)
    stop("Minimum degrees for mu, sigma, epsilon must be >= 1.")
  if (min_delta < 0)
    stop("'min_delta' must be >= 0 (0 means fixed delta).")
  if (delta <= 0) stop("'delta' must be > 0.")

  say <- function(...) {
    if (verbose) { cat(..., sep = ""); utils::flush.console() }
  }

  # ---- Build the 4-D grid ----------------------------------------------
  grid <- expand.grid(mu      = min_mu:max_mu,
                      sigma   = min_sigma:max_sigma,
                      epsilon = min_epsilon:max_epsilon,
                      delta   = min_delta:max_delta,
                      KEEP.OUT.ATTRS = FALSE)
  pairs <- lapply(seq_len(nrow(grid)),
                  function(i) c(grid$mu[i], grid$sigma[i],
                                grid$epsilon[i], grid$delta[i]))
  say(sprintf(
    "Search grid: %d candidate models (mu %d:%d, sigma %d:%d, epsilon %d:%d, delta %d:%d).\n",
    length(pairs),
    min_mu, max_mu, min_sigma, max_sigma,
    min_epsilon, max_epsilon, min_delta, max_delta
  ))

  # ---- Parallel setup with dev-mode fallback ---------------------------
  use_parallel <- FALSE
  cl <- NULL
  if (isTRUE(parallel)) {
    avail <- tryCatch(parallel::detectCores(logical = TRUE),
                      error = function(e) 1L)
    if (is.null(n_cores)) n_cores <- avail
    n_cores <- max(1L, min(n_cores, length(pairs), avail))

    if (n_cores > 1L && length(pairs) > 1L) {
      cl <- tryCatch(parallel::makeCluster(n_cores),
                     error = function(e) NULL)
      if (!is.null(cl)) {
        worker_ok <- tryCatch({
          res <- parallel::clusterCall(cl, function() {
            requireNamespace("cNORM", quietly = TRUE) &&
              exists("cnorm.shash",      envir = asNamespace("cNORM")) &&
              exists("diagnostics.shash", envir = asNamespace("cNORM"))
          })
          all(vapply(res, isTRUE, logical(1)))
        }, error = function(e) FALSE)

        if (worker_ok) {
          use_parallel <- TRUE
          on.exit(try(parallel::stopCluster(cl), silent = TRUE), add = TRUE)
          parallel::clusterExport(
            cl,
            varlist = c("age", "score", "weights",
                        "delta", "control", "scale"),
            envir = environment()
          )
          say(sprintf("Parallel mode: using %d cores.\n", n_cores))
        } else {
          try(parallel::stopCluster(cl), silent = TRUE); cl <- NULL
          say("Note: cNORM is not installed in the worker library path ",
              "(typical during devtools::load_all). ",
              "Falling back to sequential execution.\n")
        }
      }
    }
  }

  # ---- Worker --------------------------------------------------------
  fit_worker <- function(p) {
    # p = c(mu_deg, sigma_deg, epsilon_deg, delta_deg)
    # delta_deg == 0  -> pass delta_degree = NULL (fixed delta)
    dd <- if (p[4] == 0L) NULL else p[4]
    tryCatch({
      m <- suppressMessages(suppressWarnings(
        cNORM::cnorm.shash(
          age = age, score = score, weights = weights,
          mu_degree      = p[1],
          sigma_degree   = p[2],
          epsilon_degree = p[3],
          delta_degree   = dd,
          delta          = delta,
          control        = control,
          scale          = scale,
          plot           = FALSE
        )
      ))
      d <- cNORM::diagnostics.shash(m)
      list(mu = p[1], sigma = p[2], epsilon = p[3], delta = p[4],
           model = m,
           BIC = if (is.finite(d$BIC)) d$BIC else Inf,
           AIC = d$AIC, logLik = d$log_likelihood,
           converged = isTRUE(d$converged),
           status  = if (!is.finite(d$BIC)) "error"
           else if (!isTRUE(d$converged)) "not_converged"
           else "ok",
           message = NA_character_)
    }, error = function(e) {
      list(mu = p[1], sigma = p[2], epsilon = p[3], delta = p[4],
           model = NULL, BIC = Inf, AIC = NA_real_, logLik = NA_real_,
           converged = FALSE, status = "error",
           message = conditionMessage(e))
    })
  }

  # ---- Cache + reporting -----------------------------------------------
  cache <- new.env(hash = TRUE, parent = emptyenv())
  ck <- function(p) sprintf("%d_%d_%d_%d", p[1], p[2], p[3], p[4])

  fmt_delta <- function(d) if (d == 0L) "fixed" else as.character(d)

  report <- function(r) {
    tag <- switch(r$status,
                  ok            = "",
                  not_converged = "  (not strictly converged)",
                  error         = paste0("  [error: ", r$message, "]"))
    say(sprintf("  mu=%d, sigma=%d, epsilon=%d, delta=%s : BIC = %s%s\n",
                r$mu, r$sigma, r$epsilon, fmt_delta(r$delta),
                formatC(r$BIC, digits = 3, format = "f"), tag))
  }

  evaluate_pairs <- function(pairs) {
    todo <- pairs[!vapply(pairs,
                          function(p) exists(ck(p), envir = cache),
                          logical(1))]
    if (length(todo) == 0L) return(invisible(NULL))

    say(sprintf("Evaluating %d model%s ...\n",
                length(todo), if (length(todo) == 1) "" else "s"))

    if (use_parallel && length(todo) > 1L) {
      chunks <- split(todo, ceiling(seq_along(todo) / n_cores))
      for (chunk in chunks) {
        results <- parallel::parLapply(cl, chunk, fit_worker)
        for (r in results) {
          assign(ck(c(r$mu, r$sigma, r$epsilon, r$delta)), r, envir = cache)
          report(r)
        }
      }
    } else {
      for (p in todo) {
        r <- fit_worker(p)
        assign(ck(c(r$mu, r$sigma, r$epsilon, r$delta)), r, envir = cache)
        report(r)
      }
    }
    invisible(NULL)
  }

  # ---- Run the search --------------------------------------------------
  evaluate_pairs(pairs)
  all_res <- mget(ls(envir = cache), envir = cache)
  bics    <- vapply(all_res, `[[`, numeric(1), "BIC")
  if (all(!is.finite(bics)))
    stop("Selection failed: no model produced a finite BIC. ",
         "Inspect $selection$evaluated for per-fit messages.")
  current <- all_res[[which.min(bics)]]

  # ---- Compile results --------------------------------------------------
  evaluated <- do.call(rbind, lapply(
    all_res,
    function(r) data.frame(mu = r$mu, sigma = r$sigma,
                           epsilon = r$epsilon, delta = r$delta,
                           BIC = r$BIC, AIC = r$AIC,
                           logLik = r$logLik,
                           converged = r$converged,
                           status = r$status,
                           message = r$message,
                           stringsAsFactors = FALSE)))
  evaluated <- evaluated[order(evaluated$BIC), , drop = FALSE]
  rownames(evaluated) <- NULL

  say(sprintf("\nSelected model: mu=%d, sigma=%d, epsilon=%d, delta=%s (BIC = %.3f)\n",
              current$mu, current$sigma, current$epsilon,
              fmt_delta(current$delta), current$BIC))

  final_model <- current$model
  if (is.null(final_model))
    stop("Selection failed: the best candidate did not produce a usable model.")

  final_model$selection <- list(
    evaluated = evaluated,
    selected  = list(mu_degree      = current$mu,
                     sigma_degree   = current$sigma,
                     epsilon_degree = current$epsilon,
                     delta_degree   = if (current$delta == 0L) NULL else current$delta,
                     delta          = delta,
                     BIC            = current$BIC)
  )

  if (plot) print(plot(final_model, age = age, score = score, weights = weights))
  return(final_model)
}

#' Calculate Norm Tables for Sinh-Arcsinh Distribution
#'
#' Generates norm tables for specific ages based on a fitted Sinh-Arcsinh (shash) regression model.
#' Computes interval probabilities, percentiles, z-scores, and norm scores for a specified range of raw scores.
#' Optionally includes confidence intervals when reliability is provided.
#'
#' @param model Fitted shash model object of class "cnormShash"
#' @param ages Numeric vector of age points for norm table generation
#' @param start Minimum raw score value for the norm table
#' @param end Maximum raw score value for the norm table
#' @param step Step size between consecutive raw scores (default: 1)
#' @param CI Confidence coefficient (0-1, default: 0.9) for confidence intervals
#' @param reliability Reliability coefficient (0-1) for true score confidence intervals
#'
#' @return List of data frames (one per age) containing:
#'   \item{x}{Raw scores}
#'   \item{Px}{Approximate interval probabilities (density times step width).
#'     These are consistent with \code{Pcum} but do not necessarily sum to 1
#'     over the tabulated score range.}
#'   \item{Pcum}{Cumulative probabilities}
#'   \item{Percentile}{Percentile ranks (0-100)}
#'   \item{z}{Standardized z-scores}
#'   \item{norm}{Norm scores in specified scale}
#'   \item{lowerCI, upperCI}{Confidence intervals (if reliability provided)}
#'   \item{lowerCI_PR, upperCI_PR}{CI as percentile ranks (if reliability provided)}
#'
#' @details
#' For continuous shash distributions, densities are converted to interval probabilities
#' (density times step width) and cumulative probabilities. When reliability is specified,
#' confidence intervals include correction for regression to the mean.
#'
#' @examples
#' \dontrun{
#' # Basic norm table
#' model <- cnorm.shash(age, score)
#' tables <- normTable.shash(model, ages = c(7, 8, 9), start = 0, end = 50)
#'
#' # With confidence intervals and finer granularity
#' tables_ci <- normTable.shash(model, ages = c(8, 9), start = 10, end = 40,
#'                              step = 0.5, CI = 0.95, reliability = 0.85)
#' }
#'
#' @export
normTable.shash <- function(model,
                            ages,
                            start = NULL,
                            end = NULL,
                            step = 1,
                            CI = .9,
                            reliability = NULL) {
  # Input validation
  if (!isSHASH(model)) {
    stop("Wrong object. Please provide object from class 'cnormShash'.")
  }

  if (is.null(start)) {
    start <- attr(model$result, "min")
  }

  if (is.null(end)) {
    end <- attr(model$result, "max")
  }

  if (is.null(step)) {
    step <- 1
  }

  if (start >= end) {
    stop("Start value must be less than end value.")
  }

  if (step <= 0) {
    stop("Step size must be positive.")
  }

  if (is.null(CI) || is.na(CI)) {
    reliability <- NULL
  } else if (CI > .99999 || CI < .00001) {
    stop("Confidence coefficient (CI) out of range. Please specify value between 0 and 1.")
  }

  # Setup reliability and confidence intervals
  rel <- FALSE
  if (!is.null(reliability)) {
    if (reliability > .9999 || reliability < .0001) {
      stop("Reliability coefficient out of range. Please specify value between 0 and 1.")
    } else {
      se <- qnorm(1 - ((1 - CI) / 2)) * sqrt(reliability * (1 - reliability))
      rel <- TRUE
    }
  }

  # Get predictions for all ages
  predictions <- predictCoefficients_shash(model, ages)

  # Create score sequence
  x <- seq(from = start, to = end, by = step)

  # Get scale information
  mScale <- attr(model$result, "scaleMean")
  sdScale <- attr(model$result, "scaleSD")

  result <- list()

  # Generate norm table for each age
  for (k in seq_along(ages)) {
    mu_k <- predictions$mu[k]
    sigma_k <- predictions$sigma[k]
    epsilon_k <- predictions$epsilon[k]
    delta_k <- predictions$delta[k]

    Px <- dshash(
      x,
      mu = mu_k,
      sigma = sigma_k,
      epsilon = epsilon_k,
      delta = delta_k
    ) * step

    # Calculate cumulative probabilities using the continuous CDF
    cum <- pshash(
      x,
      mu = mu_k,
      sigma = sigma_k,
      epsilon = epsilon_k,
      delta = delta_k
    )

    # Calculate percentiles
    perc <- cum

    # Clamp extreme cumulative probabilities instead of mapping
    # non-finite z-scores to 0 (which assigned the MEAN norm score to
    # floor/ceiling raw scores).
    z <- qnorm(pmin(pmax(cum, 1e-12), 1 - 1e-12))

    # Calculate norm scores
    norm <- rep(NA, length(z))
    if (!is.na(mScale) && !is.na(sdScale)) {
      norm <- mScale + sdScale * z
    }

    # Create data frame
    df <- data.frame(
      x = x,
      Px = Px,
      Pcum = cum,
      Percentile = perc * 100,
      z = z,
      norm = norm
    )

    # Add confidence intervals if reliability is specified
    if (rel) {
      # True score estimates (regression to the mean correction)
      zPredicted <- reliability * z

      # Confidence intervals
      df$lowerCI <- (zPredicted - se) * sdScale + mScale
      df$upperCI <- (zPredicted + se) * sdScale + mScale
      df$lowerCI_PR <- pnorm(zPredicted - se) * 100
      df$upperCI_PR <- pnorm(zPredicted + se) * 100

      # Ensure percentile ranks are within bounds
      df$lowerCI_PR <- pmax(0, pmin(100, df$lowerCI_PR))
      df$upperCI_PR <- pmax(0, pmin(100, df$upperCI_PR))
    }

    result[[k]] <- df
  }

  # Name the list elements with ages
  names(result) <- as.character(ages)

  return(result)
}

#' Summarize a Sinh-Arcsinh Continuous Norming Model
#'
#' This function provides a summary of a fitted Sinh-Arcsinh (shash) continuous norming model,
#' including model fit statistics, convergence information, and parameter estimates.
#'
#' @param object An object of class "cnormShash", typically the result of a call to
#'   \code{\link{cnorm.shash}}.
#' @param ... Additional arguments passed to the summary method:
#'   \itemize{
#'      \item age An optional numeric vector of age values corresponding to the raw scores.
#'        If provided along with \code{score}, additional fit statistics (R-squared, RMSE, bias)
#'        will be calculated.
#'      \item score An optional numeric vector of raw scores. Must be provided if \code{age} is given.
#'      \item weights An optional numeric vector of weights for each observation.
#'    }
#'
#' @return Invisibly returns a list containing detailed diagnostic information about the model.
#'   The function primarily produces printed output summarizing the model.
#'
#' @details
#' The summary includes:
#' \itemize{
#'   \item Basic model information (polynomial degrees, delta parameter, number of observations)
#'   \item Model fit statistics (log-likelihood, AIC, BIC)
#'   \item R-squared, RMSE, and bias (if age and raw scores are provided)
#'   \item Convergence information
#'   \item Parameter estimates with standard errors, z-values, and p-values
#' }
#'
#' @examples
#' \dontrun{
#' model <- cnorm.shash(children$age, children$score)
#' summary(model)
#'
#' # Including R-squared, RMSE, and bias in the summary:
#' summary(model, age = children$age, score = children$score)
#' }
#'
#' @seealso \code{\link{cnorm.shash}}, \code{\link{diagnostics.shash}}
#' @export
summary.cnormShash <- function(object, ...) {
  args <- list(...)

  if ("age" %in% names(args)) {
    age <- args$age
  } else {
    if (length(args) > 0)
      age <- args[[1]]
    else
      age <- NULL
  }
  if ("score" %in% names(args)) {
    score <- args$score
  } else {
    if (length(args) > 1)
      score <- args[[2]]
    else
      score <- NULL
  }
  if ("weights" %in% names(args)) {
    weights <- args$weights
  } else {
    if (length(args) > 2)
      weights <- args[[3]]
    else
      weights <- NULL
  }

  diag <- diagnostics.shash(object, age, score, weights)

  cat("SinH-ArcSinH Continuous Norming Model\n")
  cat("-------------------------------------\n")
  cat("Polynomial degrees:\n")
  cat("  Location (mu):", diag$mu_degree, "\n")
  cat("  Scale (sigma):", diag$sigma_degree, "\n")
  cat("  Skewness (epsilon):", diag$epsilon_degree, "\n")
  if (!is.null(diag$delta_degree)) {
    cat("  Tail weight (delta):", diag$delta_degree, "\n")
  } else {
    cat("  Tail weight (delta): Fixed at", diag$delta, "\n")
  }
  cat("Number of observations:", diag$n_obs, "\n")
  cat("Number of parameters:", diag$n_params, "\n")
  cat("\n")

  cat("Model Fit:\n")
  cat("  Log-likelihood:", round(diag$log_likelihood, 2), "\n")
  cat("  AIC:", round(diag$AIC, 2), "\n")
  cat("  BIC:", round(diag$BIC, 2), "\n")
  if (!is.na(diag$R2)) {
    cat("  R-squared:", round(diag$R2, 4), "\n")
    cat("  RMSE:", round(diag$rmse, 4), "\n")
    cat("  Bias:", round(diag$bias, 4), "\n")
  }
  cat("\n")

  cat("Convergence:\n")
  cat("  Converged:", diag$converged, "\n")
  cat("  Function evaluations:", diag$n_evaluations, "\n")
  cat("  Max Hessian eigenvalue:", round(diag$max_gradient, 6), "\n")
  cat("  Message:", diag$message, "\n")
  cat("\n")

  cat("Parameter Estimates:\n")
  cat("Location (mu) parameters:\n")
  mu_table <- data.frame(
    Estimate = diag$mu_estimates,
    `Std. Error` = diag$mu_se,
    `z value` = diag$mu_z_values,
    `Pr(>|z|)` = diag$mu_p_values
  )
  rownames(mu_table) <- paste0("mu_", 0:(length(diag$mu_estimates) - 1))
  print(mu_table, digits = 4)
  cat("\n")

  cat("Scale (sigma) parameters:\n")
  sigma_table <- data.frame(
    Estimate = diag$sigma_estimates,
    `Std. Error` = diag$sigma_se,
    `z value` = diag$sigma_z_values,
    `Pr(>|z|)` = diag$sigma_p_values
  )
  rownames(sigma_table) <- paste0("log(sigma)_", 0:(length(diag$sigma_estimates) -
                                                      1))
  print(sigma_table, digits = 4)
  cat("\n")

  cat("Skewness (epsilon) parameters:\n")
  epsilon_table <- data.frame(
    Estimate = diag$epsilon_estimates,
    `Std. Error` = diag$epsilon_se,
    `z value` = diag$epsilon_z_values,
    `Pr(>|z|)` = diag$epsilon_p_values
  )
  rownames(epsilon_table) <- paste0("epsilon_", 0:(length(diag$epsilon_estimates) -
                                                     1))
  print(epsilon_table, digits = 4)

  if (!is.null(diag$delta_estimates)) {
    cat("\n")
    cat("Tail weight (delta) parameters:\n")
    delta_table <- data.frame(
      Estimate = diag$delta_estimates,
      `Std. Error` = diag$delta_se,
      `z value` = diag$delta_z_values,
      `Pr(>|z|)` = diag$delta_p_values
    )
    rownames(delta_table) <- paste0("log(delta)_", 0:(length(diag$delta_estimates) -
                                                        1))
    print(delta_table, digits = 4)
  }

  invisible(diag)
}

#' Diagnostic Statistics for Sinh-Arcsinh Continuous Norming Model
#'
#' This function computes detailed diagnostic statistics for a fitted shash model,
#' including fit statistics, parameter estimates, and convergence information.
#'
#' @param object An object of class "cnormShash"
#' @param age An optional numeric vector of age values for computing fit statistics
#' @param score An optional numeric vector of raw scores for computing fit statistics
#' @param weights An optional numeric vector of observation weights
#'
#' @return A list containing comprehensive diagnostic information
#'
#' @keywords internal
diagnostics.shash <- function(object,
                              age = NULL,
                              score = NULL,
                              weights = NULL) {
  if (!isSHASH(object)) {
    stop("Wrong object. Please provide object from class 'cnormShash'.")
  }

  # Basic model information
  n_obs <- attr(object$result, "N")
  n_params <- length(object$result$par)
  log_likelihood <- -object$result$value
  AIC <- 2 * n_params - 2 * log_likelihood
  BIC <- n_params * log(n_obs) - 2 * log_likelihood

  # Parameter estimates and standard errors
  mu_estimates <- object$mu_est
  sigma_estimates <- object$sigma_est
  epsilon_estimates <- object$epsilon_est
  delta_estimates <- object$delta_est

  se <- object$se
  if (is.null(se) || any(is.na(se))) {
    mu_se <- rep(NA, length(mu_estimates))
    sigma_se <- rep(NA, length(sigma_estimates))
    epsilon_se <- rep(NA, length(epsilon_estimates))
    delta_se <- if (!is.null(delta_estimates))
      rep(NA, length(delta_estimates))
    else
      NULL
  } else {
    n_mu <- length(mu_estimates)
    n_sigma <- length(sigma_estimates)
    n_epsilon <- length(epsilon_estimates)

    mu_se <- se[1:n_mu]
    sigma_se <- se[(n_mu + 1):(n_mu + n_sigma)]
    epsilon_se <- se[(n_mu + n_sigma + 1):(n_mu + n_sigma + n_epsilon)]

    if (!is.null(delta_estimates)) {
      n_delta <- length(delta_estimates)
      delta_se <- se[(n_mu + n_sigma + n_epsilon + 1):(n_mu + n_sigma + n_epsilon + n_delta)]
    } else {
      delta_se <- NULL
    }
  }

  # Calculate z-values and p-values
  mu_z_values <- ifelse(is.na(mu_se) |
                          mu_se == 0, NA, mu_estimates / mu_se)
  sigma_z_values <- ifelse(is.na(sigma_se) |
                             sigma_se == 0, NA, sigma_estimates / sigma_se)
  epsilon_z_values <- ifelse(is.na(epsilon_se) |
                               epsilon_se == 0,
                             NA,
                             epsilon_estimates / epsilon_se)

  mu_p_values <- ifelse(is.na(mu_z_values), NA, 2 * (1 - pnorm(abs(mu_z_values))))
  sigma_p_values <- ifelse(is.na(sigma_z_values), NA, 2 * (1 - pnorm(abs(sigma_z_values))))
  epsilon_p_values <- ifelse(is.na(epsilon_z_values), NA, 2 * (1 - pnorm(abs(epsilon_z_values))))

  if (!is.null(delta_estimates)) {
    delta_z_values <- ifelse(is.na(delta_se) |
                               delta_se == 0,
                             NA,
                             delta_estimates / delta_se)
    delta_p_values <- ifelse(is.na(delta_z_values), NA, 2 * (1 - pnorm(abs(delta_z_values))))
  } else {
    delta_z_values <- NULL
    delta_p_values <- NULL
  }

  # Convergence information
  converged <- object$result$convergence == 0
  n_evaluations <- object$result$counts["function"]
  message <- switch(
    as.character(object$result$convergence),
    "0" = "Successful convergence",
    "1" = "Maximum iterations reached",
    "10" = "Degeneracy in Nelder-Mead simplex",
    "51" = "Warning from L-BFGS-B",
    "52" = "Error from L-BFGS-B",
    paste("Convergence code:", object$result$convergence)
  )

  # Largest Hessian eigenvalue (curvature diagnostic), if available
  max_gradient <- NA
  if (!is.null(object$result$hessian)) {
    tryCatch({
      eigenvals <- eigen(object$result$hessian, only.values = TRUE)$values
      max_gradient <- max(abs(eigenvals), na.rm = TRUE)
    }, error = function(e) {
      max_gradient <- NA
    })
  }

  # Calculate R-squared if age and score data are provided
  R2 <- NA
  rmse <- NA
  bias <- NA
  if (!is.null(age) && !is.null(score)) {
    if (length(age) / length(unique(age)) > 50 &&
        min(table(age)) > 30) {
      data <- data.frame(group = age, raw = score)
      data <- rankByGroup(
        data = data,
        raw = "raw",
        group = "group",
        weights = weights,
        scale = c(
          attr(object$result, "scaleMean"),
          attr(object$result, "scaleSD")
        )
      )
      norm_scores <- predict(object, data$group, data$raw)
    } else{
      data <- data.frame(age = age, raw = score)
      data$groups <- getGroups(age)
      width <- (max(age) - min(age)) / length(unique(data$groups))
      data <- rankBySlidingWindow(
        data,
        age = "age",
        raw = "raw",
        width = width,
        weights = weights,
        scale = c(
          attr(object$result, "scaleMean"),
          attr(object$result, "scaleSD")
        )
      )
      norm_scores <- predict(object, data$age, data$raw)
    }

    norm_manifest <- data$normValue
    R2 <- cor(norm_scores, norm_manifest, use = "pairwise.complete.obs")^2
    rmse <- sqrt(mean((norm_scores - norm_manifest)^2))
    bias <- mean(norm_scores - norm_manifest)
  } else {
    message <- "No age and raw scores provided. Cannot calculate R2, RMSE, and bias."
  }

  # Return comprehensive diagnostic information
  list(
    # Basic model info
    mu_degree = object$mu_degree,
    sigma_degree = object$sigma_degree,
    epsilon_degree = object$epsilon_degree,
    delta = object$delta,
    delta_degree = object$delta_degree,
    n_obs = n_obs,
    n_params = n_params,

    # Fit statistics
    log_likelihood = log_likelihood,
    AIC = AIC,
    BIC = BIC,
    R2 = R2,
    rmse = rmse,
    bias = bias,

    # Parameter estimates
    mu_estimates = mu_estimates,
    sigma_estimates = sigma_estimates,
    epsilon_estimates = epsilon_estimates,
    delta_estimates = delta_estimates,

    # Standard errors
    mu_se = mu_se,
    sigma_se = sigma_se,
    epsilon_se = epsilon_se,
    delta_se = delta_se,

    # Test statistics
    mu_z_values = mu_z_values,
    sigma_z_values = sigma_z_values,
    epsilon_z_values = epsilon_z_values,
    delta_z_values = delta_z_values,

    mu_p_values = mu_p_values,
    sigma_p_values = sigma_p_values,
    epsilon_p_values = epsilon_p_values,
    delta_p_values = delta_p_values,

    # Convergence info
    converged = converged,
    n_evaluations = n_evaluations,
    max_gradient = max_gradient,
    message = message
  )
}

#' Predict Norm Scores from Raw Scores
#'
#' This function calculates norm scores based on raw scores, age, and a fitted cnormShash model.
#'
#' @param object A fitted model object of class 'cnormShash'.
#' @param ... Additional arguments passed to the prediction method:
#'   \itemize{
#'      \item age A numeric vector of ages, same length as score.
#'      \item score A numeric vector of raw scores.
#'      \item range The range of the norm scores in standard deviations. Default is 3.
#'        Thus, scores in the range of +/- 3 standard deviations are considered.
#'    }
#'
#' @return A numeric vector of norm scores.
#'
#' @details
#' The function predicts the Sinh-Arcsinh (shash) distribution parameters (mu, sigma, epsilon, delta)
#' for each age using the provided model. It then calculates the cumulative probability for each
#' raw score given these parameters using the continuous shash distribution. Finally,
#' it converts these probabilities to the norm scale specified in the model. Raw scores
#' at the extreme floor or ceiling of the distribution are mapped to the boundary of the
#' norm score range (mean +/- \code{range} standard deviations), not to the mean.
#'
#' @examples
#' \dontrun{
#' # Assuming you have a fitted model named 'shash_model':
#' model <- cnorm.shash(children$age, children$score)
#' raw_scores <- c(25.5, 30.2, 18.7, 45.3)
#' ages <- c(7, 8, 9, 10)
#' norm_scores <- predict(model, ages, raw_scores)
#' }
#'
#' @export
#' @family predict
predict.cnormShash <- function(object, ...) {
  model <- object
  args <- list(...)

  if ("age" %in% names(args)) {
    age <- args$age
  } else {
    if (length(args) > 0)
      age <- args[[1]]
    else
      age <- NULL
  }
  if ("score" %in% names(args)) {
    score <- args$score
  } else {
    if (length(args) > 1)
      score <- args[[2]]
    else
      score <- NULL
  }
  if ("range" %in% names(args)) {
    range <- args$range
  } else {
    if (length(args) > 2)
      range <- args[[3]]
    else
      range <- 3
  }

  if (!isSHASH(model)) {
    stop("Wrong object. Please provide object from class 'cnormShash'.")
  }

  if (is.null(age) || is.null(score)) {
    stop("Both 'age' and 'score' must be provided.")
  }

  if (length(age) != length(score)) {
    stop("The lengths of 'age' and 'score' must be the same.")
  }

  # Get predicted distribution parameters for each age
  predictions <- predictCoefficients_shash(model, age)

  mu <- predictions$mu
  sigma <- predictions$sigma
  epsilon <- predictions$epsilon
  delta <- predictions$delta

  # Calculate cumulative probabilities (percentiles) for each score
  percentiles <- pshash(
    score,
    mu = mu,
    sigma = sigma,
    epsilon = epsilon,
    delta = delta
  )

  percentiles_c <- pmin(pmax(percentiles, 1e-12), 1 - 1e-12)
  z_scores <- qnorm(percentiles_c)

  # Apply range constraints
  z_scores <- pmin(pmax(z_scores, -range), range)

  # Get scale information
  mScale <- attr(model$result, "scaleMean")
  sdScale <- attr(model$result, "scaleSD")

  if (!is.na(mScale) && !is.na(sdScale)) {
    # Scale z-scores to specified norm scale
    norm_scores <- mScale + sdScale * z_scores
    return(norm_scores)
  } else {
    # Return percentile ranks if no scale specified
    return(percentiles * 100)
  }
}
