set OMP threads to 1 on load and commented some examples

R/adjclust.R

@@ -81,7 +81,6 @@ 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,

R/chac.R

@@ -292,8 +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]))
+#' res <- adjClust(dist(iris[, 1:4]))
 #' select.clust <- select(res, "bs")
 #' table(select.clust)
 #' 

R/hicClust.R

@@ -56,8 +56,9 @@
 #' }
 #' 
 #' # input as text file
-#' \dontshow{Sys.setenv("OMP_THREAD_LIMIT" = 2)}
+#' \dontrun{
 #' res3 <- hicClust(system.file("extdata", "sample.txt", package = "adjclust"))
+#' }
 #' 
 #' @export
 #' 

R/zzzz.R

@@ -0,0 +1,4 @@
+.onLoad <- function(libname, pkgname) {
+  # CRAN OMP THREAD LIMIT
+  Sys.setenv("OMP_THREAD_LIMIT" = 1)
+}

tests/testthat/test_adjClust.R

@@ -1,5 +1,5 @@
 test_that("adjClust methods returns expected 'calls'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #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,
@@ -29,11 +29,11 @@ test_that("adjClust methods returns expected 'calls'", {
   lst <- as.list(fit4$call)
   expect_identical(lst[[1]], as.symbol("adjClust"))})
 
-  expect_equal(Sys.getenv("OMP_THREAD_LIMIT"), "2")
+  #expect_equal(Sys.getenv("OMP_THREAD_LIMIT"), "2")
 })
 
 test_that("adjClust methods properly catches unexpected  'calls'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   mat <- matrix(NA_character_)
   expect_error(adjClust(mat), "Input matrix is not numeric")
 
@@ -72,7 +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)
+  #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,
@@ -92,7 +92,7 @@ test_that("'matL' and 'matR' are consistent with C++ versions", {
 })
 
 test_that("WCSS functions", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #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,

tests/testthat/test_adjclust_equivalentTo_hclust.R

@@ -3,7 +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)
+  #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")

tests/testthat/test_adjclust_equivalentTo_rioja.R

@@ -2,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
 
   data("iris")
   sim <- cor(t(iris[, 1:4]))

tests/testthat/test_ascendingCompatibility.R

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

tests/testthat/test_chac.R

@@ -1,5 +1,5 @@
 test_that("Methods of class 'chac'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[, 1:4])^2
   sim <- 1-as.matrix(dissim)/2

tests/testthat/test_correct.R

@@ -1,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

tests/testthat/test_corrected_plot.R

@@ -2,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

tests/testthat/test_cuttree.R

@@ -2,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

tests/testthat/test_dense_sparse_comparison.R

@@ -1,5 +1,5 @@
 context("Comparison between the results of adjClust with sparse and dense matrices")
-Sys.setenv("OMP_THREAD_LIMIT" = 2)
+#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, 
@@ -33,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   fit1 <- adjClust(mat, h = 2)
   fit2 <- adjClust(smat1, h = 2)
   fit3 <- adjClust(smat2, h = 2)
@@ -72,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   fit1 <- adjClust(mat)
   fit2 <- adjClust(smat1)
   fit3 <- adjClust(smat2)

tests/testthat/test_final_height.R

@@ -2,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2

tests/testthat/test_hicClust.R

@@ -3,7 +3,7 @@ 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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   #case1: Input as HiTC::HTCexp object
   load(system.file("extdata", "hic_imr90_40_XX.rda", package = "adjclust"))
 

tests/testthat/test_modify.R

@@ -1,6 +1,6 @@
 context("Correctness of handling general similarity matrices")
 
-Sys.setenv("OMP_THREAD_LIMIT" = 2)
+#Sys.setenv("OMP_THREAD_LIMIT" = 2)
 data("iris")
 dissim <- dist(iris[1:10,1:4])^2
 sim <- 1-as.matrix(dissim)/2
@@ -10,14 +10,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)
+  #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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   expect_message(fit3 <- adjClust(sim2), "added")
   expect_message(fit4 <- adjClust(sim2), fit3$correction)
 
@@ -31,7 +31,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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   suppressMessages({fit3 <- adjClust(sim2)})
   expect_message(adjclust::select(fit3, type = "bstick"), "might be spurious")
 })

