Patch RenumberTips

Author: ms609

R/DropTip.R

@@ -281,7 +281,11 @@ DropTip.list <- function(tree, tip, preorder = TRUE, check = TRUE) {
   if (all(vapply(tree, inherits, logical(1), "phylo"))) {
     DropTip.multiPhylo(tree, tip, preorder, check)
   } else {
-    NextMethod()
+    stop("Expected a list of `phylo` objects, but not all elements inherit ",
+         "from \"phylo\".\n  Classes found: ",
+         paste(unique(vapply(tree, function(x) paste(class(x), collapse = "/"),
+                             character(1))),
+               collapse = ", "))
   }
 }
 
@@ -291,7 +295,11 @@ KeepTip.list <- function(tree, tip, preorder = TRUE, check = TRUE) {
   if (all(vapply(tree, inherits, logical(1), "phylo"))) {
     KeepTip.multiPhylo(tree, tip, preorder, check)
   } else {
-    NextMethod()
+    stop("Expected a list of `phylo` objects, but not all elements inherit ",
+         "from \"phylo\".\n  Classes found: ",
+         paste(unique(vapply(tree, function(x) paste(class(x), collapse = "/"),
+                             character(1))),
+               collapse = ", "))
   }
 }
 

src/renumber_tips.cpp

@@ -2,8 +2,9 @@
 using namespace Rcpp;
 
 // Apply a precomputed tip permutation to every tree in batch.
-// Returns a plain list of modified phylo objects (shallow-cloned, with new
+// Returns a list of modified phylo objects (cloned, with new
 // edge matrices, updated tip.label, and "preorder" downgraded to "cladewise").
+// Preserves the class attribute (typically "phylo") on each element.
 // [[Rcpp::export]]
 Rcpp::List renumber_tips_batch(
     Rcpp::List trees,
@@ -15,10 +16,11 @@ Rcpp::List renumber_tips_batch(
   Rcpp::List result(n_trees);
 
   for (int i = 0; i < n_trees; ++i) {
-    // Shallow-clone the phylo list so other components are shared
-    Rcpp::List tree_i = Rcpp::clone(
-      Rcpp::as<Rcpp::List>(trees[i])
-    );
+    SEXP orig = trees[i];
+    SEXP orig_class = Rf_getAttrib(orig, R_ClassSymbol);
+
+    // Clone the phylo list (as<List> may strip class; restored below)
+    Rcpp::List tree_i = Rcpp::clone(Rcpp::as<Rcpp::List>(orig));
 
     // Clone and permute the edge matrix
     Rcpp::IntegerMatrix edge = Rcpp::clone(
@@ -44,6 +46,12 @@ Rcpp::List renumber_tips_batch(
       }
     }
 
+    // Restore class last, after all modifications, to ensure it sticks.
+    // Use Rf_setAttrib on the underlying SEXP to bypass Rcpp wrappers.
+    if (orig_class != R_NilValue) {
+      Rf_setAttrib(Rcpp::wrap(tree_i), R_ClassSymbol, orig_class);
+    }
+
     result[i] = tree_i;
   }
 

tests/testthat/test-DropTip.R

@@ -250,3 +250,9 @@ test_that("KeepTipPreorder()/Postorder()", {
   expect_equal(KeepTipPostorder(post, !logical(9)),
                post)
 })
+
+test_that("DropTip.list / KeepTip.list error on non-phylo elements", {
+  bad_list <- list(list(a = 1), list(b = 2))
+  expect_error(DropTip(bad_list, "x"), "not all elements inherit")
+  expect_error(KeepTip(bad_list, "x"), "not all elements inherit")
+})

tests/testthat/test-tree_numbering.R

@@ -218,6 +218,19 @@ test_that("RenumberTips.multiPhylo() materializes tip.label", {
   expect_equal(result[[2]][["tip.label"]], labs)
 })
 
+test_that("RenumberTips.multiPhylo() preserves phylo class on elements", {
+  labs <- paste0("t", 1:6)
+  mp <- structure(
+    list(BalancedTree(6), PectinateTree(6)),
+    TipLabel = labs,
+    class = "multiPhylo"
+  )
+  result <- RenumberTips(mp, rev(labs))
+  # Each element should retain class "phylo", not be downgraded to "list"
+  expect_s3_class(.subset2(result, 1), "phylo")
+  expect_s3_class(.subset2(result, 2), "phylo")
+})
+
 test_that("RenumberTips.multiPhylo() handles unlabelled different orderings", {
   # Trees with different tip orderings in an unlabelled multiPhylo
   tree_abc <- read.tree(text = "(a, (b, c));")