tests/testthat/test_plot.R

In colocboost: Multi-Context Colocalization Analysis for QTL and GWAS Studies

library(testthat)

# Utility function to generate a simple colocboost results 
generate_test_result <- function(n = 500, p = 60, L = 4, seed = 42, output_level = 3) {
  set.seed(seed)
  
  # Generate X with LD structure
  sigma <- matrix(0, p, p)
  for (i in 1:p) {
    for (j in 1:p) {
      sigma[i, j] <- 0.9^abs(i - j)
    }
  }
  X <- MASS::mvrnorm(n, rep(0, p), sigma)
  colnames(X) <- paste0("SNP", 1:p)
  
  # Generate true effects based on the number of traits
  true_beta <- matrix(0, p, L)
  
  if (L == 1) {
    # Single trait case
    true_beta[5, 1] <- 0.5  # SNP5 affects the trait
    true_beta[30, 1] <- 0.3 # SNP10 also affects the trait
  } else if (L == 2) {
    # Simple multi-trait case
    true_beta[5, 1] <- 0.5  # SNP5 affects trait 1
    true_beta[5, 2] <- 0.4  # SNP5 also affects trait 2 (colocalized)
    true_beta[30, 2] <- 0.3 # SNP10 only affects trait 2
  } else if (L == 4) {
    # Complex multi-trait case with multiple colocalization patterns
    # SNP5 affects traits 1, 2, and 3 (colocalized across 3 traits)
    true_beta[5, 1] <- 0.5  
    true_beta[5, 2] <- 0.5
    true_beta[5, 3] <- 0.5  
    
    # SNP10 affects traits 2 and 4 (colocalized across 2 traits)
    true_beta[30, 2] <- 0.5
    true_beta[30, 4] <- 0.5
    
    # SNP15 only affects trait 3 (trait-specific effect)
    true_beta[40, 3] <- 0.6
    
    # SNP18 only affects trait 4 (trait-specific effect)
    true_beta[55, 4] <- 0.5
  }
  
  # Generate Y with some noise
  Y <- matrix(0, n, L)
  for (l in 1:L) {
    Y[, l] <- X %*% true_beta[, l] + rnorm(n, 0, 1)
  }
  
  # Prepare input for colocboost
  if (L == 1) {
    # For single trait, Y should be a vector
    Y_input <- Y[,1]
    X_input <- X
  } else {
    # For multiple traits, convert to list format
    Y_input <- lapply(1:L, function(l) Y[,l])
    X_input <- replicate(L, X, simplify = FALSE)
  }
    
  
  # Run colocboost with minimal parameters to get a model object
  suppressWarnings({
    result <- colocboost(
      X = X_input, 
      Y = Y_input,
      focal_outcome_idx = L,
      output_level = output_level
    )
  })
  
  return(result)
}

# Generate a test colocboost result
cb_res <- generate_test_result()

# Test colocboost_plot function with basic options
test_that("colocboost_plot basic functionality works", {
  
  # Basic plot call
  expect_error(suppressWarnings(colocboost_plot(cb_res)), NA)
  
  # Test with non-colocboost object
  expect_error(colocboost_plot("not_a_colocboost_object"), 
               "Input of colocboost_plot must be a 'colocboost' object!")
})

# Test colocboost_plot with different y-axis options
test_that("colocboost_plot handles different y-axis options", {
  
  # Test with different y-axis values
  expect_error(suppressWarnings(colocboost_plot(cb_res, y = "log10p")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, y = "z_original")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, y = "cos_vcp")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, y = "vcp")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, y = "coef")), NA)
  
  # Test with invalid y-axis value
  expect_error(suppressWarnings(colocboost_plot(cb_res, y = "invalid")), 
               "Invalid y value! Choose from 'log10p', 'z_original', 'vcp', 'coef', or 'cos_vcp'!")
})

# Test colocboost_plot with plot filtering options
test_that("colocboost_plot handles filtering options", {
  
  # Test with outcome index filtering
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_idx = 1)), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_idx = 2)), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_idx = 1:2)), NA)
  
  # Test with plot_cos_idx filtering
  cos_count <- length(cb_res$cos_details$cos$cos_variables)
  if (cos_count > 0) {
    expect_error(suppressWarnings(colocboost_plot(cb_res, plot_cos_idx = 1)), NA)
    
    # Test with invalid plot_cos_idx
    if (cos_count < 10) {
      expect_error(suppressWarnings(colocboost_plot(cb_res, plot_cos_idx = 10)),
                   "Please check plot_cos_idx!")
    }
  }
  
  # Test with plot_focal_only
  expect_error(suppressWarnings(colocboost_plot(cb_res, plot_focal_only = TRUE)), NA)
  
  # Test with plot_focal_cos_outcome_only
  expect_error(suppressWarnings(colocboost_plot(cb_res, plot_focal_cos_outcome_only = TRUE)), NA)
})

