Merge pull request #77 from pneuvial/develop

version 0.6.8 solving CRAN issues
pneuvial · Jan 16, 2024 · 998d52d · 998d52d
2 parents ebe2dee + f04e8fb
commit 998d52d
Show file tree

Hide file tree

Showing 42 changed files with 99 additions and 44 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -8,8 +8,8 @@ Authors@R: c(person("Christophe", "Ambroise", role="aut"),
              person("Guillem", "Rigaill", role="aut"),
              person("Nathalie", "Vialaneix", role="aut"),             
              person("Gabriel", "Hoffman", role="aut"))
-Date: 2023-04-24
-Version: 0.6.7
+Date: 2024-01-10
+Version: 0.6.8
 License: GPL-3
 Title: Adjacency-Constrained Clustering of a Block-Diagonal Similarity Matrix
 Description: Implements a constrained version of hierarchical agglomerative 

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# Version 0.6.8  [2024-01-10]
+
+* 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]
 
 * Fix #60 (increase test coverage)

diff --git a/R/adjclust.R b/R/adjclust.R
@@ -33,15 +33,14 @@ NULL
 #'   produced by the clustering process. The object is a list with the same
 #'   elements as an object of class \code{\link[stats]{hclust}} (\code{merge},
 #'   \code{height}, \code{order}, \code{labels}, \code{call}, \code{method},
-#'   \code{dist.method}), and two extra elements: \itemize{
+#'   \code{dist.method}), and two extra elements: 
 #'     \item{\code{mat}}{: (the data on which the clustering has been performed, 
 #'     possibly after the pre-transformations described in the vignette entitled
 #'     \href{https://pneuvial.github.io/adjclust/articles/notesCHAC.html#notes-on-relations-between-similarity-and-dissimilarity-implementation}{"Notes on CHAC implementation in adjclust"}}.
 #'     \item{\code{correction}}{: the value of the correction for non positive
 #'     definite similarity matrices (also described in the same vignette). If
 #'     \code{correction == 0}, it means that the initial data were not 
 #'     pre-transformed.}
-#'  }
 #'
 #' @seealso \code{\link{snpClust}} to cluster SNPs based on linkage
 #'   disequilibrium
