From 1ac2a4301f91230d79f2c8874daa0315667c7434 Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Sun, 29 Mar 2026 07:06:16 +0100 Subject: [PATCH 1/2] Check preorder assertion is true --- NAMESPACE | 1 + R/RcppExports-manual.R | 17 +++++++++++++++ R/tree_numbering.R | 9 ++++---- inst/include/TreeTools/renumber_tree.h | 22 +++++++++++++++++++ src/RcppExports-manual.cpp | 13 +++++++++++ src/RcppExports.cpp | 2 ++ tests/testthat/test-tree_numbering.R | 30 ++++++++++++++++++++++++++ 7 files changed, 90 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7f34d68f7..be138c370 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -468,6 +468,7 @@ export(as.multiPhylo) export(doubleFactorials) export(edge_to_splits) export(is.TreeNumber) +export(is_valid_preorder) export(logDoubleFactorials) export(replicate64) export(root_on_node) diff --git a/R/RcppExports-manual.R b/R/RcppExports-manual.R index 87cfd7d62..6ea78431d 100644 --- a/R/RcppExports-manual.R +++ b/R/RcppExports-manual.R @@ -4,6 +4,23 @@ keep_tip <- function(edge, keep) { .Call(`_TreeTools_keep_tip`, edge, keep) } +#' Validate preorder edge ordering +#' +#' Checks whether edges are in valid preorder: each edge's parent has been +#' introduced (appeared as a child) by an earlier edge, or is the root. +#' +#' @param parent,child Integer vectors of edge endpoints (1-indexed). +#' @param nTip Integer: number of tips in the tree. +#' @returns Logical: `TRUE` if edges are in valid preorder, `FALSE` otherwise. +#' @examples +#' tree <- BalancedTree(8) +#' is_valid_preorder(tree[["edge"]][, 1], tree[["edge"]][, 2], NTip(tree)) +#' @template MRS +#' @export +is_valid_preorder <- function(parent, child, nTip) { + .Call(`_TreeTools_is_valid_preorder`, parent, child, nTip) +} + postorder_order <- function(edge) { .Call(`_TreeTools_postorder_order`, edge) } diff --git a/R/tree_numbering.R b/R/tree_numbering.R index ff6cdc2c5..f6ccffaad 100644 --- a/R/tree_numbering.R +++ b/R/tree_numbering.R @@ -439,11 +439,12 @@ Preorder <- function(tree, topologyOnly = FALSE) UseMethod("Preorder") #' @export Preorder.phylo <- function(tree, topologyOnly = FALSE) { startOrder <- attr(tree, "order") - if (length(startOrder) && startOrder == "preorder") { - # length(x) is twice as fast as !is.null(x) - tree + edge <- tree[["edge"]] + if (length(startOrder) && # length(x) is twice as fast as !is.null(x) + startOrder == "preorder" && + is_valid_preorder(edge[, 1], edge[, 2], length(tree[["tip.label"]]))) { + tree } else { - edge <- tree[["edge"]] parent <- edge[, 1] child <- edge[, 2] if (topologyOnly) { diff --git a/inst/include/TreeTools/renumber_tree.h b/inst/include/TreeTools/renumber_tree.h index e6b18c193..54308a96b 100644 --- a/inst/include/TreeTools/renumber_tree.h +++ b/inst/include/TreeTools/renumber_tree.h @@ -341,6 +341,28 @@ inline std::pair preorder_weighted_pai return preorder_weighted_impl(parent, child, weights); } +// O(nEdge) check: in valid preorder, every edge's parent must already +// have been "introduced" (appeared as a child of an earlier edge, or +// be the root). +// [[Rcpp::export]] +inline bool is_valid_preorder(const Rcpp::IntegerVector& parent, + const Rcpp::IntegerVector& child, + int n_tip) { + const int32 n_edge = parent.length(); + if (child.length() != n_edge) return false; + const int32 root = n_tip + 1; + const int32 max_node = n_edge + 2; // safe upper bound + std::vector introduced(max_node, false); + introduced[root] = true; + for (int32 i = 0; i < n_edge; ++i) { + if (parent[i] < 1 || parent[i] >= max_node) return false; + if (!introduced[parent[i]]) return false; + if (child[i] < 1 || child[i] >= max_node) return false; + introduced[child[i]] = true; + } + return true; +} + template diff --git a/src/RcppExports-manual.cpp b/src/RcppExports-manual.cpp index 27db72dbb..54d98237f 100644 --- a/src/RcppExports-manual.cpp +++ b/src/RcppExports-manual.cpp @@ -70,6 +70,19 @@ RcppExport SEXP _TreeTools_root_binary(SEXP edgeSEXP, SEXP outgroupSEXP) { return rcpp_result_gen; END_RCPP } +// is_valid_preorder +RcppExport SEXP _TreeTools_is_valid_preorder(SEXP parentSEXP, + SEXP childSEXP, + SEXP nTipSEXP) { + BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const IntegerVector& >::type parent(parentSEXP); + Rcpp::traits::input_parameter< const IntegerVector& >::type child(childSEXP); + Rcpp::traits::input_parameter< int >::type n_tip(nTipSEXP); + rcpp_result_gen = Rcpp::wrap(TreeTools::is_valid_preorder(parent, child, n_tip)); + return rcpp_result_gen; + END_RCPP +} // root_on_node RcppExport SEXP _TreeTools_root_on_node(SEXP phySEXP, SEXP outgroupSEXP) { BEGIN_RCPP diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 31ebde5bb..f9b58ba50 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -527,6 +527,7 @@ BEGIN_RCPP END_RCPP } +RcppExport SEXP _TreeTools_is_valid_preorder(SEXP, SEXP, SEXP); RcppExport SEXP _TreeTools_keep_tip(SEXP, SEXP); RcppExport SEXP _TreeTools_postorder_order(SEXP); RcppExport SEXP _TreeTools_preorder_edges_and_nodes(SEXP, SEXP); @@ -577,6 +578,7 @@ static const R_CallMethodDef CallEntries[] = { {"_TreeTools_tips_in_splits", (DL_FUNC) &_TreeTools_tips_in_splits, 1}, {"_TreeTools_edge_to_rooted_shape", (DL_FUNC) &_TreeTools_edge_to_rooted_shape, 3}, {"_TreeTools_rooted_shape_to_edge", (DL_FUNC) &_TreeTools_rooted_shape_to_edge, 2}, + {"_TreeTools_is_valid_preorder", (DL_FUNC) &_TreeTools_is_valid_preorder, 3}, {"_TreeTools_keep_tip", (DL_FUNC) &_TreeTools_keep_tip, 2}, {"_TreeTools_postorder_order", (DL_FUNC) &_TreeTools_postorder_order, 1}, {"_TreeTools_preorder_edges_and_nodes", (DL_FUNC) &_TreeTools_preorder_edges_and_nodes, 2}, diff --git a/tests/testthat/test-tree_numbering.R b/tests/testthat/test-tree_numbering.R index 22d75bfe8..835e4d033 100644 --- a/tests/testthat/test-tree_numbering.R +++ b/tests/testthat/test-tree_numbering.R @@ -439,3 +439,33 @@ test_that("Malformed trees don't cause crashes", { expect_postorder(reordered) }) +test_that("is_valid_preorder() detects valid and invalid orderings", { + tree <- Preorder(BalancedTree(8)) + edge <- tree[["edge"]] + nTip <- NTip(tree) + + expect_true(is_valid_preorder(edge[, 1], edge[, 2], nTip)) + + # Swap two edges so a child appears before its parent + bad_edge <- edge + bad_edge[c(2, 3), ] <- bad_edge[c(3, 2), ] + expect_false(is_valid_preorder(bad_edge[, 1], bad_edge[, 2], nTip)) +}) + +test_that("Preorder() catches false preorder attribute", { + tree <- Preorder(BalancedTree(6)) + good_edge <- tree[["edge"]] + + # Corrupt the edge ordering while keeping the attribute + bad_tree <- tree + bad_tree[["edge"]][c(2, 3), ] <- bad_tree[["edge"]][c(3, 2), ] + expect_equal(attr(bad_tree, "order"), "preorder") + + # Preorder() should detect the corruption and reorder + + fixed <- Preorder(bad_tree) + expect_true(is_valid_preorder( + fixed[["edge"]][, 1], fixed[["edge"]][, 2], NTip(fixed) + )) +}) + From 5104fb4a897c9b815455f834c7b595b77c7a86ca Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Sun, 29 Mar 2026 07:08:50 +0100 Subject: [PATCH 2/2] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index adb789d9b..d5c71523a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: TreeTools Title: Create, Modify and Analyse Phylogenetic Trees -Version: 2.2.0.9002 +Version: 2.2.0.9003 Authors@R: c( person("Martin R.", 'Smith', role = c("aut", "cre", "cph"), email = "martin.smith@durham.ac.uk", diff --git a/NEWS.md b/NEWS.md index 6d81e5304..0e1e9e774 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,11 @@ -# TreeTools 2.2.0.9002 # +# TreeTools 2.2.0.9003 # ## New functionality - `Paste0()` provides a fast Rcpp-backed drop-in for `paste0()` / `stri_paste()` with `NA` propagation. Exported for use by downstream packages. +- `Preorder()` now validates edge order for trees with a "preorder" order attribute. +- Split lists support 32768 leaves. ## Usability