From 6b30f5c95a021a3e4fd5c4b6d809a0476d5f2bb0 Mon Sep 17 00:00:00 2001 From: R script <1695515+ms609@users.noreply.github.com> Date: Wed, 5 Aug 2026 19:29:33 +0100 Subject: [PATCH] Fix .SortTokens() crash for states only seen inside a polymorphism A state that never appears as its own unambiguous token -- only ever inside an ambiguous (polymorphic) token like "(12)" -- had no row in `mapping`, so `wholes` silently held 0 for it. Summing `wholes[x]` for the ambiguous token then produced 0 instead of a real combined code, corrupting the state count and crashing ExpectedLength()'s downstream tabulate/sample pipeline with a names<- length mismatch. Fixes #135 Co-Authored-By: Claude Sonnet 5 --- R/Consistency.R | 13 +++++++++++-- tests/testthat/test-Consistency.R | 23 +++++++++++++++++++++-- 2 files changed, 32 insertions(+), 4 deletions(-) diff --git a/R/Consistency.R b/R/Consistency.R index ddbb7a871..8c76be5f3 100644 --- a/R/Consistency.R +++ b/R/Consistency.R @@ -220,8 +220,17 @@ ExpectedLength <- function(dataset, tree, nRelabel = 1000, compress = FALSE) { 2 ^ seq_along(tokensToSort) nAssigned <- log2(nWhole) + 1 - wholes <- mapping[2 ^ (seq_len(nAssigned) - 1)] - + wholeBits <- 2 ^ (seq_len(nAssigned) - 1) + # A state that never occurs on its own -- only ever within an ambiguous + # (polymorphic) token -- has no row in `mapping` yet. Give it its own + # unused code so that ambiguous tokens referencing it still sum to a + # meaningful value, rather than silently contributing zero. + unassigned <- wholeBits[mapping[wholeBits] == 0] + if (length(unassigned)) { + mapping[unassigned] <- 2 ^ (length(tokensToSort) + seq_along(unassigned)) + } + wholes <- mapping[wholeBits] + ambigTokens <- contr[ambig & seq_along(contr) %fin% char] mapping[ambigTokens] <- apply(matrix(as.logical(intToBits(contr[ambig])), 32), 2, function(x) sum(wholes[x])) diff --git a/tests/testthat/test-Consistency.R b/tests/testthat/test-Consistency.R index 42f2cf43c..fa37de12e 100644 --- a/tests/testthat/test-Consistency.R +++ b/tests/testthat/test-Consistency.R @@ -92,6 +92,20 @@ test_that("Consistency() handles `-`", { ) }) +test_that("ExpectedLength() handles a state only seen within a polymorphism", { + # A state that never appears on its own -- only ever inside an ambiguous + # (polymorphic) token -- must not crash .SortTokens()'s wholes/ambiguity + # remapping. Regression test for a crash reported downstream of the + # #88/#87/#94/#112 fix: + # Error in names(object) <- nm : + # 'names' attribute [4] must be the same length as the vector [2] + tree <- TreeTools::BalancedTree(paste0("t", 1:4)) + dat <- StringToPhyDat("00(12)(12)", TipLabels(tree)) + expect_silent(el <- ExpectedLength(dat, tree, nRelabel = 20)) + expect_type(el, "double") + expect_length(el, 1) +}) + test_that(".SortTokens() works", { contrast <- structure(c(0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, @@ -119,8 +133,13 @@ test_that(".SortTokens() works", { # Inapplicables with ambiguity # TODO it would be nice to return 7 in place of 63, but # unnecessarily complex to implement at the moment - expect_equal(TreeSearch:::.SortTokens(rep(c(1, 2, 3, 4, 8, 9), + expect_equal(TreeSearch:::.SortTokens(rep(c(1, 2, 3, 4, 8, 9), c(2, 3, 4, 5, 1, 1)), cont, inapp = 1), rep(c(4, 2, 63, 1, 3, 6), c(2, 3, 4, 5, 1, 1))) - + + # States that only ever occur within a polymorphism (never on their own) + # must not be silently mapped to zero -- regression test for a crash in + # ExpectedLength() when a character like "00(12)(12)" is scored. + expect_equal(TreeSearch:::.SortTokens(rep(1:2, 2:2), c(1, 6), NA), + rep(c(2, 12), 2:2)) })