Update tests

Author: ms609

NAMESPACE

@@ -45,6 +45,7 @@ S3method(as.HPart,phylo)
 S3method(as.HPart_cpp,HPart_cpp)
 S3method(as.HPart_cpp,list)
 S3method(as.HPart_cpp,phylo)
+S3method(as.phylo,HPart_cpp)
 S3method(clone,HPart_cpp)
 S3method(median,multiPhylo)
 S3method(plot,HPart_cpp)
@@ -150,7 +151,6 @@ export(TreesConsistentWithTwoSplits)
 export(VisualizeMatching)
 export(as.HPart)
 export(as.HPart_cpp)
-export(as.phylo.HPart_cpp)
 export(clone)
 export(entropy_int)
 export(is.HPart)

R/hierarchical_mutual_information.R

@@ -22,7 +22,10 @@
 #' @param tree1,tree2 Trees of class \code{phylo}, or lists of such trees.
 #' If \code{tree2} is not provided, distances will be calculated between
 #' each pair of trees in the list \code{tree1}.
-#' @param normalize Logical. If \code{TRUE}, normalize the result to range [0,1].
+#' @param normalize If `FALSE`, do not normalize the result.  If a function,
+#' Normalize the result to range [0,1] by dividing by
+#' `Func(SelfHMI(tree1), SelfHMI(tree2))`, where `Func()` = `max()` if 
+#' `normalize == TRUE`, `normalize()` otherwise.
 #' @param reportMatching Logical specifying whether to return the clade
 #' matchings as an attribute of the score.
 #' 