@@ -263,24 +262,24 @@ run.adjclust <- function(mat, type = c("similarity", "dissimilarity"), h,
   if (is(mat, "sparseMatrix")) { 
     # left  
     rCumL <- matL_sparse_rowCumsums(mat, h)
-    rcCumL <- colCumsums(rCumL) # p x (h+1) matrix
+    rcCumL <- colCumsums(rCumL, useNames = FALSE) # p x (h+1) matrix
     rm(rCumL)
 
     # right
     rCumR <- matR_sparse_rowCumsums(mat, h)
-    rcCumR <- colCumsums(rCumR) # p x (h+1) matrix
+    rcCumR <- colCumsums(rCumR, useNames = FALSE) # p x (h+1) matrix
     rm(rCumR)
 
     out_matL <- matL_sparse(mat, 2)
   } else {
     # left
     rCumL <- matL_full_rowCumsums(mat, h)
-    rcCumL <- colCumsums(rCumL) # p x (h+1) matrix
+    rcCumL <- colCumsums(rCumL, useNames = FALSE) # p x (h+1) matrix
     rm(rCumL)
 
     # right
     rCumR <- matR_full_rowCumsums(mat, h)
-    rcCumR <- colCumsums(rCumR) # p x (h+1) matrix
+    rcCumR <- colCumsums(rCumR, useNames = FALSE) # p x (h+1) matrix
     rm(rCumR)
 
     out_matL <- matL_full(mat, 2)

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

diff --git a/R/helpers.R b/R/helpers.R
@@ -223,8 +223,8 @@ alt.plotNode <- function(x1, x2, subtree, type, center, leaflab, dLeaf, nodePar,
       vln <- NULL
       if (is.leaf(child) && leaflab == "textlike") {
         nodeText <- asTxt(attr(child, "label"))
-        cat("nodeText 2 vaut : ")
-        print(nodeText)
+        # cat("nodeText 2 vaut : ")
+        # print(nodeText)
         if (getOption("verbose")) 
           cat("-- with \"label\"", format(nodeText))
         hln <- 0.6 * strwidth(nodeText, cex = lab.cex)/2

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

diff --git a/R/snpClust.R b/R/snpClust.R
@@ -61,7 +61,7 @@
 #'
 #' @examples
 #' ## a very small example
-#' if (requireNamespace("snpStats", quietly = TRUE)) {
+#' \dontrun{
 #'   data(testdata, package = "snpStats")
 #'
 #'   # input as snpStats::SnpMatrix

diff --git a/R/zzzz.R b/R/zzzz.R
@@ -0,0 +1,4 @@
+.onLoad <- function(libname, pkgname) {
+  # CRAN OMP THREAD LIMIT
+  Sys.setenv("OMP_THREAD_LIMIT" = 1)
+}
diff --git a/README.Rmd b/README.Rmd
@@ -17,7 +17,7 @@ knitr::opts_chunk$set(
 
 [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/adjclust)](https://cran.r-project.org/package=adjclust)
 [![R build status](https://github.com/pneuvial/adjclust/workflows/R-CMD-check/badge.svg)](https://github.com/pneuvial/adjclust/actions)
-[![Coverage Status](https://img.shields.io/codecov/c/github/pneuvial/adjclust/develop.svg)](https://codecov.io/github/pneuvial/adjclust/branch/develop)
+[![Coverage Status](https://img.shields.io/codecov/c/github/pneuvial/adjclust/develop.svg)](https://app.codecov.io/github/pneuvial/adjclust/branch/develop)
 
 `adjclust` is a package that provides methods to perform adjacency-constrained hierarchical agglomerative clustering. Adjacency-constrained hierarchical agglomerative clustering is hierarchical agglomerative clustering (HAC) in which each observation is associated to a position, and the clustering is constrained so as only adjacent clusters are merged. It is useful in bioinformatics (e.g. Genome Wide Association Studies or Hi-C data analysis).
 

diff --git a/README.md b/README.md
@@ -5,7 +5,7 @@
 [![R build
 status](https://github.com/pneuvial/adjclust/workflows/R-CMD-check/badge.svg)](https://github.com/pneuvial/adjclust/actions)
 [![Coverage
-Status](https://codecov.io/gh/pneuvial/adjclust/branch/develop/graph/badge.svg)](https://app.codecov.io/gh/pneuvial/adjclust/tree/develop)
+Status](https://img.shields.io/codecov/c/github/pneuvial/adjclust/develop.svg)](https://app.codecov.io/github/pneuvial/adjclust/branch/develop)
 
 `adjclust` is a package that provides methods to perform
 adjacency-constrained hierarchical agglomerative clustering.
@@ -76,10 +76,9 @@ image(ld.ceph, lwd = 0)
 fit <- snpClust(geno, stats = "R.squared", h = h)
 #> Warning in run.snpClust(x, h = h, stats = stats): Forcing the LD similarity to
 #> be smaller than or equal to 1
-#> as(<dsTMatrix>, "dgTMatrix") is deprecated since Matrix 1.4-2; do as(., "generalMatrix") instead
 #> Note: 133 merges with non increasing heights.
 plot(fit)
-#> Warning in plot.chac(fit): 
+#> Warning: 
 #> Detected reversals in dendrogram: mode = 'corrected', 'within-disp' or 'total-disp' might be more relevant.
 ```
 
@@ -88,6 +87,9 @@ plot(fit)
 ``` r
 sel_clust <- select(fit, "bs")
 plotSim(as.matrix(ld.ceph), clustering = sel_clust, dendro = fit)
+#> Warning: 
+#> Detected reversals in dendrogram: mode = 'corrected', 'within-disp' or 'total-disp' might be more relevant.
+#> Warning: Removed 602 rows containing missing values (`geom_text()`).
 ```
 
 ![](man/figures/README-snpClust-3.png)<!-- -->
@@ -118,14 +120,17 @@ mapC(binned)
 fitB <- hicClust(binned)
 #> Note: 5 merges with non increasing heights.
 plot(fitB)
-#> Warning in plot.chac(fitB): 
+#> Warning: 
 #> Detected reversals in dendrogram: mode = 'corrected', 'within-disp' or 'total-disp' might be more relevant.
 ```
 
 ![](man/figures/README-hicClust-2.png)<!-- -->
 
 ``` r
 plotSim(intdata(binned), dendro = fitB) # default: log scale for colors
+#> Warning: 
+#> Detected reversals in dendrogram: mode = 'corrected', 'within-disp' or 'total-disp' might be more relevant.
+#> Warning: Removed 41 rows containing missing values (`geom_text()`).
 ```
 
 ![](man/figures/README-hicClust-3.png)<!-- -->

diff --git a/man/adjClust.Rd b/man/adjClust.Rd
diff --git a/man/figures/README-adjClust-1.png b/man/figures/README-adjClust-1.png
diff --git a/man/figures/README-hicClust-1.png b/man/figures/README-hicClust-1.png
diff --git a/man/figures/README-hicClust-2.png b/man/figures/README-hicClust-2.png
diff --git a/man/figures/README-hicClust-3.png b/man/figures/README-hicClust-3.png
diff --git a/man/figures/README-snpClust-1.png b/man/figures/README-snpClust-1.png
diff --git a/man/figures/README-snpClust-2.png b/man/figures/README-snpClust-2.png
diff --git a/man/figures/README-snpClust-3.png b/man/figures/README-snpClust-3.png
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/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -132,8 +132,8 @@ BEGIN_RCPP
 END_RCPP
 }
 
-RcppExport SEXP cWardHeaps(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
-RcppExport SEXP percDown(SEXP, SEXP, SEXP, SEXP);
+RcppExport SEXP cWardHeaps(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+RcppExport SEXP percDown(void *, void *, void *, void *);
 
 static const R_CallMethodDef CallEntries[] = {
     {"_adjclust_matL_sparse", (DL_FUNC) &_adjclust_matL_sparse, 2},

diff --git a/tests/testthat.R b/tests/testthat.R
@@ -1,4 +1,4 @@
 library("testthat")
 library("adjclust")
 
-test_check("adjclust")
+#test_check("adjclust")
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_chac.R b/tests/testthat/test_chac.R
@@ -1,16 +1,10 @@
 test_that("Methods of class 'chac'", {
+  #Sys.setenv("OMP_THREAD_LIMIT" = 2)
   data("iris")
   dissim <- dist(iris[, 1:4])^2
   sim <- 1-as.matrix(dissim)/2
   fit <- adjClust(sim)
-  adjclust::select(fit, type = "capushe")
-  adjclust::select(fit, type = "bs", graph = TRUE)
-  #adjclust::select(fit, graph = TRUE) # error plot DDSE (uses base "plot" ?)
 
-  class(fit)
-  print(fit)
-  head(fit)
-  summary(fit)
   fit2 <- correct(fit)
   expect_error(plot(fit2, mode = "corrected"),
                "Already corrected 'chac' object. 'mode' must be set to 'standard'")
@@ -22,14 +16,8 @@ test_that("Methods of class 'chac'", {
   p <- plot(fit2, nodeLabel = TRUE, leaflab = "textlike")
   attr(fit2, "edgetext") <- "test text"  # does not work
   p <- plot(fit2, nodeLabel = TRUE)
-  options(verbose = TRUE)
   p <- plot(fit2, nodeLabel = TRUE, leaflab = "textlike")
-  options(verbose = FALSE)
-  diagnose(fit)
-  diagnose(fit, graph = TRUE)
-  diagnose(fit, verbose = TRUE)
 
   fit_h <- hclust(dissim)
-  expect_error(cutree_chac(fit_h), 
-               "'tree' must be of class 'chac'")
+  expect_error(cutree_chac(fit_h), "'tree' must be of class 'chac'")
 })
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