# Test colocboost_plot with visual customization options
test_that("colocboost_plot handles visual customization options", {
  
  # Test with custom colors
  expect_error(suppressWarnings(colocboost_plot(cb_res, points_color = "red")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, cos_color = c("blue", "green", "orange"))), NA)
  
  # Test with custom styling
  expect_error(suppressWarnings(colocboost_plot(cb_res, lab_style = c(3, 2))), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, axis_style = c(2.5, 2))), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, title_style = c(3, 3))), NA)
  
  # Test with legend position options
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_legend_pos = "top")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_legend_pos = "bottom")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_legend_pos = "left")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_legend_pos = "right")), NA)
  
  # Test with custom legend sizes
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_legend_size = 2.0)), NA)
})

# Test colocboost_plot with layout options
test_that("colocboost_plot handles layout options", {
  
  # Test with different plot_cols values
  expect_error(suppressWarnings(colocboost_plot(cb_res, plot_cols = 1)), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, plot_cols = 3)), NA)
  
  # Test with ylim_each option
  expect_error(suppressWarnings(colocboost_plot(cb_res, ylim_each = TRUE)), NA)
  # When ylim_each is FALSE, we need to provide a ylim parameter
  expect_error(suppressWarnings(colocboost_plot(cb_res, ylim_each = FALSE, ylim = c(0, 10))), NA)
  
  # Test with title_specific option
  expect_error(suppressWarnings(colocboost_plot(cb_res, title_specific = "BRCA1")), NA)
  
  # Test with variant_coord option
  expect_error(suppressWarnings(colocboost_plot(cb_res, variant_coord = FALSE)), NA)
})

# Test colocboost_plot with additional visualization options
test_that("colocboost_plot handles additional visualization options", {
  
  # Test with vertical line options
  expect_error(suppressWarnings(colocboost_plot(cb_res, add_vertical = TRUE, add_vertical_idx = c(5, 10))), NA)
  
  # Test with show_top_variables option
  expect_error(suppressWarnings(colocboost_plot(cb_res, show_top_variables = TRUE)), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res, show_top_variables = FALSE)), NA)
  
  # Test with show_variable option
  expect_error(suppressWarnings(colocboost_plot(cb_res, show_variable = TRUE)), NA)
})

# Test colocboost_plot with custom outcome names
test_that("colocboost_plot handles custom outcome names", {
  
  # Test with custom outcome names
  expect_error(suppressWarnings(colocboost_plot(cb_res, outcome_names = c("Trait1", "Trait2"))), NA)
})

# Test colocboost_plot with a specific range
test_that("colocboost_plot handles zoom-in with grange", {
  
  # Test with grange option to zoom in
  expect_error(suppressWarnings(colocboost_plot(cb_res, grange = 5:15)), NA)
})

# Test colocboost_plot with focal outcome in L=4 case
test_that("colocboost_plot handles focal outcome in complex cases", {
  
  # Generate a test colocboost result with 4 traits and focal outcome set
  cb_res_focal <- generate_test_result(L = 4, output_level = 3)
  
  # Basic plot call with focal outcome
  expect_error(suppressWarnings(colocboost_plot(cb_res_focal)), NA)
  
  # Test plot_focal_only option
  expect_error(suppressWarnings(colocboost_plot(cb_res_focal, plot_focal_only = TRUE)), NA)
  
  # Test plot_focal_cos_outcome_only option
  expect_error(suppressWarnings(colocboost_plot(cb_res_focal, plot_focal_cos_outcome_only = TRUE)), NA)
  
  # Combine focal outcome filtering with other options
  expect_error(suppressWarnings(colocboost_plot(cb_res_focal, 
                                               plot_focal_only = TRUE,
                                               y = "cos_vcp")), NA)
  
  expect_error(suppressWarnings(colocboost_plot(cb_res_focal, 
                                               plot_focal_cos_outcome_only = TRUE,
                                               plot_ucos = TRUE)), NA)
  
  # Test focusing only on outcomes colocalized with focal outcome
  expect_error(suppressWarnings(colocboost_plot(cb_res_focal, 
                                               plot_focal_cos_outcome_only = TRUE,
                                               outcome_idx = 1:3)), NA)
})


# Test colocboost_plot with single trait (finemapping) results
test_that("colocboost_plot handles single trait results", {
  
  # Generate a single trait colocboost result
  cb_res_single <- generate_test_result(L = 1)
  
  # Basic plot call for single trait
  expect_error(suppressWarnings(colocboost_plot(cb_res_single)), NA)
  
  # Test custom options with single trait
  expect_error(suppressWarnings(colocboost_plot(cb_res_single, y = "vcp")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res_single, plot_cols = 1)), NA)
})

