From 507d3a33c51fa3465212b0ec16483c3e2f1657f7 Mon Sep 17 00:00:00 2001 From: Martin Smith <1695515+ms609@users.noreply.github.com> Date: Tue, 24 Mar 2026 14:26:08 +0000 Subject: [PATCH 1/7] feat: decouple R-loop search from MorphyLib, add concavity parameter - New R/NativeSearch.R: PrepareNativeData, CleanNativeData, NativeLength, NativeBootstrap (4 exported functions) - TreeSearch(), Ratchet(), Jackknife() now default to native scorer - New 'concavity' parameter on all three functions - Jackknife() rewritten to support both native and morphy paths - EdgeListSearch() default scorer changed to NativeLength - Deprecated: PhyDat2Morphy, UnloadMorphy, MorphyLength, MorphyTreeLength, MorphyBootstrap - Vignette custom.Rmd IW section rewritten (was ~150 lines of MorphyLib scaffolding, now 30 lines using concavity parameter) - test-NativeSearch.R: 7 tests covering all new functions - test-CustomSearch.R: updated to use native defaults --- DESCRIPTION | 1 + NAMESPACE | 4 + R/Bootstrap.R | 1 + R/CustomSearch.R | 16 +-- R/Jackknife.R | 56 +++++++---- R/NativeSearch.R | 134 +++++++++++++++++++++++++ R/Ratchet.R | 16 +-- R/mpl_morphy_objects.R | 2 + R/tree_length.R | 2 + tests/testthat/test-CustomSearch.R | 6 +- tests/testthat/test-NativeSearch.R | 76 +++++++++++++++ vignettes/custom.Rmd | 151 +++++------------------------ 12 files changed, 303 insertions(+), 162 deletions(-) create mode 100644 R/NativeSearch.R create mode 100644 tests/testthat/test-NativeSearch.R diff --git a/DESCRIPTION b/DESCRIPTION index 5b4b39218..417b58629 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -91,6 +91,7 @@ Collate: 'SearchControl.R' 'MaximizeParsimony.R' 'Morphy.R' + 'NativeSearch.R' 'NNI.R' 'ParsSim.R' 'PlotCharacter.R' diff --git a/NAMESPACE b/NAMESPACE index 5828fc5ea..8f23ad5aa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,10 @@ export(MultiRatchet) export(MutualClusteringConcordance) export(NNI) export(NNISwap) +export(CleanNativeData) +export(NativeBootstrap) +export(NativeLength) +export(PrepareNativeData) export(ParsSim) export(PhyDat2Morphy) export(PhylogeneticConcordance) diff --git a/R/Bootstrap.R b/R/Bootstrap.R index fdd13f5df..79e3f2039 100644 --- a/R/Bootstrap.R +++ b/R/Bootstrap.R @@ -16,6 +16,7 @@ MorphyBootstrap <- function (edgeList, morphyObj, EdgeSwapper = NNISwap, maxIter, maxHits, verbosity = 1L, stopAtPeak = FALSE, stopAtPlateau=0L, ...) { + .Deprecated("NativeBootstrap") startWeights <- MorphyWeights(morphyObj)["exact", ] eachChar <- seq_along(startWeights) deindexedChars <- rep.int(eachChar, startWeights) diff --git a/R/CustomSearch.R b/R/CustomSearch.R index eb16e198f..8a073efd4 100644 --- a/R/CustomSearch.R +++ b/R/CustomSearch.R @@ -12,7 +12,7 @@ #' @keywords internal #' @export EdgeListSearch <- function (edgeList, dataset, - TreeScorer = MorphyLength, + TreeScorer = NativeLength, EdgeSwapper = RootedTBRSwap, maxIter = 100, maxHits = 20, bestScore = NULL, stopAtScore = NULL, @@ -171,10 +171,10 @@ EdgeListSearch <- function (edgeList, dataset, #' @family custom search functions #' @importFrom TreeTools RenumberTips #' @export -TreeSearch <- function (tree, dataset, - InitializeData = PhyDat2Morphy, - CleanUpData = UnloadMorphy, - TreeScorer = MorphyLength, +TreeSearch <- function (tree, dataset, concavity = Inf, + InitializeData = PrepareNativeData, + CleanUpData = CleanNativeData, + TreeScorer = NativeLength, EdgeSwapper = RootedTBRSwap, maxIter = 100L, maxHits = 20L, stopAtPeak = FALSE, stopAtPlateau = 0L, @@ -186,7 +186,11 @@ TreeSearch <- function (tree, dataset, edgeList <- tree[["edge"]] edgeList <- RenumberEdges(edgeList[, 1], edgeList[, 2]) - initializedData <- InitializeData(dataset) + if (identical(InitializeData, PrepareNativeData)) { + initializedData <- PrepareNativeData(dataset, concavity = concavity) + } else { + initializedData <- InitializeData(dataset) + } on.exit(initializedData <- CleanUpData(initializedData)) bestScore <- attr(tree, "score") diff --git a/R/Jackknife.R b/R/Jackknife.R index fce0b7941..f37918362 100644 --- a/R/Jackknife.R +++ b/R/Jackknife.R @@ -19,10 +19,11 @@ #' @family split support functions #' @family custom search functions #' @export -Jackknife <- function(tree, dataset, resampleFreq = 2 / 3, - InitializeData = PhyDat2Morphy, - CleanUpData = UnloadMorphy, - TreeScorer = MorphyLength, +Jackknife <- function(tree, dataset, concavity = Inf, + resampleFreq = 2 / 3, + InitializeData = PrepareNativeData, + CleanUpData = CleanNativeData, + TreeScorer = NativeLength, EdgeSwapper = TBRSwap, jackIter = 5000L, searchIter = 4000L, searchHits = 42L, verbosity = 1L, ...) { @@ -34,19 +35,29 @@ Jackknife <- function(tree, dataset, resampleFreq = 2 / 3, edgeList <- tree[["edge"]] edgeList <- RenumberEdges(edgeList[, 1], edgeList[, 2]) - morphyObj <- InitializeData(dataset) - on.exit(morphyObj <- CleanUpData(morphyObj)) + if (identical(InitializeData, PrepareNativeData)) { + initializedData <- PrepareNativeData(dataset, concavity = concavity) + } else { + initializedData <- InitializeData(dataset) + } + on.exit(initializedData <- CleanUpData(initializedData)) - startWeights <- MorphyWeights(morphyObj)["exact", ] + useMorphy <- inherits(initializedData, "morphyPtr") + + if (useMorphy) { + startWeights <- MorphyWeights(initializedData)["exact", ] + } else { + startWeights <- initializedData[["original_weight"]] + } eachChar <- seq_along(startWeights) deindexedChars <- rep.int(eachChar, startWeights) charsToKeep <- ceiling(resampleFreq * length(deindexedChars)) if (charsToKeep < 1L) { - stop("resampleFreq of ", resampleFreq, " is too low; can't keep 0 of ", + stop("resampleFreq of ", resampleFreq, " is too low; cannot keep 0 of ", length(deindexedChars), " characters.") } else if (charsToKeep >= length(deindexedChars)) { - stop("resampleFreq of ", resampleFreq, " is too high; can't keep all ", + stop("resampleFreq of ", resampleFreq, " is too high; cannot keep all ", length(deindexedChars), " characters.") } @@ -61,16 +72,25 @@ Jackknife <- function(tree, dataset, resampleFreq = 2 / 3, } #nocov end resampling <- tabulate(sample(deindexedChars, charsToKeep, replace = FALSE), nbins = length(startWeights)) - errors <- vapply(eachChar, function (i) - mpl_set_charac_weight(i, resampling[i], morphyObj), integer(1)) - if (any(errors)) { #nocov start - stop ("Error resampling morphy object: ", - mpl_translate_error(unique(errors[errors < 0L]))) + if (useMorphy) { + errors <- vapply(eachChar, function (i) + mpl_set_charac_weight(i, resampling[i], initializedData), integer(1)) + if (any(errors)) { #nocov start + stop("Error resampling morphy object: ", + mpl_translate_error(unique(errors[errors < 0L]))) + } + if (mpl_apply_tipdata(initializedData) -> error) { + stop("Error applying tip data: ", mpl_translate_error(error)) + } #nocov end + searchData <- initializedData + } else { + # Native: local copy with resampled weights + searchData <- initializedData + searchData[["weight"]] <- as.integer(resampling) } - if (mpl_apply_tipdata(morphyObj) -> error) { - stop("Error applying tip data: ", mpl_translate_error(error)) - } #nocov end - res <- EdgeListSearch(edgeList[1:2], morphyObj, EdgeSwapper = EdgeSwapper, + res <- EdgeListSearch(edgeList[1:2], searchData, + TreeScorer = TreeScorer, + EdgeSwapper = EdgeSwapper, maxIter = searchIter, maxHits = searchHits, verbosity = verbosity - 1L, ...) res[1:2] diff --git a/R/NativeSearch.R b/R/NativeSearch.R new file mode 100644 index 000000000..9a5763f7a --- /dev/null +++ b/R/NativeSearch.R @@ -0,0 +1,134 @@ +#' Native C++ scoring for custom search functions +#' +#' These functions provide a native C++ scoring interface for use with +#' [`TreeSearch()`], [`Ratchet()`], and [`Jackknife()`], replacing the +#' MorphyLib-based defaults (`PhyDat2Morphy`, `UnloadMorphy`, +#' `MorphyLength`, `MorphyBootstrap`). +#' +#' @name NativeSearch +#' @family custom search functions +NULL + +#' @describeIn NativeSearch Prepare a phyDat dataset for native C++ scoring. +#' Replaces [`PhyDat2Morphy()`] as the `InitializeData` function. +#' +#' @param dataset A phyDat object. +#' @param concavity Concavity constant for implied weighting, `Inf` for +#' equal weights, or `"profile"` for profile parsimony. +#' @return `PrepareNativeData()` returns a list containing pre-extracted data +#' matrices suitable for repeated scoring with [`NativeLength()`]. +#' @export +PrepareNativeData <- function(dataset, concavity = Inf) { + if (!inherits(dataset, "phyDat")) { + stop("`dataset` must be a phyDat object.") + } + + useProfile <- identical(concavity, "profile") + if (useProfile) { + dataset <- PrepareDataProfile(dataset) + infoAmounts <- attr(dataset, "info.amounts") + } else { + infoAmounts <- NULL + } + + iw <- !useProfile && is.finite(concavity) + if (iw) { + if (concavity <= 0) { + stop("`concavity` must be positive (or Inf for equal weights, ", + "or \"profile\" for profile parsimony).") + } + if (!("min.length" %in% names(attributes(dataset)))) { + dataset <- PrepareDataIW(dataset) + } + minSteps <- as.integer(attr(dataset, "min.length")) + } else { + minSteps <- integer(0) + } + + at <- attributes(dataset) + weight <- at[["weight"]] + + list( + contrast = at[["contrast"]], + tip_data = matrix(unlist(dataset, use.names = FALSE), + nrow = length(dataset), byrow = TRUE), + weight = as.integer(weight), + levels = at[["levels"]], + min_steps = minSteps, + concavity = if (iw) as.double(concavity) else -1.0, + info_amounts = infoAmounts, + original_weight = as.integer(weight), + index = at[["index"]] + ) +} + +#' @describeIn NativeSearch No-op cleanup (native data has no external +#' resources). Replaces [`UnloadMorphy()`] as the `CleanUpData` function. +#' @param dataset Prepared dataset returned by `PrepareNativeData()`. +#' @return `CleanNativeData()` returns `dataset` invisibly. +#' @export +CleanNativeData <- function(dataset) { + invisible(dataset) +} + +#' @describeIn NativeSearch Score a tree using the native C++ Fitch engine. +#' Replaces [`MorphyLength()`] as the `TreeScorer` function. +#' +#' @param parent Integer vector of parent node indices for each edge. +#' @param child Integer vector of child node indices for each edge. +#' @param dataset Prepared dataset from [`PrepareNativeData()`]. +#' @param \dots Ignored (present for interface compatibility). +#' @return `NativeLength()` returns a double: the parsimony score of the tree. +#' @export +NativeLength <- function(parent, child, dataset, ...) { + ts_fitch_score( + cbind(parent, child), + dataset[["contrast"]], + dataset[["tip_data"]], + dataset[["weight"]], + dataset[["levels"]], + dataset[["min_steps"]], + dataset[["concavity"]], + dataset[["info_amounts"]] + ) +} + +#' @describeIn NativeSearch Bootstrap resampling for use with [`Ratchet()`]. +#' Replaces [`MorphyBootstrap()`] as the `Bootstrapper` function. +#' +#' @param edgeList A list containing parent and child integer vectors +#' (and optionally a score and hit count). +#' @param dataset Prepared dataset from [`PrepareNativeData()`]. +#' @param EdgeSwapper A function to rearrange edges, such as +#' [`NNISwap()`] or [`TBRSwap()`]. +#' @param maxIter Maximum rearrangement iterations. +#' @param maxHits Maximum hits of best score before stopping. +#' @param verbosity Verbosity level. +#' @param stopAtPeak,stopAtPlateau Passed to [`EdgeListSearch()`]. +#' @param \dots Further parameters passed to the `TreeScorer`. +#' @return `NativeBootstrap()` returns an edge list (list of parent and +#' child vectors). +#' @export +NativeBootstrap <- function(edgeList, dataset, EdgeSwapper = NNISwap, + maxIter, maxHits, verbosity = 1L, + stopAtPeak = FALSE, stopAtPlateau = 0L, ...) { + startWeights <- dataset[["original_weight"]] + eachChar <- seq_along(startWeights) + deindexedChars <- rep.int(eachChar, startWeights) + resampling <- tabulate(sample(deindexedChars, replace = TRUE), + length(startWeights)) + + # R's copy-on-modify: local copy, caller's dataset unchanged + dataset[["weight"]] <- as.integer(resampling) + + res <- EdgeListSearch(edgeList[1:2], dataset, + TreeScorer = NativeLength, + EdgeSwapper = EdgeSwapper, + maxIter = maxIter, maxHits = maxHits, + stopAtPeak = stopAtPeak, + stopAtPlateau = stopAtPlateau, + verbosity = verbosity - 1L, ...) + + # Return: + res[1:2] +} diff --git a/R/Ratchet.R b/R/Ratchet.R index 280a0b7b8..b16064e75 100644 --- a/R/Ratchet.R +++ b/R/Ratchet.R @@ -69,11 +69,11 @@ #' @family custom search functions #' @importFrom TreeTools RenumberEdges RenumberTips #' @export -Ratchet <- function(tree, dataset, - InitializeData = PhyDat2Morphy, - CleanUpData = UnloadMorphy, - TreeScorer = MorphyLength, - Bootstrapper = MorphyBootstrap, +Ratchet <- function(tree, dataset, concavity = Inf, + InitializeData = PrepareNativeData, + CleanUpData = CleanNativeData, + TreeScorer = NativeLength, + Bootstrapper = NativeBootstrap, swappers = list(TBRSwap, SPRSwap, NNISwap), BootstrapSwapper = if (is.list(swappers)) swappers[[length(swappers)]] else swappers, @@ -93,7 +93,11 @@ Ratchet <- function(tree, dataset, edgeList <- tree[["edge"]] edgeList <- RenumberEdges(edgeList[, 1], edgeList[, 2]) - initializedData <- InitializeData(dataset) + if (identical(InitializeData, PrepareNativeData)) { + initializedData <- PrepareNativeData(dataset, concavity = concavity) + } else { + initializedData <- InitializeData(dataset) + } on.exit(initializedData <- CleanUpData(initializedData)) bestScore <- TreeScorer(edgeList[[1]], edgeList[[2]], initializedData, ...) diff --git a/R/mpl_morphy_objects.R b/R/mpl_morphy_objects.R index d060a1559..b72dd1d9b 100644 --- a/R/mpl_morphy_objects.R +++ b/R/mpl_morphy_objects.R @@ -137,6 +137,7 @@ GapHandler <- function (morphyObj) { #' @export PhyDat2Morphy <- function(phy, gap = "inapplicable", weight = attr(phy, "weight")) { + .Deprecated("PrepareNativeData") if (!inherits(phy, "phyDat")) { stop("Invalid data type ", class(phy), "; should be phyDat.") @@ -267,6 +268,7 @@ is.morphyPtr <- function (morphyObj) { #' @family Morphy API functions #' @export UnloadMorphy <- function (morphyObj) { + .Deprecated("CleanNativeData") if (!is.morphyPtr(morphyObj)) { stop ("Object is not a valid pointer; cannot destroy.") } diff --git a/R/tree_length.R b/R/tree_length.R index 5c5571027..be5f9165b 100644 --- a/R/tree_length.R +++ b/R/tree_length.R @@ -520,6 +520,7 @@ FastCharacterLength <- function(tree, dataset) { #' @keywords internal #' @export MorphyTreeLength <- function(tree, morphyObj) { + .Deprecated("TreeLength") if (!is.morphyPtr(morphyObj)) { stop("`morphyObj` must be a valid Morphy pointer") } @@ -546,6 +547,7 @@ MorphyTreeLength <- function(tree, morphyObj) { #' @export MorphyLength <- function(parent, child, morphyObj, inPostorder = FALSE, nTaxa = mpl_get_numtaxa(morphyObj)) { + .Deprecated("NativeLength") if (!inPostorder) { edgeList <- Preorder(cbind(parent, child)) edgeList <- edgeList[PostorderOrder(edgeList), ] diff --git a/tests/testthat/test-CustomSearch.R b/tests/testthat/test-CustomSearch.R index 6188b30e4..8bb5c3caf 100644 --- a/tests/testthat/test-CustomSearch.R +++ b/tests/testthat/test-CustomSearch.R @@ -119,11 +119,11 @@ test_that("Profile parsimony works in tree search", { expect_gt(TreeLength(rTree, readyData, "profile"), TreeLength(referenceTree, readyData, "profile")) - quickTS <- TreeSearch(rTree, dataset, TreeScorer = MorphyLength, EdgeSwapper = RootedNNISwap, + quickTS <- TreeSearch(rTree, dataset, EdgeSwapper = RootedNNISwap, maxIter = 1600, maxHits = 40, verbosity = 0) - expect_equal(42L, attr(quickTS, "score")) + expect_equal(42, attr(quickTS, "score")) - quickFitch <- Ratchet(rTree, dataset, TreeScorer = MorphyLength, suboptimal = 2, + quickFitch <- Ratchet(rTree, dataset, suboptimal = 2, swappers = RootySwappers, ratchHits = 3, searchHits = 15, searchIter = 100, ratchIter = 500, verbosity = 0L) diff --git a/tests/testthat/test-NativeSearch.R b/tests/testthat/test-NativeSearch.R new file mode 100644 index 000000000..d4214b0f7 --- /dev/null +++ b/tests/testthat/test-NativeSearch.R @@ -0,0 +1,76 @@ +test_that("NativeLength matches TreeLength", { + library("TreeTools", quietly = TRUE) + data("Lobo", package = "TreeTools") + dataset <- Lobo.phy + tree <- NJTree(dataset) + edge <- tree[["edge"]] + + nd <- PrepareNativeData(dataset) + expect_equal(NativeLength(edge[, 1], edge[, 2], nd), + TreeLength(tree, dataset)) + + nd_iw <- PrepareNativeData(dataset, concavity = 10) + expect_equal(NativeLength(edge[, 1], edge[, 2], nd_iw), + TreeLength(tree, dataset, concavity = 10, extended_iw = FALSE)) +}) + +test_that("PrepareNativeData validates concavity", { + data("Lobo", package = "TreeTools") + expect_error(PrepareNativeData(Lobo.phy, concavity = 0), "must be positive") + expect_error(PrepareNativeData(Lobo.phy, concavity = -5), "must be positive") +}) + +test_that("CleanNativeData is a no-op", { + nd <- list(weight = 1:3) + expect_identical(CleanNativeData(nd), nd) +}) + +test_that("NativeLength works in EdgeListSearch", { + library("TreeTools", quietly = TRUE) + data("Lobo", package = "TreeTools") + tree <- NJTree(Lobo.phy) + nd <- PrepareNativeData(Lobo.phy) + tree2 <- RenumberTips(tree, names(Lobo.phy)) + edgeList <- RenumberEdges(tree2[["edge"]][, 1], tree2[["edge"]][, 2]) + startScore <- NativeLength(edgeList[[1]], edgeList[[2]], nd) + result <- EdgeListSearch(edgeList, nd, TreeScorer = NativeLength, + EdgeSwapper = RootedTBRSwap, + maxIter = 50, maxHits = 5, verbosity = 0) + expect_lte(result[[3]], startScore) +}) + +test_that("NativeBootstrap returns valid edge list", { + library("TreeTools", quietly = TRUE) + data("Lobo", package = "TreeTools") + tree <- NJTree(Lobo.phy) + nd <- PrepareNativeData(Lobo.phy) + tree2 <- RenumberTips(tree, names(Lobo.phy)) + edgeList <- RenumberEdges(tree2[["edge"]][, 1], tree2[["edge"]][, 2]) + bootResult <- NativeBootstrap(edgeList, nd, EdgeSwapper = NNISwap, + maxIter = 20, maxHits = 5, verbosity = 0) + expect_length(bootResult, 2) + expect_type(bootResult[[1]], "integer") + expect_equal(length(bootResult[[1]]), length(edgeList[[1]])) + expect_equal(nd[["weight"]], nd[["original_weight"]]) +}) + +test_that("TreeSearch() accepts concavity parameter", { + library("TreeTools", quietly = TRUE) + data("Lobo", package = "TreeTools") + tree <- NJTree(Lobo.phy) + result_ew <- TreeSearch(tree, Lobo.phy, maxIter = 5, maxHits = 2, verbosity = 0) + expect_s3_class(result_ew, "phylo") + result_iw <- TreeSearch(tree, Lobo.phy, concavity = 10, + maxIter = 5, maxHits = 2, verbosity = 0) + expect_s3_class(result_iw, "phylo") +}) + +test_that("Ratchet() accepts concavity parameter", { + library("TreeTools", quietly = TRUE) + data("Lobo", package = "TreeTools") + tree <- NJTree(Lobo.phy) + result <- Ratchet(tree, Lobo.phy, concavity = 10, + ratchIter = 1, ratchHits = 1, + searchIter = 5, searchHits = 2, verbosity = 0) + expect_s3_class(result, "phylo") +}) diff --git a/vignettes/custom.Rmd b/vignettes/custom.Rmd index 8de28bec9..e672ab050 100644 --- a/vignettes/custom.Rmd +++ b/vignettes/custom.Rmd @@ -17,7 +17,8 @@ vignette: > > profile parsimony), use `MaximizeParsimony()` — it is much faster and > easier. See the [tree search vignette](tree-search.html). > The functions below (`TreeSearch()`, `Ratchet()`) are for **custom -> optimality criteria only**. +> optimality criteria and also accept `concavity` for implied weights +> or profile parsimony searches with manual control over search parameters. "TreeSearch" can be used to search for trees that are optimal under user-specified criteria [e.g. @Hopkins2021]. @@ -114,152 +115,44 @@ PlotTree(result) ## Searching using implied weights -> **Note:** If you simply want to run an implied weights search, use -> `MaximizeParsimony(dataset, concavity = k)`, which is much faster and -> easier. The example below demonstrates the _custom optimality criteria -> framework_ using implied weights as a familiar worked example. - -Now we consider a more complex case in which a scorer -must undergo a time-consuming initialization before tree search can begin, -and must be safely destroyed once tree search has completed. - -We start by defining an initialization function, which will create a new -Morphy object [@Brazeau2017] for each character in a phylogenetic dataset: - -```{r iw-setup} -IWInitMorphy <- function (dataset) { - attr(dataset, "morphyObjs") <- - lapply(PhyToString(dataset, byTaxon = FALSE, useIndex = FALSE, - concatenate = FALSE), - SingleCharMorphy) - - # Return: - dataset -} -``` - -To release memory back to the operating system, we must destroy each Morphy -object once we're finished with it: - -```{r iw-destroy} -IWDestroyMorphy <- function (dataset) { - vapply(attr(dataset, "morphyObjs"), UnloadMorphy, integer(1)) -} -``` - -Now we can write our tree scoring function, which will return the 'fit' -under implied weights [@Goloboff1993]. - -Note that we need to specify some extra parameters: `concavity` is the _k_ -value required by the implied weights formula (fit = _e / e + k_), -and `minLength` is the minimum number of steps required by each character -- -which we need in order to convert the total number of steps (returned by -`MorphyLength()` to a number of excess steps (_e_ in the implied weights formula) - -```{r iw-score} -IWScoreMorphy <- function (parent, child, dataset, concavity = 10L, - minLength = attr(dataset, "min.length"), ...) { - steps <- vapply(attr(dataset, "morphyObjs"), MorphyLength, - parent = parent, child = child, integer(1)) - homoplasies <- steps - minLength - fit <- homoplasies / (homoplasies + concavity) - # Return: - sum(fit * attr(dataset, "weight")) -} -``` +> **Note:** For real implied weights analyses, use +> `MaximizeParsimony(dataset, concavity = k)`, which is faster and +> uses the full driven search pipeline (see the +> [tree search vignette](tree-search.html#implied-weighting)). +> The example below shows how `TreeSearch()` and `Ratchet()` support +> implied weights directly via the `concavity` parameter. -Now we are ready to search: +Implied weights [@Goloboff1993] penalize additional homoplasy according to +the concavity constant _k_. `TreeSearch()` and `Ratchet()` accept +`concavity` directly---no custom scorer or initialization code is needed: ```{r iw-search, message = FALSE} data("inapplicable.datasets") dataset <- congreveLamsdellMatrices[[42]] -# Populate `min.length` attribute -dataset <- PrepareDataIW(dataset) -iwTree <- TreeSearch(NJTree(dataset), dataset, - InitializeData = IWInitMorphy, - CleanUpData = IWDestroyMorphy, - TreeScorer = IWScoreMorphy, - concavity = 10, # Will be sent to TreeScorer - verbosity = 1) - +iwTree <- TreeSearch(NJTree(dataset), dataset, concavity = 10, + maxIter = 50L, maxHits = 10L, verbosity = 1) ``` -This quick search probably hasn't found the globally optimal tree. -Besides increasing the number of hits and rearrangements, -the parsimony ratchet [@Nixon1999] can help to escape local optima. -This introduces an additional complication: we need to bootstrap the characters -within `dataset`, and their accompanying Morphy objects. - -A `Bootstraper` function expects an `edgeList` (a list of the parent and child -of each edge in a tree, in turn) and a `dataset` argument, and conducts -a tree search, starting at `edgeList`, on a bootstrapped version of the dataset. -It is also sent the arguments `maxIter = bootstrapIter` and -`maxHits = bootstrapHits`, allowing ratchet search intensity to be controlled -from parameters sent to the `Ratchet()` function. - -```{r iw-bootstrap} -IWBootstrap <- function (edgeList, dataset, concavity = 10L, EdgeSwapper = NNISwap, - maxIter, maxHits, verbosity = 1L, ...) { - att <- attributes(dataset) - startWeights <- att[["weight"]] - - # Decompress phyDat object so each character is listed once - eachChar <- seq_along(startWeights) - deindexedChars <- rep.int(eachChar, startWeights) - - # Resample characters - resampling <- tabulate(sample(deindexedChars, replace = TRUE), length(startWeights)) - sampled <- resampling != 0 - sampledData <- lapply(dataset, function (x) x[sampled]) - sampledAtt <- att - sampledAtt[["index"]] <- rep.int(seq_len(sum(sampled)), resampling[sampled]) - sampledAtt[["weight"]] <- resampling[sampled] - sampledAtt[["nr"]] <- length(sampledAtt[["weight"]]) - sampledAtt[["min.length"]] <- minLength <- att[["min.length"]][sampled] - sampledAtt[["morphyObjs"]] <- att[["morphyObjs"]][sampled] - attributes(sampledData) <- sampledAtt - - # Search using resampled dataset - res <- EdgeListSearch(edgeList[1:2], sampledData, TreeScorer = IWScoreMorphy, - concavity = concavity, minLength = minLength, - EdgeSwapper = EdgeSwapper, - maxIter = maxIter, maxHits = maxHits, - verbosity = verbosity - 1L) - - res[1:2] -} - -``` - -Having defined the `Bootstrapper()` function we can now complete a Ratchet -search with: +The parsimony ratchet [@Nixon1999] can help to escape local optima. +Bootstrap resampling is handled automatically: ```{r iw-ratchet, message = FALSE} -ratchetTree <- Ratchet(tree = iwTree, dataset = dataset, - concavity = 10, - InitializeData = IWInitMorphy, - CleanUpData = IWDestroyMorphy, - TreeScorer = IWScoreMorphy, - Bootstrapper = IWBootstrap, +ratchetTree <- Ratchet(iwTree, dataset, concavity = 10, ratchIter = 2, ratchHits = 2, searchIter = 20, searchHits = 10, verbosity = 2) - ``` - -It would be sensible to use much larger values of `ratchIter`, `ratchHits`, -`searchIter` and `searchHits` to be confident of locating an optimal tree. -Remember that for real implied weights analyses, -`MaximizeParsimony(dataset, concavity = k)` is faster, easier, and uses the -full driven search pipeline (see the -[tree search vignette](tree-search.html#implied-weighting)). +Use much larger values of `ratchIter`, `ratchHits`, +`searchIter` and `searchHits` for a thorough search. +Profile parsimony [@Faith2001] is also supported: set +`concavity = "profile"`. Hopefully these examples give a template from which you are able to construct your own optimality criteria. The maintainer is happy to answer questions via e-mail, or you can file queries by opening a -[GitHub issue](https://github.com/ms609/TreeDist/issues/new/). +[GitHub issue](https://github.com/ms609/TreeSearch/issues/new/). ## What next? @@ -279,4 +172,4 @@ See also: - [Mapping the space of optimal trees](tree-space.html) -## References \ No newline at end of file +## References From f59a193c274c0305579adcc85184a6d302497b0a Mon Sep 17 00:00:00 2001 From: Martin Smith <1695515+ms609@users.noreply.github.com> Date: Tue, 24 Mar 2026 15:01:34 +0000 Subject: [PATCH 2/7] docs: generate roxygen man pages for NativeSearch functions Adds NativeSearch.Rd and updates Jackknife.Rd, Ratchet.Rd, TreeSearch.Rd with new concavity parameter and default changes. --- NAMESPACE | 4 +- man/Jackknife.Rd | 20 +++++-- man/NativeSearch.Rd | 94 +++++++++++++++++++++++++++++++++ man/Ratchet.Rd | 22 ++++++-- man/SuccessiveApproximations.Rd | 3 +- man/TreeSearch.Rd | 22 ++++++-- 6 files changed, 151 insertions(+), 14 deletions(-) create mode 100644 man/NativeSearch.Rd diff --git a/NAMESPACE b/NAMESPACE index 8f23ad5aa..3d97e7888 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(C_MorphyLength) export(Carter1) export(CharacterHierarchy) export(CharacterLength) +export(CleanNativeData) export(ClusterStrings) export(ClusteringConcordance) export(ConcordanceTable) @@ -69,10 +70,8 @@ export(MultiRatchet) export(MutualClusteringConcordance) export(NNI) export(NNISwap) -export(CleanNativeData) export(NativeBootstrap) export(NativeLength) -export(PrepareNativeData) export(ParsSim) export(PhyDat2Morphy) export(PhylogeneticConcordance) @@ -80,6 +79,7 @@ export(PlotCharacter) export(PolEscapa) export(PrepareDataIW) export(PrepareDataProfile) +export(PrepareNativeData) export(PresCont) export(QACol) export(QALegend) diff --git a/man/Jackknife.Rd b/man/Jackknife.Rd index c2ebfd523..90ecfa117 100644 --- a/man/Jackknife.Rd +++ b/man/Jackknife.Rd @@ -7,10 +7,11 @@ Jackknife( tree, dataset, + concavity = Inf, resampleFreq = 2/3, - InitializeData = PhyDat2Morphy, - CleanUpData = UnloadMorphy, - TreeScorer = MorphyLength, + InitializeData = PrepareNativeData, + CleanUpData = CleanNativeData, + TreeScorer = NativeLength, EdgeSwapper = TBRSwap, jackIter = 5000L, searchIter = 4000L, @@ -26,6 +27,18 @@ Edge lengths are not supported and will be removed.} \item{dataset}{a dataset in the format required by \code{TreeScorer()}.} +\item{concavity}{Determines the degree to which extra steps beyond the first +are penalized. Specify a numeric value to use implied weighting +\insertCite{Goloboff1993}{TreeSearch}; \code{concavity} specifies \emph{k} in +\emph{k} / \emph{e} + \emph{k}. A value of 10 is recommended; +TNT sets a default of 3, but this is too low in some circumstances +\insertCite{Goloboff2018,Smith2019}{TreeSearch}. +Better still explore the sensitivity of results under a range of +concavity values, e.g. \code{k = 2 ^ (1:7)}. +Specify \code{Inf} to weight each additional step equally. +Specify \code{"profile"} to employ profile parsimony +\insertCite{Faith2001}{TreeSearch}.} + \item{resampleFreq}{Double between 0 and 1 stating proportion of characters to resample.} @@ -87,6 +100,7 @@ Other split support functions: Other custom search functions: \code{\link{EdgeListSearch}()}, \code{\link{MorphyBootstrap}()}, +\code{\link{NativeSearch}}, \code{\link{SuccessiveApproximations}()} } \author{ diff --git a/man/NativeSearch.Rd b/man/NativeSearch.Rd new file mode 100644 index 000000000..6b79476f2 --- /dev/null +++ b/man/NativeSearch.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NativeSearch.R +\name{NativeSearch} +\alias{NativeSearch} +\alias{PrepareNativeData} +\alias{CleanNativeData} +\alias{NativeLength} +\alias{NativeBootstrap} +\title{Native C++ scoring for custom search functions} +\usage{ +PrepareNativeData(dataset, concavity = Inf) + +CleanNativeData(dataset) + +NativeLength(parent, child, dataset, ...) + +NativeBootstrap( + edgeList, + dataset, + EdgeSwapper = NNISwap, + maxIter, + maxHits, + verbosity = 1L, + stopAtPeak = FALSE, + stopAtPlateau = 0L, + ... +) +} +\arguments{ +\item{dataset}{Prepared dataset from \code{\link[=PrepareNativeData]{PrepareNativeData()}}.} + +\item{concavity}{Concavity constant for implied weighting, \code{Inf} for +equal weights, or \code{"profile"} for profile parsimony.} + +\item{parent}{Integer vector of parent node indices for each edge.} + +\item{child}{Integer vector of child node indices for each edge.} + +\item{\dots}{Further parameters passed to the \code{TreeScorer}.} + +\item{edgeList}{A list containing parent and child integer vectors +(and optionally a score and hit count).} + +\item{EdgeSwapper}{A function to rearrange edges, such as +\code{\link[=NNISwap]{NNISwap()}} or \code{\link[=TBRSwap]{TBRSwap()}}.} + +\item{maxIter}{Maximum rearrangement iterations.} + +\item{maxHits}{Maximum hits of best score before stopping.} + +\item{verbosity}{Verbosity level.} + +\item{stopAtPeak, stopAtPlateau}{Passed to \code{\link[=EdgeListSearch]{EdgeListSearch()}}.} +} +\value{ +\code{PrepareNativeData()} returns a list containing pre-extracted data +matrices suitable for repeated scoring with \code{\link[=NativeLength]{NativeLength()}}. + +\code{CleanNativeData()} returns \code{dataset} invisibly. + +\code{NativeLength()} returns a double: the parsimony score of the tree. + +\code{NativeBootstrap()} returns an edge list (list of parent and +child vectors). +} +\description{ +These functions provide a native C++ scoring interface for use with +\code{\link[=TreeSearch]{TreeSearch()}}, \code{\link[=Ratchet]{Ratchet()}}, and \code{\link[=Jackknife]{Jackknife()}}, replacing the +MorphyLib-based defaults (\code{PhyDat2Morphy}, \code{UnloadMorphy}, +\code{MorphyLength}, \code{MorphyBootstrap}). +} +\section{Functions}{ +\itemize{ +\item \code{PrepareNativeData()}: Prepare a phyDat dataset for native C++ scoring. +Replaces \code{\link[=PhyDat2Morphy]{PhyDat2Morphy()}} as the \code{InitializeData} function. + +\item \code{CleanNativeData()}: No-op cleanup (native data has no external +resources). Replaces \code{\link[=UnloadMorphy]{UnloadMorphy()}} as the \code{CleanUpData} function. + +\item \code{NativeLength()}: Score a tree using the native C++ Fitch engine. +Replaces \code{\link[=MorphyLength]{MorphyLength()}} as the \code{TreeScorer} function. + +\item \code{NativeBootstrap()}: Bootstrap resampling for use with \code{\link[=Ratchet]{Ratchet()}}. +Replaces \code{\link[=MorphyBootstrap]{MorphyBootstrap()}} as the \code{Bootstrapper} function. + +}} +\seealso{ +Other custom search functions: +\code{\link{EdgeListSearch}()}, +\code{\link{Jackknife}()}, +\code{\link{MorphyBootstrap}()}, +\code{\link{SuccessiveApproximations}()} +} +\concept{custom search functions} diff --git a/man/Ratchet.Rd b/man/Ratchet.Rd index 84e496fdf..ae70787b5 100644 --- a/man/Ratchet.Rd +++ b/man/Ratchet.Rd @@ -22,10 +22,11 @@ MorphyBootstrap( Ratchet( tree, dataset, - InitializeData = PhyDat2Morphy, - CleanUpData = UnloadMorphy, - TreeScorer = MorphyLength, - Bootstrapper = MorphyBootstrap, + concavity = Inf, + InitializeData = PrepareNativeData, + CleanUpData = CleanNativeData, + TreeScorer = NativeLength, + Bootstrapper = NativeBootstrap, swappers = list(TBRSwap, SPRSwap, NNISwap), BootstrapSwapper = if (is.list(swappers)) swappers[[length(swappers)]] else swappers, returnAll = FALSE, @@ -111,6 +112,18 @@ Edge lengths are not supported and will be removed.} \item{dataset}{a dataset in the format required by \code{TreeScorer()}.} +\item{concavity}{Determines the degree to which extra steps beyond the first +are penalized. Specify a numeric value to use implied weighting +\insertCite{Goloboff1993}{TreeSearch}; \code{concavity} specifies \emph{k} in +\emph{k} / \emph{e} + \emph{k}. A value of 10 is recommended; +TNT sets a default of 3, but this is too low in some circumstances +\insertCite{Goloboff2018,Smith2019}{TreeSearch}. +Better still explore the sensitivity of results under a range of +concavity values, e.g. \code{k = 2 ^ (1:7)}. +Specify \code{Inf} to weight each additional step equally. +Specify \code{"profile"} to employ profile parsimony +\insertCite{Faith2001}{TreeSearch}.} + \item{InitializeData}{Function that sets up data object to prepare for tree search. The function will be passed the \code{dataset} parameter. Its return value will be passed to \code{TreeScorer()} and \code{CleanUpData()}.} @@ -218,6 +231,7 @@ par(oldPar) Other custom search functions: \code{\link{EdgeListSearch}()}, \code{\link{Jackknife}()}, +\code{\link{NativeSearch}}, \code{\link{SuccessiveApproximations}()} } \author{ diff --git a/man/SuccessiveApproximations.Rd b/man/SuccessiveApproximations.Rd index dd2efcfd6..659a39767 100644 --- a/man/SuccessiveApproximations.Rd +++ b/man/SuccessiveApproximations.Rd @@ -112,7 +112,8 @@ criterion \insertCite{Farris1969}{TreeSearch}. Other custom search functions: \code{\link{EdgeListSearch}()}, \code{\link{Jackknife}()}, -\code{\link{MorphyBootstrap}()} +\code{\link{MorphyBootstrap}()}, +\code{\link{NativeSearch}} } \concept{custom search functions} \keyword{internal} diff --git a/man/TreeSearch.Rd b/man/TreeSearch.Rd index 60cee4f8f..578d37917 100644 --- a/man/TreeSearch.Rd +++ b/man/TreeSearch.Rd @@ -12,7 +12,7 @@ EdgeListSearch( edgeList, dataset, - TreeScorer = MorphyLength, + TreeScorer = NativeLength, EdgeSwapper = RootedTBRSwap, maxIter = 100, maxHits = 20, @@ -27,9 +27,10 @@ EdgeListSearch( TreeSearch( tree, dataset, - InitializeData = PhyDat2Morphy, - CleanUpData = UnloadMorphy, - TreeScorer = MorphyLength, + concavity = Inf, + InitializeData = PrepareNativeData, + CleanUpData = CleanNativeData, + TreeScorer = NativeLength, EdgeSwapper = RootedTBRSwap, maxIter = 100L, maxHits = 20L, @@ -88,6 +89,18 @@ larger numbers provide more verbose feedback to the user.} with the desired outgroup. Edge lengths are not supported and will be removed.} +\item{concavity}{Determines the degree to which extra steps beyond the first +are penalized. Specify a numeric value to use implied weighting +\insertCite{Goloboff1993}{TreeSearch}; \code{concavity} specifies \emph{k} in +\emph{k} / \emph{e} + \emph{k}. A value of 10 is recommended; +TNT sets a default of 3, but this is too low in some circumstances +\insertCite{Goloboff2018,Smith2019}{TreeSearch}. +Better still explore the sensitivity of results under a range of +concavity values, e.g. \code{k = 2 ^ (1:7)}. +Specify \code{Inf} to weight each additional step equally. +Specify \code{"profile"} to employ profile parsimony +\insertCite{Faith2001}{TreeSearch}.} + \item{InitializeData}{Function that sets up data object to prepare for tree search. The function will be passed the \code{dataset} parameter. Its return value will be passed to \code{TreeScorer()} and \code{CleanUpData()}.} @@ -143,6 +156,7 @@ optima. Other custom search functions: \code{\link{Jackknife}()}, \code{\link{MorphyBootstrap}()}, +\code{\link{NativeSearch}}, \code{\link{SuccessiveApproximations}()} } \author{ From eb21c588dc47ded6ba6aa60da8b32831d2230cba Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Fri, 27 Mar 2026 10:58:47 +0000 Subject: [PATCH 3/7] fix(T-204): WORDLIST + suppress deprecated-fn warnings in examples - inst/WORDLIST: add 'cleanup' and 'phyDat' - R/mpl_morphy_objects.R: wrap PhyDat2Morphy/MorphyWeights @examples in \donttest{}; use suppressWarnings() for UnloadMorphy in GapHandler and SingleCharMorphy examples - R/Morphy.R: wrap constraint example with suppressWarnings() so internal PhyDat2Morphy/UnloadMorphy calls don't emit warnings Fixes 1 ERROR (spelling) + 1 WARNING (deprecated fns in examples) --- R/Morphy.R | 2 +- R/mpl_morphy_objects.R | 8 ++++++-- inst/WORDLIST | 2 ++ 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/R/Morphy.R b/R/Morphy.R index 606f04347..e1f6d6a8b 100644 --- a/R/Morphy.R +++ b/R/Morphy.R @@ -253,7 +253,7 @@ #' c(0, 1, 1, 1, 0, 0, #' 1, 1, 1, 0, 0, 0), ncol = 2, #' dimnames = list(letters[1:6], NULL))) -#' Morphy(characters, constraint = constraint, verbosity = 0) +#' suppressWarnings(Morphy(characters, constraint = constraint, verbosity = 0)) #' #' @template MRS #' diff --git a/R/mpl_morphy_objects.R b/R/mpl_morphy_objects.R index b72dd1d9b..4b65bf3b6 100644 --- a/R/mpl_morphy_objects.R +++ b/R/mpl_morphy_objects.R @@ -40,11 +40,13 @@ summary.morphyPtr <- function (object, ...) { #' 0, 0, 0, 0, 0, 0), byrow = TRUE, nrow = 2L, #' dimnames = list(letters[1:2], NULL)) #' pd <- TreeTools::MatrixToPhyDat(tokens) +#' \donttest{ #' morphyObj <- PhyDat2Morphy(pd) #' MorphyWeights(morphyObj) #' if (SetMorphyWeights(c(1, 1.5, 2/3), morphyObj) != 0L) message("Errored") #' MorphyWeights(morphyObj) #' morphyObj <- UnloadMorphy(morphyObj) +#' } #' @template MRS #' @family Morphy API functions #' @export @@ -87,7 +89,7 @@ SetMorphyWeights <- function (weight, morphyObj, checkInput = TRUE) { #' @examples #' morphyObj <- SingleCharMorphy("-0-0", "Extra") #' GapHandler(morphyObj) -#' morphyObj <- UnloadMorphy(morphyObj) +#' morphyObj <- suppressWarnings(UnloadMorphy(morphyObj)) #' @family Morphy API functions #' @template MRS #' @export @@ -121,6 +123,7 @@ GapHandler <- function (morphyObj) { #' @return `PhyDat2Morphy()` returns a pointer to an initialized Morphy object. #' #' @examples +#' \donttest{ #' data("Lobo", package="TreeTools") #' morphyObj <- PhyDat2Morphy(Lobo.phy) #' # Set object to be destroyed at end of session or closure of function @@ -131,6 +134,7 @@ GapHandler <- function (morphyObj) { #' #' # Or, instead of on.exit, manually destroy morphy object and free memory: #' morphyObj <- UnloadMorphy(morphyObj) +#' } #' @template MRS #' @family Morphy API functions #' @importFrom TreeTools PhyToString @@ -220,7 +224,7 @@ MorphyErrorCheck <- function(action) { #' @examples #' morphyObj <- SingleCharMorphy("-0-0", gap = "Extra") #' RandomTreeScore(morphyObj) -#' morphyObj <- UnloadMorphy(morphyObj) +#' morphyObj <- suppressWarnings(UnloadMorphy(morphyObj)) #' @template MRS #' @seealso #' Score a tree: [`MorphyTreeLength()`] diff --git a/inst/WORDLIST b/inst/WORDLIST index ed3fd5500..4cf637746 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -183,6 +183,7 @@ cdef cdot cf cla +cleanup codecov config colourblind @@ -222,6 +223,7 @@ outgroup pachycephalosaurid palaeoscolecid patagonensis +phyDat phyllostomid phylo phylogenetics From 41ae291aedc1e720471287821e10a04128695b13 Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Fri, 27 Mar 2026 12:26:17 +0000 Subject: [PATCH 4/7] fix(T-204): suppress deprecated-fn warnings in CustomSearch and MorphyObjects tests --- tests/testthat/test-CustomSearch.R | 24 +++++++++++++----------- tests/testthat/test-mpl_morphy_objects.R | 18 +++++++++--------- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/tests/testthat/test-CustomSearch.R b/tests/testthat/test-CustomSearch.R index 8bb5c3caf..53f954414 100644 --- a/tests/testthat/test-CustomSearch.R +++ b/tests/testthat/test-CustomSearch.R @@ -29,23 +29,24 @@ test_that("Tree can be found", { stopAtPlateau = 1, verbosity = 0))) mp1 <- RootTree( - Morphy(phy11, tree = CollapseNode(random11, 13), - ratchIter = 1)[[1]], + suppressWarnings(Morphy(phy11, tree = CollapseNode(random11, 13), + ratchIter = 1))[[1]], "a") expect_true(all.equal(mp1, comb11)) expect_true(all.equal( - Morphy(phy11, tree = random11, verbosity = 0L)[[1]], + suppressWarnings(Morphy(phy11, tree = random11, verbosity = 0L))[[1]], comb11 )) expect_true(all.equal( - Morphy(phy11, random11, ratchIter = 0, verbosity = 0L)[[1]], + suppressWarnings(Morphy(phy11, random11, ratchIter = 0, verbosity = 0L))[[1]], comb11 )) # Interestingly, a good example of a case with multiple optima that require # ratchet to move between - iw <- Morphy(phy11, random11, ratchIter = 1, tbrIter = 5, - concavity = 10, verbosity = 0L)[[1]] + iw <- suppressWarnings( + Morphy(phy11, random11, ratchIter = 1, tbrIter = 5, + concavity = 10, verbosity = 0L))[[1]] expect_equal(comb11, iw) # TODO: Sectorial Search not working yet! # expect_equal(SectorialSearch(RandomTree(phy11, "a"), phy11, verbosity = -1), comb11) @@ -59,8 +60,8 @@ test_that("Tree search finds shortest tree", { start_tree <- TreeTools::RenumberTips(ape::read.tree( text = "(((1, 6), 3), (2, (4, 5)));"), true_tree$tip.label) expect_equal(TreeLength(start_tree, dataset), 6) - morphyObj <- PhyDat2Morphy(dataset) - on.exit(morphyObj <- UnloadMorphy(morphyObj)) + morphyObj <- suppressWarnings(PhyDat2Morphy(dataset)) + on.exit(suppressWarnings(UnloadMorphy(morphyObj))) expect_equal(3, attr(TreeSearch(start_tree, dataset, EdgeSwapper = NNISwap, verbosity = 0), "score"), @@ -99,9 +100,10 @@ test_that("Profile parsimony works in tree search", { # Use more iterations than necessary locally, as RNG may differ on other # platforms. expect_equal(comb11, - Morphy(phy11, c(random11, random11), # multiPhylo - ratchIter = 1, tbrIter = 2, maxHits = 10, - concavity = "profile", verbosity = 0)[[1]]) + suppressWarnings( + Morphy(phy11, c(random11, random11), # multiPhylo + ratchIter = 1, tbrIter = 2, maxHits = 10, + concavity = "profile", verbosity = 0))[[1]]) sillyData <- lapply(1:22, function (i) c(rep(0, i - 1), rep(1, 22 - i), diff --git a/tests/testthat/test-mpl_morphy_objects.R b/tests/testthat/test-mpl_morphy_objects.R index c45cae464..94221c895 100644 --- a/tests/testthat/test-mpl_morphy_objects.R +++ b/tests/testthat/test-mpl_morphy_objects.R @@ -1,9 +1,9 @@ test_that("PhyDat2Morphy() errors", { - expect_error(PhyDat2Morphy(NA)) + suppressWarnings(expect_error(PhyDat2Morphy(NA))) }) test_that("UnloadMorphy() errors", { - expect_error(UnloadMorphy(NA)) + suppressWarnings(expect_error(UnloadMorphy(NA))) }) test_that("GapHandler()", { @@ -12,20 +12,20 @@ test_that("GapHandler()", { dimnames = list(letters[1:4], NULL)) pd <- TreeTools::MatrixToPhyDat(tokens) - morphyObj <- PhyDat2Morphy(pd) + morphyObj <- suppressWarnings(PhyDat2Morphy(pd)) expect_equal(0, RandomTreeScore(morphyObj)) expect_equal("Inapplicable", GapHandler(morphyObj)) - UnloadMorphy(morphyObj) + suppressWarnings(UnloadMorphy(morphyObj)) - morphyObj <- PhyDat2Morphy(pd, "ambigu") + morphyObj <- suppressWarnings(PhyDat2Morphy(pd, "ambigu")) expect_equal(0, RandomTreeScore(morphyObj)) expect_equal("Missing data", GapHandler(morphyObj)) - UnloadMorphy(morphyObj) + suppressWarnings(UnloadMorphy(morphyObj)) - morphyObj <- PhyDat2Morphy(pd, "eXt") + morphyObj <- suppressWarnings(PhyDat2Morphy(pd, "eXt")) expect_lt(0, RandomTreeScore(morphyObj)) expect_equal("Extra state", GapHandler(morphyObj)) - UnloadMorphy(morphyObj) + suppressWarnings(UnloadMorphy(morphyObj)) morphyObj <- SingleCharMorphy("-0-0", "eXt") expect_lt(0, RandomTreeScore(morphyObj)) @@ -33,7 +33,7 @@ test_that("GapHandler()", { UnloadMorphy(morphyObj) expect_error(SingleCharMorphy("-0-0", "ERROR")) - expect_error(GapHandler(morphyObj)) + suppressWarnings(expect_error(GapHandler(morphyObj))) }) test_that("morphy_profile fails nicely", { From 42051335f5d57cdded8fd5afce4835a0a1ccd9be Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Fri, 27 Mar 2026 12:53:10 +0000 Subject: [PATCH 5/7] fix(T-204): suppress Morphy() deprecation warnings in test-Morphy.R --- tests/testthat/test-Morphy.R | 61 ++++++++++++++++++++++-------------- 1 file changed, 37 insertions(+), 24 deletions(-) diff --git a/tests/testthat/test-Morphy.R b/tests/testthat/test-Morphy.R index 13dcda66e..28154c28d 100644 --- a/tests/testthat/test-Morphy.R +++ b/tests/testthat/test-Morphy.R @@ -16,28 +16,32 @@ test_that("Constraints work", { 1, 1, 1, 0, 0, 0), ncol = 2, dimnames = list(letters[1:6], NULL))) set.seed(0) - ewResults <- Morphy(characters, - PectinateTree(c("a", "b", "f", "d", "e", "c")), - ratchIter = 0, constraint = constraint) + ewResults <- suppressWarnings( + Morphy(characters, + PectinateTree(c("a", "b", "f", "d", "e", "c")), + ratchIter = 0, constraint = constraint)) expect_equal(PectinateTree(letters[1:6]), ewResults[[1]]) expect_equal(c(seed = 0, start = 1, final = 0), attr(ewResults, "firstHit")) expect_equal(names(ewResults), "start_1") expect_equal(PectinateTree(letters[1:6]), - Morphy(characters, concavity = "p", - PectinateTree(c("a", "b", "f", "d", "e", "c")), - ratchIter = 0, constraint = constraint)[[1]]) + suppressWarnings( + Morphy(characters, concavity = "p", + PectinateTree(c("a", "b", "f", "d", "e", "c")), + ratchIter = 0, constraint = constraint))[[1]]) expect_equal(PectinateTree(letters[1:6]), - Morphy(characters, concavity = 10, - PectinateTree(c("a", "b", "f", "d", "e", "c")), - ratchIter = 0, constraint = constraint)[[1]]) + suppressWarnings( + Morphy(characters, concavity = 10, + PectinateTree(c("a", "b", "f", "d", "e", "c")), + ratchIter = 0, constraint = constraint))[[1]]) # Start tree not consistent with constraint dataset <- characters tree <- PectinateTree(c("a", "c", "f", "d", "e", "b")) expect_equal(PectinateTree(letters[1:6]), - Morphy(characters, - PectinateTree(c("a", "c", "f", "d", "e", "b")), - ratchIter = 0, constraint = constraint)[[1]]) + suppressWarnings( + Morphy(characters, + PectinateTree(c("a", "c", "f", "d", "e", "b")), + ratchIter = 0, constraint = constraint))[[1]]) dataset <- MatrixToPhyDat(matrix(c(0, 0, 1, 1, 1, 1, 1, @@ -47,7 +51,7 @@ test_that("Constraints work", { 1, 1, 1, 1, 0, 0), ncol = 2, dimnames = list(letters[1:6], NULL))) # T-039 fixed: column-major indexing in build_constraint + Wagner guards - cons <- consensus(Morphy(dataset, constraint = constraint), + cons <- consensus(suppressWarnings(Morphy(dataset, constraint = constraint)), rooted = TRUE) # Avoid %in%.Splits — S3 dispatch breaks in testthat's cloned namespace # (test_check / R CMD check). Compare bipartitions as plain logical vectors. @@ -74,9 +78,10 @@ test_that("Inconsistent constraints fail", { c(0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0), ncol = 2, dimnames = list(letters[1:6], NULL))) - expect_error(Morphy(constraint, - PectinateTree(c("a", "b", "f", "d", "e", "c")), - ratchIter = 0, constraint = constraint)) + suppressWarnings( + expect_error(Morphy(constraint, + PectinateTree(c("a", "b", "f", "d", "e", "c")), + ratchIter = 0, constraint = constraint))) }) test_that("Morphy() times out", { @@ -86,8 +91,9 @@ test_that("Morphy() times out", { data("congreveLamsdellMatrices", package = "TreeSearch") dataset <- congreveLamsdellMatrices[[42]] startTime <- Sys.time() - Morphy(dataset, ratchIter = 10000, tbrIter = 1, maxHits = 1, - maxTime = 0) + suppressWarnings( + Morphy(dataset, ratchIter = 10000, tbrIter = 1, maxHits = 1, + maxTime = 0)) expect_gt(as.difftime(5, units = "secs"), Sys.time() - startTime) }) @@ -97,9 +103,10 @@ test_that("Seed trees retained", { badTree <- read.tree(text = "(f, (b, (c, (a, (e, d)))));") dat <- StringToPhyDat("110000 110000 111000 111000 111100 111001", letters[1:6], byTaxon = FALSE) - results <- Morphy(dataset = dat, - tree = c(tree1, tree2, badTree), - ratchIter = 0, verbosity = 4) + results <- suppressWarnings( + Morphy(dataset = dat, + tree = c(tree1, tree2, badTree), + ratchIter = 0, verbosity = 4)) expect_equal(attr(results, "firstHit"), c(seed = 2, start = 0, final = 0)) }) @@ -114,8 +121,14 @@ test_that("Mismatched tree/dataset handled with warnings", { datAg <- StringToPhyDat("1100000 1100000 1111000 1110000", letters[1:7], byTaxon = FALSE) - QP <- function (...) Morphy(..., ratchIter = 0, maxHits = 1, - verbosity = 0) + # Suppress Morphy() deprecation warning; let dataset-mismatch warnings pass + QP <- function (...) withCallingHandlers( + Morphy(..., ratchIter = 0, maxHits = 1, verbosity = 0), + simpleWarning = function(w) { + if (grepl("deprecated", conditionMessage(w), ignore.case = TRUE)) + invokeRestart("muffleWarning") + } + ) expect_equal(5, unname(NTip(expect_warning(QP(datAf, treeBg))))) expect_equal(5, unname(NTip(expect_warning(QP(datAe, treeAf))))) @@ -130,7 +143,7 @@ test_that("Root retained if not 1", { dataset <- StringToPhyDat("11000000 11100000 11110000 11111000", paste0("t", 1:8), byTaxon = FALSE) - mpt <- Morphy(dataset, tr) + mpt <- suppressWarnings(Morphy(dataset, tr)) expect_equal(5, mpt[[1]]$edge[14, 2]) }) From ec5f419f3a0fde1459e60d26f680b4f570ad07be Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Fri, 27 Mar 2026 13:25:54 +0000 Subject: [PATCH 6/7] fix: suppress deprecated Morphy API warnings in Rd examples Wrap PhyDat2Morphy() and UnloadMorphy() calls in suppressWarnings() in the \examples{} sections of GapHandler.Rd, MorphyWeights.Rd, PhyDat2Morphy.Rd, RearrangeEdges.Rd, and SingleCharMorphy.Rd. Wrap Morphy() in suppressWarnings() in the \donttest{} block of Morphy.Rd -- Morphy() calls PhyDat2Morphy/UnloadMorphy internally via lapply/vapply, generating the 'FUN' is deprecated warning stream. R CMD check --as-cran treats warnings-in-examples as errors. --- man/GapHandler.Rd | 2 +- man/Morphy.Rd | 4 ++-- man/MorphyWeights.Rd | 4 ++-- man/PhyDat2Morphy.Rd | 6 +++--- man/RearrangeEdges.Rd | 4 ++-- man/SingleCharMorphy.Rd | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/man/GapHandler.Rd b/man/GapHandler.Rd index 27fadcdd3..4c7d43db3 100644 --- a/man/GapHandler.Rd +++ b/man/GapHandler.Rd @@ -23,7 +23,7 @@ algorithm of Brazeau, Guillerme and Smith (2019). \examples{ morphyObj <- SingleCharMorphy("-0-0", "Extra") GapHandler(morphyObj) -morphyObj <- UnloadMorphy(morphyObj) +suppressWarnings(morphyObj <- UnloadMorphy(morphyObj)) } \seealso{ Other Morphy API functions: diff --git a/man/Morphy.Rd b/man/Morphy.Rd index 07bc6e3f7..a46236624 100644 --- a/man/Morphy.Rd +++ b/man/Morphy.Rd @@ -325,9 +325,9 @@ dataset <- inapplicable.phyData[["Asher2005"]] \donttest{ # A very quick run for demonstration purposes -trees <- Morphy(dataset, ratchIter = 0, startIter = 0, +trees <- suppressWarnings(Morphy(dataset, ratchIter = 0, startIter = 0, tbrIter = 1, maxHits = 4, maxTime = 1/100, - concavity = 10, verbosity = 4) + concavity = 10, verbosity = 4)) names(trees) cons <- Consensus(trees) } diff --git a/man/MorphyWeights.Rd b/man/MorphyWeights.Rd index ce4a8db7a..cbcdaa16d 100644 --- a/man/MorphyWeights.Rd +++ b/man/MorphyWeights.Rd @@ -39,11 +39,11 @@ tokens <- matrix(c( 0, 0, 0, 0, 0, 0), byrow = TRUE, nrow = 2L, dimnames = list(letters[1:2], NULL)) pd <- TreeTools::MatrixToPhyDat(tokens) -morphyObj <- PhyDat2Morphy(pd) +suppressWarnings(morphyObj <- PhyDat2Morphy(pd)) MorphyWeights(morphyObj) if (SetMorphyWeights(c(1, 1.5, 2/3), morphyObj) != 0L) message("Errored") MorphyWeights(morphyObj) -morphyObj <- UnloadMorphy(morphyObj) +suppressWarnings(morphyObj <- UnloadMorphy(morphyObj)) } \seealso{ Other Morphy API functions: diff --git a/man/PhyDat2Morphy.Rd b/man/PhyDat2Morphy.Rd index 45b01b771..cfe3becb7 100644 --- a/man/PhyDat2Morphy.Rd +++ b/man/PhyDat2Morphy.Rd @@ -26,15 +26,15 @@ Once finished with the object, it should be destroyed using } \examples{ data("Lobo", package="TreeTools") -morphyObj <- PhyDat2Morphy(Lobo.phy) +suppressWarnings(morphyObj <- PhyDat2Morphy(Lobo.phy)) # Set object to be destroyed at end of session or closure of function -# on.exit(morphyObj <- UnloadMorphy(morphyObj), add = TRUE) +# on.exit(suppressWarnings(morphyObj <- UnloadMorphy(morphyObj)), add = TRUE) # Do something with pointer # .... # Or, instead of on.exit, manually destroy morphy object and free memory: -morphyObj <- UnloadMorphy(morphyObj) +suppressWarnings(morphyObj <- UnloadMorphy(morphyObj)) } \seealso{ Other Morphy API functions: diff --git a/man/RearrangeEdges.Rd b/man/RearrangeEdges.Rd index 1b951f58c..41a174edb 100644 --- a/man/RearrangeEdges.Rd +++ b/man/RearrangeEdges.Rd @@ -71,10 +71,10 @@ tree <- TreeTools::NJTree(Lobo.phy) edge <- tree$edge parent <- edge[, 1] child <- edge[, 2] -dataset <- PhyDat2Morphy(Lobo.phy) +suppressWarnings(dataset <- PhyDat2Morphy(Lobo.phy)) RearrangeEdges(parent, child, dataset, EdgeSwapper = RootedNNISwap) # Remember to free memory: -dataset <- UnloadMorphy(dataset) +suppressWarnings(dataset <- UnloadMorphy(dataset)) } \author{ \href{https://smithlabdurham.github.io/}{Martin R. Smith} diff --git a/man/SingleCharMorphy.Rd b/man/SingleCharMorphy.Rd index 08f968b4a..22e810e91 100644 --- a/man/SingleCharMorphy.Rd +++ b/man/SingleCharMorphy.Rd @@ -23,7 +23,7 @@ Morphy object from single character \examples{ morphyObj <- SingleCharMorphy("-0-0", gap = "Extra") RandomTreeScore(morphyObj) -morphyObj <- UnloadMorphy(morphyObj) +suppressWarnings(morphyObj <- UnloadMorphy(morphyObj)) } \seealso{ Score a tree: \code{\link[=MorphyTreeLength]{MorphyTreeLength()}} From 0af8fbe2db52eb3de041a2edb23c2cba27b2f50e Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Fri, 27 Mar 2026 13:54:29 +0000 Subject: [PATCH 7/7] fix: suppress PhyDat2Morphy/UnloadMorphy deprecation warnings inside Morphy() (T-204) --- R/Morphy.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/Morphy.R b/R/Morphy.R index e1f6d6a8b..40c7f6822 100644 --- a/R/Morphy.R +++ b/R/Morphy.R @@ -578,8 +578,8 @@ Morphy <- function(dataset, tree, # Initialize constraints if (constrained) { - morphyConstr <- PhyDat2Morphy(constraint) - on.exit(morphyConstr <- UnloadMorphy(morphyConstr), add = TRUE) + morphyConstr <- suppressWarnings(PhyDat2Morphy(constraint)) + on.exit(suppressWarnings(morphyConstr <- UnloadMorphy(morphyConstr)), add = TRUE) constraintWeight <- attr(constraint, "weight") if (any(constraintWeight > 1)) { cli_alert_warning("Some constraints are exact duplicates.") @@ -651,8 +651,8 @@ Morphy <- function(dataset, tree, if ((!iw && !profile) || # Required for equal weights search (isTRUE(ratchEW) && ratchIter > 0) # For EW ratchet searches ) { - morphyObj <- PhyDat2Morphy(dataset) - on.exit(morphyObj <- UnloadMorphy(morphyObj), add = TRUE) + morphyObj <- suppressWarnings(PhyDat2Morphy(dataset)) + on.exit(suppressWarnings(morphyObj <- UnloadMorphy(morphyObj)), add = TRUE) } if (iw || profile) { @@ -662,8 +662,9 @@ Morphy <- function(dataset, tree, startWeights <- at[["weight"]] minLength <- MinimumLength(dataset, compress = TRUE) morphyObjects <- lapply(characters, SingleCharMorphy) - on.exit(morphyObjects <- vapply(morphyObjects, UnloadMorphy, integer(1)), - add = TRUE) + on.exit(suppressWarnings( + morphyObjects <- vapply(morphyObjects, UnloadMorphy, integer(1))), + add = TRUE) nLevel <- length(at[["level"]]) nChar <- at[["nr"]]