Merge pull request #80 from pneuvial/develop

version 0.6.9

Author: tuxette

DESCRIPTION

@@ -1,15 +1,18 @@
 Package: adjclust
 Maintainer: Pierre Neuvial <[email protected]>
-Authors@R: c(person("Christophe", "Ambroise", role="aut"),
-             person("Shubham", "Chaturvedi", role="aut"),
-             person("Alia", "Dehman", role="aut"),
-             person("Pierre", "Neuvial", role=c("aut", "cre"), 
-                 email="[email protected]"),
-             person("Guillem", "Rigaill", role="aut"),
-             person("Nathalie", "Vialaneix", role="aut"),             
-             person("Gabriel", "Hoffman", role="aut"))
-Date: 2024-01-10
-Version: 0.6.8
+Authors@R: c(person("Christophe", "Ambroise", role = "aut"),
+             person("Shubham", "Chaturvedi", role = "aut"),
+             person("Alia", "Dehman", role = "aut"),
+             person("Pierre", "Neuvial", role = c("aut", "cre"), 
+                    email = "[email protected]",
+		    comment = c(ORCID = "0000-0003-3584-9998")),	
+             person("Guillem", "Rigaill", role = "aut"),
+             person("Nathalie", "Vialaneix", role = "aut", 
+                    email = "[email protected]",
+		    comment = c(ORCID = "0000-0003-1156-0639")),
+             person("Gabriel", "Hoffman", role = "aut"))
+Date: 2024-02-07
+Version: 0.6.9
 License: GPL-3
 Title: Adjacency-Constrained Clustering of a Block-Diagonal Similarity Matrix
 Description: Implements a constrained version of hierarchical agglomerative 
@@ -48,7 +51,7 @@ biocViews:
 VignetteBuilder: knitr
 URL: https://pneuvial.github.io/adjclust/
 BugReports: https://github.com/pneuvial/adjclust/issues
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 LinkingTo: 
     Rcpp, 
     RcppArmadillo

NEWS.md

@@ -1,3 +1,11 @@
+# Version 0.6.9  [2024-02-07]
+
+* Properly handled OMP threads in C++ code (now default to 1 but with an option
+to increase this value)
+* Reintroduced tests and examples
+* Removed WCSS function that was not exported or documented
+* Fixed a problem in S3class for a non exported function
+
 # Version 0.6.8  [2024-01-10]
 
 * Fix CRAN error on useNames (deprecated NA)

R/RcppExports.R

@@ -9,12 +9,12 @@ matL_full <- function(Csq, h) {
     .Call(`_adjclust_matL_full`, Csq, h)
 }
 
