* Fix #45 (update 'calls' for 'adjclust.*' methods)

NEWS.md

@@ -1,5 +1,6 @@
-# dev version  [2022-12-08]
+# dev version  [2023-01-12]
 
+* Fix #45 (update 'calls' for 'adjclust.*' methods)
 * Fix #49 (calls to 'library' in tests)
 * Fix #55 (pkgdown action)
 

R/adjclust.R

@@ -126,6 +126,8 @@ adjClust.matrix <- function(mat, type = c("similarity", "dissimilarity"),
   if (!(isSymmetric(mat)))
     stop("Input matrix is not symmetric")
   res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -137,6 +139,8 @@ adjClust.dsyMatrix <- function(mat, type = c("similarity", "dissimilarity"),
   # RcppArmadillo functions don't support dsyMatrix, so convert to matrix
   res <- run.adjclust(as.matrix(mat), type = type, h = h, 
                       strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -150,6 +154,8 @@ adjClust.dgeMatrix <- function(mat, type = c("similarity", "dissimilarity"),
     mat <- forceSymmetric(mat)
   }
   res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -160,6 +166,8 @@ adjClust.dsCMatrix <- function(mat, type = c("similarity", "dissimilarity"),
   if (type == "dissimilarity")
     stop("'type' can only be 'similarity' with sparse Matrix inputs")
   res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -172,6 +180,8 @@ adjClust.dgCMatrix <- function(mat, type = c("similarity", "dissimilarity"),
     mat <- forceSymmetric(mat)
   }
   res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -182,6 +192,8 @@ adjClust.dsTMatrix <- function(mat, type = c("similarity", "dissimilarity"),
   if (type == "dissimilarity")
     stop("'type' can only be 'similarity' with sparse Matrix inputs")
   res <- run.adjclust(mat, type = type, h = h, strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -195,6 +207,8 @@ adjClust.dgTMatrix <- function(mat, type = c("similarity", "dissimilarity"),
     mat <- forceSymmetric(mat)
   }
   res <- adjClust(mat, type = type, h = h, strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 
@@ -207,6 +221,8 @@ adjClust.dist <- function(mat, type = c("similarity", "dissimilarity"),
   mat <- as.matrix(mat)
   res <- adjClust.matrix(mat, type = "dissimilarity", h = h, 
                          strictCheck = strictCheck)
+  x <- sys.call()
+  res$call <- update_call(x, "adjClust")
   return(res)
 }
 

R/helpers.R

@@ -355,3 +355,11 @@ alt.plot <- function(x, type = c("rectangle", "triangle"), center = FALSE,
                dLeaf = dLeaf, nodePar = nodePar, edgePar = edgePar, 
                horiz = horiz)
 }
+
+# update call to replace e.g. 'run.adjclust' by 'adjclust'
+update_call <- function(x, name_to) {
+  lst <- as.list(x)
+  lst[[1]] <- as.symbol(name_to)
+  as.call(lst)
+}
+

tests/testthat/test_adjClust.R

@@ -0,0 +1,30 @@
+test_that("adjClust methods returns expected 'calls'", {
+  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)
+
+  ## similarity, full width
+  fit1 <- adjClust(sim, "similarity")
+  lst <- as.list(fit1$call)
+  expect_identical(lst[[1]], as.symbol("adjClust"))
+
+  ## similarity, h < p-1
+  fit2 <- adjClust(sim, "similarity", h = 2)
+  lst <- as.list(fit2$call)
+  expect_identical(lst[[1]], as.symbol("adjClust"))
+
+  ## dissimilarity
+  dist <- as.dist(sqrt(2-(2*sim)))
+
+  ## dissimilarity, full width
+  fit3 <- adjClust(dist, "dissimilarity")
+  lst <- as.list(fit3$call)
+  expect_identical(lst[[1]], as.symbol("adjClust"))
+
+  ## dissimilarity, h < p-1
+  fit4 <- adjClust(dist, "dissimilarity", h = 2)
+  lst <- as.list(fit4$call)
+  expect_identical(lst[[1]], as.symbol("adjClust"))
+})

tests/testthat/test_dense_sparse_comparison.R

@@ -57,6 +57,16 @@ test_that("test that adjClust gives identical results for sparse and dense matri
 
   expect_equal(fit1$merge, fit7$merge)
   expect_equal(fit1$height, fit7$height)
+
+  # test that adjClust methods returns expected 'calls' for sparse matrices
+  expect_identical(as.list(fit1$call)[[1]], as.symbol("adjClust"))
+  expect_identical(as.list(fit2$call)[[1]], as.symbol("adjClust"))
+  expect_identical(as.list(fit3$call)[[1]], as.symbol("adjClust"))
+  expect_identical(as.list(fit4$call)[[1]], as.symbol("adjClust"))
+  expect_identical(as.list(fit5$call)[[1]], as.symbol("adjClust"))
+  expect_identical(as.list(fit6$call)[[1]], as.symbol("adjClust"))
+  expect_identical(as.list(fit7$call)[[1]], as.symbol("adjClust"))
+
 })
 
 test_that("test that adjClust gives identical results for sparse and dense matrices when h is p-1", {