finalization

R/colocboost_output.R

@@ -507,14 +507,19 @@ get_ucos_summary <- function(cb_output, outcome_names = NULL, region_name = NULL
 }
 
 #' Extract CoS at different coverages
-#'
-#' @description `get_cos` get the colocalization confidence sets (CoS) with different coverage. If Genotype...provided...check purity
-#'
+#' 
+#' @description `get_cos` extracts colocalization confidence sets (CoS) at different coverage levels 
+#' from ColocBoost results. When genotype data (X) or correlation matrix (Xcorr) is provided, it 
+#' can also calculate and filter CoS based on purity statistics, ensuring that variants within 
+#' each CoS are sufficiently correlated.
+#' 
 #' @param cb_output Output object from `colocboost` analysis
 #' @param coverage A number between 0 and 1 specifying the \dQuote{coverage} of the estimated colocalization confidence sets (CoS) (default is 0.95).
 #' @param X Genotype matrix of values of the p variables. Used to compute correlations if Xcorr is not provided.
 #' @param Xcorr Correlation matrix of correlations between variables. Alternative to X.
 #' @param n_purity The maximum number of CoS variables used in calculating the correlation (\dQuote{purity}) statistics. 
+#' @param min_abs_corr The minimum absolute correlation value of variants in a CoS to be considered pass (\dQuote{purity}) statistics.
+#' @param median_abs_corr The median absolute correlation value of variants in a CoS to be considered pass (\dQuote{purity}) statistics.
 #' When the number of variables included in the CoS is greater than this number, the CoS variables are randomly subsampled.
 #'
 #' @return A list of indices of variables in each CoS.

tests/testthat/test_colocboost.R

