updated tests and examples to solve notes related to OMP threads

pneuvial · Jan 12, 2024 · c995877 · c995877
1 parent cae48ef
commit c995877
Show file tree

Hide file tree

Showing 27 changed files with 58 additions and 6 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,8 @@
 
 * Fix CRAN error on useNames (deprecated NA)
 * Fix CRAN note on itemize (unecessary use of itemize)
+* Limited OMP threads to 2 in examples, vignettes and tests
+* Updated citation of the package
 
 # Version 0.6.7  [2023-04-24]
 

diff --git a/R/adjclust.R b/R/adjclust.R
@@ -81,6 +81,7 @@ NULL
 #' and (Murtagh and Legendre, 2014) for further details.
 #'
 #' @examples
+#' \dontshow{Sys.setenv("OMP_THREAD_LIMIT" = 2)}
 #' sim <- matrix(
 #' c(1.0, 0.1, 0.2, 0.3,
 #'   0.1, 1.0 ,0.4 ,0.5,

diff --git a/R/chac.R b/R/chac.R
@@ -292,6 +292,7 @@ cutree_chac <- function(tree, k = NULL, h = NULL) {
 #'   table(selected.bs)
 #' }}
 #' 
+#' \dontshow{Sys.setenv("OMP_THREAD_LIMIT" = 2)}
 #' res <- adjClust(dist(iris[ ,1:4]))
 #' select.clust <- select(res, "bs")
 #' table(select.clust)

diff --git a/R/hicClust.R b/R/hicClust.R
@@ -56,6 +56,7 @@
 #' }
 #' 
 #' # input as text file
+#' \dontshow{Sys.setenv("OMP_THREAD_LIMIT" = 2)}
 #' res3 <- hicClust(system.file("extdata", "sample.txt", package = "adjclust"))
 #' 
 #' @export

diff --git a/R/snpClust.R b/R/snpClust.R
@@ -60,6 +60,7 @@
 #'
 #'
 #' @examples
+#' \dontshow{Sys.setenv("OMP_THREAD_LIMIT" = 2)}
 #' ## a very small example
 #' if (requireNamespace("snpStats", quietly = TRUE)) {
 #'   data(testdata, package = "snpStats")

diff --git a/man/adjClust.Rd b/man/adjClust.Rd
diff --git a/man/hicClust.Rd b/man/hicClust.Rd
diff --git a/man/select.Rd b/man/select.Rd
diff --git a/man/snpClust.Rd b/man/snpClust.Rd
diff --git a/tests/testthat/test_adjClust.R b/tests/testthat/test_adjClust.R
@@ -1,5 +1,6 @@
 test_that("adjClust methods returns expected 'calls'", {
-  sim <- matrix(
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  toto <- system.time({sim <- matrix(
     c(1.0, 0.1, 0.2, 0.3,
       0.1, 1.0 ,0.4 ,0.5,
       0.2, 0.4, 1.0, 0.6,
@@ -26,10 +27,13 @@ test_that("adjClust methods returns expected 'calls'", {
   ## dissimilarity, h < p-1
   fit4 <- adjClust(dist, "dissimilarity", h = 2)
   lst <- as.list(fit4$call)
-  expect_identical(lst[[1]], as.symbol("adjClust"))
+  expect_identical(lst[[1]], as.symbol("adjClust"))})
+
+  expect_equal(Sys.getenv("OMP_THREAD_LIMIT"), "2")
 })
 
 test_that("adjClust methods properly catches unexpected  'calls'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   mat <- matrix(NA_character_)
   expect_error(adjClust(mat), "Input matrix is not numeric")
 
@@ -68,6 +72,7 @@ test_that("adjClust methods properly catches unexpected  'calls'", {
 })
 
 test_that("'matL' and 'matR' are consistent with C++ versions", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   sim <- matrix(
     c(1.0, 0.1, 0.2, 0.3,
       0.1, 1.0 ,0.4 ,0.5,
@@ -87,6 +92,7 @@ test_that("'matL' and 'matR' are consistent with C++ versions", {
 })
 
 test_that("WCSS functions", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   sim <- matrix(
     c(1.0, 0.1, 0.2, 0.3,
       0.1, 1.0 ,0.4 ,0.5,

diff --git a/tests/testthat/test_adjclust_equivalentTo_hclust.R b/tests/testthat/test_adjclust_equivalentTo_hclust.R
@@ -3,6 +3,7 @@ context("Comparison between the results of the 'hclust' and 'adjclust' when
 
 test_that("'hclust' and 'adjClust' give identical results on toy data when the
           best merges are always adjacent merges", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[1:10,1:4])^2  ## Note the "^2"
   fit0 <- hclust(dissim, method = "ward.D")
@@ -24,6 +25,4 @@ test_that("'hclust' and 'adjClust' give identical results on toy data when the
 
   expect_equal(fit1$height, fit2$height, tolerance = 0.00001)
   expect_equal(fit1$merge, fit2$merge)
-
-
-  })
+})
diff --git a/tests/testthat/test_adjclust_equivalentTo_rioja.R b/tests/testthat/test_adjclust_equivalentTo_rioja.R
@@ -2,6 +2,7 @@ context("Comparison between the results of the 'rioja' and 'adjclust' packages")
 
 test_that("rioja and adjClust with full band give identical results on toy data", {
   skip_if_not_installed("rioja")
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
 
   data("iris")
   sim <- cor(t(iris[, 1:4]))

diff --git a/tests/testthat/test_ascendingCompatibility.R b/tests/testthat/test_ascendingCompatibility.R
@@ -7,7 +7,8 @@ check_snp <- function() {
 context("Ascending compatibility of the adjclust algorithm")
 
 test_that("snpClust gives results identical to those of adjclust 0.3.0", {
-  check_snp()  
+  check_snp()
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
 
   ## Note: this test depends on external data (genotypes) and functions 
   ## (snpStats::ld) which may change over time

diff --git a/tests/testthat/test_correct.R b/tests/testthat/test_correct.R
@@ -1,6 +1,7 @@
 context("Test outputs of diagnose and correct.")
 
 test_that("'diagnose' and 'correct' must return a warning or a message when no reversals are found.", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

diff --git a/tests/testthat/test_corrected_plot.R b/tests/testthat/test_corrected_plot.R
@@ -2,6 +2,7 @@ context("Check that the corrected plots have increasing heights")
 
 test_that("'adjClust' returns a dendrogram with increasing heights for 
           'mode=corrected'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

diff --git a/tests/testthat/test_cuttree.R b/tests/testthat/test_cuttree.R
@@ -2,6 +2,7 @@ context("Test cuttree in various situations (decreasing merges or not, k and/or
         h given.")
 
 test_that("'cuttree_chac' must ignore 'h' when reversals are present.", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

diff --git a/tests/testthat/test_dense_sparse_comparison.R b/tests/testthat/test_dense_sparse_comparison.R
@@ -1,4 +1,5 @@
 context("Comparison between the results of adjClust with sparse and dense matrices")
+Sys.setenv("OMP_THREAD_LIMIT" = 2)
 
 mat <- matrix(c(1.0, 0.0, 0.0, 0.0, 0.0, 
                 0.1, 1.0, 0.0, 0.0, 0.0, 
@@ -32,6 +33,7 @@ mat <- as(mat, "matrix")
 p <- nrow(mat)
 
 test_that("test that adjClust gives identical results for sparse and dense matrices when h < p-1", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   fit1 <- adjClust(mat, h = 2)
   fit2 <- adjClust(smat1, h = 2)
   fit3 <- adjClust(smat2, h = 2)
@@ -70,6 +72,7 @@ test_that("test that adjClust gives identical results for sparse and dense matri
 })
 
 test_that("test that adjClust gives identical results for sparse and dense matrices when h is p-1", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   fit1 <- adjClust(mat)
   fit2 <- adjClust(smat1)
   fit3 <- adjClust(smat2)

diff --git a/tests/testthat/test_final_height.R b/tests/testthat/test_final_height.R
@@ -2,6 +2,7 @@ context("Check that the sum of heights is the dataset (pseudo) inertia")
 
 test_that("'adjClust' returns an object for which the sum of heights is the 
           dataset (pseudo) inertia", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

diff --git a/tests/testthat/test_hicClust.R b/tests/testthat/test_hicClust.R
@@ -2,6 +2,8 @@ context("Consistency of the results of 'hicClust' across various input formats")
 
 test_that("'hicClust' gives identical results regardless of data input format", {
   testthat::skip_if_not_installed("HiTC")
+
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   #case1: Input as HiTC::HTCexp object
   load(system.file("extdata", "hic_imr90_40_XX.rda", package = "adjclust"))
 

diff --git a/tests/testthat/test_modify.R b/tests/testthat/test_modify.R
@@ -9,12 +9,14 @@ fit <- adjClust(sim)
 fit2 <- adjClust(sim + diag(rep(3, ncol(sim))))
 
 test_that("Results of 'adjclust' are shifted by lambda when similarity is shifted by lambda", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   expect_equal(fit$height, fit2$height - 3, tolerance = 0.00001)
   expect_equal(fit$merge, fit2$merge)
   expect_equal(fit$correction, 0)
 })
 
 test_that("Results of the algorithm are shifted by lambda when similarity is unnormalized and heights are positive", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   expect_message(fit3 <- adjClust(sim2), "added")
   expect_message(fit4 <- adjClust(sim2), fit3$correction)
 
@@ -28,6 +30,7 @@ test_that("Results of the algorithm are shifted by lambda when similarity is unn
 })
 
 test_that("A message is displayed when 'select' is used on results obtained from preprocessed matrices", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   suppressMessages({fit3 <- adjClust(sim2)})
   expect_message(adjclust::select(fit3, type = "bstick"), "might be spurious")
 })
diff --git a/tests/testthat/test_plotSim.R b/tests/testthat/test_plotSim.R
@@ -1,6 +1,7 @@
 context("Check plotSim plots for all types of input")
 
 test_that("'plotSim' works for 'matrix'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   sim <- matrix(c(1.0, 0.1, 0.2, 0.3, 
                   0.1, 1.0 ,0.4 ,0.5, 
                   0.2, 0.4, 1.0, 0.6, 
@@ -45,6 +46,7 @@ test_that("'plotSim' works for 'matrix'", {
 })
 
 test_that("'plotSim' works for 'dgCMatrix'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   sim <- Matrix::Matrix(
     c(0, 2:0, 0, 0, 0, 2:0, 0, 0, 0, 2:0, 2:0, 0, 2:0, 0, 0),
     5, 5)
@@ -66,6 +68,7 @@ test_that("'plotSim' works for 'dgCMatrix'", {
 })
 
 test_that("'plotSim' works for 'dsCMatrix'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   sim <- Matrix::Matrix(toeplitz(c(10, 0, 1, 0, 3)), sparse = TRUE)
   p <- plotSim(sim, "similarity", axis = TRUE, naxis = 2)
   expect_s3_class(p, "ggplot")
@@ -82,6 +85,7 @@ test_that("'plotSim' works for 'dsCMatrix'", {
 })
 
 test_that("'plotSim' works for 'dist'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[1:10, 1:4])^2
   fit0 <- hclust(dissim, method = "ward.D")
@@ -100,6 +104,7 @@ test_that("'plotSim' works for 'dist'", {
 })
 
 test_that("'plotSim' works for 'HTCexp'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   testthat::skip_if_not_installed("HiTC")
   load(system.file("extdata", "hic_imr90_40_XX.rda", package = "adjclust"))
   p <- plotSim(hic_imr90_40_XX, axis = TRUE)
@@ -109,6 +114,7 @@ test_that("'plotSim' works for 'HTCexp'", {
 })
 
 test_that("'plotSim' works for 'snpMatrix'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   skip_if_not_installed("snpStats")
 
   data("ld.example", package = "snpStats")

diff --git a/tests/testthat/test_similarity_equivalentTo_dissimilarity.R b/tests/testthat/test_similarity_equivalentTo_dissimilarity.R
@@ -6,13 +6,15 @@ sim <- 12-dissim^2/2
 fit1 <- adjClust(sim)
 
 test_that("Case of a dissimilarity of type 'matrix'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   fit2 <- adjClust(dissim, type = "dissimilarity")
 
   expect_equal(fit1$height, fit2$height, tolerance = 0.00001)
   expect_equal(fit1$merge, fit2$merge)
 })
 
 test_that("Case of a dissimilarity of type 'dist'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   dissim <- dist(iris[1:10,1:4])
   expect_message(fit2 <- adjClust(dissim), "type")
 

diff --git a/tests/testthat/test_snpClust.R b/tests/testthat/test_snpClust.R
@@ -13,6 +13,7 @@ test_that("'snpClust' gives identical results regardless of data input format",
   skip_if_not_installed("snpStats")
   check_snpStat_data()
 
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   h <- 100
   ld.ceph <- snpStats::ld(ceph.1mb, depth = h, stats = "R.squared")

diff --git a/tests/testthat/test_snpClust_NA-in-LD.R b/tests/testthat/test_snpClust_NA-in-LD.R
@@ -2,6 +2,8 @@ context("Case of NA values in LD estimates")
 
 check_missing_ld <- function() {
   skip_if_not_installed("snpStats")
+
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   p <- ncol(ceph.1mb)
   h <- p - 1

diff --git a/tests/testthat/test_warning_with_decreasing_height_plots.R b/tests/testthat/test_warning_with_decreasing_height_plots.R
@@ -4,6 +4,7 @@ context("Check that the messages or warnings are produced for decreasing
 test_that("'adjClust' returns a note when decreasing heights are produced and
           warnings when such results are plotted with 'mode=standard' and
           'mode=average-disp'", {
+  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

diff --git a/vignettes/hicClust.Rmd b/vignettes/hicClust.Rmd
@@ -11,6 +11,12 @@ vignette: >
   %\VignetteEncoding{UTF-8}
 ---
 
+```{r include=FALSE}
+# limit number of threads on OpenMP
+Sys.setenv("OMP_THREAD_LIMIT" = 2)
+```
+
+
 ```{r skipNoHITC}
 # IMPORTANT: this vignette can not be created if HiTC is not installed
 if (!require("HiTC", quietly = TRUE)) {

diff --git a/vignettes/snpClust.Rmd b/vignettes/snpClust.Rmd
@@ -11,6 +11,11 @@ vignette: >
   %\VignetteEncoding{UTF-8}
 ---
 
+```{r include=FALSE}
+# limit number of threads on OpenMP
+Sys.setenv("OMP_THREAD_LIMIT" = 2)
+```
+
 ```{r skipNoSNPSTATS}
 # IMPORTANT: this vignette is not created if snpStats is not installed
 if (!require("snpStats")) {