tests/testthat/test_plotSim.R

@@ -1,7 +1,7 @@
 context("Check plotSim plots for all types of input")
 
 test_that("'plotSim' works for 'matrix'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #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, 
@@ -46,7 +46,7 @@ test_that("'plotSim' works for 'matrix'", {
 })
 
 test_that("'plotSim' works for 'dgCMatrix'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #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)
@@ -68,7 +68,7 @@ test_that("'plotSim' works for 'dgCMatrix'", {
 })
 
 test_that("'plotSim' works for 'dsCMatrix'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #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")
@@ -85,7 +85,7 @@ test_that("'plotSim' works for 'dsCMatrix'", {
 })
 
 test_that("'plotSim' works for 'dist'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[1:10, 1:4])^2
   fit0 <- hclust(dissim, method = "ward.D")
@@ -104,8 +104,9 @@ test_that("'plotSim' works for 'dist'", {
 })
 
 test_that("'plotSim' works for 'HTCexp'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   testthat::skip_if_not_installed("HiTC")
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
+
   load(system.file("extdata", "hic_imr90_40_XX.rda", package = "adjclust"))
   p <- plotSim(hic_imr90_40_XX, axis = TRUE)
   expect_s3_class(p, "ggplot")
@@ -114,8 +115,8 @@ test_that("'plotSim' works for 'HTCexp'", {
 })
 
 test_that("'plotSim' works for 'snpMatrix'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
   skip_if_not_installed("snpStats")
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
 
   data("ld.example", package = "snpStats")
   ceph.1mb[4, 286]@.Data[1, 1] <- as.raw(3) ## to avoid NaNs

tests/testthat/test_similarity_equivalentTo_dissimilarity.R

@@ -1,21 +1,21 @@
 context("Equivalence between similarity and dissimilarity implementations")
 
-Sys.setenv("OMP_THREAD_LIMIT" = 2)
+#Sys.setenv("OMP_THREAD_LIMIT" = 2)
 data("iris")
 dissim <- as.matrix(dist(iris[1:10,1:4]))
 sim <- 12-dissim^2/2
 fit1 <- adjClust(sim)
 
 test_that("Case of a dissimilarity of type 'matrix'", {
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   dissim <- dist(iris[1:10,1:4])
   expect_message(fit2 <- adjClust(dissim), "type")
 

tests/testthat/test_snpClust.R

@@ -13,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   h <- 100
   ld.ceph <- snpStats::ld(ceph.1mb, depth = h, stats = "R.squared")

tests/testthat/test_snpClust_NA-in-LD.R

@@ -3,7 +3,7 @@ context("Case of NA values in LD estimates")
 check_missing_ld <- function() {
   skip_if_not_installed("snpStats")
 
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   p <- ncol(ceph.1mb)
   h <- p - 1
@@ -22,7 +22,7 @@ test_that("NA values in LD estimates gives a warning/error in 'snpClust'", {
   skip_if_not_installed("snpStats")
   check_missing_ld()
 
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   p <- ncol(ceph.1mb)
   h <- p - 1
@@ -39,7 +39,7 @@ test_that("NA values in LD estimates gives a warning/error in 'snpClust' (second
   # when check_missing_ld() skips the previous test: it means that snpClust does not produce NA
   skip_if_not_installed("snpStats")
 
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   p <- ncol(ceph.1mb)
   h <- p - 1
@@ -59,7 +59,7 @@ test_that("Dropping a SNP yielding NA values in LD fixes the NA problem", {
   skip_if_not_installed("snpStats")
   check_missing_ld()
 
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   geno <- ceph.1mb[, -316]  ## drop one SNP leading to one missing LD value
   p <- ncol(geno)
   h <- p - 1
@@ -81,7 +81,7 @@ test_that("Modifying one genotype also fixes the NA problem", {
   skip_if_not_installed("snpStats")
   check_missing_ld()
 
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("ld.example", package = "snpStats")
   p <- ncol(ceph.1mb)
   h <- p - 1

tests/testthat/test_warning_with_decreasing_height_plots.R

@@ -4,7 +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)
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[ ,1:4])^2
   sim <- 1-as.matrix(dissim)/2