R/compute_wls_error.R

In DTEBOP2: Bayesian Optimal Phase II Randomized Clinical Trial Design with Delayed Outcomes

#' @title Compute Weighted Least Squares Error (Internal)
#'
#' @description
#' This function calculates the weighted least squares (WLS) error between
#' simulated truncated Gamma samples and expert-provided statistics.
#' It is used internally by `trunc_gamma_para()` and is not
#' intended for direct user access.
#'
#' @param sim_data Numeric vector. A sample of simulated truncated Gamma values.
#' @param expert_values Named list. A list containing expert-provided statistics,
#' including `mean`, `median`, `sd`, `q25`, and `q975`. Some values may be NULL.
#' @param weights Numeric vector. A vector of weights for the WLS calculation,
#' corresponding to the importance of `c(mean, median, sd, q25, q975)`.
#'
#' @return Numeric. The weighted least squares error.
#'
#' @keywords internal
compute_wls_error <- function(sim_data, expert_values, weights) {

  sim_stats <- list(
    mean   = mean(sim_data),
    median = median(sim_data),
    sd     = sd(sim_data),
    q25    = quantile(sim_data, 0.025),  # 2.5% 分位数
    q975   = quantile(sim_data, 0.975)   # 97.5% 分位数
  )

  errors <- numeric(0)
  used_weights <- numeric(0)

  for (stat_name in names(expert_values)) {
    if (!is.null(expert_values[[stat_name]])) {
      error_value <- (sim_stats[[stat_name]] - expert_values[[stat_name]])^2
      errors <- c(errors, error_value)
      used_weights <- c(used_weights, weights[match(stat_name, c("mean", "median", "sd", "q25", "q975"))])
    }
  }

  weighted_error <- sum(used_weights * errors, na.rm = TRUE)
  return(weighted_error)
}