@@ -49,11 +49,19 @@ test_that("colocboost runs with individual data", {
   X_list <- list(test_data$X, test_data$X)
 
   # Run colocboost with minimal parameters
-  result <- colocboost(
-    X = X_list, 
-    Y = Y_list,
-    M = 10,  # Small number of iterations for testing
-    output_level = 2  # More detailed output for testing
+  warnings <- capture_warnings({
+    result <- colocboost(
+      X = X_list, 
+      Y = Y_list,
+      M = 10,  # Small number of iterations for testing
+      output_level = 2  # More detailed output for testing
+    )
+  })
+
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("smallest number of variables", warnings)) || 
+    any(grepl("did not coverage", warnings))
   )
 
   # Test that we get a colocboost object
@@ -101,11 +109,19 @@ test_that("colocboost runs with summary statistics", {
   }
 
   # Run colocboost with summary statistics
-  result <- colocboost(
-    sumstat = sumstat_list,
-    LD = list(LD),
-    M = 10,  # Small number of iterations for testing
-    output_level = 2  # More detailed output for testing
+  warnings <- capture_warnings({
+    result <- colocboost(
+      sumstat = sumstat_list,
+      LD = list(LD),
+      M = 10,  # Small number of iterations for testing
+      output_level = 2  # More detailed output for testing
+    )
+  })
+
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("smallest number of variables", warnings)) || 
+    any(grepl("did not coverage", warnings))
   )
 
   # Test that we get a colocboost object
@@ -124,12 +140,20 @@ test_that("colocboost handles focal outcome correctly", {
   X_list <- list(test_data$X, test_data$X)
 
   # Run colocboost with focal_outcome_idx = 1
-  result <- colocboost(
-    X = X_list, 
-    Y = Y_list,
-    focal_outcome_idx = 1,
-    M = 10,  # Small number of iterations for testing
-    output_level = 2  # More detailed output for testing
+  warnings <- capture_warnings({
+    result <- colocboost(
+      X = X_list, 
+      Y = Y_list,
+      focal_outcome_idx = 1,
+      M = 10,  # Small number of iterations for testing
+      output_level = 2  # More detailed output for testing
+    )
+  })
+
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("smallest number of variables", warnings)) || 
+    any(grepl("did not coverage", warnings))
   )
 
   # Test that we get a colocboost object
@@ -148,11 +172,19 @@ test_that("get_cos_summary returns expected structure", {
   X_list <- list(test_data$X, test_data$X)
 
   # Run colocboost with minimal parameters
-  result <- colocboost(
-    X = X_list, 
-    Y = Y_list,
-    M = 10,  # Small number of iterations for testing
-    output_level = 2  # More detailed output for testing
+  warnings <- capture_warnings({
+    result <- colocboost(
+      X = X_list, 
+      Y = Y_list,
+      M = 10,  # Small number of iterations for testing
+      output_level = 2  # More detailed output for testing
+    )
+  })
+
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("smallest number of variables", warnings)) || 
+    any(grepl("did not coverage", warnings))
   )
 
   # Get summary
@@ -182,11 +214,19 @@ test_that("colocboost_plot runs without error", {
   X_list <- list(test_data$X, test_data$X)
 
   # Run colocboost with minimal parameters
-  result <- colocboost(
-    X = X_list, 
-    Y = Y_list,
-    M = 10,  # Small number of iterations for testing
-    output_level = 2  # More detailed output for testing
+  warnings <- capture_warnings({
+    result <- colocboost(
+      X = X_list, 
+      Y = Y_list,
+      M = 10,  # Small number of iterations for testing
+      output_level = 2  # More detailed output for testing
+    )
+  })
+
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("smallest number of variables", warnings)) || 
+    any(grepl("did not coverage", warnings))
   )
 
   # Basic plotting should not throw an error
@@ -202,11 +242,19 @@ test_that("get_robust_colocalization maintains colocboost structure", {
   X_list <- list(test_data$X, test_data$X)
 
   # Run colocboost with minimal parameters
-  result <- colocboost(
-    X = X_list, 
-    Y = Y_list,
-    M = 10,  # Small number of iterations for testing
-    output_level = 2  # More detailed output for testing
+  warnings <- capture_warnings({
+    result <- colocboost(
+      X = X_list, 
+      Y = Y_list,
+      M = 10,
+      output_level = 2
+    )
+  })
+
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("smallest number of variables", warnings)) || 
+    any(grepl("did not coverage", warnings))
   )
 
   # Run get_strong_colocalization
@@ -234,5 +282,13 @@ test_that("colocboost handles missing/invalid inputs appropriately", {
   Y_list <- list(test_data$Y[,1], test_data$Y[,2])
   X_list <- list(X_bad, X_bad)
 
-  expect_error(colocboost(X = X_list, Y = Y_list), "Please provide the sample index of X and Y, since they do not have the same samples!")
+  expect_error(
+    suppressWarnings(
+      colocboost(
+        X = X_list, 
+        Y = Y_list
+      )
+    ),
+    "Please provide the sample index of X and Y, since they do not have the same samples!"
+  )
 })

tests/testthat/test_corner_cases.R

@@ -94,10 +94,12 @@ test_that("colocboost handles missing values in Y", {
 
   # Run colocboost - should handle NAs automatically
   expect_error(
-    result <- colocboost(
-      X = X_list, 
-      Y = Y_list,
-      M = 5  # Small number of iterations for testing
+    suppressWarnings(
+      result <- colocboost(
+        X = X_list, 
+        Y = Y_list,
+        M = 5  # Small number of iterations for testing
+      )
     ),
     NA
   )
@@ -114,9 +116,11 @@ test_that("colocboost handles different sample sizes", {
 
   # Run colocboost - should error without sample indices
   expect_error(
-    colocboost(
-      X = test_data$X, 
-      Y = test_data$Y
+    suppressWarnings(
+      colocboost(
+        X = test_data$X, 
+        Y = test_data$Y
+      )
     )
   )
 
@@ -144,13 +148,17 @@ test_that("colocboost handles different variant sets", {
   test_data <- generate_edge_case_data("different_variants")
 
   # Run colocboost
-  expect_warning(
+  warnings <- capture_warnings({
     result <- colocboost(
       X = test_data$X, 
       Y = test_data$Y,
       dict_YX = dict_YX,
       M = 5  # Small number of iterations for testing
     )
+  })
+  # Check if any of the expected warning patterns are present
+  expect_true(
+    any(grepl("did not coverage", warnings))
   )
 
   # Test that we get a colocboost object

tests/testthat/test_model.R

@@ -116,12 +116,18 @@ test_that("colocboost_workhorse performs boosting iterations", {
 
   # If the workhorse function is exported
   if (exists("colocboost_workhorse")) {
-    expect_error({
+    warnings <- capture_warnings({
       result <- colocboost_workhorse(
         cb_obj$cb_data,
         M = 5  # Small number for testing
       )
-    }, NA)
+    })
+    # Check if any of the expected warning patterns are present
+    expect_true(
+      any(grepl("did not coverage", warnings))
+    )
+    # Then test the result
+    expect_s3_class(result, "colocboost")
   } else {
     skip("colocboost_workhorse not directly accessible")
   }