# Test colocboost_plot with L=4 case for complex colocalization and trait-specific effects
test_that("colocboost_plot handles L=4 case with complex colocalization patterns", {
  
  # Generate a test colocboost result with 4 traits and high output level
  cb_res_complex <- generate_test_result(L = 4, output_level = 3)
  
  # Basic plot call for complex case
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex)), NA)
  
  # Test y-axis options for complex case
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex, y = "log10p")), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex, y = "cos_vcp")), NA)
  
  # Test filtering for specific outcomes
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex, outcome_idx = 1:2)), NA)
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex, outcome_idx = c(1,3))), NA)
  
  # Test plot_ucos for visualizing trait-specific effects
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex, plot_ucos = TRUE)), NA)
  
  # Test with specific plot_ucos_idx if available
  # This is conditional because it depends on the actual number of ucos detected
  if (!is.null(cb_res_complex$ucos_details) && 
      !is.null(cb_res_complex$ucos_details$ucos) && 
      length(cb_res_complex$ucos_details$ucos$ucos_index) > 0) {
    n_ucos <- length(cb_res_complex$ucos_details$ucos$ucos_index)
    if (n_ucos > 0) {
      expect_error(suppressWarnings(colocboost_plot(cb_res_complex, 
                                                   plot_ucos = TRUE, 
                                                   plot_ucos_idx = 1:min(n_ucos, 2))), NA)
    }
  }
  
  # Test visualization of both colocalization and trait-specific effects together
  expect_error(suppressWarnings(colocboost_plot(cb_res_complex, 
                                               plot_ucos = TRUE, 
                                               show_cos_to_uncoloc = TRUE)), NA)
})


# Generate a test colocboost result with high output level to include ucos details
cb_res <- generate_test_result(output_level = 3)

# Test colocboost_plot with uncolocalized visualization options
test_that("colocboost_plot handles uncolocalized visualization options", {
  
  
  # Test with plot_ucos options
  expect_error(suppressWarnings(colocboost_plot(cb_res, plot_ucos = TRUE)), NA)
  
  # Test with show_cos_to_uncoloc options
  expect_error(suppressWarnings(colocboost_plot(cb_res, show_cos_to_uncoloc = TRUE)), NA)
  
  # Generate a different colocboost result to test the warning for plot_ucos
  cb_res_low <- generate_test_result(output_level = 1)
  # This should give a warning but not an error
  expect_warning(colocboost_plot(cb_res_low, plot_ucos = TRUE),
                 "Since you want to plot trait-specific \\(uncolocalized\\) sets with plot_ucos = TRUE")
})

# Test colocboost_plot with varying cutoff settings from get_robust_colocalization
test_that("colocboost_plot handles varying cutoff settings", {
  
  # Generate a test colocboost result
  cb_res <- generate_test_result(output_level = 3)
  
  # Test with different cutoff settings
  cutoff_settings <- list(
    list(cos_npc_cutoff = 0.5, npc_outcome_cutoff = 0.2),
    list(cos_npc_cutoff = 0.7, npc_outcome_cutoff = 0.3),
    list(cos_npc_cutoff = 0.9, npc_outcome_cutoff = 0.5),
    list(cos_npc_cutoff = 1.0, npc_outcome_cutoff = 0.5),  # Corner case: cos_npc_cutoff = 1
    list(cos_npc_cutoff = 0.5, npc_outcome_cutoff = 1.0),  # Corner case: npc_outcome_cutoff = 1
    list(cos_npc_cutoff = 1.0, npc_outcome_cutoff = 1.0)   # Corner case: both cutoffs = 1
  )
  
  for (cutoff in cutoff_settings) {
    # Apply robust colocalization filtering
    filter_res <- get_robust_colocalization(
      cb_res, 
      cos_npc_cutoff = cutoff$cos_npc_cutoff, 
      npc_outcome_cutoff = cutoff$npc_outcome_cutoff
    )
    
    # Test basic plot call with filtered results
    expect_error(suppressWarnings(colocboost_plot(filter_res)), NA)
    
    # Test y-axis options with filtered results
    expect_error(suppressWarnings(colocboost_plot(filter_res, y = "log10p")), NA)
    expect_error(suppressWarnings(colocboost_plot(filter_res, y = "cos_vcp")), NA)
    
    # Test plot_focal_only option
    expect_error(suppressWarnings(colocboost_plot(filter_res, plot_focal_only = TRUE)), NA)
    
    # Test plot_ucos option
    expect_error(suppressWarnings(colocboost_plot(filter_res, plot_ucos = TRUE)), NA)
    
    # Test show_cos_to_uncoloc option
    expect_error(suppressWarnings(colocboost_plot(filter_res, show_cos_to_uncoloc = TRUE)), NA)
    
    # Test combined options
    expect_error(suppressWarnings(colocboost_plot(filter_res, 
                                                  plot_focal_only = TRUE, 
                                                  plot_ucos = TRUE, 
                                                  y = "cos_vcp")), NA)
  }
})