@@ -58,7 +61,30 @@
 #' @family tree distances
 #' @export
 HierarchicalMutualInfo <- function(tree1, tree2 = NULL, normalize = FALSE) {
-  UseMethod("HierarchicalMutualInfo")
+  hp1 <- as.HPart_cpp(tree1)
+  if (is.null(tree2)) {
+    if (isFALSE(normalize)) {
+      SelfHMI_cpp(hp1)
+    } else {
+      warning("Normalized self-information == 1; did you mean to provide tree2?")
+      1
+    }
+  } else {
+    hp2 <- as.HPart_cpp(tree2)
+    hmi <- HMI_xptr(hp1, hp2)
+    if (isFALSE(normalize)) {
+      hmi
+    } else {
+      if (isTRUE(normalize)) {
+        normalize <- max
+      }
+      if (!is.function(normalize)) {
+        stop("`normalize` must be logical, or a function")
+      }
+      denom <- normalize(SelfHMI_cpp(hp1), SelfHMI_cpp(hp2))
+      hmi / denom
+    }
+  }
 }
 
 XLnX <- function(x) {

man/HierarchicalMutualInfo.Rd

@@ -122,6 +122,9 @@ double hierarchical_self_info(const std::vector<TreeDist::HNode>& nodes, size_t
 double HMI_xptr(SEXP ptr1, SEXP ptr2) {
   Rcpp::XPtr<TreeDist::HPart> hp1(ptr1);
   Rcpp::XPtr<TreeDist::HPart> hp2(ptr2);
+  if (hp1->nodes[hp1->root].n_tip != hp2->nodes[hp2->root].n_tip) {
+    Rcpp::stop("Trees must have the same number of leaves");
+  }
   return TreeDist::hierarchical_mutual_info(hp1->nodes, hp1->root,
                                             hp2->nodes, hp2->root).second;
 }

src/hmi.cpp

@@ -1,6 +1,6 @@
+library("TreeTools", quietly = TRUE)
+
 test_that("Hierarchical Mutual Information", {
-  skip_if_not_installed("TreeTools")
-  library("TreeTools", quietly = TRUE)
 
   # Create test trees
   tree1 <- BalancedTree(8)
@@ -38,97 +38,12 @@ test_that("Hierarchical Mutual Information", {
   expect_equal(hmi_self_norm, 1, tolerance = 1e-10)
 
   # Test error handling
-  expect_error(HierarchicalMutualInfo(tree1), "tree2 must be provided")
+  expect_equal(HierarchicalMutualInfo(tree1), SelfHMI(tree1))
+  expect_warning(expect_equal(HierarchicalMutualInfo(tree1, norm = TRUE), 1),
+                 "tree2")
 
   # Test with different tip numbers (should error)
   tree_small <- BalancedTree(6)
-  expect_error(HierarchicalMutualInfo(tree1, tree_small))
-  
-  # Test reportMatching
-  hmi_with_matching <- HierarchicalMutualInfo(tree1, tree2, reportMatching = TRUE)
-  expect_true(is.numeric(hmi_with_matching))
-  expect_true("matching" %in% names(attributes(hmi_with_matching)))
-  
-  # Test expected value for bal6 vs pec6 (should be approximately 0.24)
-  bal6 <- BalancedTree(6)
-  pec6 <- PectinateTree(6)
-  hmi_bal_pec <- HierarchicalMutualInfo(bal6, pec6)
-  
-  # The expected value is 0.24 based on Python reference implementation
-  expect_equal(hmi_bal_pec, 0.24, tolerance = 0.02)
-})
-
-test_that("HMI helper functions", {
-  skip_if_not_installed("TreeTools")
-  library("TreeTools", quietly = TRUE)
-  
-  tree <- BalancedTree(8)
-  
-  # Test hierarchical partition building
-  partition <- as.HPart(tree)
-  
-  expect_true(is.list(partition))
-  
-  # Test HMI recursive calculation
-  tree2 <- PectinateTree(8)
-  partition2 <- as.HPart(tree2)
-  
-  result <- .CalculateHMIRecursive(partition, partition2)
-  expect_true(is.list(result))
-  expect_true("n_ts" %in% names(result))
-  expect_true("I_ts" %in% names(result))
-  expect_true(is.numeric(result$n_ts))
-  expect_true(is.numeric(result$I_ts))
-  expect_true(result$n_ts >= 0)
-  expect_true(result$I_ts >= 0)
-})
-
-test_that("HMI comparison with standard mutual information", {
-  library("TreeTools", quietly = TRUE)
-  
-  tree1 <- BalancedTree(8)
-  tree2 <- PectinateTree(8)
-  
-  # Compare HMI with some basic principles
-  hmi <- HierarchicalMutualInfo(tree1, tree2)
-  
-  # Both should be positive for different trees
-  expect_true(hmi >= 0)
-  
-  # Test with identical trees
-  hmi_identical <- HierarchicalMutualInfo(tree1, tree1)
-  
-  expect_true(hmi_identical >= 0)
-  expect_true(is.numeric(hmi))
-  expect_true(is.numeric(hmi_identical))
-})
-
-test_that("HMI with list inputs", {
-  library("TreeTools", quietly = TRUE)
-  
-  trees <- list(
-    BalancedTree(8),
-    PectinateTree(8),
-    RandomTree(8, 1)
-  )
-  
-  # Test with list input
-  hmi_result <- HierarchicalMutualInfo(trees)
-  
-  expect_true(inherits(hmi_result, "dist"))
-  expect_equal(length(hmi_result), 3) # 3 pairwise distances for 3 trees
-  
-  # Convert to full matrix to test properties
-  hmi_matrix <- as.matrix(hmi_result)
-  expect_equal(dim(hmi_matrix), c(3, 3))
-  
-  # Matrix should be symmetric
-  expect_equal(hmi_matrix[1, 2], hmi_matrix[2, 1], tolerance = 1e-10)
-  expect_equal(hmi_matrix[1, 3], hmi_matrix[3, 1], tolerance = 1e-10)
-  expect_equal(hmi_matrix[2, 3], hmi_matrix[3, 2], tolerance = 1e-10)
-  
-  # Diagonal should be zero (distance from tree to itself in distance matrix)
-  expect_equal(hmi_matrix[1, 1], 0, tolerance = 1e-10)
-  expect_equal(hmi_matrix[2, 2], 0, tolerance = 1e-10)
-  expect_equal(hmi_matrix[3, 3], 0, tolerance = 1e-10)
+  expect_error(HierarchicalMutualInfo(tree1, tree_small),
+               "number of leaves")
 })