R/upsilon.gof.statistic.R

In Upsilon: Another Test of Association for Count Data

# upsilon.gof.statistic.R
#
# Author: Xuye Luo, Joe Song
#
# Updated:
# December 20, 2025. 
#   - Updated the documentation
#
# December 12, 2025

#' @title Upsilon Goodness-of-Fit Test Statistic
#'
#' @description (FOR INTERNAL USE ONLY) 
#'   Calculates the Upsilon statistic for a 
#'   Goodness-of-Fit (GoF) test. 
#'   
#' @details This statistic measures
#'   the discrepancy between observed counts and 
#'   expected probabilities.
#'
#' @param x a numeric vector or one-column matrix 
#'   representing observed counts.
#' @param p a numeric vector of probabilities 
#'   of the same length as \code{x}. 
#'          Defaults to a uniform distribution (1/length(x)).
#' @param rescale.p a logical scalar. 
#'          If \code{TRUE} (default), \code{p} is rescaled to sum to 1. 
#'          If \code{FALSE}, and \code{p} does not sum to 1, an error is raised.
#'
#' @return A numeric value of the Upsilon Goodness-of-Fit statistic.
#' 
#' @importFrom Rdpack reprompt
#' @importFrom Rcpp sourceCpp
#' @importFrom stats pchisq
#' @useDynLib Upsilon, .registration=TRUE
#' @export
#'
#' @examples
#' library("Upsilon")
#' counts <- c(10, 20, 30)
#' upsilon.gof.statistic(counts)
#' @keywords internal
upsilon.gof.statistic <- function(
    x, 
    p = rep(1/length(x), length(x)), 
    rescale.p = TRUE) 
{
  x <- as.matrix(x)
  

  if (length(x) != length(p)) {
    stop("Length of observed counts 'x' must match length of probabilities 'p'.")
  }
  
  # Rescaling Logic
  p_sum <- sum(p)
  
  if (rescale.p) {
    # If rescaling is allowed and needed (sum != 1)
    if (abs(p_sum - 1) > 1e-9) {
      p <- p / p_sum
    }
  } else {
    # If rescaling is forbidden, check strictly
    if (abs(p_sum - 1) > 1e-9) {
      stop("Probabilities 'p' must sum to 1 when rescale.p = FALSE.")
    }
  }
  
  if (any(p < 0)) {
    stop("Probabilities 'p' cannot be negative.")
  }
  
  # Call C++ backend
  statistic <- upsilon_gof_statistic_cpp(x, p)
  
  return(statistic)
}