diff --git a/DESCRIPTION b/DESCRIPTION index cdd7977..1a51adb 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NEWS b/NEWS index f9d83af..4c96e17 100644 --- a/NEWS +++ b/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 diff --git a/tests/testthat/test_countInteractions.R b/tests/testthat/test_countInteractions.R index 33c6878..df2d10a 100644 --- a/tests/testthat/test_countInteractions.R +++ b/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", diff --git a/tests/testthat/test_integration_interactions.R b/tests/testthat/test_integration_interactions.R index 5d72e7a..f6701b7 100644 --- a/tests/testthat/test_integration_interactions.R +++ b/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)