Merge pull request #129 from BodenmillerGroup/test_fix

Fixing tests

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: imcRtools
-Version: 1.11.1
+Version: 1.11.2
 Title: Methods for imaging mass cytometry data analysis
 Description: 
     This R package supports the handling and analysis of imaging mass cytometry 

NEWS

@@ -227,3 +227,6 @@ Changes in version 1.11.1 (2024-10-03)
 
 + fixed BiocNeighbors error for DFrame type data
 
+Changes in version 1.11.2 (2024-10-08)
+
++ fixed testInteraction and countInteraction tests due to machine precision issues

tests/testthat/test_countInteractions.R

@@ -386,14 +386,14 @@ test_that("countInteractions function works", {
                                                    patch_size = 4,
                                                    colPairName = "knn_interaction_graph")) 
 
-    expect_true(all(cur_out$ct[!is.na(cur_out$ct)] == 0))
+    expect_equal(cur_out$ct[!is.na(cur_out$ct)], rep(0, 22))
 
     expect_silent(cur_out <- countInteractions(pancreasSCE, group_by = "ImageNb",
                                                    label = "CellType", method = "patch",
                                                    patch_size = 0,
                                                    colPairName = "knn_interaction_graph")) 
 
-    expect_true(all(cur_out$ct[!is.na(cur_out$ct)] == 1))
+    expect_equal(cur_out$ct[!is.na(cur_out$ct)], rep(1, 22))
 
     expect_silent(cur_out <- countInteractions(pancreasSCE, group_by = "ImageNb",
                                                    label = "CellType", method = "patch",

tests/testthat/test_integration_interactions.R

@@ -167,10 +167,12 @@ calc_p_vals<- function(dat_baseline, dat_perm, n_perm, p_tresh=0.01){
     dat_perm[, ':='(ct_perm=replace(ct_perm, is.na(ct_perm), 0),
                     ct_obs=replace(ct_obs, is.na(ct_obs), 0)
     )]
-
-
-    dat_stat = dat_perm[ , .(p_gt=ifelse(max(ct_obs)==0, 1,(sum(ct_perm>=ct_obs)+1)/(n_perm+1)),
-                             p_lt=(n_perm-sum(ct_perm>ct_obs)+1)/(n_perm+1)) , by=.(group, FirstLabel, SecondLabel)]
+    # We introduced a more lenient way of checking equality to avoid issues
+    # with machine precision
+    tolerance <- sqrt(.Machine$double.eps)
+    dat_stat <- dat_perm[ , .(p_gt = ifelse(max(ct_obs) == 0, 1, (sum((ct_perm - ct_obs) > -tolerance) + 1) / (n_perm + 1)),
+                              p_lt = (n_perm - sum((ct_perm - ct_obs) > tolerance) + 1) / (n_perm + 1)),
+                          by=.(group, FirstLabel, SecondLabel)]
 
     dat_stat[, direction := p_gt < p_lt]
     dat_stat[, p := p_gt * direction + p_lt * (direction == FALSE)]
@@ -348,12 +350,12 @@ test_that("testInteractions gives same results as neighbouRhood", {
     expect_equal(dat_p$group, imcRtools_classic_perm$group_by)
     expect_equal(as.character(dat_p$FirstLabel), imcRtools_classic_perm$from_label)
     expect_equal(as.character(dat_p$SecondLabel), imcRtools_classic_perm$to_label)
-    expect_equal(dat_p$p_gt[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$p_gt[!is.na(imcRtools_classic$ct)])
-    expect_equal(dat_p$p_lt[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$p_lt[!is.na(imcRtools_classic$ct)])
-    expect_equal(dat_p$direction[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$interaction[!is.na(imcRtools_classic$ct)])
-    expect_equal(dat_p$p[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$p[!is.na(imcRtools_classic$ct)])
-    expect_equal(dat_p$sig[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$sig[!is.na(imcRtools_classic$ct)])
-    expect_equal(dat_p$sigval[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$sigval[!is.na(imcRtools_classic$ct)])
+    expect_equal(dat_p$p_gt[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$p_gt[!is.na(imcRtools_classic_perm$ct)])
+    expect_equal(dat_p$p_lt[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$p_lt[!is.na(imcRtools_classic_perm$ct)])
+    expect_equal(dat_p$direction[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$interaction[!is.na(imcRtools_classic_perm$ct)])
+    expect_equal(dat_p$p[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$p[!is.na(imcRtools_classic_perm$ct)])
+    expect_equal(dat_p$sig[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$sig[!is.na(imcRtools_classic_perm$ct)])
+    expect_equal(dat_p$sigval[!is.na(imcRtools_classic$ct)], imcRtools_classic_perm$sigval[!is.na(imcRtools_classic_perm$ct)])
 
     ###################################### histocat #############################
     d <- prepare_tables(dat_cells, dat_relation)