R/telescoped.upsilon.plot.R

In Upsilon: Another Test of Association for Count Data

# telescoped.upsilon.plot.R
#
# Author: Xuye Luo, Joe Song
# Modified: 
# December 20, 2025:
#   - Commented out print() and cat() function calls
# December 11, 2025

#' @title Visualize Upsilon Test Results on Telescoped Data
#'
#' @description Performs an Upsilon test on telescoped data and visualizes the results.
#' It generates two plots: 
#' 1. A Point Plot showing the distribution of the raw data.
#' 2. A Table Plot (using \code{plot_matrix}) showing the contingency table with test statistics.
#'
#' @param x A numeric vector (x coordinates). Must not contain NAs.
#' @param y A numeric vector (y coordinates). Must not contain NAs.
#' @param focus Integer. Exponential scaling factor. Defaults to -1.
#' @param log.p Logical. If TRUE, returns log(p.value). Defaults to TRUE.
#' @param base Integer. Base for exponential scaling. Defaults to 2.
#' @param show_table Logical. If TRUE, generates the balloon plot of the contingency table.
#' @param show_points Logical. If TRUE, generates the hexagonal bin plot of the data distribution.
#' @param xlab String. Label for the x-axis.
#' @param ylab String. Label for the y-axis.
#' @param title_prefix String. Prefix for the plot titles (e.g., figure number).
#' @param point_title String. Title for the points plot.
#'
#' @return A list containing:
#' \item{contingency_table}{The raw contingency table.}
#' \item{test_result}{A data frame with P-value, Effect Size, and DF.}
#' \item{plot_point}{The ggplot object for the hexagonal bin plot (if show_points=TRUE).}
#' \item{plot_table}{The ggplot object for the balloon plot (if show_table=TRUE).}
#' @references
#' \insertRef{luo2021upsilon}{Upsilon}
#' @import ggplot2
#'
#' @examples
#' library("Upsilon")
#' set.seed(123)
#' n <- 100
#' x <- rnorm(n)
#' y <- rnorm(n)
#' 
#' # Run analysis
#' res <- telescoped.upsilon.plot(x, y)
#' 
#' # Display plots
#' if (!is.null(res$plot_point)) print(res$plot_point)
#' if (!is.null(res$plot_table)) print(res$plot_table)
#' @keywords internal
#' export
#' @noRd
telescoped.upsilon.plot <- function(
    x, 
    y, 
    focus = -1, 
    log.p = TRUE, 
    base = 2, 
    show_table = TRUE, 
    show_points = TRUE,
    xlab = "x", 
    ylab = "y", 
    title_prefix = "", 
    point_title = "Upsilon Test")
{
  # Get Telescoped Data
  d <- telescoped.data(x, y, focus = focus, base = base)
  rx <- d[, 1]
  ry <- d[, 2]
  
  # Statistics
  ct <- table(rx, -ry)
  
  test_res <- fast.upsilon.test(rx, ry, log.p = log.p)
  
  ups_pvalue <- test_res$p.value
  ups_esize  <- test_res$estimate
  ups_df     <- test_res$parameter
  
  # Prepare Result Data Frame
  stat_df <- data.frame(
    Metric = c("P-value", "Effect Size", "DF"),
    Value = c(
      format(ups_pvalue, digits = 3),
      format(ups_esize, digits = 3),
      as.character(ups_df)
    )
  )
  
  # Initialize return objects
  p_hex <- NULL
  p_balloon <- NULL
  
  # Points
  if (show_points) {
    custom_colors <- c("#00A600", "#63C600", "#E6E600", "#E9BD3A", "#ECB176", "#EFC2B3", "#F2F2F2")
    
    df_plot <- data.frame(x = rx, y = ry)
    
    p_hex <- ggplot(df_plot, aes(x = x, y = y)) +
      stat_binhex(bins = 50) + 
      coord_fixed() +
      scale_fill_gradientn(colours = custom_colors) +
      labs(
        title = paste(title_prefix, point_title),
        x = xlab, 
        y = ylab
      ) +
      theme_minimal() +
      theme(
        plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
        axis.title = element_text(size = 12, face = "bold"),
        legend.position = "right"
      )
  }
  
  # Table
  if (show_table) {
    # Construct informative title
    table_title <- paste0(
      title_prefix, " Upsilon Result\n",
      "Log P: ", round(ups_pvalue, 2), " | ",
      "Effect: ", round(ups_esize, 2), " | ",
      "N: ", sum(ct)
    )
    
    p_balloon <- plot_matrix(
      t(ct), 
      title = table_title,
      x.axis = "",
      y.axis = "",
      x.lab = xlab,
      y.lab = ylab,
      shape.color = "tomato", 
      size.by = "none"
    )
  }
  
  # Output
  # cat("\nUpsilon Test\n")
  # print(stat_df)
  
  invisible(list(
    contingency_table = ct,
    test_result = stat_df,
    plot_point = p_hex,
    plot_table = p_balloon
  ))
}