R/telescoped.chisq.test.R

Defines functions telescoped.chisq.test

# telescoped.chisq.test.R
#
# Author: Xuye Luo, Joe Song

# Updated:
# December 20, 2025. 
#   - Updated the documentation
#
# December 12, 2025

#' @title Find Best Chi-squared Test Result in Telescoped Data
#'
#' @description Performs Pearson's Chi-squared tests on telescoped data at multiple 
#' resolution levels (or a specific focus level) to identify the "best" association.
#' The "best" result is determined either by the most significant p-value or 
#' the largest effect size, depending on the \code{esize} parameter.
#'
#' @param x A numeric vector without NA values, same length as y.
#' @param y A numeric vector without NA values, same length as x.
#' @param focus An integer specifying a specific resolution level to test. 
#'              If \code{NULL} (default), tests are performed across all available levels.
#' @param base Integer. The base for exponential scaling in telescoping. Defaults to 2.
#' @param log.p a logical. If \code{TRUE}, 
#'   the \emph{p}-value is calculated in
#'   closed form to \strong{natural logarithm} of \emph{p}-value 
#'   to improve numerical precision when
#'   \emph{p}-value approaches zero.
#'   Defaults to \code{FALSE}.
#' @param esize Logical. If \code{TRUE}, sorts results primarily by Effect Size (descending). 
#'              If \code{FALSE} (default), sorts primarily by P-value (most significant).
#'
#' @return A data frame containing the best result with columns:
#' \item{p.value}{The p-value (or log p-value) of the test.}
#' \item{estimate}{The effect size (Cramér's V).}
#' \item{focus}{The resolution level (focus) where this result was found.}
#'
#' @examples
#' library("Upsilon")
#' set.seed(123)
#' n <- 100
#' x <- rnorm(n)
#' y <- rnorm(n)
#' 
#' # Find best result across all levels based on significance
#' telescoped.chisq.test(x, y)
#' 
#' @keywords internal
#' export
#' @noRd
telescoped.chisq.test <- function(
    x, 
    y, 
    focus = NULL, 
    base = 2, 
    log.p = TRUE, 
    esize = FALSE) 
{
  telescope_list <- telescoped.data(x, y, focus = focus, base = base)

  if (is.list(telescope_list) && is.null(focus)) {
    
    if (length(telescope_list) > 1) {
      telescope_list <- telescope_list[-1]
    }
    
    chisq_result_list <- lapply(telescope_list, function(mat) {

      val_x <- mat[, 1]
      val_y <- mat[, 2]
      
      results <- fast.chisq.test(val_x, val_y, log.p = log.p)
      
      data.frame(
        p.value = results$p.value, 
        estimate = results$estimate
      )
    })
    
    chisq_result <- do.call(rbind, chisq_result_list)
    
    # Assign focus levels (0 to N-1 based on list index)
    chisq_result$focus <- seq_len(nrow(chisq_result)) - 1
    
    # Sorting Logic
    if (esize) {
      ord <- order(
        chisq_result$estimate, 
        -chisq_result$p.value, 
        -chisq_result$focus, 
        decreasing = TRUE
      )
    } else {

      ord <- order(
        -chisq_result$p.value, 
        -chisq_result$focus, 
        decreasing = TRUE
      )
    }
    
    chisq_result_sorted <- chisq_result[ord, , drop = FALSE]
    chisq_result_best <- chisq_result_sorted[1, , drop = FALSE]
    
  } else {

    mat <- if (is.list(telescope_list)) telescope_list[[1]] else telescope_list
    
    results <- fast.chisq.test(mat[, 1], mat[, 2], log.p = log.p)
    
    chisq_result_best <- data.frame(
      p.value = results$p.value,
      estimate = results$estimate,
      focus = ifelse(is.null(focus), -1, focus)
    )
  }
  
  return(chisq_result_best)
}

Try the Upsilon package in your browser

Any scripts or data that you put into this service are public.

Upsilon documentation built on March 7, 2026, 5:07 p.m.