-matL_sparse_rowCumsums <- function(Csq, h) {
-    .Call(`_adjclust_matL_sparse_rowCumsums`, Csq, h)
+matL_sparse_rowCumsums <- function(Csq, h, nthreads) {
+    .Call(`_adjclust_matL_sparse_rowCumsums`, Csq, h, nthreads)
 }
 
-matL_full_rowCumsums <- function(Csq, h) {
-    .Call(`_adjclust_matL_full_rowCumsums`, Csq, h)
+matL_full_rowCumsums <- function(Csq, h, nthreads) {
+    .Call(`_adjclust_matL_full_rowCumsums`, Csq, h, nthreads)
 }
 
 matR_sparse <- function(Csq, h) {
@@ -25,19 +25,11 @@ matR_full <- function(Csq, h) {
     .Call(`_adjclust_matR_full`, Csq, h)
 }
 
-matR_sparse_rowCumsums <- function(Csq, h) {
-    .Call(`_adjclust_matR_sparse_rowCumsums`, Csq, h)
+matR_sparse_rowCumsums <- function(Csq, h, nthreads) {
+    .Call(`_adjclust_matR_sparse_rowCumsums`, Csq, h, nthreads)
 }
 
-matR_full_rowCumsums <- function(Csq, h) {
-    .Call(`_adjclust_matR_full_rowCumsums`, Csq, h)
-}
-
-wcss_single <- function(C, cluster) {
-    .Call(`_adjclust_wcss_single`, C, cluster)
-}
-
-WCSS <- function(C, clusterMat) {
-    .Call(`_adjclust_WCSS`, C, clusterMat)
+matR_full_rowCumsums <- function(Csq, h, nthreads) {
+    .Call(`_adjclust_matR_full_rowCumsums`, Csq, h, nthreads)
 }
 

R/adjclust.R

@@ -16,7 +16,7 @@ NULL
 #' band of width \code{h}). The method is fully described in (Dehman, 2015) and
 #' based on a kernel version of the algorithm. The different options for the
 #' implementation are available in the package vignette entitled 
-#' \href{https://pneuvial.github.io/adjclust/articles/notesCHAC.html}{"Notes on CHAC implementation in adjclust}.
+#' \href{https://pneuvial.github.io/adjclust/articles/notesCHAC.html}{"Notes on CHAC implementation in adjclust"}.
 #'
 #' @param mat A similarity matrix or a dist object. Most sparse formats from
 #'   \code{\link[Matrix]{sparseMatrix}} are allowed
@@ -28,6 +28,8 @@ NULL
 #' @param strictCheck Logical (default to \code{TRUE}) to systematically check
 #'   default of positivity in input similarities. Can be disabled to avoid
 #'   computationally expensive checks when the number of features is large.
+#' @param nthreads Integer (default to \code{1L}). Number of threads use for
+#' matrix precomputations.
 #'
 #' @returns An object of class \code{\link{chac}} which describes the tree
 #'   produced by the clustering process. The object is a list with the same
@@ -82,10 +84,11 @@ NULL
 #'
 #' @examples
 #' 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,
-#'   0.3, 0.5, 0.6, 1.0), nrow = 4)
+#'   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,
+#'     0.3, 0.5, 0.6, 1.0), 
+#'  nrow = 4)
 #'
 #' ## similarity, full width
 #' fit1 <- adjClust(sim, "similarity")
@@ -112,112 +115,124 @@ NULL
 #' @importFrom Matrix diag
 #' @importFrom Matrix t
 adjClust <- function(mat, type = c("similarity", "dissimilarity"), 
-                     h = ncol(mat) - 1, strictCheck=TRUE) {
+                     h = ncol(mat) - 1, strictCheck = TRUE, nthreads = 1L) {
   UseMethod("adjClust")
 }
 
 #' @importFrom Matrix isSymmetric forceSymmetric
 #' @export
 adjClust.matrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                            h = ncol(mat) - 1, strictCheck = TRUE) {
+                            h = ncol(mat) - 1, strictCheck = TRUE,
+                            nthreads = 1L) {
   if (!is.numeric(mat))
     stop("Input matrix is not numeric")
   if (!(isSymmetric(mat)))
     stop("Input matrix is not symmetric")
-  res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck)
+  res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck,
+                      nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dsyMatrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                            h = ncol(mat) - 1, strictCheck = TRUE) {
+                            h = ncol(mat) - 1, strictCheck = TRUE, 
+                            nthreads = 1L) {
   # RcppArmadillo functions don't support dsyMatrix, so convert to matrix
   res <- run.adjclust(as.matrix(mat), type = type, h = h, 
-                      strictCheck = strictCheck)
+                      strictCheck = strictCheck, nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dgeMatrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                               h = ncol(mat) - 1, strictCheck = TRUE) {
+                               h = ncol(mat) - 1, strictCheck = TRUE, 
+                               nthreads = 1L) {
   type <- match.arg(type)
   if (!(isSymmetric(mat))) {
     stop("Input matrix is not symmetric")
-  } else {
-    mat <- forceSymmetric(mat)
-  }
-  res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck)
+  } else mat <- forceSymmetric(mat)
+  res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck, 
+                  nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dsCMatrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                               h = ncol(mat) - 1, strictCheck = TRUE) {
+                               h = ncol(mat) - 1, strictCheck = TRUE, 
+                               nthreads = 1L) {
   type <- match.arg(type)
   if (type == "dissimilarity")
     stop("'type' can only be 'similarity' with sparse Matrix inputs")
-  res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck)
+  res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck,
+                      nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dgCMatrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                               h = ncol(mat) - 1, strictCheck = TRUE) {
+                               h = ncol(mat) - 1, strictCheck = TRUE,
+                               nthreads = 1L) {
   if (!(isSymmetric(mat))) {
     stop("Input matrix is not symmetric")
   } else {
     mat <- forceSymmetric(mat)
   }
-  res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck)
+  res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck, 
+                  nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dsTMatrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                               h = ncol(mat) - 1, strictCheck = TRUE) {
+                               h = ncol(mat) - 1, strictCheck = TRUE, 
+                               nthreads = 1L) {
   type <- match.arg(type)
   if (type == "dissimilarity")
     stop("'type' can only be 'similarity' with sparse Matrix inputs")
-  res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck)
+  res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck, 
+                      nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dgTMatrix <- function(mat, type = c("similarity", "dissimilarity"), 
-                               h = ncol(mat) - 1, strictCheck = TRUE) {
+                               h = ncol(mat) - 1, strictCheck = TRUE,
+                               nthreads = 1L) {
   type <- match.arg(type)
   if (!(isSymmetric(mat))) {
     stop("Input matrix is not symmetric")
   } else {
     mat <- forceSymmetric(mat)
   }
-  res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck)
+  res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck,
+                  nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
 }
 
 #' @export
 adjClust.dist <- function(mat, type = c("similarity", "dissimilarity"), 
-                          h = ncol(mat) - 1, strictCheck = TRUE) {
+                          h = ncol(mat) - 1, strictCheck = TRUE, 
+                          nthreads = 1L) {
   type <- match.arg(type)
   if (type != "dissimilarity")
     message("Note: input class is 'dist' so 'type' is supposed to be 'dissimilarity'")
   mat <- as.matrix(mat)
   res <- adjClust.matrix(mat, type = "dissimilarity", h = h, 
-                         strictCheck = strictCheck)
+                         strictCheck = strictCheck, nthreads = nthreads)
   x <- sys.call()
   res$call <- update_call(x, "adjClust")
   return(res)
