Don't remove node order info when reqd

ms609 · Jul 25, 2024 · ceef251 · ceef251
1 parent dab4f75
commit ceef251
Show file tree

Hide file tree

Showing 6 changed files with 57 additions and 6 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -49,7 +49,7 @@ Imports:
   Rdpack (>= 0.7),
   shiny,
   shinyjs,
-  TreeTools (> 1.10.0),
+  TreeTools (>= 1.11.1.9004),
 Suggests:
   bookdown,
   cluster,

diff --git a/NAMESPACE b/NAMESPACE
@@ -151,6 +151,7 @@ importFrom(TreeTools,SplitInformation)
 importFrom(TreeTools,SplitsInBinaryTree)
 importFrom(TreeTools,TipLabels)
 importFrom(TreeTools,TipsInSplits)
+importFrom(TreeTools,TopologyOnly)
 importFrom(TreeTools,TreeIsRooted)
 importFrom(TreeTools,TreesMatchingSplit)
 importFrom(TreeTools,as.ClusterTable)

diff --git a/R/tree_distance_info.R b/R/tree_distance_info.R
@@ -203,9 +203,16 @@ TreeDistance <- function(tree1, tree2 = NULL) {
 }
 
 #' @rdname TreeDistance
+#' @importFrom TreeTools TopologyOnly
 #' @export
 SharedPhylogeneticInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
                                    reportMatching = FALSE, diag = TRUE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
+
   unnormalized <- CalculateTreeDistance(SharedPhylogeneticInfoSplits, tree1,
                                         tree2, reportMatching = reportMatching)
 
@@ -224,6 +231,12 @@ SharedPhylogeneticInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
 #' @export
 DifferentPhylogeneticInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
                                       reportMatching = FALSE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
+
   spi <- SharedPhylogeneticInfo(tree1, tree2, normalize = FALSE, diag = FALSE,
                                 reportMatching = reportMatching)
   treesIndependentInfo <- .MaxValue(tree1, tree2, SplitwiseInfo)
@@ -249,6 +262,12 @@ PhylogeneticInfoDistance <- DifferentPhylogeneticInfo
 #' @export
 ClusteringInfoDistance <- function(tree1, tree2 = NULL, normalize = FALSE,
                                    reportMatching = FALSE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
+
   mci <- MutualClusteringInfo(tree1, tree2, normalize = FALSE, diag = FALSE,
                               reportMatching = reportMatching)
   treesIndependentInfo <- .MaxValue(tree1, tree2, ClusteringEntropy)
@@ -315,9 +334,16 @@ ExpectedVariation <- function(tree1, tree2, samples = 1e+4) {
 
 #' @rdname TreeDistance
 #' @aliases MutualClusteringInformation
+#' @importFrom TreeTools TopologyOnly
 #' @export
 MutualClusteringInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
                                  reportMatching = FALSE, diag = TRUE) {
+  if (!reportMatching) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
+
   unnormalized <- CalculateTreeDistance(Func = MutualClusteringInfoSplits,
                                         tree1, tree2, reportMatching)
   if (diag && is.null(tree2)) {

diff --git a/R/tree_distance_nye.R b/R/tree_distance_nye.R
@@ -64,13 +64,18 @@
 #' @family tree distances
 #' 
 #' @encoding UTF-8
-#' @importFrom TreeTools NSplits SplitsInBinaryTree
+#' @importFrom TreeTools NSplits SplitsInBinaryTree TopologyOnly
 #' @export
 NyeSimilarity <- function(tree1, tree2 = NULL, similarity = TRUE,
                            normalize = FALSE,
                            normalizeMax = !is.logical(normalize),
                            reportMatching = FALSE,
                            diag = TRUE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
 
   unnormalized <- CalculateTreeDistance(NyeSplitSimilarity, tree1, tree2, 
                                         reportMatching)
@@ -179,11 +184,16 @@ NyeSplitSimilarity <- function(splits1, splits2,
 #' @family tree distances
 #' 
 #' @encoding UTF-8
-#' @importFrom TreeTools NSplits
+#' @importFrom TreeTools NSplits TopologyOnly
 #' @export
 JaccardRobinsonFoulds <- function(tree1, tree2 = NULL, k = 1L, 
                                    allowConflict = TRUE, similarity = FALSE,
                                    normalize = FALSE, reportMatching = FALSE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
   unnormalized <- CalculateTreeDistance(JaccardSplitSimilarity, tree1, tree2, 
                                         k = k, allowConflict = allowConflict, 
                                         reportMatching = reportMatching) * 2L

diff --git a/R/tree_distance_rf.R b/R/tree_distance_rf.R
@@ -66,6 +66,12 @@
 #' @rdname Robinson-Foulds
 InfoRobinsonFoulds <- function(tree1, tree2 = NULL, similarity = FALSE,
                                 normalize = FALSE, reportMatching = FALSE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
+
   unnormalized <- CalculateTreeDistance(InfoRobinsonFouldsSplits, tree1, tree2, 
                                         reportMatching) * 2
 
@@ -96,10 +102,16 @@ InfoRobinsonFouldsSplits <- function(splits1, splits2,
 }
 
 #' @rdname Robinson-Foulds
-#' @importFrom TreeTools NSplits as.ClusterTable
+#' @importFrom TreeTools as.ClusterTable NSplits TopologyOnly
 #' @export
 RobinsonFoulds <- function(tree1, tree2 = NULL, similarity = FALSE,
                             normalize = FALSE, reportMatching = FALSE) {
+  if (!isTRUE(reportMatching)) {
+    # Remove unnecessary metadata that will slow calculations
+    tree1 <- TopologyOnly(tree1)
+    tree2 <- TopologyOnly(tree2)
+  }
+
   if (is.null(tree2)) {
     ct <- as.ClusterTable(tree1)
     rf <- robinson_foulds_all_pairs(if(is.list(ct)) ct else list(ct))

diff --git a/tests/testthat/test-tree_distance.R b/tests/testthat/test-tree_distance.R
@@ -448,6 +448,7 @@ test_that("Clustering information is correctly calculated", {
     tip.label = c("t1", "t2", "t3", "t4", "t5", "t6", "t7", "t8", "t9", "t10",
                   "t11", "t12", "t13", "t14", "t15", "t16", "t17", "t18", "t19",
                   "t20"), br = NULL), class = "phylo")
+  # NOT in Preorder.  Preordering the tree will change the matching.
   threeAwayPoly <- structure(
     list(edge = structure(c(21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 29L, 
                             28L, 27L, 26L, 30L, 30L, 30L, 26L, 31L, 31L, 25L, 
@@ -463,8 +464,9 @@ test_that("Clustering information is correctly calculated", {
   expect_equal(
     MutualClusteringInfo(threeAwayPoly, randomBif20),
     MutualClusteringInfo(randomBif20, threeAwayPoly))
-  match <- MutualClusteringInfo(randomBif20, threeAwayPoly, reportMatching = TRUE)
-  expect_equal(c(NA, NA,  1,  2, NA,  3,  7, 11, 10,  4,  6,  9,  8, NA,  5, 12, NA),
+  match <- MutualClusteringInfo(randomBif20, threeAwayPoly, 
+                                reportMatching = TRUE)
+  expect_equal(c(NA, NA, 1, 2, NA, 3, 7, 11, 10, 4, 6, 9, 8, NA, 5, 12, NA),
                attr(match, "matching"))
 
   # Multiple bins, calculated expectation