R/telescoped.gtest.plot.R

In Upsilon: Another Test of Association for Count Data

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

#' @title Visualize G-Test Results on Telescoped Data
#'
#' @description Performs a G-test (Likelihood Ratio Test) on telescoped data and visualizes the results.
#' It generates two plots: 
#' 1. A Point lot showing the distribution of the raw data.
#' 2. A Table Plot 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 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 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 (Mutual Information), 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).}
#'
#' @import ggplot2
#'
#' @examples
#' library("Upsilon")
#' library("ggplot2")
#' set.seed(123)
#' n <- 100
#' x <- rnorm(n)
#' y <- rnorm(n)
#' 
#' # Run analysis
#' res <- telescoped.gtest.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.gtest.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 = "G-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.gtest(rx, ry, log.p = log.p)
  
  gtest_pvalue <- test_res$p.value
  gtest_esize  <- test_res$estimate # Mutual Information
  gtest_df     <- test_res$parameter
  
  # Prepare Result Data Frame
  stat_df <- data.frame(
    Metric = c("P-value", "Mutual Info", "DF"),
    Value = c(
      format(gtest_pvalue, digits = 3),
      format(gtest_esize, digits = 3),
      as.character(gtest_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, " G-Test Result\n",
      "Log P: ", round(gtest_pvalue, 2), " | ",
      "MI: ", round(gtest_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("\nG-Test (Likelihood Ratio)\n")
  # print(stat_df)
  
  invisible(list(
    contingency_table = ct,
    test_result = stat_df,
    plot_point = p_hex,
    plot_table = p_balloon
  ))
}