@@ -226,7 +241,7 @@ adjClust.dist <- function(mat, type = c("similarity", "dissimilarity"),
 #' @importFrom methods is
 #' @import Rcpp
 run.adjclust <- function(mat, type = c("similarity", "dissimilarity"), h, 
-                         strictCheck = TRUE) {
+                         strictCheck = TRUE, nthreads = 1L) {
   # sanity checks
   type <- match.arg(type)
   if (any(is.na(mat)))
@@ -261,24 +276,24 @@ run.adjclust <- function(mat, type = c("similarity", "dissimilarity"), h,
 
   if (is(mat, "sparseMatrix")) { 
     # left  
-    rCumL <- matL_sparse_rowCumsums(mat, h)
+    rCumL <- matL_sparse_rowCumsums(mat, h, nthreads = nthreads)
     rcCumL <- colCumsums(rCumL, useNames = FALSE) # p x (h+1) matrix
     rm(rCumL)
 
     # right
-    rCumR <- matR_sparse_rowCumsums(mat, h)
+    rCumR <- matR_sparse_rowCumsums(mat, h, nthreads = nthreads)
     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)
+    rCumL <- matL_full_rowCumsums(mat, h, nthreads = nthreads)
     rcCumL <- colCumsums(rCumL, useNames = FALSE) # p x (h+1) matrix
     rm(rCumL)
 
     # right
-    rCumR <- matR_full_rowCumsums(mat, h)
+    rCumR <- matR_full_rowCumsums(mat, h, nthreads = nthreads)
     rcCumR <- colCumsums(rCumR, useNames = FALSE) # p x (h+1) matrix
     rm(rCumR)
 

R/hicClust.R

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

R/plotSim.R

@@ -303,7 +303,10 @@ plotSim.default <- function(mat, type = c("similarity", "dissimilarity"),
   # Coordinate computation ####
   if (type == "dissimilarity") mat <- max(mat) - mat
 
-  coordinates <- poly_coords(mat)
+  if (inherits(mat, "dsCMatrix")) {
+    poly_coords_fun <- poly_coords_dsCMatrix
+  } else poly_coords_fun <- poly_coords_default
+  coordinates <- poly_coords_fun(mat)
   fake_coords <- make_coords(c(1, d, d), c(1, d, 1), rep(0, 3))
 
 
@@ -463,11 +466,7 @@ poly_coords_sparse <- function(mat) {
   return(coords)
 }
 
-poly_coords <- function(mat) {
-  UseMethod("poly_coords")
-}
-
-poly_coords.default <- function(mat) {
+poly_coords_default <- function(mat) {
   # extracting coordinates in the matrix (genomic) and IF
   p <- ncol(mat)
   indi <- row(mat)
@@ -481,7 +480,7 @@ poly_coords.default <- function(mat) {
   return(coords)
 }
 
-poly_coords.dsCMatrix <- function(mat) {
+poly_coords_dsCMatrix <- function(mat) {
   p <- ncol(mat)
   mat <- as(mat, "TsparseMatrix")
   coords <- poly_coords_sparse(mat)

R/snpClust.R

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