diff --git a/.AGENTS/memory/architecture.md b/.AGENTS/memory/architecture.md index 702ad3492..4de3e30bf 100644 --- a/.AGENTS/memory/architecture.md +++ b/.AGENTS/memory/architecture.md @@ -94,8 +94,49 @@ Profile mode sets `ds.concavity = 1.0` (finite sentinel) so existing ## Constraint enforcement +- A constraint split names **two disjoint groups** plus a FREE remainder. A tree + satisfies it iff some edge separates the groups; free tips may fall either + side. This is what `?MaximizeParsimony`'s `constraint` documents and, since + agent-issues/TreeSearch#54, what every entry point enforces. `ts::node_displays_split()` + (`ts_constraint.h`) is THE shared predicate — `map_constraint_nodes()`, + `wagner_tree_displays_constraint()` and `ts_collapse_pool()` all call it. + Reintroducing an exact-clade test at any one of them freezes replicates. - `build_constraint()` reads R split matrix with **column-major** indexing: - `split_matrix[s + n_splits * t]`. + `split_matrix[s + n_splits * t]`. Values: `1` = together-group, `0` = + apart-group, **anything else (`NA_INTEGER`) = free**. A hand-built 0/1 matrix + therefore means "no free tips" and reduces to the exact-clade behaviour, which + is what `build_constraint_from_bitsets()` (consensus constraints) relies on. +- `ConstraintData` carries `split_zeros` (the apart-group) alongside + `split_tips`, and both ends of the displaying-node chain: + `constraint_node` (tightest, used for "must land outside") and + `constraint_node_hi` (highest, "must land inside"). Any writer of one must + write the other — `ts_wagner.cpp` pins hi to the tight anchor. +- `.PrepareConstraint()` drops (and warns about) a character whose `1` **or** + `0` group holds fewer than two taxa: vacuous under the documented contract, + since every tree separates such a group from the rest. +- A user constraint binds at three boundaries besides the per-move filter + (agent-issues/TreeSearch#59): the start tree is repaired by `impose_constraint()` + before it is scored, each replicate's finished tree is gated by + `capture_satisfies_constraint()` on its way into the pool, and the enforced + split is kept out of the final collapse. `impose_constraint()` is heuristic and + can fail, so every caller re-verifies. The collapse protects a realising node + only when no other realising node already survives — protecting + unconditionally would resolve a branch the constraint never asked for. +- `random_constrained_tree()` (`ts_wagner.cpp`, the `RANDOM_TREE` start + strategy) has TWO samplers. No free tips → the old group-nesting backbone, + which is then complete and uniform. Any free tip → tip-at-a-time insertion: + rejection first (uniform when it lands), then legality-filtered insertion + (always lands), then unnamed tips unfiltered. The backbone alone reaches only + 15 of 35 compliant trees on 6 taxa / 1 character, and 105 of 1155 on 8 taxa / + 2 characters; insertion reaches all. The filter is + `regraft_violates_constraint()` with a one-tip clip, over masks restricted to + the placed tips — unrestricted masks make every edge look illegal. Probe via + `ts_random_constrained_tree()`, not `MaximizeParsimony()`: TBR rearranges the + start, so the returned tree says nothing about the generator. The rejection + pass is wasted work when it cannot land (agent-issues/TreeSearch#128). +- A compliance checker built on `as.Splits()` MISSES pendant edges, so a + constraint whose group has one taxon reads as violated when every tree + satisfies it. Add the trivial splits before testing. - Wagner uses LCA-based constraint mapping (`wagner_map_constraint_nodes`) since splits aren't fully present during incremental construction. - Wagner has a posthoc retry loop (up to 100 random addition orders) as a diff --git a/.github/workflows/ASan.yml b/.github/workflows/ASan.yml index 8abea408d..a50c0baab 100644 --- a/.github/workflows/ASan.yml +++ b/.github/workflows/ASan.yml @@ -53,10 +53,10 @@ jobs: # (two vignettes + the Shiny consensus module) is requireNamespace- # guarded and skips cleanly when absent. # - # MaxMin is GitHub-only (Remotes: ms609/MaxMin); pak::pkg_install() + # Coreset is GitHub-only (Remotes: ms609/Coreset); pak::pkg_install() # resolves the vignettes leg's Suggests as plain CRAN refs and can't # see the local DESCRIPTION's Remotes mapping, so it fails the whole - # dependency solve with "Can't find package called MaxMin". All - # MaxMin use (WideSample()) is requireNamespace-guarded and skips + # dependency solve with "Can't find package called Coreset". All + # Coreset use (WideSample()) is requireNamespace-guarded and skips # cleanly when absent. - exclude-packages: Rogue,MaxMin + exclude-packages: Rogue,Coreset diff --git a/.github/workflows/R-CMD-check.yml b/.github/workflows/R-CMD-check.yml index 5cbba4b7f..219d521fd 100644 --- a/.github/workflows/R-CMD-check.yml +++ b/.github/workflows/R-CMD-check.yml @@ -118,17 +118,17 @@ jobs: # is used only by inst/Parsimony/tests, which is .Rbuildignore'd and # so absent from the tarball R CMD check sees, and those tests run in # the dedicated `shiny` job on Windows. - # MaxMin isn't on CRAN, so without this pak fetches and compiles it + # Coreset isn't on CRAN, so without this pak fetches and compiles it # from source on every cache miss -- ~67 s of the ~174 s dependency # step (measured on this exact leg, run 30697330564). This URL is a # prebuilt binary for this exact platform/R combo (aarch64, # release), published by ms609/packages' build-maxmin workflow. # The URL has no version/commit in it -- it always points at - # whatever MaxMin build is current -- so it never needs updating - # here when MaxMin changes. + # whatever Coreset build is current -- so it never needs updating + # here when Coreset changes. extra-packages: | shinytest2=?ignore - url::https://ms609.github.io/packages/bin/linux/aarch64-release/MaxMin_latest.tar.gz + url::https://ms609.github.io/packages/bin/linux/aarch64-release/Coreset_latest.tar.gz # cache-version bumped to 2: the v1 caches were built while a # project-level .Rprofile shadowed ~/.Rprofile, so every package # in them was compiled from source. Retire them once. @@ -237,19 +237,19 @@ jobs: needs: | check coverage - # MaxMin url:: -- this is the Windows leg, so it cannot use the Linux + # Coreset url:: -- this is the Windows leg, so it cannot use the Linux # tarball the `runner.os != 'Windows'` step below selects. Without a # url:: reference the solve fails outright ("Can't find package called - # MaxMin"): pak does not read `Additional_repositories`, so the drat's + # Coreset"): pak does not read `Additional_repositories`, so the drat's # indexed contrib/ layout is invisible to it. See ms609/packages' # tools/publish-maxmin.R, which publishes this flat alias for exactly # this purpose. extra-packages: | - url::https://ms609.github.io/packages/bin/windows/MaxMin_latest.zip + url::https://ms609.github.io/packages/bin/windows/Coreset_latest.zip # install-pandoc must stay explicit -- see the long note in # agent-check.yml's windows leg. Auto-detect runs a second, fresh # `pak::pkg_deps(".")` solve that cannot see extra-packages, so it - # fails on MaxMin by name; the branch only fires when pandoc is off + # fails on Coreset by name; the branch only fires when pandoc is off # PATH, which is why only the non-Linux legs hit it. install-pandoc: true # cache-version bumped to 2: the v1 caches were built while a @@ -270,13 +270,13 @@ jobs: # their dev branch). Remove once a fixed highs reaches CRAN. # shinytest2=?ignore: see the note on the sense-check leg -- its # chromium sysreq costs ~70 s of apt per run and no Linux leg needs it. - # MaxMin url:: -- see the note on the sense-check leg: a prebuilt + # Coreset url:: -- see the note on the sense-check leg: a prebuilt # binary from ms609/packages' build-maxmin workflow, picked per # this matrix's (arch, R version) combo (x86_64+4.1 vs aarch64+devel). extra-packages: | phangorn=?ignore-before-r=4.1.0 shinytest2=?ignore - ${{ matrix.config.r == '4.1' && 'url::https://ms609.github.io/packages/bin/linux/x86_64-4.1/MaxMin_latest.tar.gz' || 'url::https://ms609.github.io/packages/bin/linux/aarch64-devel/MaxMin_latest.tar.gz' }} + ${{ matrix.config.r == '4.1' && 'url::https://ms609.github.io/packages/bin/linux/x86_64-4.1/Coreset_latest.tar.gz' || 'url::https://ms609.github.io/packages/bin/linux/aarch64-devel/Coreset_latest.tar.gz' }} ${{ matrix.config.r == '4.1' && 'url::https://cran.r-project.org/src/contrib/Archive/highs/highs_1.12.0-3.tar.gz' || '' }} # cache-version bumped to 2: the v1 caches were built while a # project-level .Rprofile shadowed ~/.Rprofile, so every package @@ -342,14 +342,14 @@ jobs: with: needs: | check - # MaxMin url:: -- same reason as the core Windows leg. Added + # Coreset url:: -- same reason as the core Windows leg. Added # pre-emptively: this job was skipped in the run that diagnosed the # failure (it is gated on `detect app changes`), so unlike the core leg # it is not yet observed failing -- but it resolves the same # `needs: check` Suggests on the same platform, so it would. extra-packages: | local::. - url::https://ms609.github.io/packages/bin/windows/MaxMin_latest.zip + url::https://ms609.github.io/packages/bin/windows/Coreset_latest.zip # install-pandoc explicit for the same reason as the core Windows leg # (auto-detect's `pak::pkg_deps(".")` solve cannot see extra-packages). # `false` here: this job runs shinytest2, not vignettes. @@ -435,7 +435,7 @@ jobs: with: needs: | check - # MaxMin url:: -- same mechanism as the Windows and Linux legs, picked + # Coreset url:: -- same mechanism as the Windows and Linux legs, picked # per architecture (macOS-latest is arm64; macos-15-intel is x86_64). # Added pre-emptively and NOT yet observed failing: this job is # `needs: core`, so it was skipped while the Windows leg was red. @@ -443,7 +443,7 @@ jobs: # unresolvable-Suggests error -- note `_R_CHECK_FORCE_SUGGESTS_: false` # does not help, since it governs R CMD check, not pak's solve. extra-packages: | - ${{ matrix.config.os == 'macos-15-intel' && 'url::https://ms609.github.io/packages/bin/macosx/big-sur-x86_64/MaxMin_latest.tgz' || 'url::https://ms609.github.io/packages/bin/macosx/big-sur-arm64/MaxMin_latest.tgz' }} + ${{ matrix.config.os == 'macos-15-intel' && 'url::https://ms609.github.io/packages/bin/macosx/big-sur-x86_64/Coreset_latest.tgz' || 'url::https://ms609.github.io/packages/bin/macosx/big-sur-arm64/Coreset_latest.tgz' }} # install-pandoc explicit for the same reason as the Windows legs; also # pre-emptive, since whether a macOS runner ships pandoc on PATH is # exactly the condition that decides whether the bad branch fires. diff --git a/.github/workflows/agent-check.yml b/.github/workflows/agent-check.yml index 1f8319baa..2f5b2307a 100644 --- a/.github/workflows/agent-check.yml +++ b/.github/workflows/agent-check.yml @@ -59,14 +59,14 @@ jobs: # shinytest2=?ignore: its chromote/chromium system requirement makes # pak add the ppa:xtradeb/apps PPA and install Chromium on every run # (~70 s, not cached). No Linux leg needs it -- see R-CMD-check.yml. - # MaxMin isn't on CRAN, so without this pak fetches and compiles it + # Coreset isn't on CRAN, so without this pak fetches and compiles it # from source on every cache miss (~67 s). This URL is a prebuilt # binary for this exact platform/R combo (aarch64, release), # published by ms609/packages' build-maxmin workflow -- see the # note on R-CMD-check.yml's sense-check leg. extra-packages: | shinytest2=?ignore - url::https://ms609.github.io/packages/bin/linux/aarch64-release/MaxMin_latest.tar.gz + url::https://ms609.github.io/packages/bin/linux/aarch64-release/Coreset_latest.tar.gz # cache-version bumped to 2: the v1 caches were built while a # project-level .Rprofile shadowed ~/.Rprofile, so every package # in them was compiled from source. Retire them once. @@ -92,6 +92,85 @@ jobs: " shell: bash + glibcxx-assertions: + runs-on: ubuntu-24.04-arm + name: libstdc++ hardened assertions + + # libstdc++'s -D_GLIBCXX_ASSERTIONS turns container out-of-bounds *address + # formation* (e.g. `vec[n]` where n == vec.size(), with no load or store) + # into a hard abort. That class is invisible to plain builds, to the R CMD + # check leg above, and to ASan itself (which watches accesses, not address + # arithmetic) -- see agent-issues/TreeSearch#60 and #51. Runs independently + # of `ubuntu` for the fastest possible feedback, and skips vignettes/manual + # since it only needs testthat, not a full R CMD check. + env: + NOT_CRAN: "true" + # Cover the same tier-3 paths (long TBR/ratchet/resample searches) as + # `ubuntu`, since that's where a container out-of-bounds is most likely + # to be formed. + TREESEARCH_EXTENDED_TESTS: ${{ inputs.extended }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + RSPM: "https://packagemanager.posit.co/cran/__linux__/noble/2026-07-30" + + steps: + - name: Checkout git repo + uses: actions/checkout@v6 + + - name: Set up R + uses: r-lib/actions/setup-r@v2 + with: + r-version: "release" + + - name: Set up R dependencies + uses: r-lib/actions/setup-r-dependencies@v2 + with: + needs: check + extra-packages: | + shinytest2=?ignore + url::https://ms609.github.io/packages/bin/linux/aarch64-release/Coreset_latest.tar.gz + # A cache-version distinct from `ubuntu`'s: that job's cache is + # saved post-job from the *same* restore key (OS/R-version/needs), + # and would otherwise get overwritten with this leg's hardened + # TreeSearch install -- silently handing `ubuntu` a build it never + # asked for, and next time round handing this leg a stale cached + # library that skips reinstalling under the flag. + cache-version: 3 + + - name: Build source tarball + shell: bash + run: R CMD build --no-build-vignettes --no-manual --no-resave-data . + + - name: Install with libstdc++ hardened assertions + # MUST be PKG_CPPFLAGS, not PKG_CXXFLAGS: a user Makevars can zero the + # latter (it does on the maintainer's own dev machine), and the flag + # would then silently not reach the compiler. + # + # `shell: bash` (not the stepless default) is load-bearing here: only + # the explicit form runs with `-o pipefail`, so a failing `R CMD + # INSTALL` still fails the step even though its exit code is piped + # through `tee`. + env: + PKG_CPPFLAGS: -D_GLIBCXX_ASSERTIONS + shell: bash + run: | + R CMD INSTALL TreeSearch_*.tar.gz 2>&1 | tee /tmp/install.log + flag_count=$(grep -c -- '-D_GLIBCXX_ASSERTIONS' /tmp/install.log || echo 0) + echo "Compiler invocations carrying the flag: $flag_count" + if [ "${flag_count:-0}" -eq 0 ]; then + echo "::error::-D_GLIBCXX_ASSERTIONS never reached a compiler invocation -- this leg would silently provide no coverage" + exit 1 + fi + + - name: Run test suite under hardened libstdc++ + shell: bash + run: | + Rscript -e " + library(testthat) + library(TreeSearch) + test_dir('tests/testthat', package = 'TreeSearch', load_package = 'installed', + reporter = 'summary', stop_on_failure = TRUE) + " + windows: needs: ubuntu runs-on: windows-latest @@ -115,23 +194,23 @@ jobs: uses: r-lib/actions/setup-r-dependencies@v2 with: needs: check - # MaxMin url:: -- the Windows counterpart of the arm64 leg's line, and - # the reason this leg used to fail before compiling anything. MaxMin is + # Coreset url:: -- the Windows counterpart of the arm64 leg's line, and + # the reason this leg used to fail before compiling anything. Coreset is # not on CRAN, and pak does NOT read `Additional_repositories` from # DESCRIPTION (confirmed empirically 2026-08-03, recorded in # ms609/packages' tools/publish-maxmin.R), so the indexed drat layout # alone leaves it unresolvable and the solve dies with "Can't find - # package called MaxMin". Naming the flat, unversioned alias directly + # package called Coreset". Naming the flat, unversioned alias directly # is the mechanism that publish script exists to provide; it always - # points at the current build, so it needs no edit when MaxMin moves. + # points at the current build, so it needs no edit when Coreset moves. extra-packages: | - url::https://ms609.github.io/packages/bin/windows/MaxMin_latest.zip + url::https://ms609.github.io/packages/bin/windows/Coreset_latest.zip # install-pandoc MUST stay explicit here, and the url:: above is not # sufficient without it. Left unset, setup-r-dependencies auto-detects # by running `pak::pkg_deps(".", dependencies = list(direct = "all"))` # -- a SECOND, fresh solve that sees neither the lockfile nor - # extra-packages, so it looks MaxMin up by name and dies with - # "* local::.: Can't install dependency MaxMin" even though MaxMin has + # extra-packages, so it looks Coreset up by name and dies with + # "* local::.: Can't install dependency Coreset" even though Coreset has # just been installed successfully. That branch only runs when pandoc # is absent from PATH, which is exactly why the Linux legs never hit it # (their runners ship pandoc) and this one did. `true` rather than diff --git a/DESCRIPTION b/DESCRIPTION index 0044fda8d..adc319bd8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -58,7 +58,7 @@ Suggests: future, highs, knitr, - MaxMin, + Coreset, phangorn (>= 2.2.1), PlotTools, promises, diff --git a/NEWS.md b/NEWS.md index 746f71ab4..fb7534252 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,34 @@ the same argument does hold, which is why the ceiling is raised at that point instead. Raising `poolMaxSize` yourself still works and still governs both phases; `enumMaxTrees` is the side-effect-free way to keep more trees. +- Profile parsimony computes exactly for more multi-state characters, where it + previously approximated nearly all of them. The exact Maddison & Slatkin + solver caches into fixed-capacity memo tables and bails out when one fills -- + a guard added to stop an unbounded probe loop -- but its reserved size was + never matched to the feasibility gate that feeds it. Measured against the + worst character that gate admits, every one of them overflowed: a 3-state + character needs up to ~28,000 memo entries against the 4,096 reserved. + `StepInformation()` and `PrepareDataProfile(approx = "auto")` therefore fell + back to the Monte Carlo approximation for essentially every multi-state + character -- a documented mode, but not the one asked for. + + The 2 s wall-clock budget is unchanged, and remains what caps the wait: a + character that cannot be solved within it still falls back to Monte Carlo. + Only the characters that fit inside that budget are affected. + + **Information amounts for those characters will therefore change**, from a + sampled estimate to the exact value. Which characters those are depends on + how fast the machine is, since the budget is what decides; pass + `approx = "mc"` for the previous behaviour throughout. Note that + `approx = "exact"` waives the feasibility gate but not the budget, so it too + can fall back on a slow machine. + + Under sanitizer builds the budget is scaled by the instrumentation's + slowdown. Those builds run one to two orders of magnitude slower, so a 2 s + budget tripped on everything -- leaving the sanitizer inspecting the fallback + rather than the algorithm it was aimed at. There is no responsiveness to + protect in a nightly memory check. + - `constraint` now binds the trees `MaximizeParsimony()` returns, at three boundaries where it did not. A starting tree supplied through `tree` was never checked against the constraint; because a constrained search rejects @@ -38,6 +66,37 @@ ended on a tree that could not be made to satisfy the constraint, and now raises an error rather than returning an unverified tree if no constraint-satisfying tree was found at all. +- Every part of the search now reads `constraint` the way it is documented: a + tree is compatible with a constraint character when some edge separates the + taxa coded `1` from those coded `0`, with `?`-coded and unmentioned taxa free + to fall on either side. The locked-node filter that screens individual + rearrangements, the constrained Wagner build and the collapse pass previously + required the `1` group to be a clade *exactly*, free taxa excluded. That is + strictly stronger, so the search never accepted a rearrangement that broke the + documented constraint; but a start tree that satisfied the documented + constraint without making either group an exact clade matched no node, every + rearrangement was rejected, and the replicate returned its start unimproved. + Constrained searches with `?`-coded taxa therefore reach better scores. + The exact match also blunted the collapse protection described above: with + free taxa it matched no branch, so the separating edge could still be + contracted away -- the one route by which a *returned* tree could break the + constraint. +- Random starting trees under a constraint now sample every topology the + constraint permits. Every tree the old generator produced was compliant, but + it built each "together" group as an exact clade with the `?`-coded taxa held + outside, so most compliant topologies could never be drawn at all: 15 of the + 35 on six taxa with one constraint character, and 105 of the 1155 on eight + taxa with two. Both are now drawn in full, and at close to equal rates. + Constrained searches that use random starts therefore begin from the whole + range of legal trees rather than one corner of it. +- A constraint character whose `1` or `0` group holds fewer than two taxa now + warns and is ignored, rather than being enforced as a clade. Every tree + separates such a group from the rest, so the character constrains nothing + under the documented reading. The test is symmetric in the two groups, which + the old one was not: `c(a = 1, b = 1, c = 0)` and `c(a = 0, b = 0, c = 1)` + state the same constraint and are now treated the same way. Code the taxa + that must fall outside a group as `0`, rather than leaving them `?`, to keep + it enforced. - `TreeLength()`, `CharacterLength()`, `TreeScore()` and `EdgeListScore()` -- and so `Consistency()`, `ExpectedLength()`, `ConcordantInformation()`, `LengthAdded()` and `SuccessiveApproximations()`, which score trees through @@ -482,7 +541,7 @@ are now private and no longer exported. - `WideSample()` now dispatches to the appropriate Max-Min diversity (MMDP) - solver from the `MaxMin` package, choosing the tier automatically + solver from the `Coreset` package, choosing the tier automatically from `length(trees)`. - New functions `LeastSquaresTree()` and `LeastSquaresFit()` search for, and @@ -511,6 +570,126 @@ both the `qmApp` (T-302) and `qm` (commit e8b318c3) scalar-unwrap paths, confirming all deltas are non-negative and match independent computation. +- `ExpectedLength()`'s internal cache no longer collides across trees: + its key omitted any tree-derived component, so scoring two different trees + against the same dataset with the same `nRelabel` could silently return one + tree's cached result for the other, corrupting `rhi` -- a published + statistic -- returned by `Consistency()`. + +- `.SortTokens()` (used internally by `ExpectedLength()`) no longer rewrites + a partial-ambiguity token (e.g. `(01)`) as full ambiguity when the + dataset's contrast holds other ambiguous tokens (e.g. `?`) that are not + present in the character being processed, another silent corruption of + `rhi`. + +- `Consistency()` now always returns a matrix, even for a dataset that + compresses to a single character pattern; it previously returned a bare + numeric vector in that case, breaking `[, "ci"]`-style column access. + +- `Consistency()`'s documentation now states explicitly when its `ci`, `ri`, + `rc` and `rhi` columns are `NaN` (constant, autapomorphic and + zero-null-homoplasy characters respectively); the values themselves are + unchanged. + +- `QuartetResolution()` no longer errors on a tree in which the four focal + tips form an unresolved (star) quartet -- reachable from + `MaximizeParsimony(collapse = TRUE)` output, the default since 2026-06-24. + Such a tree now contributes `NA` rather than raising a `vapply` error. + +- `WideSample()` fixes three bugs in tree-set handling: the `effort = 1` + (`FarFirst()`) tier returned trees in farthest-first selection order rather + than the ascending input order its own comment described; `FarFirst()` was + called with a mix of positional and named arguments, fragile to any future + change to the function's argument order; and the `firstHit` attribute + (a per-*stage* tally computed from tree names) was copied onto the + subsetted output unchanged, so it continued to describe the pre-subset + input rather than the trees actually returned -- `firstHit` is now dropped + when subsetting, rather than carried over stale; call `WhenFirstHit()` on + the result to recompute it. Other attributes (`score`, `hits_to_best`, + etc.) are unaffected. + +- `BootstrapTree()` no longer risks the classic `sample()` length-1 vector + trap, in which a single remaining character index `k` would be sampled as + `sample(1:k, ...)` rather than always returning `k`. + +- `WhenFirstHit()`'s stage-name pattern is now anchored, so a tree or + replicate name that merely contains a stage pattern (rather than matching + it exactly) no longer produces a spurious, garbled stage label. + +- `TaxonInfluence()`'s distance-weighted mean no longer assumes a fixed + dimension ordering from a user-supplied `Distance` function; the returned + matrix's shape is now checked and normalized explicitly. +- `ClusterStrings()` no longer crashes when the best clustering contains a + singleton cluster, no longer omits the documented `silhouette` attribute + when few unique strings are supplied, and its "no structure" branch now + returns the documented per-element cluster-assignment vector rather than a + bare scalar `1`. Its internal call to `cluster::pam()` now passes the + Levenshtein distance matrix via `as.dist()`, so it is treated as a + dissimilarity rather than clustered on Euclidean distance between its + rows; **silhouette scores and, in some cases, cluster assignments for the + `pam` method may change** to more accurately reflect string similarity. + +- `ParsSim()` now errors clearly, instead of silently corrupting the Fitch + score, if asked to simulate a character with 32 or more states -- the + internal bit-set representation of state sets overflows a 32-bit integer + beyond that. It also errors clearly, instead of an opaque + `sample.int()` failure, if a tree lacks the structure to host the number + of requested states for a character. Simulation with `nExtraSteps > 0` + is also faster, as the redundant saturation scan previously performed + again on every character at return now reuses the result already + computed during the step-placement loop. + +- `ClusteringConcordance(normalize = TRUE)` now chance-corrects large trees, + which it previously left uncorrected while still describing the result as + corrected. The expected mutual information that sets the zero point was + accumulated by a recurrence over the hypergeometric distribution of cell + overlaps, seeded at the smallest overlap the marginals allow. That + probability sinks below the smallest representable double once a character + scores about 1080 tips, and the recurrence being multiplicative, every later + term then stayed zero: `expected_mi()` returned exactly 0 where the seed + vanished for every block of the character, and a silently truncated sum -- + as little as a quarter of the true value -- where it vanished for some. The recurrence is now anchored at the + mode of the distribution, whose probability is the largest of at most + `N + 1` values summing to one and so is always representable. The threshold + is a property of the tips each character scores rather than of the tree, and + only marginals close to even reach it: of 600 random partitions, none below + 1200 items was affected, 13 of 60 at 1500 items, and 30 of 60 at 3000. + Values that were already correct are unchanged, to of order 1e-11 relative. + +- `expected_mi()` now checks that `ni` gives exactly two block sizes, as its + documentation always required. A shorter vector was read past its end, and + the arbitrary values that produced could index the log-factorial lookup + table out of bounds and crash the session. + +- `QuartetConcordance()`'s counting kernel now rejects a negative character + state code rather than indexing its count buffers out of bounds. State + codes generated by the package are always positive, so no result changes. + +- `TBRMoves()` now lists the complete TBR neighbourhood. It never + bisected the edge leading to the first-labelled tip, so every rearrangement + that relocates that tip was missing -- around a dozen trees on a typical + eleven-leaf tree, and enough that the output was not even a superset of + `SPRMoves()`, which TBR contains by definition. `TBRMoves()` + therefore returns more trees than before, and any count derived from it will + rise. `MaximizeParsimony()` is unaffected: it drives a separate enumerator + that has always swept the root edge. +- `Ratchet(stopAtScore = )` no longer returns a tree whose independently + recomputed score disagrees with its `"score"` attribute. Its early-exit + paths -- meeting the target score during search, or already meeting it on + entry -- skipped the bookkeeping that the return value depends on, so the + *input* tree could be returned carrying the *improved* score. + `returnAll = TRUE` no longer errors ("No trees!?") when the target score is + met during search, and `MultiRatchet()` no longer errors when a starting + tree already meets `stopAtScore`. + +- The cache behind `ClusteringConcordance(normalize = TRUE)` keyed partitions + on block sizes narrowed to 16 bits, so two partitions whose block sizes + differed by a multiple of 65536 shared an entry and the second was given the + first one's expected mutual information. Reaching this needed a tree of at + least 65536 tips, so no published result is affected; keys now span the full + range of an integer, which rules the collision out rather than making it + unlikely. + # TreeSearch 2.0.0 ## Breaking changes diff --git a/R/Bootstrap.R b/R/Bootstrap.R index de3c785f6..de29b49b3 100644 --- a/R/Bootstrap.R +++ b/R/Bootstrap.R @@ -17,10 +17,16 @@ BootstrapTree <- function (edgeList, dataset, EdgeSwapper = NNISwap, maxIter, maxHits, verbosity = 1L, stopAtPeak = FALSE, stopAtPlateau = 0L, ...) { startWeights <- dataset[["original_weight"]] + if (sum(startWeights) == 0L) { + stop("`dataset[[\"original_weight\"]]` sums to zero; no characters ", + "to resample.") + } eachChar <- seq_along(startWeights) deindexedChars <- rep.int(eachChar, startWeights) - resampling <- tabulate(sample(deindexedChars, replace = TRUE), - length(startWeights)) + resampling <- tabulate( + deindexedChars[sample.int(length(deindexedChars), replace = TRUE)], + length(startWeights) + ) # R copy-on-modify: the caller's `dataset` is unchanged. dataset[["weight"]] <- as.integer(resampling) diff --git a/R/ClusterStrings.R b/R/ClusterStrings.R index 4d4962099..67fd12e20 100644 --- a/R/ClusterStrings.R +++ b/R/ClusterStrings.R @@ -5,12 +5,14 @@ #' #' @param x Character vector. #' @param maxCluster Integer specifying maximum number of clusters to consider. -#' @return `NameClusters()` returns an integer assigning each element of `x` -#' to a cluster, with an attribute `med` specifying the median string in each +#' @return `ClusterStrings()` returns an integer assigning each element of `x` +#' to a cluster, with an attribute `med` specifying the median string in each #' cluster, and `silhouette` reporting the silhouette coefficient of the optimal -#' clustering. Coefficients < 0.5 indicate weak structure, and no clusters are -#' returned. If the number of unique elements of `x` is less than `maxCluster`, -#' all occurrences of each entry are assigned to an individual cluster. +#' clustering. Coefficients < 0.5 indicate weak structure, in which case all +#' elements of `x` are assigned to a single cluster. If the number of unique +#' elements of `x` is less than `maxCluster`, all occurrences of each entry +#' are assigned to an individual cluster instead, with `silhouette` reported +#' as `NA`. #' #' @examples #' ClusterStrings(c(paste0("FirstCluster ", 1:5), @@ -36,19 +38,14 @@ ClusterStrings <- function (x, maxCluster = 12) { if (length(unique(x)) < maxCluster) { nom <- unique(x) - structure(match(x, nom), "med" = nom) + structure(match(x, nom), "med" = nom, silhouette = NA_real_) } else { possibleClusters <- 2:maxCluster hSil <- pamSil <- -99 dists <- adist(x) # approximate string distance - - nMethodsChecked <- 2 - methInc <- 1 / nMethodsChecked - nK <- length(possibleClusters) - kInc <- 1 / (nMethodsChecked * nK) - + pamClusters <- lapply(possibleClusters, function (k) { - cluster::pam(dists, k = k) + cluster::pam(as.dist(dists), k = k) }) pamSils <- vapply(pamClusters, function (pamCluster) { mean(cluster::silhouette(pamCluster)[, 3]) @@ -68,12 +65,13 @@ ClusterStrings <- function (x, maxCluster = 12) { bestCluster <- c("none", "pam", "hmm")[which.max(c(0.5, pamSil, hSil))] - clustering <- switch(bestCluster, pam = pamCluster, hmm = hCluster, 1) - + clustering <- switch(bestCluster, pam = pamCluster, hmm = hCluster, + rep(1L, length(x))) + medians <- vapply(seq_len(max(clustering)), function (i) { these <- clustering == i - x[these][which.min(colSums(dists[these, these]))] + x[these][which.min(colSums(dists[these, these, drop = FALSE]))] }, character(1)) structure(clustering, diff --git a/R/Concordance.R b/R/Concordance.R index 2ba797245..9cb70455d 100644 --- a/R/Concordance.R +++ b/R/Concordance.R @@ -177,7 +177,19 @@ ClusteringConcordance <- function( dataset <- dataset[keep] # Prepare data - splits <- as.logical(as.Splits(tree)) + # `tree` may carry tips absent from `dataset`; Subsplit restricts `splits` to the + # shared taxa without renumbering nodes. + splits <- as.logical(Subsplit(as.Splits(tree), keep)) + # Recover each surviving split's original node number + if (is.null(rownames(splits))) { + fullRestricted <- as.logical(as.Splits(tree))[, TipLabels(tree) %in% keep, + drop = FALSE] + rownames(splits) <- vapply(seq_len(nrow(splits)), function(i) { + row <- splits[i, ] + hit <- apply(fullRestricted, 1, function(r) all(r == row) || all(r != row)) + rownames(fullRestricted)[which(hit)[1]] + }, character(1)) + } at <- attributes(dataset) cont <- at[["contrast"]] @@ -311,7 +323,7 @@ ClusteringConcordance <- function( zero <- if (isFALSE(normalize)) { 0 } else if (isTRUE(normalize)) { - apply(hh["miRand", , ], 2, max) + apply(.ConcSlice(hh, "miRand"), 2, max) } else { randMean } @@ -534,10 +546,10 @@ ConcordanceTable <- function(tree, dataset, Col = QACol, largeClade = 0, cc <- ClusteringConcordance(tree, dataset, return = "all", normalize = normalize) nodes <- seq_len(dim(cc)[[2]]) - info <- cc["hBest", , ] * cc["n", , ] + info <- .ConcSlice(cc, "hBest") * .ConcSlice(cc, "n") amount <- info / max(info, na.rm = TRUE) amount[is.na(amount)] <- 0 - quality <- cc["normalized", , ] + quality <- .ConcSlice(cc, "normalized") # Plot points with incalculable quality as black, not transparent. amount[is.na(quality)] <- 0 quality[is.na(quality)] <- 0 @@ -589,7 +601,7 @@ ConcordanceTable <- function(tree, dataset, Col = QACol, largeClade = 0, n_chars <- dim(cc)[[3]] # Marginal concordance: hBest-weighted average of normalized MI - hBest_w <- cc["hBest", , ] + hBest_w <- .ConcSlice(cc, "hBest") hBest_w[is.na(hBest_w)] <- 0 # `quality` already has NAs zeroed above @@ -621,7 +633,7 @@ ConcordanceTable <- function(tree, dataset, Col = QACol, largeClade = 0, denom_e <- rowSums(hBest_w) edge_conc <- pmax(-1, pmin(1, ifelse(denom_e == 0, 0, rowSums(quality * hBest_w) / denom_e))) - edge_cols <- Col(edge_conc, rowMeans(cc["hSplit", , ])) + edge_cols <- Col(edge_conc, rowMeans(.ConcSlice(cc, "hSplit"))) if (ms_bottom > 0L) { for (j in seq_len(ms_bottom)) ext_col[xi, ps_y_offset + j] <- edge_cols } @@ -703,6 +715,8 @@ ConcordanceTable <- function(tree, dataset, Col = QACol, largeClade = 0, #' concordance of each character in `dataset` with `tree`. #' The attribute `weighted.mean` gives the mean value, weighted by the #' information content of each character. +#' `NaN` is returned for a character that no split in `tree` is informative +#' about (zero possible information, a 0 / 0 division). #' @importFrom TreeTools MatchStrings #' @importFrom TreeDist ClusteringEntropy MutualClusteringInfo #' @export @@ -757,6 +771,9 @@ MutualClusteringConcordance <- function(tree, dataset) { #' Ambiguous and inapplicable tokens are treated as containing no grouping #' information (i.e. `(02)` or `-` are each treated as `?`). #' +#' `return` is matched (case-insensitively, and partially) against `"edge"` +#' and `"char"`; any other value raises an error. +#' #' @return #' `QuartetConcordance(return = "edge")` returns a numeric vector giving the #' concordance index at each split across all sites; names specify the number of @@ -764,6 +781,8 @@ MutualClusteringConcordance <- function(tree, dataset) { #' #' `QuartetConcordance(return = "char")` returns a numeric vector giving the #' concordance index calculated at each site, averaged across all splits. +#' Unlike the `"edge"` result, this vector is unnamed: characters retain no +#' persistent identifier once collapsed to patterns. #' #' @param weight Logical specifying whether to weight sites according to the #' number of quartets they are decisive for. @@ -799,8 +818,13 @@ QuartetConcordance <- function( contrast <- attr(dataset, "contrast") charLevels <- attr(dataset, "allLevels") + appCols <- colnames(contrast) != "-" isInapp <- charLevels == "-" - isAmbig <- rowSums(contrast[, colnames(contrast) != "-"]) > 1 + # A level combining an applicable state with "-" (e.g. `{0,-}`) sets + # exactly one non-"-" column, so it would otherwise pass the `rowSums` + # check below as if it were a pure single-state (grouping) level. + combinesInapp <- rowSums(contrast[, !appCols, drop = FALSE] > 0) > 0 & !isInapp + isAmbig <- rowSums(contrast[, appCols, drop = FALSE]) > 1 | combinesInapp isGrouping <- !isAmbig & !isInapp # For each grouping level, which column of the contrast matrix does it uniquely set? @@ -820,12 +844,15 @@ QuartetConcordance <- function( num <- raw_counts$concordant den <- raw_counts$decisive - options <- c("character", "site", "default") - return <- options[[pmatch(tolower(trimws(return)), options, - nomatch = length(options))]] - + options <- c("edge", "char") + matched <- pmatch(tolower(trimws(return)), options, nomatch = NA_integer_) + if (is.na(matched)) { + stop("`return` must (partially) match one of ", + paste(sQuote(options), collapse = ", ")) + } + return <- options[[matched]] - if (return == "default") { + if (return == "edge") { if (isTRUE(weight)) { # Sum numerator and denominator across sites (columns), then divide # This matches weighted.mean(num/den, den) == sum(num) / sum(den) @@ -848,7 +875,6 @@ QuartetConcordance <- function( setNames(ret, names(splits)) } else { # return = "char" - p <- num / den if (isTRUE(weight)) { vapply( seq_len(dim(num)[[2]]), @@ -870,6 +896,16 @@ QuartetConcordance <- function( } .ExpectedMICache <- new.env(hash = TRUE, parent = emptyenv()) +# Bound on cache size: a session computing concordance for many differently +# -sized trees/characters would otherwise grow this cache without limit. +# Simplest possible bounded policy: wipe the whole cache once full, rather +# than tracking per-entry recency for an LRU/LFU scheme. The entry count is +# tracked separately (`.ExpectedMICacheSize`) rather than read via `length()` +# on every miss: `length()` on a hashed environment is O(n), which would make +# filling the cache to its bound an O(limit^2) operation. +.ExpectedMICacheLimit <- 100000L +.ExpectedMICacheSize <- new.env(parent = emptyenv()) +.ExpectedMICacheSize$n <- 0L # @param a must be a vector of length <= 2 # @param b may be longer @@ -884,7 +920,13 @@ QuartetConcordance <- function( ret <- expected_mi(a, b) # Cache: + if (.ExpectedMICacheSize$n >= .ExpectedMICacheLimit) { + rm(list = ls(.ExpectedMICache, all.names = TRUE), + envir = .ExpectedMICache) + .ExpectedMICacheSize$n <- 0L + } .ExpectedMICache[[key]] <- ret + .ExpectedMICacheSize$n <- .ExpectedMICacheSize$n + 1L # Return: ret } @@ -899,6 +941,15 @@ QuartetConcordance <- function( (value - zero) / (1 - zero) } +# Extract row `name` of a (measure x split x character) concordance array as +# a (split x character) matrix, preserving dimnames. Plain `[` silently +# drops the split or character axis whenever it has extent one, corrupting +# shape and rownames downstream (e.g. a single-split tree, or a +# single-pattern dataset). +.ConcSlice <- function(x, name) { + array(x[name, , , drop = FALSE], dim(x)[2:3], dimnames(x)[2:3]) +} + #' @rdname SiteConcordance #' #' @details @@ -922,6 +973,8 @@ QuartetConcordance <- function( #' @return `PhylogeneticConcordance()` returns a numeric vector giving the #' phylogenetic information of each split in `tree`, named according to the #' split's internal numbering. +#' `NaN` is returned for a split that no character is informative about +#' (zero possible information, a 0 / 0 division). #' #' @importFrom TreeTools as.multiPhylo CladisticInfo CompatibleSplits #' @importFrom TreeTools MatchStrings @@ -973,6 +1026,8 @@ PhylogeneticConcordance <- function(tree, dataset) { #' concordance of each character in `dataset` with `tree`. #' The attribute `weighted.mean` gives the mean value, weighted by the #' information content of each character. +#' `NaN` is returned for a character that no split in `tree` is informative +#' about (zero possible information, a 0 / 0 division). #' @importFrom TreeTools as.multiPhylo MatchStrings #' @importFrom TreeDist ClusteringInfo SharedPhylogeneticInfo #' @export @@ -1073,7 +1128,7 @@ ConcordantInformation <- function(tree, dataset) { kept <- sum(icA[index]) discarded <- totalInfo - kept warning("Could not calculate signal for characters ", - paste0(match(which(na), index), collapse = ", "), + paste0(which(index %in% which(na)), collapse = ", "), "; discarded ", signif(discarded), " bits from totals.") totalNoise <- sum(noise[index], na.rm = TRUE) totalSignal <- sum(signal[index], na.rm = TRUE) @@ -1095,7 +1150,6 @@ ConcordantInformation <- function(tree, dataset) { totalNoise <- sum(noise[index]) totalSignal <- sum(signal[index]) signalNoise <- totalSignal / totalNoise - discarded = 0 infoNeeded <- Log2Unrooted(length(dataset)) infoOverkill <- totalInfo / infoNeeded diff --git a/R/Consistency.R b/R/Consistency.R index e084370f6..dc59d113d 100644 --- a/R/Consistency.R +++ b/R/Consistency.R @@ -51,12 +51,21 @@ #' If zero (the default), the \acronym{RHI} is not calculated. #' @inheritParams CharacterLength #' -#' @return `Consistency()` returns a matrix with named columns specifying the +#' @return `Consistency()` returns a matrix with named columns specifying the #' consistency index (`ci`), #' retention index (`ri`), #' rescaled consistency index (`rc`) and #' relative homoplasy index (`rhi`). -#' +#' `ci` is `NaN` for a constant character, for which both the observed and +#' minimum length are zero. +#' `ri` and `rc` are `NaN` when the maximum and minimum length coincide, as +#' for a constant or an autapomorphic character. +#' `rhi` is `NA` throughout if `nRelabel = 0`, as it is then not calculated. +#' Otherwise `rhi` is `NaN` when the observed length already equals the +#' minimum length and the median length under random leaf relabelling also +#' equals the minimum; if only the median length equals the minimum, `rhi` +#' is `Inf`. +#' #' @examples #' data(inapplicable.datasets) #' dataset <- inapplicable.phyData[[4]] @@ -104,7 +113,7 @@ Consistency <- function (dataset, tree, nRelabel = 0, compress = FALSE) { if (compress) { ret } else { - ret[attr(dataset, "index"), ] + ret[attr(dataset, "index"), , drop = FALSE] } } @@ -131,7 +140,6 @@ Consistency <- function (dataset, tree, nRelabel = 0, compress = FALSE) { ExpectedLength <- function(dataset, tree, nRelabel = 1000, compress = FALSE) { .CheckDataCharLen(dataset) .CheckTreeCharLen(tree) - tipLabel <- tree[["tip.label"]] tree <- .TreeForTaxa(tree, names(dataset)) mat <- do.call(rbind, dataset) @@ -148,10 +156,19 @@ ExpectedLength <- function(dataset, tree, nRelabel = 1000, compress = FALSE) { as.integer(intToBits(x)[1:nLevels]) }, integer(nLevels))) + # Key on the unlabelled rooted shape + treeKey <- .ShapeKey(tree) + # Cache per shape, and within that per character + treeCache <- .CharLengthCache[[treeKey]] + if (is.null(treeCache)) { + treeCache <- new.env(hash = TRUE, parent = emptyenv()) + .CharLengthCache[[treeKey]] <- treeCache + } + .LengthForChar <- function(x) { key <- paste(c(nRelabel, x), collapse = ",") - if (!is.null(.CharLengthCache[[key]])) { - .CharLengthCache[[key]] + if (!is.null(treeCache[[key]])) { + treeCache[[key]] } else { patterns <- apply(unname(unique(t( as.data.frame(replicate(nRelabel, sample(rep(seq_along(x), x))))))), @@ -168,7 +185,7 @@ ExpectedLength <- function(dataset, tree, nRelabel = 1000, compress = FALSE) { contrast = rwContrast, class = "phyDat") ret <- median(FastCharacterLength(tree, phy)) - .CharLengthCache[[key]] <- ret + treeCache[[key]] <- ret ret } } @@ -189,6 +206,38 @@ ExpectedLength <- function(dataset, tree, nRelabel = 1000, compress = FALSE) { } +# Canonical identifier of a rooted tree's unlabelled shape, after +# Aho, Hopcroft & Ullman: a leaf encodes as `01`, and an internal node wraps +# its children's codes, sorted into a fixed order, in `0`...`1`. +# @param tree A rooted, binary tree of class `phylo`. +# @return A string identifying the shape of `tree`. +#' @importFrom TreeTools NTip Postorder +.ShapeKey <- function(tree) { + edge <- Postorder(tree)[["edge"]] + nTip <- NTip(tree) + code <- character(max(edge)) + code[seq_len(nTip)] <- "01" + kids <- vector("list", max(edge)) + # Postorder guarantees that a node's children are coded before the edge that + # subtends it is read, so a single pass suffices. + for (i in seq_len(dim(edge)[[1]])) { + parent <- edge[[i, 1]] + kids[[parent]] <- c(kids[[parent]], code[[edge[[i, 2]]]]) + if (length(kids[[parent]]) == 2L) { + code[[parent]] <- paste0("0", paste(sort(kids[[parent]], + method = "radix"), + collapse = ""), "1") + } + } + bits <- as.integer(strsplit(code[[edge[[dim(edge)[[1]], 1]]]], "", + fixed = TRUE)[[1]]) == 1L + # Pack to bytes for compactness. Padding to a byte boundary could otherwise + # conflate shapes whose codes differ only in length, so the leaf count leads. + bits <- c(bits, rep(FALSE, (-length(bits)) %% 8)) + paste0(nTip, ":", paste(as.character(packBits(bits, "raw")), collapse = "")) +} + + # Relabel a character such that 1 is the most common; then 2, etc. # @param char integer vector: row of contrast matrix that applies to each taxon # @param contr binary representation of contrast matrix @@ -221,10 +270,19 @@ 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), + mapping[ambigTokens] <- apply(matrix(as.logical(intToBits(ambigTokens)), 32), 2, function(x) sum(wholes[x])) # Return: diff --git a/R/Jackknife.R b/R/Jackknife.R index 697b792ef..d5bc3b0c0 100644 --- a/R/Jackknife.R +++ b/R/Jackknife.R @@ -104,6 +104,10 @@ JackknifeTree <- function (edgeList, dataset, resampleFreq = 2 / 3, TreeScorer = EdgeListScore, EdgeSwapper = NNISwap, maxIter, maxHits, verbosity = 1L, ...) { startWeights <- dataset[["original_weight"]] + if (sum(startWeights) == 0L) { + stop("`dataset[[\"original_weight\"]]` sums to zero; no characters ", + "to resample.") + } eachChar <- seq_along(startWeights) deindexedChars <- rep.int(eachChar, startWeights) charsToKeep <- ceiling(resampleFreq * length(deindexedChars)) diff --git a/R/MaximizeParsimony.R b/R/MaximizeParsimony.R index 9407e1485..d2f39209d 100644 --- a/R/MaximizeParsimony.R +++ b/R/MaximizeParsimony.R @@ -121,7 +121,10 @@ consContrast <- attr(constraint, "contrast") nConsStates <- ncol(consContrast) - if (nConsStates < 2L) return(list()) + if (nConsStates < 2L) { + warning("Ignoring empty constraint", call. = FALSE) + return(list()) + } # Constraints are enforced as bipartitions, so only the two extreme states of # a character are read: taxa carrying an intermediate state are in neither @@ -139,8 +142,7 @@ # For each constraint character, record the tips unambiguously in the "1" # group (derived state present, ancestral absent) and, separately, those in # the "0" group (ancestral present, derived absent). Tips ambiguous for the - # character ("?", or unconstrained taxa) belong to neither group and are free - # to plot on either side of the split. + # character ("?", or unconstrained taxa) may plot anywhere. consSplits <- matrix(0L, nrow = ncol(consMat), ncol = length(constraint)) consZero <- matrix(0L, nrow = ncol(consMat), ncol = length(constraint)) for (ch in seq_len(ncol(consMat))) { @@ -156,23 +158,20 @@ } } - keep <- apply(consSplits, 1, function(row) { - s <- sum(row) - s >= 1 && s < length(constraint) - 1 - }) + # Ignore trivial constraints + nOne <- rowSums(consSplits) + nZero <- rowSums(consZero) + inert <- nOne < 2 | nZero < 2 + if (any(inert)) { + warning("Ignoring trivial constraint character", if (sum(inert) > 1) "s" else "", " ", + paste(which(inert), collapse = ", "), call. = FALSE) + } + keep <- !inert consSplits <- consSplits[keep, , drop = FALSE] consZero <- consZero[keep, , drop = FALSE] if (nrow(consSplits) == 0L) return(list()) # Every returned tree must display all constraint splits simultaneously. - # Two splits are jointly displayable iff they are compatible in the - # four-gamete sense: treating each as a bipartition of the tips it - # constrains (its "1" group vs its "0" group, ambiguous tips excluded), the - # pair is compatible iff at least one of the four group intersections is - # empty. A laminar (nested-or-disjoint) test alone is too strict: it rejects - # the case where the two "0" groups are disjoint -- i.e. the splits' "1" - # sides jointly cover the constrained tips -- which is perfectly displayable, - # e.g. ab | cef and abcd | ef coexist on ((a,b),(d,(c,(e,f)))). nSplits <- nrow(consSplits) if (nSplits > 1L) { for (i in seq_len(nSplits - 1L)) { @@ -185,7 +184,7 @@ !any(aZero & bOne) || !any(aZero & bZero) if (!compatible) { stop("Constraint is impossible to satisfy: splits ", i, " and ", j, - " are incompatible (all four taxon groupings co-occur)") + " are incompatible") } } } @@ -199,6 +198,15 @@ consTipData <- matrix(unlist(constraint, use.names = FALSE), nrow = length(constraint), byrow = TRUE) + # Fold the two groups into the single membership matrix the C++ engine reads: + # 1 = "together", 0 = "apart", NA = free to fall on either side. A tip that + # is in neither group must not be coded 0, or the engine would enforce the + # stricter "the 1 group is an exact clade" reading and refuse to move a start + # tree that already satisfies the documented one (agent-issues/TreeSearch#54). + # build_constraint() (src/ts_constraint.cpp) treats any value that is neither + # 1 nor 0 as free, so a plain 0/1 matrix still means "no free tips". + consSplits[consSplits == 0L & consZero == 0L] <- NA_integer_ + list( consSplitMatrix = consSplits, consZero = consZero, @@ -234,6 +242,11 @@ # neither group here and are unconstrained there too (.PrepareConstraint() # warns about that at input). .ConstraintViolated <- function(tree, consOne, consZero) { + # `consOne` is the membership matrix the C++ kernels read, so it uses their + # coding: 1 = in the group, anything else -- including the NA that marks a + # free tip -- out of it. Reduce it to 0/1 here rather than let an NA + # propagate through the accumulation below and turn every comparison NA. + consOne <- (!is.na(consOne) & consOne == 1L) * 1L edge <- Postorder(tree)[["edge"]] parent <- edge[, 1L] child <- edge[, 2L] @@ -798,6 +811,14 @@ #' returned trees will be perfectly compatible with each character in #' `constraint`; or a tree of class `phylo`, all of whose nodes will occur #' in any output tree. +#' A returned tree is compatible with a constraint character when some edge +#' separates the taxa coded `1` from those coded `0`. Taxa coded `?`, and taxa +#' that `constraint` does not mention, are unconstrained: they may fall on +#' either side of that edge, and are not required to join either group. +#' A character whose `1` or `0` group contains fewer than two taxa therefore +#' constrains nothing -- every tree separates such a group from the rest -- and +#' is ignored with a warning. To group taxa, code the taxa they must be +#' separated from as `0` rather than leaving them `?`. #' Constraint searches are supported natively: all tree rearrangements #' are filtered to respect the constraint topology. #' Each constraint character is enforced as a single split, so one with more @@ -1793,21 +1814,17 @@ MaximizeParsimony <- function( # enforced clade"): a constraint is external evidence for a grouping the # matrix doesn't capture, so it stays visible even at zero length, while the # unsupported non-constraint branches still collapse. consSplitMatrix rows - # are the enforced bipartitions in tip_data order (see .PrepareConstraint). - # `consZero` names the tips the constraint places on the far side of the - # split; tips ambiguous for the character are in neither group. Without it - # the kernel can only recognise a node whose tip set is the 1 group exactly, - # and a split realised by any wider node goes unprotected -- collapsing the - # enforced grouping out of the returned tree. + # are the enforced bipartitions in tip_data order, carrying both groups + # (1 = together, 0 = apart, NA = free; see .PrepareConstraint). The kernel + # needs both: a tree with free tips generally realises the split at a node + # whose tip set is wider than the 1 group, which no exact match reaches, so + # the enforced grouping would collapse out of the returned tree. consSplits <- if (!is.null(constraintConfig)) { constraintConfig[["consSplitMatrix"]] } - consZero <- if (!is.null(constraintConfig)) { - constraintConfig[["consZero"]] - } collapsed <- ts_collapse_pool( bestTrees, contrast, tip_data, weight, levels, - scoringConfig, hsjConfig, xformConfig, consSplits, consZero + scoringConfig, hsjConfig, xformConfig, consSplits ) outTrees <- lapply(collapsed$trees, function(edgeMat) { tr <- list( diff --git a/R/ParsSim.R b/R/ParsSim.R index 590894e7d..11c8acd38 100644 --- a/R/ParsSim.R +++ b/R/ParsSim.R @@ -131,6 +131,9 @@ ParsSim <- function(tree, # --- Determine state counts per character ---------------------------------- n_states_vec <- rep(seq_along(nChar) + 1L, times = nChar) + if (any(n_states_vec > 31L)) { + stop("ParsSim() supports at most 31 states per character.") + } # --- Validate and expand rootState ------------------------------------------ rootState <- as.integer(rootState) @@ -170,6 +173,12 @@ ParsSim <- function(tree, extra_steps <- integer(total_chars) steps_exhausted <- logical(total_chars) + # Cache of the last .pars_sim_legal_edges() result computed for each + # character, so the saturation check at return can reuse it instead of + # rescanning. Valid only until the character's state next changes. + legal_cache <- vector("list", total_chars) + legal_cache_valid <- logical(total_chars) + if (nExtraSteps > 0L) { steps_placed <- 0L while (steps_placed < nExtraSteps) { @@ -189,6 +198,11 @@ ParsSim <- function(tree, legal <- .pars_sim_legal_edges(char_states[[char_idx]], tree_info, char_scores[char_idx], n_states_vec[char_idx]) + # `[char_idx] <- list(legal)`, not `[[char_idx]] <- legal`: assigning + # NULL via `[[<-` deletes the list element instead of storing NULL, + # shrinking legal_cache and misaligning it with char_idx. + legal_cache[char_idx] <- list(legal) + legal_cache_valid[char_idx] <- TRUE if (is.null(legal)) { steps_exhausted[char_idx] <- TRUE @@ -206,6 +220,9 @@ ParsSim <- function(tree, char_scores[char_idx] <- char_scores[char_idx] + 1L extra_steps[char_idx] <- extra_steps[char_idx] + 1L steps_placed <- steps_placed + 1L + # The character's state just changed, so the cached legal-edges result + # no longer describes its current state. + legal_cache_valid[char_idx] <- FALSE # In profile mode, mark exhausted when info drops to 0 if (use_profile) { @@ -240,9 +257,15 @@ ParsSim <- function(tree, } # --- Calculate saturation for all characters -------------------------------- + # Reuse the legal-edges result already computed during the step loop where + # still valid, instead of rescanning every character from scratch. saturated <- vapply(seq_len(total_chars), function(i) { - is.null(.pars_sim_legal_edges(char_states[[i]], tree_info, - char_scores[i], n_states_vec[i])) + if (legal_cache_valid[i]) { + is.null(legal_cache[[i]]) + } else { + is.null(.pars_sim_legal_edges(char_states[[i]], tree_info, + char_scores[i], n_states_vec[i])) + } }, logical(1)) attr(result, "saturated") <- saturated @@ -505,6 +528,12 @@ ParsSim <- function(tree, #' @keywords internal #' @noRd .safe_sample_idx <- function(n, prob = NULL) { + if (n == 0L) { + stop("No candidate edges are available to place a new character state: ", + "the tree does not have enough unmarked structure left to host ", + "another distinct state. Reduce the number of states requested, ", + "or supply a larger tree.") + } if (n == 1L) return(1L) if (!is.null(prob)) { # Edge lengths drive the weights; a tree with all-zero (or absent / diff --git a/R/PrepareData.R b/R/PrepareData.R index 43a8f0b74..9738b5f43 100644 --- a/R/PrepareData.R +++ b/R/PrepareData.R @@ -60,20 +60,24 @@ PrepareData <- function(dataset, concavity = Inf) { } at <- attributes(dataset) - # `original_weight` (integer pattern multiplicities) is the base for - # character resampling; `weight` is the rescaled score weight passed to the - # C++ engine (identical for the usual integer weights). + # `original_weight` is the base for character resampling; `weight` is the + # same value, passed to the C++ engine. Both must go through + # `.ScaleWeight()`: for the usual integer weights it's a no-op, but for + # fractional weights (e.g. `rep(0.5, nChar)`) truncating `original_weight` + # to an integer instead floors every value to zero, so bootstrap/jackknife + # resample from an all-zero vector without any error (#139). + scaledWeight <- .ScaleWeight(at[["weight"]]) structure( list( contrast = at[["contrast"]], tip_data = matrix(unlist(dataset, use.names = FALSE), nrow = length(dataset), byrow = TRUE), - weight = .ScaleWeight(at[["weight"]]), + weight = scaledWeight, levels = at[["levels"]], min_steps = minSteps, concavity = if (iw) as.double(concavity) else Inf, info_amounts = infoAmounts, - original_weight = as.integer(at[["weight"]]), + original_weight = scaledWeight, index = at[["index"]], tip.label = names(dataset), nTip = length(dataset) diff --git a/R/QuartetResolution.R b/R/QuartetResolution.R index 1962c6889..94337ffbd 100644 --- a/R/QuartetResolution.R +++ b/R/QuartetResolution.R @@ -5,9 +5,10 @@ #' reported, in a format accepted by \code{\link[TreeTools]{KeepTip}()}. #' #' @return A vector specifying an integer, for each tree, which of `tips[-1]` -#' is most closely related to `tips[1]`. -#' -#' @examples +#' is most closely related to `tips[1]`. A tree in which the four tips form +#' an unresolved (star) quartet contributes `NA` to this vector. +#' +#' @examples #' trees <- inapplicable.trees[["Vinther2008"]] #' tips <- c("Lingula", "Halkieria", "Wiwaxia", "Acaenoplax") #' QuartetResolution(trees, tips) @@ -15,10 +16,13 @@ #' @family utility functions #' @export QuartetResolution <- function(trees, tips) { - fours <- as.integer(vapply( - lapply(as.Splits(KeepTip(trees, tips), tips), PolarizeSplits), - as.raw, - raw(1) - )) + splits <- lapply(as.Splits(KeepTip(trees, tips), tips), PolarizeSplits) + fours <- unname(vapply(splits, function(x) { + if (length(x) == 0) { + NA_integer_ # Unresolved (star) quartet: no split to report + } else { + as.integer(as.raw(x)) + } + }, integer(1))) log2(fours - 1L) } diff --git a/R/Ratchet.R b/R/Ratchet.R index 78fc9e200..763878f05 100644 --- a/R/Ratchet.R +++ b/R/Ratchet.R @@ -121,7 +121,15 @@ Ratchet <- function(tree, dataset, if (verbosity > 1L) { message("*** Target score of ", stopAtScore, " met.") # nocov } - return(tree) + tree[["edge"]] <- cbind(edgeList[[1]], edgeList[[2]]) + attr(tree, "score") <- bestScore + return( + if (returnAll) { + structure(list(tree), class = "multiPhylo") + } else { + tree + } + ) } if (is.function(swappers)){ swappers <- list(swappers) @@ -167,10 +175,15 @@ Ratchet <- function(tree, dataset, if (!is.null(stopAtScore) && candScore < stopAtScore + epsilon) { BREAK <- TRUE if (verbosity > 1L) { # nocov start - message(" * Target score ", stopAtScore, + message(" * Target score ", stopAtScore, " met; terminating tree search.") } # nocov end + edgeList <- candidate bestScore <- candScore + if (returnAll) { + forest[[i]] <- candidate + forestScores[i] <- candScore + } break } } diff --git a/R/RcppExports.R b/R/RcppExports.R index 46704fd61..7e94f7957 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -197,8 +197,8 @@ ts_driven_search <- function(contrast, tip_data, weight, levels, searchControl, .Call(`_TreeSearch_ts_driven_search`, contrast, tip_data, weight, levels, searchControl, runtimeConfig, scoringConfig, constraintConfig, hsjConfig, xformConfig) } -ts_collapse_pool <- function(edges, contrast, tip_data, weight, levels, scoringConfig, hsjConfig = NULL, xformConfig = NULL, consSplitMatrix = NULL, consZero = NULL) { - .Call(`_TreeSearch_ts_collapse_pool`, edges, contrast, tip_data, weight, levels, scoringConfig, hsjConfig, xformConfig, consSplitMatrix, consZero) +ts_collapse_pool <- function(edges, contrast, tip_data, weight, levels, scoringConfig, hsjConfig = NULL, xformConfig = NULL, consSplitMatrix = NULL) { + .Call(`_TreeSearch_ts_collapse_pool`, edges, contrast, tip_data, weight, levels, scoringConfig, hsjConfig, xformConfig, consSplitMatrix) } ts_resample_search <- function(contrast, tip_data, weight, levels, bootstrap = FALSE, jackProportion = 2.0 / 3.0, maxReplicates = 5L, targetHits = 2L, tbrMaxHits = 1L, ratchetCycles = 3L, ratchetPerturbProb = 0.04, driftCycles = 0L, min_steps = integer(), concavity = -1.0, consSplitMatrix = NULL, consContrast = NULL, consTipData = NULL, consWeight = NULL, consLevels = NULL, consExpectedScore = 0L, infoAmounts = NULL, xpiwe = FALSE, xpiwe_r = 0.5, xpiwe_max_f = 5.0, obs_count = integer()) { @@ -245,3 +245,7 @@ ts_ev_cache_key_probe <- function(edge, contrast, tip_data, weight, levels, conc .Call(`_TreeSearch_ts_ev_cache_key_probe`, edge, contrast, tip_data, weight, levels, concavity, zero_active, set_upweight, bump_pattern_freq) } +ts_random_constrained_tree <- function(contrast, tip_data, weight, levels, consSplitMatrix = NULL) { + .Call(`_TreeSearch_ts_random_constrained_tree`, contrast, tip_data, weight, levels, consSplitMatrix) +} + diff --git a/R/SPR.R b/R/SPR.R index ef58b82fd..619c9bb7c 100644 --- a/R/SPR.R +++ b/R/SPR.R @@ -115,7 +115,7 @@ SPR <- function(tree, edgeToBreak = NULL, mergeEdge = NULL) { } #' @rdname SPR -#' @return `TBRMoves()` returns a list of all trees one SPR move away from +#' @return `SPRMoves()` returns a list of all trees one SPR move away from #' `tree`, with edges and nodes in preorder, rooted on the first-labelled tip. #' @export SPRMoves <- function (tree, edgeToBreak = integer(0)) UseMethod("SPRMoves") diff --git a/R/TaxonInfluence.R b/R/TaxonInfluence.R index c0e982e1c..5d6919ead 100644 --- a/R/TaxonInfluence.R +++ b/R/TaxonInfluence.R @@ -180,7 +180,27 @@ TaxonInfluence <- function( write.nexus(result, file = leafFile) } } - d <- matrix(Distance(tree, result), length(result)) + # `Distance()`'s matrix orientation is not a documented contract: TreeDist + # returns dim (length(result), length(tree)) when tip labels mismatch + # (the path this function always takes) but (length(tree), length(result)) + # when they match, so a user-supplied `Distance` could transpose silently. + # Normalize explicitly rather than assuming either orientation. (When + # length(result) == nTreeArg the two orientations are indistinguishable + # from shape alone; a transposed square result would pass through + # undetected, same as any shape-only check.) + # (`length()` of a single "phylo" counts its list components, not trees.) + nTreeArg <- if (inherits(tree, "phylo")) 1L else length(tree) + d <- as.matrix(Distance(tree, result)) + expectedDim <- c(length(result), nTreeArg) + if (!identical(dim(d), expectedDim)) { + if (identical(dim(d), rev(expectedDim))) { + d <- t(d) + } else { + stop("`Distance(tree, result)` returned a ", + paste(dim(d), collapse = " x "), " matrix; expected ", + paste(expectedDim, collapse = " x "), ".") + } + } dwMean <- if (calcWeighted) { resWeights <- if (length(result) > 1) { colSums(as.matrix(Distance(result))) diff --git a/R/WhenFirstHit.R b/R/WhenFirstHit.R index 5e0fbad36..a6bd6e616 100644 --- a/R/WhenFirstHit.R +++ b/R/WhenFirstHit.R @@ -28,7 +28,7 @@ WhenFirstHit <- function(trees) { if (is.null(attr(trees, "firstHit"))) { treeNames <- names(trees) - pattern <- "(seed|start|ratch\\d+|final)_\\d+" + pattern <- "^(seed|start|ratch\\d+|final)_\\d+$" if (length(grep(pattern, treeNames, perl = TRUE)) == length(trees)) { whenHit <- gsub(pattern, "\\1", treeNames, perl = TRUE) diff --git a/R/WideSample.R b/R/WideSample.R index 7f698faee..3e229a569 100644 --- a/R/WideSample.R +++ b/R/WideSample.R @@ -13,9 +13,9 @@ #' topologies that sit on broad plateaux and under-represents isolated optima. #' `WideSample()` instead selects for topological *spread*, density-blind, by #' dispatching to the appropriate Max-Min Diversity Problem solver from the -#' \pkg{MaxMin} package: +#' \pkg{Coreset} package: #' -# TODO replace {TreeSearch} refs with {MaxMin} once package on CRAN and +# TODO replace {TreeSearch} refs with {Coreset} once package on CRAN and # imported, and remove refs from inst/REFERENCES.bib (DRY) #' \describe{ #' \item{`FarFirst()` (`effort = 1`)}{Greedy farthest-first selection @@ -87,23 +87,25 @@ #' @return A `multiPhylo` object of length `min(n, length(trees))` containing #' a topologically diverse (Max-Min) subset of `trees`. #' If `n == 1`, the single most central tree (the medoid) is returned. -#' Attributes of the input (e.g. `score`, `hits_to_best`) are preserved. +#' Attributes of the input (e.g. `score`, `hits_to_best`) are preserved, +#' except `firstHit`, which describes the pre-subset set of trees and is +#' dropped; call [WhenFirstHit()] on the result to recompute it. #' #' @examples #' library("TreeTools") #' trees <- as.phylo(0:99, nTip = 8) #' -#' # WideSample() needs the MaxMin package (Max-Min diversity solvers) -#' if (requireNamespace("MaxMin", quietly = TRUE)) { +#' # WideSample() needs the Coreset package (Max-Min diversity solvers) +#' if (requireNamespace("Coreset", quietly = TRUE)) { #' #' # Fast FarFirst subsample (deterministic, matrix-free) #' sub10 <- WideSample(trees, 10, effort = 1) #' length(sub10) # 10 #' -#' # The remaining tiers (DropAdd, Grasp, exact) all dispatch to 'MaxMin'/ +#' # The remaining tiers (DropAdd, Grasp, exact) all dispatch to 'Coreset'/ #' # 'highs' solvers whose runtime is environment-dependent (e.g. a #' # from-source 'highs' build can be far slower than the CRAN binary) and -#' # whose calling convention tracks 'MaxMin' development. Demonstrate them +#' # whose calling convention tracks 'Coreset' development. Demonstrate them #' # interactively only. #' if (interactive()) { #' # Pre-computed distances @@ -146,17 +148,17 @@ WideSample <- function( effort = NULL, maxSeconds = 60 ) { - if (!requireNamespace("MaxMin", quietly = TRUE)) { - stop("`WideSample()` requires the 'MaxMin' package, which provides the ", + if (!requireNamespace("Coreset", quietly = TRUE)) { + stop("`WideSample()` requires the 'Coreset' package, which provides the ", "Max-Min diversity solvers; install it from ", - "https://github.com/ms609/MaxMin", call. = FALSE) + "https://github.com/ms609/Coreset", call. = FALSE) } # Build ceiling: largest N for which we materialize a dense N x N matrix from # a distance function. ~1.1 GB at 12,000; as.matrix.dist overflows near # 46,340 (the dist half-vector exceeds .Machine$integer.max). buildCeiling <- getOption("WideSample.buildCeiling", 12000L) # Exact ceiling: largest N at which auto-selection reaches the exact tier. - # MaxMin::ExactMaxMin() is now a sparse-matrix, heuristic-warm-started solver + # Coreset::ExactMaxMin() is now a sparse-matrix, heuristic-warm-started solver # (~20x faster than the dense form), practical to a few hundred trees at the # small `n` of interest; beyond that the node-packing IP wall bites (the # MaxMin optimum sits near the diameter, where the threshold graph is @@ -256,13 +258,13 @@ WideSample <- function( } else { .WideSampleColumnOracle(dist, trees, nTrees) } - MaxMin::FarFirst(n, colFn, N = nTrees) + Coreset::FarFirst(k = n, d = colFn, N = nTrees) }, # Tier 2: DropAdd returns the bare (sorted) index vector; it runs to its # deterministic plateau, with `maxSeconds` as a safety cap. - `2` = MaxMin::DropAdd(n, dmat, maxSeconds = maxSeconds), + `2` = Coreset::DropAdd(n, dmat, maxSeconds = maxSeconds), # Tier 3: Grasp likewise returns the bare index vector (RNG-dependent). - `3` = MaxMin::Grasp(n, dmat, maxSeconds = maxSeconds), + `3` = Coreset::Grasp(n, dmat, maxSeconds = maxSeconds), # Tier 4: exact solver returns the bare (ascending) index vector, like the # other tiers. `4` = { @@ -272,14 +274,14 @@ WideSample <- function( "or 3 (Grasp), or a larger `maxSeconds`.", immediate. = TRUE) } - MaxMin::ExactMaxMin(k = n, dmat, maxSeconds = maxSeconds) + Coreset::ExactMaxMin(k = n, dmat, maxSeconds = maxSeconds) } ) # FarFirst returns farthest-first (selection) order; sort to ascending tree # order so the subset preserves the input ordering. A no-op for tiers 2-4, # which already return ascending indices. - .SubsetMultiPhylo(trees, as.integer(idx)) + .SubsetMultiPhylo(trees, sort(as.integer(idx))) } #' Choose the `WideSample()` solver tier @@ -331,7 +333,7 @@ WideSample <- function( #' distance to all others. Uses the distance matrix when one is available or #' affordable to build; when only a distance function is supplied for a set too #' large to build a matrix, the central medoid is not affordable, so the -#' deterministic peripheral seed ([MaxMin::FarFirst()] with `k = 1`) is returned +#' deterministic peripheral seed ([Coreset::FarFirst()] with `k = 1`) is returned #' as a matrix-free fallback. #' @return Integer index (1-based) of the selected tree. #' @keywords internal @@ -347,7 +349,7 @@ WideSample <- function( } else { colFn <- .WideSampleColumnOracle(dist, trees, nTrees) # Return: - as.integer(MaxMin::FarFirst(colFn, k = 1L, N = nTrees)) + as.integer(Coreset::FarFirst(k = 1L, d = colFn, N = nTrees)) } } @@ -355,7 +357,7 @@ WideSample <- function( #' #' Returns a function of one 1-based index `i` giving the distances from tree #' `i` to every tree, as required by the distance-column oracle path of -#' [MaxMin::FarFirst()]. Probes +#' [Coreset::FarFirst()]. Probes #' the `(tree, trees)` calling form once up front and fails clearly if the #' supplied `dist` function does not support it. #' @keywords internal @@ -378,13 +380,20 @@ WideSample <- function( } #' Subset a multiPhylo preserving attributes +#' +#' Non-standard attributes describe the whole `multiPhylo` object (e.g. +#' `score`, `hits_to_best`, `replicate_scores`) and are copied over +#' unchanged, with one exception: `firstHit` is a per-*stage* tally computed +#' from the (pre-subset) set of tree names, so it no longer describes the +#' returned subset and is dropped rather than carried over stale. +#' [WhenFirstHit()] can recompute it from the subset's own names if needed. #' @keywords internal .SubsetMultiPhylo <- function(trees, idx) { saved <- attributes(trees) result <- trees[idx] - # Restore non-standard attributes (e.g. score, hits_to_best) standard <- c("names", "class") - for (nm in setdiff(names(saved), standard)) { + invalidated <- "firstHit" + for (nm in setdiff(names(saved), c(standard, invalidated))) { attr(result, nm) <- saved[[nm]] } # Return: diff --git a/R/data_manipulation.R b/R/data_manipulation.R index aeb20b1f9..20aff7344 100644 --- a/R/data_manipulation.R +++ b/R/data_manipulation.R @@ -1,11 +1,31 @@ # Feasibility thresholds for MaddisonSlatkin exact computation. # The split_count is the coefficient of x^floor(n/2) in the generating # polynomial prod_i (1 + x + ... + x^{a_i}), capturing partition shape. -# Calibrated from worst-case (balanced) partition timing experiments -# using bitmask encoding (states at positions 2^(i-1)): -# k=3: n=27 (9,9,9) sc=75 0.97s safe; n=31 (11,10,10) sc=96 1.32s marginal -# k=4: n=13 (4,3,3,3) sc=50 0.36s safe; n=15 (4,4,4,3) sc=70 0.94s marginal -# k=5: n=9 (2,2,2,2,1) sc=35 0.22s safe; n=10 (2,2,2,2,2) sc=51 0.49s +# Calibrated in work units, not seconds. The figures below are each +# character's peak demand on the solver's two memo tables, measured at the +# entry high-water mark on a normal build. They are properties of the +# character, so they mean the same thing on every machine and do not go stale +# as hardware turns over; `MaddisonSlatkin.cpp` reserves against the largest +# of them, so nothing this gate admits can overflow a table. +# Worst-case (balanced) partitions, bitmask encoding (states at 2^(i-1)): +# k=3: n=27 (9,9,9) sc=75 logB 990 logPVec 27951 <- threshold +# n=20 (8,7,5) sc=42 logB 422 logPVec 12047 +# k=4: n=13 (4,3,3,3) sc=50 logB 305 logPVec 9555 <- threshold +# k=5: n=9 (2,2,2,2,1) sc=35 logB 142 logPVec 4990 <- threshold +# +# This gate is not the latency control, and should not be tuned as one. It +# skips work hopeless enough not to be worth starting; what a caller actually +# waits is capped by `TIME_BUDGET_S` in MaddisonSlatkin.cpp, which stops the +# recursion mid-flight and falls back to Monte Carlo. Admitting a character +# here therefore costs at most that budget, not the figures below. +# +# Consequently these thresholds may be generous without hurting anyone, and +# raising one does not make the package less responsive. Timings, for scale +# only, on a 2021-vintage desktop: (9,9,9) ~12.7 s, (8,7,5) ~1.9 s -- i.e. most +# of the k=3 range is stopped by the clock, not finished. Earlier revisions of +# this comment quoted sub-second figures for the same characters and are +# superseded; they were ~13x optimistic, which is how a 2 s budget came to look +# like a backstop when it was in fact the operative limit. .MS_SC_THRESHOLD <- c(Inf, Inf, 75L, 50L, 35L) .MSSplitCount <- function(state_counts) { diff --git a/dev/benchmarks/tbr_oracle.R b/dev/benchmarks/tbr_oracle.R index 2b8ad4d1d..67ba91bb1 100644 --- a/dev/benchmarks/tbr_oracle.R +++ b/dev/benchmarks/tbr_oracle.R @@ -73,10 +73,12 @@ kernelTbrEmul <- function(tree, d, unrooted) { best } -# Full unrooted-TBR cleanliness check: all_tbr at TWO distinct rootings (tip1 & -# tip2) covers every break edge (each rooting only omits its own root-edge = -# that tip's pendant); plus all_spr for good measure. Returns the best -# improving neighbour length and tree, or NULL if clean. +# Full unrooted-TBR cleanliness check. The two rootings (tip1 & tip2) date +# from when all_tbr omitted its own root edge, so one rooting could not see that +# tip's pendant bisection; #147 fixed that, and a single rooting now covers +# every break edge. Kept as belt and braces -- it is cheap relative to scoring, +# and it also exercises all_spr. Returns the best improving neighbour length +# and tree, or NULL if clean. bestImproving <- function(tree, d) { base <- TreeLength(tree, d$phy) cand <- list() diff --git a/dev/benchmarks/tbr_unrooted_validate.R b/dev/benchmarks/tbr_unrooted_validate.R index abd062d84..bdc75f1fe 100644 --- a/dev/benchmarks/tbr_unrooted_validate.R +++ b/dev/benchmarks/tbr_unrooted_validate.R @@ -25,8 +25,9 @@ runKernel <- function(tree, seed, unrooted) { list(tree = tr, len = TreeLength(tr, d$phy), sec = as.double(t["elapsed"])) } -# Is `tree` canonical-unrooted-TBR clean? all_tbr at two rootings (covers all -# break edges). Expensive (~2x100k neighbours); call sparingly. +# Is `tree` canonical-unrooted-TBR clean? all_tbr at two rootings; since #147 +# one rooting already covers every break edge, so the second is redundant but +# harmless. Expensive (~2x100k neighbours); call sparingly. isClean <- function(tree) { base <- TreeLength(tree, d$phy) best <- base diff --git a/dev/red-team/focus-areas.md b/dev/red-team/focus-areas.md index 0bd48eef2..a5c1a5b0c 100644 --- a/dev/red-team/focus-areas.md +++ b/dev/red-team/focus-areas.md @@ -26,7 +26,7 @@ top of `log.md`; seams that a version bump has made re-eligible are queued in | # | Area | Files | start_tier | Key questions | |---|------|-------|-----------|---------------| | 1 | **Fitch scoring correctness** | `src/ts_fitch.h/.cpp`, `src/ts_fitch_na.h`, `src/ts_fitch_na_incr.h`, `src/ts_fitch_na_dirty.h`, `src/ts_simd.h` (added 2026-08-04 — the bit-parallel SIMD portability layer every Fitch combine call goes through; UNMEASURED, no inherited maturity) | **opus** | Does incremental / dirty-set scoring match full `score_tree()`? Bounded variants bail correctly? NA three-pass edge cases? Write a targeted test if you find a gap. | -| 2 | **Search topology invariants** | `src/ts_tbr.cpp`, `src/ts_drift.cpp`, `src/ts_search.cpp`, `src/ts_tree.cpp/.h`, `src/ts_pool.cpp/.h`, `src/ts_tabu.h` (added 2026-08-04 — the tabu-list hash buffer that directly implements this row's own "symmetry-breaking hash collisions" question; UNMEASURED) | **opus** | After every rejected move, is topology fully restored? Undo stack correct? No stale `postorder`? Constraint metadata re-synced on *all* reject paths (incl. tabu)? Symmetry-breaking hash collisions? `TreePool` (dedup key, capacity eviction) consistent with the topology invariants above? | +| 2 | **Search topology invariants** | `src/ts_tbr.cpp`, `src/ts_drift.cpp`, `src/ts_search.cpp`, `src/ts_tree.cpp/.h`, `src/ts_pool.cpp/.h`, `src/ts_tabu.h` (added 2026-08-04 — the tabu-list hash buffer that directly implements this row's own "symmetry-breaking hash collisions" question; UNMEASURED), `src/ts_temper.cpp/.h` (added 2026-08-06 — stochastic TBR with Boltzmann acceptance plus the annealing schedule, called from `ts_drift.cpp`, `ts_driven.cpp` and `ts_rcpp.cpp`; a probabilistically *rejected* move is precisely this row's restore question, and it was the last `src/` file owned by no row. UNMEASURED) | **opus** | After every rejected move, is topology fully restored? Undo stack correct? No stale `postorder`? Constraint metadata re-synced on *all* reject paths (incl. tabu)? Symmetry-breaking hash collisions? `TreePool` (dedup key, capacity eviction) consistent with the topology invariants above? | | 3 | **Ratchet & perturbation** | `src/ts_ratchet.cpp`, `src/ts_sector.cpp`, `src/ts_fuse.cpp`, `src/ts_prune_reinsert.cpp` | **opus** | `active_mask`/`upweight_mask`/`flat_blocks` fully restored after perturbation? Sectorial reinsertion reverts on worse score? `build_reduced_dataset` copies all needed fields? Fuse handles tied scores? | | 4 | **Parallelism & RNG** | `src/ts_parallel.cpp`, `src/ts_rng.h/.cpp`, `src/ts_driven.cpp`, `src/ts_resample.cpp`, `src/ts_heartbeat.cpp/.h`, `src/build_postorder.h`, `src/ts_strategy.h`, `R/Resample.R`, `R/Jackknife.R` (added 2026-08-04 — `ts_heartbeat`/`build_postorder.h` are exactly this row's bug class: main-thread-only R-API + `set.seed()`-reproducibility RNG state; `ts_strategy.h` is the bandit consumed by `ts_driven.cpp`; `R/Resample.R`/`R/Jackknife.R` are the R-level entries to the parallel resample path already named in T-336/T-337/T-398 but never an owned file. ALL UNMEASURED, no inherited maturity) | **opus** | Thread-local RNG set before any search call? **No R API (incl. `unif_rand`/`Get/PutRNGstate`) from worker threads** — note the resample path. Pool mutex correct? Atomic stop-flag races? Seeds drawn from R RNG before spawn? | | 5 | **Data pipeline & simplification** | `src/ts_data.h/.cpp`, `src/ts_simplify.h/.cpp`, `src/ts_ls.h/.cpp`, `R/tree_length.R`, `R/IWScore.R`, `R/LeastSquares.R`, `R/PrepareData.R`, `R/data.R`, `R/data_manipulation.R`, `R/fractional-weights.R`, `R/length_range.R` (added 2026-08-04 — the R-layer half of `TreeLength`/`MinimumLength`/`CharacterLength`/IW scoring flagged unowned by the 2026-07-03 area-12 round and by `escalation-backlog.md` item 5(a); `R/tree_length.R` is directly implicated by open issue #16/T-400, sev:high. ALL UNMEASURED, no inherited maturity) | **opus** | `build_dataset` handles edge cases (all-ambiguous, single-state, zero-weight, `n_states==32` UBSAN)? `build_reduced_dataset` copies all fields? XPIWE `obs==0` division? Least-squares distance fitting (`ts_ls.cpp`) — degenerate `dist` (NA/Inf) handled (cf. filed P1: `LeastSquaresFit`/`LeastSquaresTree` RSS=0 garbage)? | @@ -38,8 +38,8 @@ top of `log.md`; seams that a version bump has made re-eligible are queued in | 11 | **Zero-length-branch collapse (MPT set)** | `src/ts_collapsed.cpp/.h`, `src/ts_splits.cpp` (`compute_collapsed_splits`), `src/ts_rcpp.cpp` (`ts_collapse_flags_batch`), `src/ts_tbr.cpp` (enum `add_collapsed` sites), `R/MaximizeParsimony.R` (collapse block) | **opus** | DEFAULT-ON since 2026-06-24, so every `MaximizeParsimony` call exercises it. Does `compute_collapsed_flags_aggressive` flag the *correct* min-length-0 branches under **IW / profile / NA**, not just EW (verified)? Is it really rooting-invariant, or does tip-rooting+`RenumberTips(labs)` alignment break on constraint trees / user start trees / `RenumberTips` permutations (cf. [[na-validation-alignment-gotcha]])? Can the dedup key `write.tree(SortTree(unroot(t)))` over-merge (two distinct collapsed topologies → same key) or under-merge across rootings? `result$scores == best_score` float-equality safe under IW/profile? Degenerate inputs: star tree, single MPT, 3–4 tips, all-resolved (must be exact no-op), fully-unresolved? Does collapse ever produce a tree that violates an active `constraint`? | | 12 | **Red-team process meta-review** | `dev/red-team/focus-areas.md`, `dev/red-team/log.md`, the `red-team` issue list in `agent-issues/TreeSearch`, `dev/red-team/README.md` | **sonnet** | Are any areas too broad — spanning multiple distinct seams such that a finder concentrating on one file family misses another? Are any too narrow — a single-feature scope that would be better merged into a neighbour? Do any areas overlap (same source files audited under two different area headings)? Has any area gone persistently dry (≥ 3 consecutive rounds with zero confirmed findings) — should it be retired, merged, or downtiered? Are there new code seams (recently merged features, new source files) not covered by any existing area? Are tier assignments calibrated to actual yield recorded in `log.md` — any area that keeps surprising at its current tier and should escalate, or one that has been consistently empty and should drop? Propose concrete restructuring actions (split, merge, retire, add, re-tier) with rationale tied to `log.md` yield history. | | 13 | **Constrained search correctness** | `src/ts_constraint.h/.cpp`, `src/ts_nni_perturb.cpp`, constraint integration points in `src/ts_driven.cpp` (fuse), `src/ts_parallel.cpp` (parallel-fuse), `src/ts_wagner.cpp`/`src/ts_sector.cpp` (posthoc retry), `src/ts_tbr.cpp` (`regraft_violates_constraint`) | **opus** | Does every `impose_constraint()` caller verify-before-capture, not just trust an improved score (T-213 gap, fixed d9a4f827: `nni_perturb_search` was the one caller that didn't re-check `constraint_node[]` after repair — fuse/parallel-fuse already did)? Any other heuristic-repair or posthoc-retry caller (Wagner build retry, sector) that skips discard-on-failure? Is `impose_one_pass`'s `best_node` reference stale after its own move-out loop's `topology_spr()` calls relocate a node — traced mechanism, produced one `std::bad_alloc` crash under experimental code, did NOT reproduce in 600 stress-test seeds against shipped code; needs a targeted adversarial tree construction, not more random seeds, to confirm either way. Is `map_constraint_nodes`/DFS-timestamp resync correct on every topology-mutation path, including reject paths (cross-check vs area 2's tabu-reject question)? Are nested/overlapping constraint splits handled consistently across TBR clip-gating, Wagner retry, and sector/fuse posthoc paths? | -| 14 | **Statistics & support metrics** | `src/MaddisonSlatkin.cpp`, `src/expected_mi.cpp`, `src/ts_mc_fitch.cpp`, `src/quartet_concordance.cpp`, `R/Concordance.R`, `R/ParsSim.R`, `R/pp_info_extra_step.r`, `R/WideSample.R`, `R/Consistency.R`, `R/TaxonInfluence.R`, `R/ScoreSpectrum.R`, `R/RandomTreeScore.R`, `R/WhenFirstHit.R`, `R/QuartetResolution.R` | **sonnet** | Is the recursive Maddison–Slatkin DP correct at its recursion boundaries, and does its cache key everything the recurrence depends on? Does the factorial-cache log-space arithmetic under/overflow at realistic tip counts, and are log-space sums accumulated stably? When does the exact DP hand off to the Monte Carlo fallback, and is the fallback's estimator unbiased — or silently substituted without the caller being able to tell? Are concordance-factor statistics well-defined on polytomies, on single-taxon splits, and on characters with missing data? Do the R wrappers validate tip-label correspondence, or index by position (cf. the [[na-validation-alignment-gotcha]] class)? | -| 15 | **Legacy pure-R search API** | `R/CustomSearch.R` (`TreeSearch()`), `R/Ratchet.R`, `R/NNI.R`, `R/SPR.R`, `R/TBR.R`, `R/SuccessiveApproximations.R`, `R/tree_rearrangement.R`, `R/morphy-deprecated.R`, `R/Bootstrap.R` | **sonnet** | Is `EdgeListScore()` — the default `TreeScorer` for `TreeSearch()`/`Ratchet()`/`Jackknife()`, and one of the four entry points #16 confirms vulnerable — reachable with the out-of-bounds inputs #16 describes? Do the pure-R rearrangement samplers (`NNI`/`SPR`/`TBR`) generate only valid topologies, and do they cover the neighbourhood they claim? Does `SuccessiveApproximations` reweight consistently with the C++ IW kernel, or has it drifted? Do `Bootstrap`/`Jackknife` resample characters with the weights the user supplied? Does anything here still route through removed MorphyLib paths (`morphy-deprecated.R`)? | +| 14 | **Statistics & support metrics** | `src/MaddisonSlatkin.cpp`, `src/expected_mi.cpp`, `src/ts_mc_fitch.cpp`, `src/quartet_concordance.cpp`, `R/Concordance.R`, `R/ParsSim.R`, `R/pp_info_extra_step.r`, `R/WideSample.R`, `R/Consistency.R`, `R/TaxonInfluence.R`, `R/ScoreSpectrum.R`, `R/RandomTreeScore.R`, `R/WhenFirstHit.R`, `R/QuartetResolution.R`, `R/PresentContra.R`, `R/ClusterStrings.R` (last two added 2026-08-05 — owned by no other row, and both reviewed by the first-ever round) | **sonnet** | Is the recursive Maddison–Slatkin DP correct at its recursion boundaries, and does its cache key everything the recurrence depends on? Does the factorial-cache log-space arithmetic under/overflow at realistic tip counts, and are log-space sums accumulated stably? When does the exact DP hand off to the Monte Carlo fallback, and is the fallback's estimator unbiased — or silently substituted without the caller being able to tell? Are concordance-factor statistics well-defined on polytomies, on single-taxon splits, and on characters with missing data? Do the R wrappers validate tip-label correspondence, or index by position (cf. the [[na-validation-alignment-gotcha]] class)? Is any of this reachable from `MaximizeParsimony()`'s default output path the way #16/T-400 was — and does it return a silently wrong number rather than erroring? (carried from the 2026-08-05 round, where this question produced three of the four `sev:high` findings) | +| 15 | **Legacy pure-R search API** | `R/CustomSearch.R` (`TreeSearch()`), `R/Ratchet.R`, `R/NNI.R`, `R/SPR.R`, `R/TBR.R`, `R/SuccessiveApproximations.R`, `R/tree_rearrangement.R`, `R/morphy-deprecated.R`, `R/Bootstrap.R`, `src/rearrange.cpp` (added 2026-08-06 — the C++ enumerators (`nni`, `spr_moves`, `spr`, `all_spr`, `all_tbr`) that this row's own R functions call; owned by no row, and #147 was found only because an area-15 finder used `TBRMoves()` as a cross-check. UNMEASURED) | **sonnet** | Is `EdgeListScore()` — the default `TreeScorer` for `TreeSearch()`/`Ratchet()`/`Jackknife()`, and one of the four entry points #16 confirms vulnerable — reachable with the out-of-bounds inputs #16 describes? Do the pure-R rearrangement samplers (`NNI`/`SPR`/`TBR`) generate only valid topologies, and do they cover the neighbourhood they claim? Does `SuccessiveApproximations` reweight consistently with the C++ IW kernel, or has it drifted? Do `Bootstrap`/`Jackknife` resample characters with the weights the user supplied? Does anything here still route through removed MorphyLib paths (`morphy-deprecated.R`)? | ### Maturity / tier rationale (one line each) @@ -142,7 +142,7 @@ top of `log.md`; seams that a version bump has made re-eligible are queued in reading the backlog row that holds the actual ask (item 7 explains this at length). Whoever takes area 13 next must decide explicitly: harness first, or #18/#19 first — both are live, and the harness plan predates the two findings. -- **14 Statistics & support metrics — sonnet, UNMEASURED / no inherited maturity.** Added +- **14 Statistics & support metrics — MEASURED 2026-08-05, still yielding heavily.** Added 2026-08-05 from #42's scope-coverage diff: 5,553 lines across 14 files that were owned by no area and therefore never reviewed at any tier. **The gap has already cost a finding** — the arm64 `probe_slot()` hang in `src/MaddisonSlatkin.cpp` (fixed, PR #272, @@ -151,8 +151,18 @@ top of `log.md`; seams that a version bump has made re-eligible are queued in fallbacks — the profile the tier doctrine normally reserves for `opus`, and #42 recommended `opus` on that basis. **Deliberately starting at `sonnet` anyway** (maintainer decision, 2026-08-05): density is a prediction about where bugs *hide*, not evidence that cheap sweeps - are exhausted, and this area has no measured yield at all. Let a Sonnet pass measure it; the - escalation rules will lift the tier the moment a round comes back dry. Its own test convention + are exhausted, and this area has no measured yield at all. **Overtaken by events:** the + first-ever review had already run at `opus` on 2026-08-05, before this row merged, and returned + **36 findings, 4 sev:high — the highest yield on record for this rotation** (see `log.md`). + `start_tier` is left at `sonnet` as decided, but it is now inert: the seam is measured and + yielding, so the routing rules keep the next visit at **opus** with a fresh agent. + **Next visit starts here** (the round's own leads, and the reason it stays opus): the + **array-dimension-drop pattern** — four independent instances in one round (`ConcordanceTable`, + `ClusteringConcordance`, `Consistency`, `ClusterStrings`, all missing `drop = FALSE`), so treat + it as a class and sweep for it rather than re-finding instances; and the **not-yet-examined + `R/PresentContra.R` forest/reference-tip-mismatch angle** — read but never exercised against a + forest whose trees have tips absent from the reference (it calls `KeepTip` first, which *should* + be safe, but that is unproven). Its own test convention (`test-MaddisonSlatkin.R`, `test-Concordance.R`, `test-ParsSim.R`, `test-Consistency.R`, `test-ScoreSpectrum.R`, `test-QuartetResolution.R`, `test-TaxonInfluence.R`, `test-WideSample.R`, `test-pp-*.R`) is a useful first read. @@ -167,3 +177,11 @@ top of `log.md`; seams that a version bump has made re-eligible are queued in seam stops yielding.** Legacy is not the same as clean, and this code is still shipped and still the documented entry point for users who have not moved to the C++ engine. Treat "it isn't growing" as a reason the seam should *exhaust* quickly, not as a reason to stop early. + **`src/rearrange.cpp` added 2026-08-06** while closing #147: `all_tbr()` had never broken the + root edge, so `TBRMoves()` returned a strict subset of `SPRMoves()` for six years. The bug is + instructive twice over. It was an **off-by-one propagated by copy**: `all_spr()` was created + in 2020 as a copy of `all_tbr()`, inherited its `break_seq` starting at edge 3, and had that + corrected in PR #65 (2021) — the parent never was. And two `dev/benchmarks/` scripts had + already *characterised* the omission and routed around it by enumerating at two rootings, + without anyone filing it. **A documented workaround for a package deficiency is a finding + that was never written down** — grep `dev/` for such comments when auditing a new file. diff --git a/dev/red-team/log.md b/dev/red-team/log.md index c4895f8ce..6d8901573 100644 --- a/dev/red-team/log.md +++ b/dev/red-team/log.md @@ -60,6 +60,88 @@ persistently-dry reputation leans on pre-tier rounds (areas 3 and 10 both do) ha --- +area: 14 (Statistics & support-metrics cluster) — first-ever review, area enacted this round +reviewed_by: opus finder a01961467a9937203 + opus verifier a13226f4cad264aea (7 high-sev/memory-safety candidates) + haiku verifier a02207b4e4057b65e (30 low/med batch) + orchestrator direct code-read (A14-11, A14-12 — omitted by the haiku batch's return) +date: 2026-08-05 +tier: opus (Opus 5) +yield: **36 filed (#85-#120): sev:high 4 (A14-01,13,19,20), sev:med 12 (A14-02,03,07,14,15,22,24,25,26,28,33,35), sev:low 20 (A14-04,05,06,08,09,10,11,12,16,17,18,23,27,29,30,31,32,34,36,37)** + 4 doc/dead-code fixes applied inline (1 typo, 3 unused-variable removals); 1 refuted (A14-21) from 37 candidates +notes: Dispatched directly at the user's explicit request (`/red-team area 14`), which named an area that did not yet exist as a scope row — `area:14`/`area:15` labels had been pre-created by the 2026-08-04 area-12 round's restructuring proposal, but the row itself was left unenacted. **Enacted this round**, before dispatching: added area 14 (statistics & support-metrics cluster, `src/MaddisonSlatkin.cpp`+`expected_mi.cpp`+`quartet_concordance.cpp`, `R/Concordance.R`+`Consistency.R`+`PresentContra.R`+`TaxonInfluence.R`+`ScoreSpectrum.R`+`QuartetResolution.R`+`WhenFirstHit.R`+`RandomTreeScore.R`+`ClusterStrings.R`+`WideSample.R`+`ParsSim.R`+`Bootstrap.R`) to `focus-areas.md` at `start_tier: opus` per the area-12 proposal's rationale (the one file anyone had looked at, `MaddisonSlatkin.cpp`, already carried a real platform-specific crash — PR #272 — while unowned). `N` in the rotation-formula note updated 13→14. Area 15 (legacy pure-R search API) deliberately left un-enacted — out of scope for this explicit area-14 request. **[Superseded at merge: PR #57 landed first and enacted BOTH rows independently, so the scope row, `start_tier: sonnet` (a deliberate maintainer decision) and `N = 15` are #57's, not this round's. `R/PresentContra.R`/`R/ClusterStrings.R` were merged into #57's row; `R/Bootstrap.R` sits in area 15, so A14-36 was filed across the boundary. The round itself ran at `opus` and the yield stands.]** + +**HIGHEST YIELD ON RECORD FOR THIS ROTATION — 36 confirmed findings from a single first-ever pass, more than double the previous record (area 10's 8-in-a-round).** The area-12 proposal's own justification (an "unowned but already bitten" cluster) proved conservative, not alarmist. Four **sev:high** findings, one of which (A14-01: `MaddisonSlatkin(steps < 0)` writes through a null `data()` pointer) reproduces a **segfault** with a one-line user-facing repro and zero input validation on the exported entry point. The other three high-severity findings are all silent-wrong-number bugs in commonly-reachable R-layer code: A14-13 (`ClusteringConcordance()` recycles a shorter split-index vector against a longer character-index vector whenever the tree carries tips absent from the dataset — silently wrong, not just wrong-with-a-warning, whenever `length(keep)` divides `NTip(tree)`), and a matched pair in `Consistency.R`'s support-statistic machinery — A14-19 (`.CharLengthCache`'s key omits the tree, so scoring two different trees against the same dataset in one session silently returns the *wrong tree's* cached median) and A14-20 (`.SortTokens()` rewrites a partial-ambiguity character as full ambiguity whenever the dataset's contrast has more than one ambiguous level) — both of which corrupt `rhi`, a headline published statistic (Steell 2025), with a plausible-looking wrong number rather than an error. + +**One high-severity candidate REFUTED, and the refutation is itself informative: the finder's library was stale.** A14-21 claimed `CharacterLength()`'s non-binary-tree guard (`.CheckTreeCharLen()`) was missing, unlike `TreeLength()`'s, and that the resulting memory-unsound C++ read produced non-deterministic output (0,0,0 in 1 of 6 fresh-process runs, 1,1,1 in the other 5) on a `CollapseNode()`-polytomy input — the same class as issue #16/T-400. The opus verifier traced the guard to `R/tree_length.R:454-457` and found it **already present**, added in `7c8c3ab06` ("fix: reject non-binary trees at the TreeState boundary") — an ancestor of current HEAD — and reproduced the claimed repro erroring cleanly in 6/6 fresh processes via all three of `CharacterLength()`, `Consistency()` and `TreeLength()`. The finder almost certainly built against a pre-`7c8c3ab06` install. **Do not re-file this claim without first confirming which commit introduced the guard predates the build under test** — this is exactly the failure mode [[redteam-verify-against-current-tip]] exists to catch, now observed inside a single round rather than across rounds. + +**Verification gap, self-corrected: the haiku batch silently dropped 2 of 30 candidates.** The haiku verifier's returned table had only 28 rows against 30 candidates sent (missing A14-11, A14-12) with no note explaining the omission. The orchestrator read both cited code sites directly rather than re-dispatching a third verifier pass: A14-11 (`quartet_concordance.cpp`'s `n0[state]`/`n1[state]` indexing has no lower-bound guard against a negative `state` — confirmed unguarded, safe today only by the R caller's contract) and A14-12 (a `{0,-}`-style contrast level is misclassified `isGrouping` by `Concordance.R`'s ambiguity check because the check's `rowSums` excludes the `\"-\"` column — confirmed by hand-tracing a constructed `{0,-}` contrast row through `isAmbig`/`groupingCols`) — both REAL. **Process note for future rounds: count the verifier's returned rows against the candidate count sent; a silent drop is not the same as a REFUTED verdict and needs the same anti-duplication care as any other gap.** + +**Structural pattern across the round, useful for scoping the next visit: the cluster is systematically weak on R's array-dimension-drop behaviour.** `ConcordanceTable()` (A14-14), `ClusteringConcordance(return=)` (A14-15) and `Consistency()` (A14-22) all error identically whenever an array axis (splits, patterns, or characters) has length exactly 1 and a subsetting operation is missing `drop = FALSE`. `ClusterStrings()` (A14-25) has the same shape on a singleton cluster. Four independent instances of one missing idiom — a future pass targeting exactly this pattern across the rest of the R codebase (not just this area) would likely be efficient. + +**High-severity signal for escalation, NOT resolved by A14-21's refutation.** The finder's underlying suspicion — that the C++ char-steps kernel (`ts_char_steps`, area unclear — outside every current scope row's explicit file list, adjacent to area 1's `ts_fitch*` and area 5's `R/tree_length.R`) may be memory-unsound on multifurcating trees — is now moot for the *specific* reachability path claimed (the R-layer guard blocks it), but the finder's claim of process-to-process non-determinism on a *guard-bypassing* direct C++ call was never independently tested by either verifier, since the guard made the R-level repro impossible to run in the first place. **Not filed, not ruled out** — a future round with an actual C++-level (not R-level) test harness could still check whether `ts_char_steps` itself is sound when fed a raw non-binary edge matrix, independent of whether any R entry point can currently reach it. Low priority: the R-layer guard covers every known call site. + +**Fixed inline, verified before committing:** `src/MaddisonSlatkin.cpp:1587` typo in a dead-code boolean expression (`!(p > NEG_INF) || !(p > NEG_INF)` → `!(b > NEG_INF) || ...`, inside the unreachable `Solver` class — see A14-04); `R/Concordance.R` dead `p <- num / den` and dead `discarded = 0` removed; `R/Consistency.R` unused `tipLabel` removed; `R/ClusterStrings.R` unused `nMethodsChecked`/`methInc`/`nK`/`kInc` removed. All four are inside dead/unreachable code paths or clearly-inert local bindings — no behaviour change, no test run required. + +**Ruled out this round, do not re-hunt:** the `MaddisonSlatkin` DP recursion itself (brute-forced against exhaustive tree enumeration across 4 ambiguous-token configurations, exact match to the last tree — the bugs are all in the plumbing around it, never the DP); `ExpectedLength`'s de-duplication of random relabellings (looks like a bias, isn't — uniform sampling over a distinct set is still unbiased for the population median); `weighted.mean()`'s zero-weight guard in `QuartetConcordance`; `TreeDist::ClusteringInfoDistance`'s tip-pruning behaviour (confirms `TaxonInfluence()`'s reference-vs-reduced comparison is methodologically sound, downgrading the finder's initial A14-32 suspicion to a narrower latent-fragility finding); `quartet_concordance.cpp`'s concordant/decisive combinatorics (algebraically correct); `.pars_sim_init_char`'s claimed achievable score bound (genuinely achieved). + +**Not yet examined, flagged as the obvious next seam:** `R/PresentContra.R` was read but not exercised against a forest whose trees have tips absent from the reference (calls `KeepTip` first, should be safe, not proven). Area 15 (legacy pure-R search API, `R/CustomSearch.R` etc.) remains proposed-not-enacted — its `area:15` label exists but no scope row; still urgent per the area-12 round's original note (#16/T-400's `EdgeListScore()` exposure). + +Seam status: **still yielding, heavily** (36 filed from 37 candidates, only 1 refuted and that refutation was a stale-library artifact, not a genuine clean result) → next area-14 visit should stay **opus** with a fresh agent, starting from the array-dimension-drop pattern and the not-yet-examined `PresentContra.R` forest-mismatch angle. + +--- + +area: 1 (Fitch scoring correctness) — version-bump revisit +reviewed_by: opus finder a681ba267668c44d8 + haiku verifier a269ed170472c58bf (RT1-A1-01..08 batch) + sonnet verifier a1355d889b272f745 (RT1-A1-08 re-verify, overturning a flawed haiku refutation) +date: 2026-08-05 +tier: opus (Opus 5) +yield: 8 filed (#76-#83: sev:med #77 (A1-02), #83 (A1-08, upgraded from finder's `low`); sev:low #76,#78,#79,#80,#81,#82) + 1 doc fix + 1 new regression test (65 assertions) applied inline; 0 refuted +notes: Rotation `(13 mod 13)+1 = 1`. Legend reconciled at round start: no rung has moved since 2026-07-27, so the routing was purely the standing version-bump-revisit record for this area (dry at opus-4.8, 2026-07-24; re-targeted to opus-5 with a fresh angle, NOT fable — version bump precedes rung bump). Brief explicitly chartered the ONE residual the 2026-07-24 round's relative `TS_L3B_ORACLE`-style checks structurally cannot see: a bug shared by BOTH the incremental and full-recompute paths, invisible to any check that only compares the two against each other. Pasted the prior round's full derivation as claims to break, per the version-bump-revisit protocol. + +**THE CHARTERED QUESTION WAS ANSWERED, AND THE ANSWER IS NEGATIVE — recorded as a genuine result, not an absence of one.** The finder built two independent reference implementations sharing no code with `src/ts_fitch*` — a from-scratch Sankoff DP for EW, and a from-scratch brute-force applicability-enumeration + region DP for BGS inapplicable scoring — and cross-checked the *absolute* output of the real `score_tree()` against them across ~3000 datasets (multi-state, ambiguous, `{-,X}`/`{-}`/`?`-dense inapplicable, degenerate, deep-pectinate and shallow-balanced). 0 mismatches wherever the criterion is tie-break-free; the one-sided never-below-minimum bound held 1000/1000 including 500 `{-,X}`-dense cases; rooting-invariance held on every edge across 150+1500+576 test configurations; block-boundary additivity held across nChar ∈ {1,5,63,64,65,70,130}; IW/profile C++-vs-R agreement held 0/900. **The shared-machinery correctness question for area 1 is now closed at this tier** — a future revisit needs either a genuinely new angle (the finder's suggestion: cross-check `vroot_cache`/`below_actives_cache` candidate-scoring values against an independent rescore of the applied move, rather than the reconstruction layer already covered here) or an escalation to fable if a *new* delta lands that this round's coverage doesn't reach. + +**Incidental product of the chartered work: the BGS criterion this engine implements is now pinned down in writing for the first time in this repo.** `min` over applicability reconstructions that are Fitch-optimal for the binary applicability character, of `sum(within-region Fitch length) + (tip-bearing regions - 1)`, applicable-preferred tie-break on `{-,X}` tips. Two consequences that will look like bugs to a future reviewer and are not, now both encoded as assertions in the new `tests/testthat/test-ts-na-oracle.R`: (1) the engine can exceed the unconstrained minimum-cost reconstruction (17/500 definite-applicability cases, 30/500 with `{-,X}`) because Fitch minimises applicability *changes*, not *regions* — exactly what Goloboff et al. 2021 critique and what `inapplicable = "xform"` exists to address; (2) two applicable tips with the same state separated by inapplicable tips score 1, not 0. + +**Eight findings filed, none touching the shared-scoring correctness question itself — all either perf, latent-unreachable, or a documentation/invariant gap.** RT-A1-02 (#77, med): the EW dirty-buffer allocation was `static thread_local`-optimised, then reverted by the emutls/MinGW fix (`d6fa51293`) for correctness, and the cost was never recovered on the NA hot path (`exact_verify_sweep`, ~97.7% of native-NA wall per this project's Mission-B profiling) — same class exists in 4 sites across `ts_fitch.cpp`/`ts_fitch_na_dirty.h`/`ts_fitch_na_incr.h`. RT-A1-08 (#83, upgraded to med): `TreeLength()` defaults to extended IW (XPIWE) but `PrepareData()`/`EdgeListScore()` — the documented default `TreeScorer` for `TreeSearch()`/`Ratchet()`/`Jackknife()` — always scores plain IW with no way to opt into XPIWE, so the two nominally-identical "score this tree at concavity k" paths silently disagree by default (600/600 measured mismatches, resolved by explicit `extended_iw=FALSE`). RT-A1-01 (#76, low): a detached-tip OOB guard present in `fitch_na_score` (added after a real ASAN abort) is missing from both incremental NA sibling loops — latent, currently unreachable. RT-A1-03/04/05/06/07 (#78-#82, low): residual per-call allocations in two "allocation-free"-labelled functions; a negative-delta path in `precompute_profile_delta` whose bounded-scorer-bail soundness rests on an unstated, unasserted invariant; an unproven (7500+ fuzz cases, 0 counterexamples, no proof) equivalence between two different `ss_app` derivations for EW vs IW/profile NA scoring; a diagnostic-only export whose own internal sum doesn't reconcile because it omits `precomputed_steps`; and two harmless dead/unreachable code fragments. + +**ONE HAIKU REFUTATION OVERTURNED ON RE-VERIFICATION — record the pattern, not just the outcome.** RT-A1-08 was initially routed to the haiku batch (all 8 candidates were low/med severity, per this skill's severity-matched-verification rule — no `sev:high` this round to trigger automatic peer-tier routing). The haiku verifier refuted it by arguing `extended_iw` is a legitimate, documented feature — true, and not the claim. The actual claim was a **default mismatch** between two commonly-used paths for the same nominal computation. Per [[redteam-reverify-flawed-refutes]] and this project's standing note to route library-fact verdicts above haiku, re-verified with a sonnet pass, which traced the full default chain (`R/tree_length.R` → `R/PrepareData.R` → `src/ts_rcpp.cpp`'s `xpiwe=false` C++ default) and confirmed REAL, overturning the refutation. **Generalisable point for this severity-routing rule: "not sev:high" does not mean "safe to haiku" when the claim is a library/default-semantics fact rather than a straightforward code-pattern check** — this round's median finding (allocation exists, guard missing) was well within haiku's competence, but the one finding requiring cross-file default-chain reasoning was not, independent of its filed severity. + +**Fixed inline, verified before committing.** Corrected a stale comment in `fitch_incremental_uppass` (`src/ts_fitch.cpp:244-251`) that still described the `static thread_local` optimisation as current; it was reverted by `d6fa51293` and the comment was never updated (this round's finder caught it while investigating RT-A1-02). Added `tests/testthat/test-ts-na-oracle.R` (new, 65 assertions, 2.3s), the independent-reference NA oracle the chartered work produced as a byproduct — built via the tarball recipe into `.agent-rt1`, ran with `NOT_CRAN=true`, confirmed 65/65 pass before committing; build artifacts (`.agent-rt1/`, `src/*.o`, `src/*.dll`) cleaned up after. + +Seam status: **shared-correctness question closed at this tier; perf/hygiene seam still yielding** (8 filed, 0 refuted) → a future area-1 visit should target the candidate-scoring layer (`vroot_cache`/`below_actives_cache` vs an independent rescore of the applied move) per the finder's own suggested next angle, not another reconstruction-layer sweep. + +--- + +area: 13 (Constrained search correctness) — opus finder sweep, directed round +reviewed_by: opus finder ac6ece01b95dec79c + opus verifier ad74e7246bc17d134 (A13-01/A13-02) + haiku verifier a67f772b67755c4a0 (A13-03..A13-12 batch) +date: 2026-08-05 +tier: opus (Opus 5) +yield: 12 filed (#61-#72: A13-01/A13-02 sev:high, A13-03/A13-04/A13-05 sev:med, A13-06..A13-12 sev:low) + 2 doc fixes applied inline; 0 refuted — all 12 candidates confirmed REAL +notes: Dispatched directly at the user's request ("sounds like we're ready for a proper area 13 sweep now"), immediately after the same-day directed harness re-run (see the entry below) closed out area 13's standing "not a finder" blocker. + +**Two high-severity findings, both independently reproduced end-to-end.** A13-01 (#61): `.PrepareConstraint`'s joint-satisfiability gate (`R/MaximizeParsimony.R:156-181`, T-329's fix) is pairwise four-gamete only, which does not imply joint displayability for **partial** splits (taxa excluded from both groups) — unlike for complete splits, where pairwise ⇒ joint holds by Buneman. Verifier independently enumerated all 105 six-taxon trees and confirmed a 3-split counterexample (`{a,b}|{c,d}`, `{a,b}|{c,e}`, `{a,d}|{b,e}`) that is pairwise-compatible on every pair but displayed by **0** trees; an end-to-end run then accepted the constraint with no error/warning and returned trees that violate it (score 67 vs unconstrained 65). Aggravating factor found during verification: only `consSplitMatrix` crosses to C++, never `consZero`, so C++ actually enforces a *different, stricter* proposition than what the R gate validated — in the repro this makes the C++-level splits mutually incompatible, which is why the search freezes on top of the original silent-violation risk. A13-02 (#62): `map_constraint_nodes` (`ts_constraint.cpp:207`,`:217`) iterates `tree.postorder`, confirmed internal-nodes-only (`ts_collapsed.h:23`), so a single-tip 1-group constraint split can never map unless that tip happens to be a root child — `constraint_node[s]` stays -1 forever, freezing every phase touching that split. `.PrepareConstraint` doesn't filter size-1 rows. Verifier's control repro (25 taxa) isolated a clean 12-step cost for an otherwise-free vacuous single-tip constraint, and corrected the finder's "totally frozen" framing to "measurably degraded, not fully frozen" (1068 < 1090 Wagner baseline) — kept the finding, tightened the claim. + +**Ten more filed at med/low, all confirmed by the haiku batch verifier against current HEAD line numbers.** A13-03 (#63, med): loose (`violates_constraint_posthoc`+`has_posthoc`) vs strict (`constraint_node[s]<0`+`active`) gates diverge across phases, full call-site inventory across Wagner/sector/TBR/drift/spr_search/prune-reinsert/nni_perturb/fuse/parallel-fuse — including a genuine serial-vs-parallel-fuse mismatch (parallel-fuse trigger is loose, its own verify half is strict). A13-04 (#64, med): `consensusConstrain` auto-constraints (`has_posthoc=false` by construction) are invisible to the sector phase's gate but the sector phase's post-accept resync fires regardless, freezing the rest of the replicate — opt-in only (`consensus_constrain` defaults false), distinct from the already-ruled-down T-13-B. A13-05 (#65, med): `tree_fuse` has no `ConstraintData` parameter at all — constraint-blind internally, makes fuse near-inert under a constraint (relies entirely on caller-side repair/discard). A13-06 (#66, low): `anneal_search` has no post-move constraint verification, unlike every sibling phase — mitigated because the pre-move screen is argued sound for its SPR-only move set and `annealCycles` defaults `0L`, so filed as defence-in-depth not a proven hole. A13-07 (#67, low): `impose_one_pass` computes `move_out_roots`/`move_in_roots` once per pass but consumes them stale across re-anchored moves within that pass — silently ineffective repair, not corruption (T-333 still catches actual invalidity). A13-08 (#68, low): `topology_spr`'s root-child no-op bail is still counted as a successful move by `try_move`, defeating `impose_constraint`'s `moves==0` convergence check. A13-09 (#69, low): drift's RFD re-apply failure path is the one exit skipping the constraint resync every sibling exit performs — assessed practically unreachable, filed for consistency. A13-10 (#70, low): `spr_search` leaves `cd` stale on return, safe today only because every downstream caller happens to re-init. A13-11 (#71, low): `extract_consensus_splits` dedups by 64-bit hash alone with no bitset comparison — theoretical collision risk feeding the same freeze mechanism as A13-04. A13-12 (#72, low): `expand_and_reinsert` takes a `ConstraintData* cd` parameter it never reads — dead/misleading, and a natural spot to close part of A13-03's gate inconsistency if enforcement is ever added here. + +**Q3 (false-negative direction of `regraft_violates_constraint`) answered as a resolved negative — do not re-hunt.** Traced every `ClipZone`×`constraint_complement` combination including the `below==cn` boundary exception and the `cn==parent(clip)` splice-out case. The `straddle→UNCONSTRAINED` branch is sound for SPR (the clip's internal induced bipartitions are invariant under relocation) and is *only* unsound for TBR (rerooting moves the attachment leaf, changing which clip-internal edges induce which whole-tree bipartition) — which is exactly why the TBR (`ts_tbr.cpp:2867`) and drift (`ts_drift.cpp:741`) backstops exist, and both are correctly placed with correct resync on every reject path. The residual exposure from this line of attack is A13-06 (anneal_search's missing backstop), not a hole in the predicate itself. One over-rejection case noted but not filed separately (when the clip subtree *is* `cn`, every regraft is rejected even though it's harmless) — that's issue #54's territory, not a new bug. + +**Q4 (laminar/nested consistency across TBR/Wagner/sector) answered: the divergent axis is loose-vs-strict (A13-03), not nesting.** Every path tests each constraint split independently and none assumes or mishandles laminarity — confirmed by direct code read, not just absence of a counterexample. + +**Ruled out this round, do not re-trace:** constraint-metadata resync on TBR / prune-reinsert / ratchet / sector *revert* paths (all correct — A13-09/A13-10 are specifically about narrower exit paths, not a general resync failure); per-worker `ConstraintData` copies in parallel mode (T-336 still holds); split canonicalisation agreement between `ts_splits.cpp::canonicalize_split` and `build_constraint` post-T-384 (now largely cosmetic for mapping, polarity handled symmetrically); `structurally_valid()` (T-333) remains a complete check as documented. + +**Not yet examined, flagged as the obvious next seam:** `Resample.R`/`SuccessiveApproximations.R` also call `.PrepareConstraint` (`R/Resample.R:311`, `R/SuccessiveApproximations.R:71`) and route to `ts_resample_search`/`ts_parallel_resample`/`ts_successive_approx` — not traced this round for whether they carry the fuse/sector/pool gates at all. Also latent, not yet a bug: `impose_constraint`'s repair always targets making the *canonical* side the clade regardless of which side is cheaper to realise (`ts_constraint.cpp:741-753`), which combined with A13-07 probably explains part of the heuristic's weak convergence on nested/complex constraints. + +**Doc fixes applied inline (not filed, comment-only):** `src/ts_constraint.h` — `regraft_violates_constraint`'s doc no longer references a nonexistent `above` parameter and now states explicitly it's screening-only (every caller must re-verify the applied move); `impose_constraint`'s doc replaced the false "after return, all constraint splits are displayed" contract with the actual heuristic contract (bail-out cap, per-move revert, return value doesn't distinguish repaired-from-gave-up). + +Seam status: **still yielding** (12 filed from 12 candidates, 0 refuted) → next area-13 visit, once rotation reaches it, should stay **opus** with a fresh agent, targeting the `Resample.R`/`SuccessiveApproximations.R` seam named above first. + +--- + +area: 13 (Constrained search correctness) — directed bounded-harness re-run, not a rotation round +reviewed_by: mcmc-diagnostician (opus) a436b906635edf851 +date: 2026-08-05 +tier: n/a (directed harness task, per the standing 2026-07-03 "NEXT VISIT: NOT another finder" verdict) +yield: 0 new findings — the requested harness already existed and its question was already resolved and merged +notes: Dispatched out of rotation while PR #44 (area-12 duplicate-detection round, see the entry below) was pending human review (merged same day). The brief asked for a bounded exhaustive harness testing whether `impose_one_pass`'s `postorder.size()==n_internal` revert-guard is equivalent to full topological validity, per the open question the 2026-07-03 area-13 round left unresolved (a hypothesised "net-zero slip": a degenerate `topology_spr` graft producing a duplicate-referenced node + a compensating orphan, landing exactly on `n_internal` while the tree is actually invalid). **That harness was already built and the question already answered**, on `cpp-search` HEAD before this round started: `31d2a542c` (red-team(area 13): exhaustive T-327 constraint-repair guard validity harness) + `3d50dfd47` (fix(constraint): make T-327 repair guard a complete structural validator, T-333) — both merged. The net-zero slip **is real** (TYPE-1 corruption: one node double-referenced, one orphaned, landing exactly on `n_internal`), but the hypothesised P1 was refuted — across ~1.33M accepted-invalid trees at n_tip 4–8, zero root-reachable cycles, zero parent[] cycles, zero corrupt trees survived callers' verify-and-discard. Filed and fixed as **T-333 (P3)**: `postorder.size()==n_internal` replaced by a real structural validator, `ts::structurally_valid()` (`src/ts_constraint.cpp:647-697`, called at `:878`). **This round's own contribution: re-validated the fix against current HEAD**, since `src/ts_constraint.cpp` changed after T-333 landed (`4c66a5544`, T-384 rooting-agnostic constraint mapping desynced the harness's kernel-extraction). Re-ran full n_tip 4-8 (5m11s single-core; 60,642,180 pass-A probes + 217,423,980 pass-C probes; tree counts match `(2n-3)!!` exactly at every n; 15,532 reachable TYPE-1 corruptions, 0 TYPE-2, 0 cycles of either kind). **Verdict: the T-333 fix still holds post-T-384** — the shipped `ts::structurally_valid()` rejected every one of the 15,532 reachable corruptions the old guard would have admitted, 0 disagreements vs the harness's independent validator. No new finding; nothing filed. **Scope caveat carried forward, not new:** the wrong-answer refutation is scoped to single-split constraints at n<=8; multi-split constraint interaction and larger n remain outside this harness's coverage (crash refutation — 0 cycles — is the more robust half and is not so scoped). Harness lives at `dev/red-team/heavy-tests/impose_validity/` (`driver.cpp`, `build_and_run.sh`, `extract_funcs.sh`, `README.md`), regenerates `extracted_spr.gen.inc`/`driver` locally as untracked build products (cleaned up after this run, not committed). Seam status: this specific mechanism is now **closed with a passing regression re-check** — a future area-13 visit should return to the finder-shaped questions the 2026-07-03 round left open (Q3: does `regraft_violates_constraint` ever ALLOW a violating regraft — false-negative direction; Q4: laminar/nested-split consistency across TBR/Wagner/sector paths), which remain untouched. + +--- + area: 12 (Red-team process meta-review) reviewed_by: sonnet finder ac1757d5 + haiku verifier aacdbbbb (3 low-sev) + orchestrator mechanical verification (scope-row diffs, label semantics, symbol-registration trace) date: 2026-08-04 @@ -1294,4 +1376,4 @@ tier: n/a (directed single-finding fix) yield: 1 filed-and-fixed same session (T-366, P3) notes: Handed a pre-verified finding for `expand_and_reinsert` (`ts_prune_reinsert.cpp:396`): it scored the rebuilt backbone with `score_tree()`, which on `has_inapplicable` data falls through to `fitch_na_score` and writes NA-regime `prelim`, while the insertion loop's `wagner_incremental_rescore` (`ts_wagner.cpp:131-166`) only maintains standard-Fitch `prelim` with no NA branch — `compute_insertion_edge_sets` then reads this mixed-regime array to choose reinsertion edges. The two sibling backbone-scoring call sites (`ts_wagner.cpp:449`, `ts_sector.cpp:917`) both already use the EW-proxy `fitch_score`, so this one call site reads as an oversight. **Fix applied:** swapped to `fitch_score(tree, ds)`. **Verification performed this session:** built clean; ran an NA repro (`Vinther2008`, then `Dikow2009` for a stronger test) with `pruneReinsertCycles` forced nonzero (default is `0L`, fully inert otherwise) — confirmed the path was actually exercised via `prune_reinsert_ms` timing (0ms before forcing the params right, ~1.3s after). Direct A/B (temporarily reverted the fix, rebuilt, re-ran identical seeds): on `Dikow2009` with 6 fixed RNG seeds, 5/6 gave byte-identical final score AND topology (`write.tree` hash) before vs. after; seed 4 diverged (1614 before → 1616 after) — confirms the fix changes search trajectory on this now-live path, exactly as the finding predicted, with no crash and no corrupted score in either arm. Existing `test-ts-prune-reinsert.R` (52 tests) and `test-ts-sector.R` (52 tests) both still pass. **Not done, flagged as a separate follow-up (do not conflate with this fix):** `fitch_na_score`'s `local_cost` is only written on its non-NA branch, which independently corrupts `wagner_incremental_rescore`'s `old_cost` subtraction for NA blocks — this changes placement further and needs its own A/B before landing. **This entry was not independently re-verified by a second reviewer** (no red-team-verifier pass) — the A/B above is empirical evidence, not a peer confirmation; a future round should sanity-check the reasoning, not just re-trust this note. This was a directed fix task, not a rotation round, so `last_focus` is left untouched. -last_focus: 12 +last_focus: 14 diff --git a/dev/red-team/reviews/container-ub-class-audit/README.md b/dev/red-team/reviews/container-ub-class-audit/README.md new file mode 100644 index 000000000..3efb60f2b --- /dev/null +++ b/dev/red-team/reviews/container-ub-class-audit/README.md @@ -0,0 +1,97 @@ +# Re-audit: degenerate-container undefined behaviour + +Ordered 2026-08-07, after the July sign-off on this class proved wrong twice +in a week (`agent-issues/TreeSearch#124`, `#151`). Both misses shared a +cause: the earlier pass reasoned about reachability *transitively* ("callers +cannot produce zero words") instead of checking, and one of its false claims +was written into memory, where it then actively hid `#124`. + +## The class, and why it takes two detectors + +| Sub-class | Example | Detected by | Blind to it | +|---|---|---|---| +| 1. Null pointer to a `nonnull` parameter | `memcpy(v.data(), w.data(), 0)` where `v` is empty | UBSan `nonnull-attribute` (gcc-ASAN leg) | `_GLIBCXX_ASSERTIONS`; plain builds | +| 2. Out-of-range container address *formation* | `&v[0]`, `v.back()` on an empty `v` — no load or store | `_GLIBCXX_ASSERTIONS` (`glibcxx-assertions` leg, added by `#60`/PR #133) | ASan, which watches accesses, not address arithmetic | + +Neither detector sees the other's sub-class, so any statement of the form +"the sanitizers are clean" is meaningful only once both legs have executed +the shape in question. That is the whole finding: coverage here is bounded +by *input* coverage, not by code reading. + +## What was done + +**Static pass, sub-class 1 — all 69 `memcpy`/`memmove`/`memset` sites.** +Classified per site as *guarded* / *provably non-empty at the site* / +*needs a guard*; a proof counts only if it is visible at the call, never as +a claim about callers. + +| Group | Sites | Verdict | +|---|---|---| +| `MaddisonSlatkin.cpp`, `ts_data.cpp` `_pad` | 19 | Fixed-size C arrays; `sizeof(data)` cannot be zero | +| `ts_tbr.cpp:930` | 1 | Two scalars (`&kbits`, `&ds.concavity`) | +| `TbrSnapshot::save`/`restore` | 12 | Guarded — PR #134 | +| `ts_bench_tbr_phases` | 12 | Guarded at entry — PR #174 | +| `ts_tree.cpp` `load_tip_states`, `save_node_state` | 8 | Guarded on `tip_bytes > 0` / `total_words == 0` | +| `ts_tree.cpp` `restore_prealloc_undo` | 5 | Unreachable at zero words: the loop is `while (u.count > 0)`, and `save_node_state` returns before incrementing `count` | +| `ts_prune_reinsert.cpp`, `ts_sector.cpp`, `ts_collapsed.cpp` | 3 | Guarded on `tw > 0` / an early return at `total_words == 0` | +| `ts_tbr.cpp` L3b + vroot + NA clip | 8 | Gated by `l3b_active`/`use_directional` (both require `total_words > 0`) and by `has_na` (which implies at least one block) | +| `ts_splits.cpp` | 2 | `wps = (n_tip + 63) / 64 >= 1`; the emit loop's filters are identical to the count loop's, so `idx < n_splits` | + +No unguarded site. The sibling patterns `.front()`, `.back()` and +`.data() + i` were swept too (45 + 11 sites); every `.back()` is inside a +`while (!stack.empty())` or on `postorder`, which is never empty. + +**Dynamic pass, sub-class 2 — 1704 runs under a local +`-D_GLIBCXX_ASSERTIONS` build**, in three batteries: + +| Battery | Runs | Axis | +|---|---:|---| +| 1 | 663 | 13 degenerate shapes (all-constant, all-autapomorphic, all-`?`, all-`-`, single character, 3 and 4 tips, …) x ~30 entry points x {EW, IW} | +| 2 | 382 | Hierarchy/HSJ/XFORM modes, constraints, profile parsimony, resampling API, 24- and 40-tip trees, 12-state characters | +| 3 | 659 | 37 `TS_*` environment knobs, each switching on an alternative kernel, plus the >=150-tip regime that activates L3b incremental edge sets | + +Zero aborts. Battery 3 matters most: `l3b_active` requires `n_tip >= 150` +unless `TS_L3B_INCREMENTAL` is set, so eight `ts_tbr.cpp` sites had never +been executed by any test at any point. + +Two honest qualifications on battery 3. The knobs were *set*; that each one +switched on the path it names was not verified individually, so read that +row as breadth, not as 37 confirmed alternative kernels. The exception is +L3b, which is load-bearing and was confirmed: `l3b_active` also demands a +null sector mask, no tabu list and no pool collection, and under +`TS_L3B_STATS=1` the forced 12-tip call reports `patch_clips=36`, so the +path really does engage. + +**Positive control.** "No aborts" is uninterpretable without proof that the +harness can abort. Reverting the `#151` entry guard and rebuilding produced +`stl_vector.h:1130: Assertion '__n < this->size()' failed` on the very first +degenerate call, `rc=127`; restoring it returned the run to green. The same +control was then run against the new test file, which likewise aborts +without the guard — so that file is not tautological. + +## What landed + +`tests/testthat/test-ts-degenerate-shapes.R` (Tier 2, 329 expectations, +~5 s). Its expectations are contract checks; its purpose is to put the +degenerate shapes in front of both CI legs on every dispatch, so this class +is watched continuously rather than re-audited by hand after each escape. +It includes an `TS_L3B_INCREMENTAL`-forced block, which buys the L3b sites +on a 12-tip tree instead of 150. + +## Residual risk — what this audit does NOT establish + +- `_GLIBCXX_ASSERTIONS` hardens libstdc++ containers only. Raw arrays, and + raw pointers *derived* from a container (`const uint64_t* bits = &v[i];` + then `bits[w]`), are unchecked; those reads are ASan's job. +- Rcpp vector indexing is not hardened by either flag. +- The dynamic pass is bounded by the shapes imagined. Every historical + instance was a zero-Fitch-word dataset, so that axis is now covered + thoroughly and others less so. +- `p + 0` on a null `.data()` (`ts_rcpp.cpp:1750`) is UB before C++20 and + well-defined from C++20; it is not reported by either detector and was + left alone. + +**Reopening condition.** Any new UBSan `nonnull-attribute` report, any +libstdc++ assertion abort, or any new entry point that indexes per-word +state without a `total_words == 0` guard. A new entry point should be added +to `test-ts-degenerate-shapes.R` in the same commit that introduces it. diff --git a/dev/smoke_40k.R b/dev/smoke_40k.R index dfa6b019d..33e972888 100644 --- a/dev/smoke_40k.R +++ b/dev/smoke_40k.R @@ -1,5 +1,5 @@ # 40,000-tree matrix-free smoke test for WideSample() over the -# MaxMin::FarFirst() distance-column oracle path. +# Coreset::FarFirst() distance-column oracle path. suppressPackageStartupMessages({ library(TreeTools) # for as.phylo.numeric library(TreeSearch) diff --git a/dev/tbr-root-edge/oracle.R b/dev/tbr-root-edge/oracle.R new file mode 100644 index 000000000..8e0ef503a --- /dev/null +++ b/dev/tbr-root-edge/oracle.R @@ -0,0 +1,155 @@ +# Independent TBR-neighbourhood oracle for agent-issues/TreeSearch#147. +# +# Deliberately shares no code with src/rearrange.cpp, R/TBR.R or src/ts_tbr.cpp: +# the tree is held as a bare undirected edge list, splits are recovered by +# deleting an edge and flood-filling one side, and TBR is performed by the +# textbook definition (delete an edge, suppress the two exposed degree-2 +# vertices, subdivide one edge in each fragment, join the two new vertices). +# +# Not part of the package; not sourced by any test. + +# ---- undirected representation ------------------------------------------- + +# Convert a `phylo` (rooted or not) to an undirected edge list. +AsUndirected <- function(tree) { + edge <- tree[["edge"]] + list(nTip = length(tree[["tip.label"]]), + from = as.integer(edge[, 1]), + to = as.integer(edge[, 2])) +} + +# Vertices reachable from `start`, optionally refusing to cross edge `blocked`. +Reach <- function(g, start, blocked = 0L) { + nV <- max(c(g[["from"]], g[["to"]], start)) + seen <- logical(nV) + seen[[start]] <- TRUE + keep <- seq_along(g[["from"]]) != blocked + from <- g[["from"]][keep] + to <- g[["to"]][keep] + repeat { + grew <- FALSE + hit <- seen[from] & !seen[to] + if (any(hit)) { seen[to[hit]] <- TRUE; grew <- TRUE } + hit <- seen[to] & !seen[from] + if (any(hit)) { seen[from[hit]] <- TRUE; grew <- TRUE } + if (!grew) break + } + which(seen) +} + +# Canonical key for the *unrooted* topology of `g`. +# +# Each edge contributes the set of leaves on one side, complemented if needed so +# that leaf 1 is always absent. Trivial splits are dropped, so a degree-2 root +# and any suppressed vertex are invisible to the key. +SplitKey <- function(g) { + nTip <- g[["nTip"]] + full <- seq_len(nTip) + masks <- character(0) + for (i in seq_along(g[["from"]])) { + side <- intersect(Reach(g, start = g[["to"]][[i]], blocked = i), full) + if (1L %in% side) { + side <- setdiff(full, side) + } + if (length(side) < 2L || length(side) > nTip - 2L) next + masks <- c(masks, paste0(sort(side), collapse = ".")) + } + paste0(sort(unique(masks)), collapse = "|") +} + +# Delete a degree-2 vertex, joining its two neighbours directly. +SuppressVertex <- function(g, v) { + inc <- which(g[["from"]] == v | g[["to"]] == v) + stopifnot(length(inc) == 2L) + nbr <- c(g[["from"]][inc], g[["to"]][inc]) + nbr <- nbr[nbr != v] + stopifnot(length(nbr) == 2L) + g[["from"]] <- c(g[["from"]][-inc], nbr[[1]]) + g[["to"]] <- c(g[["to"]][-inc], nbr[[2]]) + g +} + +# Drop every degree-2 internal vertex, e.g. the root of a rooted `phylo`, so +# that enumeration runs over the 2n - 3 edges of the unrooted tree rather than +# the 2n - 2 edges of its rooted representation. +Unroot <- function(g) { + repeat { + deg <- tabulate(c(g[["from"]], g[["to"]])) + twos <- setdiff(which(deg == 2L), seq_len(g[["nTip"]])) + if (!length(twos)) break + g <- SuppressVertex(g, twos[[1]]) + } + g +} + +# Subdivide edge `i` of `g` with a new vertex `v`; returns the modified graph. +Subdivide <- function(g, i, v) { + far <- g[["to"]][[i]] + g[["to"]][[i]] <- v + g[["from"]] <- c(g[["from"]], v) + g[["to"]] <- c(g[["to"]], far) + g +} + +# Every unrooted topology one TBR move from `tree`, as canonical split keys. +# `includeSelf = FALSE` drops the starting topology, which TBR reaches whenever +# it rejoins where it cut. +TbrOracle <- function(tree, includeSelf = FALSE) { + g0 <- Unroot(AsUndirected(tree)) + self <- SplitKey(g0) + nTip <- g0[["nTip"]] + spare <- max(c(g0[["from"]], g0[["to"]])) + 1L + + out <- character(0) + for (cut in seq_along(g0[["from"]])) { + u <- g0[["from"]][[cut]] + v <- g0[["to"]][[cut]] + # A leaf on each side of the cut, identified before any suppression. + anchorU <- intersect(Reach(g0, start = u, blocked = cut), seq_len(nTip))[[1]] + anchorV <- intersect(Reach(g0, start = v, blocked = cut), seq_len(nTip))[[1]] + + g <- g0 + g[["from"]] <- g[["from"]][-cut] + g[["to"]] <- g[["to"]][-cut] + for (end in c(u, v)) { + if (end > nTip) g <- SuppressVertex(g, end) + } + + compU <- Reach(g, anchorU) + compV <- Reach(g, anchorV) + stopifnot(!length(intersect(compU, compV))) + + edgesU <- which(g[["from"]] %in% compU) + edgesV <- which(g[["from"]] %in% compV) + # A single-leaf fragment offers no edge to subdivide: attach at the leaf. + attachU <- if (length(edgesU)) edgesU else 0L + attachV <- if (length(edgesV)) edgesV else 0L + + for (a in attachU) { + for (b in attachV) { + h <- g + if (a == 0L) { + newU <- compU + } else { + newU <- spare + h <- Subdivide(h, a, newU) + } + if (b == 0L) { + newV <- compV + } else { + newV <- spare + 1L + h <- Subdivide(h, b, newV) + } + h[["from"]] <- c(h[["from"]], newU) + h[["to"]] <- c(h[["to"]], newV) + out <- c(out, SplitKey(h)) + } + } + } + out <- unique(out) + if (!includeSelf) out <- setdiff(out, self) + sort(out) +} + +# Split key of a `phylo`, for comparing package output against the oracle. +TreeKey <- function(tree) SplitKey(AsUndirected(tree)) diff --git a/dev/tbr-root-edge/validate.R b/dev/tbr-root-edge/validate.R new file mode 100644 index 000000000..d4c2ee46b --- /dev/null +++ b/dev/tbr-root-edge/validate.R @@ -0,0 +1,113 @@ +# Validate the oracle in oracle.R, then measure all_tbr() against it. +# Usage: Rscript dev/tbr-root-edge/validate.R [lib] + +args <- commandArgs(trailingOnly = TRUE) +lib <- if (length(args)) args[[1]] else ".agent-147" +library("TreeSearch", lib.loc = normalizePath(lib)) +library("TreeTools", quietly = TRUE) +source("dev/tbr-root-edge/oracle.R") + +Head <- function(x) cat("\n== ", x, " ==\n", sep = "") + +# ---- 1. the key must be injective over unrooted tree space ---------------- +Head("Key injectivity, 8 leaves") +n8 <- NUnrooted(8) +cat("NUnrooted(8) =", n8, "\n") +keys8 <- vapply(seq_len(n8) - 1L, function(i) TreeKey(as.phylo(i, 8)), + character(1)) +cat("distinct keys over as.phylo(0:", n8 - 1, ", 8): ", + length(unique(keys8)), "\n", sep = "") +stopifnot(length(unique(keys8)) == n8) + +# ---- 2. the oracle must contain the NNI neighbourhood, exactly 2(n-3) ----- +Head("NNI containment") +for (nm in c("BalancedTree", "PectinateTree")) { + tr <- get(nm)(8) + nni <- unique(vapply(seq_len(500), function(i) { + set.seed(i) + TreeKey(NNI(tr)) + }, character(1))) + nni <- setdiff(nni, TreeKey(tr)) + orc <- TbrOracle(tr) + # Symmetric trees collapse some of the 2(n - 3) NNI swaps to one topology, + # so the sampled count is a ceiling, not an identity. + cat(sprintf("%-14s |NNI sampled| = %2d (<= %d), all inside oracle: %s\n", + nm, length(nni), 2 * (8 - 3), all(nni %in% orc))) + stopifnot(all(nni %in% orc), length(nni) <= 2 * (8 - 3), length(nni) > 0) +} + +# ---- 3. the oracle must agree with the pure-R TBRSwap --------------------- +Head("Oracle vs exhaustive TBRSwap") +SwapAll <- function(tr) { + tr <- Preorder(RootTree(tr, 1)) + parent <- tr[["edge"]][, 1] + child <- tr[["edge"]][, 2] + nEdge <- length(parent) + keys <- character(0) + for (etb in seq_len(nEdge)) { + for (m1 in seq_len(nEdge)) { + for (m2 in seq_len(nEdge)) { + if (m1 == m2) next + res <- suppressWarnings( + TBRSwap(parent, child, nEdge, edgeToBreak = etb, + mergeEdges = c(m1, m2)) + ) + t2 <- tr + t2[["edge"]] <- cbind(res[[1]], res[[2]]) + keys <- c(keys, TreeKey(t2)) + } + } + } + sort(setdiff(unique(keys), TreeKey(tr))) +} +for (nm in c("BalancedTree", "PectinateTree")) { + tr <- get(nm)(8) + orc <- TbrOracle(tr) + swp <- SwapAll(tr) + cat(sprintf("%-14s oracle %3d TBRSwap %3d swap\\oracle %d oracle\\swap %d\n", + nm, length(orc), length(swp), + length(setdiff(swp, orc)), length(setdiff(orc, swp)))) +} +set.seed(1) +for (i in 1:3) { + tr <- RandomTree(8, root = TRUE) + orc <- TbrOracle(tr) + swp <- SwapAll(tr) + cat(sprintf("random8 #%d oracle %3d TBRSwap %3d swap\\oracle %d oracle\\swap %d\n", + i, length(orc), length(swp), + length(setdiff(swp, orc)), length(setdiff(orc, swp)))) +} + +# ---- 4. what all_tbr() actually returns ----------------------------------- +Head("TBRMoves vs SPRMoves vs oracle") +Row <- function(label, tr) { + orc <- TbrOracle(tr) + tbr <- sort(unique(vapply(TBRMoves(tr), TreeKey, character(1)))) + spr <- sort(unique(vapply(SPRMoves(tr), TreeKey, character(1)))) + cat(sprintf( + "%-16s oracle %3d | TBR %3d | SPR %3d | SPR\\TBR %2d | oracle\\TBR %2d | TBR\\oracle %d\n", + label, length(orc), length(tbr), length(spr), + length(setdiff(spr, tbr)), length(setdiff(orc, tbr)), + length(setdiff(tbr, orc)))) + invisible(list(orc = orc, tbr = tbr, spr = spr)) +} +Row("Balanced(8)", BalancedTree(8)) +Row("Pectinate(8)", PectinateTree(8)) +Row("Balanced(7)", BalancedTree(7)) +Row("Pectinate(7)", PectinateTree(7)) +set.seed(2) +for (i in 1:4) Row(sprintf("random8 #%d", i), RandomTree(8, root = TRUE)) +set.seed(3) +for (i in 1:3) Row(sprintf("random9 #%d", i), RandomTree(9, root = TRUE)) +set.seed(4) +for (i in 1:2) Row(sprintf("random11 #%d", i), RandomTree(11, root = TRUE)) + +Head("Are the missing trees exactly the tip-1 regrafts?") +tr <- BalancedTree(8) +r <- Row("Balanced(8)", tr) +missing <- setdiff(r[["orc"]], r[["tbr"]]) +byEdge2 <- sort(unique(vapply(SPRMoves(tr, 2L), TreeKey, character(1)))) +cat("missing =", length(missing), "; SPR(edge 2) =", length(byEdge2), + "; missing in SPR(edge 2):", all(missing %in% byEdge2), "\n") + +cat("\nDone.\n") diff --git a/dev/tbr-root-edge/verify-fix.R b/dev/tbr-root-edge/verify-fix.R new file mode 100644 index 000000000..461178829 --- /dev/null +++ b/dev/tbr-root-edge/verify-fix.R @@ -0,0 +1,70 @@ +# Post-fix verification for agent-issues/TreeSearch#147. +# Usage: Rscript dev/tbr-root-edge/verify-fix.R [lib] + +args <- commandArgs(trailingOnly = TRUE) +lib <- if (length(args)) args[[1]] else ".agent-147" +library("TreeSearch", lib.loc = normalizePath(lib)) +library("TreeTools", quietly = TRUE) +source("dev/tbr-root-edge/oracle.R") + +Head <- function(x) cat("\n== ", x, " ==\n", sep = "") +Keys <- function(trees) sort(unique(vapply(trees, TreeKey, character(1)))) + +# ---- 1. TBRMoves == the complete TBR neighbourhood ------------------------ +Head("TBRMoves vs oracle, and SPRMoves containment") +Check <- function(label, tr) { + orc <- TbrOracle(tr) + tbr <- Keys(TBRMoves(tr)) + spr <- Keys(SPRMoves(tr)) + ok <- identical(orc, tbr) && !length(setdiff(spr, tbr)) + cat(sprintf("%-16s oracle %4d | TBR %4d | missing %2d | spurious %2d | SPR\\TBR %2d %s\n", + label, length(orc), length(tbr), + length(setdiff(orc, tbr)), length(setdiff(tbr, orc)), + length(setdiff(spr, tbr)), if (ok) "OK" else "**FAIL**")) + ok +} +ok <- c( + Check("Balanced(7)", BalancedTree(7)), + Check("Pectinate(7)", PectinateTree(7)), + Check("Balanced(8)", BalancedTree(8)), + Check("Pectinate(8)", PectinateTree(8)), + Check("Balanced(9)", BalancedTree(9)), + Check("Pectinate(9)", PectinateTree(9)) +) +set.seed(2) +for (i in 1:4) ok <- c(ok, Check(sprintf("random8 #%d", i), RandomTree(8, root = TRUE))) +set.seed(3) +for (i in 1:3) ok <- c(ok, Check(sprintf("random9 #%d", i), RandomTree(9, root = TRUE))) +set.seed(4) +for (i in 1:2) ok <- c(ok, Check(sprintf("random11 #%d", i), RandomTree(11, root = TRUE))) +stopifnot(all(ok)) + +# ---- 2. exhaustive over every 7-leaf unrooted topology -------------------- +Head("Every unrooted 7-leaf topology") +n7 <- NUnrooted(7) +bad <- 0L +for (i in seq_len(n7) - 1L) { + tr <- as.phylo(i, 7) + if (!identical(TbrOracle(tr), Keys(TBRMoves(tr)))) bad <- bad + 1L +} +cat(sprintf("%d / %d topologies match the oracle exactly\n", n7 - bad, n7)) +stopifnot(bad == 0L) + +# ---- 3. the root-edge identity: TBR on edge 2 == SPR on edge 2 ------------ +Head("all_tbr(e, 2) == all_spr(e, 2)") +for (n in 5:12) { + set.seed(n) + tr <- Preorder(RootTree(RandomTree(n, root = TRUE), 1)) + e <- tr[["edge"]] + a <- TreeSearch:::all_tbr(e, 2L) + b <- TreeSearch:::.all_spr(e, 2L) + # Theory: bisecting tip 1's pendant edge leaves 2(n-1)-3 re-rooting sites, + # one of which recreates the starting tree. + expected <- 2 * (n - 1) - 3 - 1 + cat(sprintf("n=%2d tbr %2d spr %2d identical %s expected %2d %s\n", + n, length(a), length(b), identical(a, b), expected, + if (length(a) == expected) "OK" else "**FAIL**")) + stopifnot(identical(a, b), length(a) == expected) +} + +cat("\nAll checks passed.\n") diff --git a/inst/Parsimony/global.R b/inst/Parsimony/global.R index 8b1094481..adbcd18c9 100644 --- a/inst/Parsimony/global.R +++ b/inst/Parsimony/global.R @@ -2,7 +2,7 @@ # options("TreeSearch.write.code" = TRUE) # Show code as it is written to log logging <- isTRUE(getOption("TreeSearch.logging")) options(shiny.maxRequestSize = 1024 ^ 3) # Allow max 1 GB files -options(MaxMin.progress = FALSE) # Suppress DropAdd progress messages in app +options(Coreset.progress = FALSE) # Suppress DropAdd progress messages in app # Development: prepend .agent-shiny library so library("TreeSearch") finds # the pre-built v2.0.0 install, preventing pkgload from intercepting and diff --git a/inst/Parsimony/server/mod_treespace.R b/inst/Parsimony/server/mod_treespace.R index a3161662f..4b2d278f7 100644 --- a/inst/Parsimony/server/mod_treespace.R +++ b/inst/Parsimony/server/mod_treespace.R @@ -79,7 +79,7 @@ treespace_server <- function(id, r, clusterings, silThreshold, scores, }) LogFirstHit <- function() { - LogCodeP("whenHit <- gsub(\"(seed|start|ratch\\\\d+|final)_\\\\d+\", \"\\\\1\", + LogCodeP("whenHit <- gsub(\"^(seed|start|ratch\\\\d+|final)_\\\\d+$\", \"\\\\1\", names(trees), perl = TRUE)") LogCodeP("attr(trees, \"firstHit\") <- table(whenHit)[unique(whenHit)]") } diff --git a/inst/Parsimony/tests/testthat/setup.R b/inst/Parsimony/tests/testthat/setup.R index 79b14ccec..f428820db 100644 --- a/inst/Parsimony/tests/testthat/setup.R +++ b/inst/Parsimony/tests/testthat/setup.R @@ -60,7 +60,7 @@ new_app_driver <- function(name, ...) { # reproducible rather than timing-dependent. # # This is how the Distribution baseline came to record `trees[1:125]` for a -# state its test had set to c(77, 125) -- noticed only once the MaxMin +# state its test had set to c(77, 125) -- noticed only once the Coreset # dependency fix let CI reach the suite at all. # --------------------------------------------------------------------------- wait_stable <- function(app, timeout = 30000, attempts = 3L, diff --git a/inst/WORDLIST b/inst/WORDLIST index 940b38b7e..8d0dc270b 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -95,6 +95,7 @@ Maddison Magnoliidae Maldanidae Margoliash +Coreset MaxMin Melpomene Meridiolestidan @@ -197,6 +198,7 @@ abcd ac aculiferan archaeopriapulid +autapomorphic bristleworm cdef cdot @@ -220,6 +222,7 @@ durham eff entelegyne equiprobable +etc ffmpeg frac geq @@ -266,6 +269,7 @@ rearranger reconverged reconverges regraft +regrafted regrafting regrafts reoptimisation diff --git a/man/AdditionTree.Rd b/man/AdditionTree.Rd index 105b21191..dcc28b8ad 100644 --- a/man/AdditionTree.Rd +++ b/man/AdditionTree.Rd @@ -37,6 +37,14 @@ construction begins.} returned trees will be perfectly compatible with each character in \code{constraint}; or a tree of class \code{phylo}, all of whose nodes will occur in any output tree. +A returned tree is compatible with a constraint character when some edge +separates the taxa coded \code{1} from those coded \code{0}. Taxa coded \verb{?}, and taxa +that \code{constraint} does not mention, are unconstrained: they may fall on +either side of that edge, and are not required to join either group. +A character whose \code{1} or \code{0} group contains fewer than two taxa therefore +constrains nothing -- every tree separates such a group from the rest -- and +is ignored with a warning. To group taxa, code the taxa they must be +separated from as \code{0} rather than leaving them \verb{?}. Constraint searches are supported natively: all tree rearrangements are filtered to respect the constraint topology. Each constraint character is enforced as a single split, so one with more diff --git a/man/ClusterStrings.Rd b/man/ClusterStrings.Rd index 9f5aba13f..ef8dd0aa0 100644 --- a/man/ClusterStrings.Rd +++ b/man/ClusterStrings.Rd @@ -12,12 +12,14 @@ ClusterStrings(x, maxCluster = 12) \item{maxCluster}{Integer specifying maximum number of clusters to consider.} } \value{ -\code{NameClusters()} returns an integer assigning each element of \code{x} +\code{ClusterStrings()} returns an integer assigning each element of \code{x} to a cluster, with an attribute \code{med} specifying the median string in each cluster, and \code{silhouette} reporting the silhouette coefficient of the optimal -clustering. Coefficients < 0.5 indicate weak structure, and no clusters are -returned. If the number of unique elements of \code{x} is less than \code{maxCluster}, -all occurrences of each entry are assigned to an individual cluster. +clustering. Coefficients < 0.5 indicate weak structure, in which case all +elements of \code{x} are assigned to a single cluster. If the number of unique +elements of \code{x} is less than \code{maxCluster}, all occurrences of each entry +are assigned to an individual cluster instead, with \code{silhouette} reported +as \code{NA}. } \description{ Calculate string similarity using the Levenshtein distance and return diff --git a/man/Consistency.Rd b/man/Consistency.Rd index 3727b27be..b50327f42 100644 --- a/man/Consistency.Rd +++ b/man/Consistency.Rd @@ -28,6 +28,15 @@ consistency index (\code{ci}), retention index (\code{ri}), rescaled consistency index (\code{rc}) and relative homoplasy index (\code{rhi}). +\code{ci} is \code{NaN} for a constant character, for which both the observed and +minimum length are zero. +\code{ri} and \code{rc} are \code{NaN} when the maximum and minimum length coincide, as +for a constant or an autapomorphic character. +\code{rhi} is \code{NA} throughout if \code{nRelabel = 0}, as it is then not calculated. +Otherwise \code{rhi} is \code{NaN} when the observed length already equals the +minimum length and the median length under random leaf relabelling also +equals the minimum; if only the median length equals the minimum, \code{rhi} +is \code{Inf}. } \description{ \code{Consistency()} calculates the consistency "index" and retention index diff --git a/man/MaximizeParsimony.Rd b/man/MaximizeParsimony.Rd index 253bf304f..d8a8a8fde 100644 --- a/man/MaximizeParsimony.Rd +++ b/man/MaximizeParsimony.Rd @@ -143,6 +143,14 @@ block. Only used when \code{inapplicable = "hsj"}.} returned trees will be perfectly compatible with each character in \code{constraint}; or a tree of class \code{phylo}, all of whose nodes will occur in any output tree. +A returned tree is compatible with a constraint character when some edge +separates the taxa coded \code{1} from those coded \code{0}. Taxa coded \verb{?}, and taxa +that \code{constraint} does not mention, are unconstrained: they may fall on +either side of that edge, and are not required to join either group. +A character whose \code{1} or \code{0} group contains fewer than two taxa therefore +constrains nothing -- every tree separates such a group from the rest -- and +is ignored with a warning. To group taxa, code the taxa they must be +separated from as \code{0} rather than leaving them \verb{?}. Constraint searches are supported natively: all tree rearrangements are filtered to respect the constraint topology. Each constraint character is enforced as a single split, so one with more diff --git a/man/QuartetResolution.Rd b/man/QuartetResolution.Rd index 01fb495df..5f0443ad3 100644 --- a/man/QuartetResolution.Rd +++ b/man/QuartetResolution.Rd @@ -14,7 +14,8 @@ reported, in a format accepted by \code{\link[TreeTools]{KeepTip}()}.} } \value{ A vector specifying an integer, for each tree, which of \code{tips[-1]} -is most closely related to \code{tips[1]}. +is most closely related to \code{tips[1]}. A tree in which the four tips form +an unresolved (star) quartet contributes \code{NA} to this vector. } \description{ Relationship between four taxa diff --git a/man/Resample.Rd b/man/Resample.Rd index 530a527af..98a744665 100644 --- a/man/Resample.Rd +++ b/man/Resample.Rd @@ -71,6 +71,14 @@ Specify \code{"profile"} to employ profile parsimony returned trees will be perfectly compatible with each character in \code{constraint}; or a tree of class \code{phylo}, all of whose nodes will occur in any output tree. +A returned tree is compatible with a constraint character when some edge +separates the taxa coded \code{1} from those coded \code{0}. Taxa coded \verb{?}, and taxa +that \code{constraint} does not mention, are unconstrained: they may fall on +either side of that edge, and are not required to join either group. +A character whose \code{1} or \code{0} group contains fewer than two taxa therefore +constrains nothing -- every tree separates such a group from the rest -- and +is ignored with a warning. To group taxa, code the taxa they must be +separated from as \code{0} rather than leaving them \verb{?}. Constraint searches are supported natively: all tree rearrangements are filtered to respect the constraint topology. Each constraint character is enforced as a single split, so one with more diff --git a/man/SPR.Rd b/man/SPR.Rd index ca49e66dd..d92395409 100644 --- a/man/SPR.Rd +++ b/man/SPR.Rd @@ -61,7 +61,7 @@ class \code{\link[ape]{phylo}}, i.e. \code{dim(tree$edge)[1]}} \value{ This function returns a tree in \code{phyDat} format that has undergone one \acronym{SPR} iteration. -\code{TBRMoves()} returns a list of all trees one SPR move away from +\code{SPRMoves()} returns a list of all trees one SPR move away from \code{tree}, with edges and nodes in preorder, rooted on the first-labelled tip. a list containing two elements, corresponding in turn to the diff --git a/man/SiteConcordance.Rd b/man/SiteConcordance.Rd index 7dc208b54..4436e882d 100644 --- a/man/SiteConcordance.Rd +++ b/man/SiteConcordance.Rd @@ -91,6 +91,8 @@ or meaningful measure. concordance of each character in \code{dataset} with \code{tree}. The attribute \code{weighted.mean} gives the mean value, weighted by the information content of each character. +\code{NaN} is returned for a character that no split in \code{tree} is informative +about (zero possible information, a 0 / 0 division). \code{QuartetConcordance(return = "edge")} returns a numeric vector giving the concordance index at each split across all sites; names specify the number of @@ -98,15 +100,21 @@ each corresponding split in \code{tree}. \code{QuartetConcordance(return = "char")} returns a numeric vector giving the concordance index calculated at each site, averaged across all splits. +Unlike the \code{"edge"} result, this vector is unnamed: characters retain no +persistent identifier once collapsed to patterns. \code{PhylogeneticConcordance()} returns a numeric vector giving the phylogenetic information of each split in \code{tree}, named according to the split's internal numbering. +\code{NaN} is returned for a split that no character is informative about +(zero possible information, a 0 / 0 division). \code{SharedPhylogeneticConcordance()} returns the shared phylogenetic concordance of each character in \code{dataset} with \code{tree}. The attribute \code{weighted.mean} gives the mean value, weighted by the information content of each character. +\code{NaN} is returned for a character that no split in \code{tree} is informative +about (zero possible information, a 0 / 0 division). } \description{ Concordance measures the strength of support that characters in a dataset @@ -173,6 +181,9 @@ rather than a random subsample \insertCite{@cf. @Minh2020}{TreeSearch}. Ambiguous and inapplicable tokens are treated as containing no grouping information (i.e. \code{(02)} or \code{-} are each treated as \verb{?}). +\code{return} is matched (case-insensitively, and partially) against \code{"edge"} +and \code{"char"}; any other value raises an error. + \code{PhylogeneticConcordance()} treats each character in \code{dataset} as a phylogenetic hypothesis and measures the extent to which it supports the splits of \code{tree}. Each character is first interpreted as a tree (or set of diff --git a/man/SuccessiveApproximations.Rd b/man/SuccessiveApproximations.Rd index 6dfbce7c4..5d602dd61 100644 --- a/man/SuccessiveApproximations.Rd +++ b/man/SuccessiveApproximations.Rd @@ -83,6 +83,14 @@ Specify \code{"profile"} to employ profile parsimony returned trees will be perfectly compatible with each character in \code{constraint}; or a tree of class \code{phylo}, all of whose nodes will occur in any output tree. +A returned tree is compatible with a constraint character when some edge +separates the taxa coded \code{1} from those coded \code{0}. Taxa coded \verb{?}, and taxa +that \code{constraint} does not mention, are unconstrained: they may fall on +either side of that edge, and are not required to join either group. +A character whose \code{1} or \code{0} group contains fewer than two taxa therefore +constrains nothing -- every tree separates such a group from the rest -- and +is ignored with a warning. To group taxa, code the taxa they must be +separated from as \code{0} rather than leaving them \verb{?}. Constraint searches are supported natively: all tree rearrangements are filtered to respect the constraint topology. Each constraint character is enforced as a single split, so one with more diff --git a/man/WideSample.Rd b/man/WideSample.Rd index 045ef6214..4d7cd3114 100644 --- a/man/WideSample.Rd +++ b/man/WideSample.Rd @@ -45,7 +45,9 @@ Default \code{60}.} A \code{multiPhylo} object of length \code{min(n, length(trees))} containing a topologically diverse (Max-Min) subset of \code{trees}. If \code{n == 1}, the single most central tree (the medoid) is returned. -Attributes of the input (e.g. \code{score}, \code{hits_to_best}) are preserved. +Attributes of the input (e.g. \code{score}, \code{hits_to_best}) are preserved, +except \code{firstHit}, which describes the pre-subset set of trees and is +dropped; call \code{\link[=WhenFirstHit]{WhenFirstHit()}} on the result to recompute it. } \description{ Selects \code{n} trees from a \code{multiPhylo} object that are as topologically @@ -62,7 +64,7 @@ the likelihood or support for that topology. A random draw over-represents topologies that sit on broad plateaux and under-represents isolated optima. \code{WideSample()} instead selects for topological \emph{spread}, density-blind, by dispatching to the appropriate Max-Min Diversity Problem solver from the -\pkg{MaxMin} package: +\pkg{Coreset} package: \describe{ \item{\code{FarFirst()} (\code{effort = 1})}{Greedy farthest-first selection @@ -111,17 +113,17 @@ which automatic selection reaches the exact tier (default \code{200}).} library("TreeTools") trees <- as.phylo(0:99, nTip = 8) -# WideSample() needs the MaxMin package (Max-Min diversity solvers) -if (requireNamespace("MaxMin", quietly = TRUE)) { +# WideSample() needs the Coreset package (Max-Min diversity solvers) +if (requireNamespace("Coreset", quietly = TRUE)) { # Fast FarFirst subsample (deterministic, matrix-free) sub10 <- WideSample(trees, 10, effort = 1) length(sub10) # 10 -# The remaining tiers (DropAdd, Grasp, exact) all dispatch to 'MaxMin'/ +# The remaining tiers (DropAdd, Grasp, exact) all dispatch to 'Coreset'/ # 'highs' solvers whose runtime is environment-dependent (e.g. a # from-source 'highs' build can be far slower than the CRAN binary) and -# whose calling convention tracks 'MaxMin' development. Demonstrate them +# whose calling convention tracks 'Coreset' development. Demonstrate them # interactively only. if (interactive()) { # Pre-computed distances diff --git a/man/dot-SubsetMultiPhylo.Rd b/man/dot-SubsetMultiPhylo.Rd index dcab41fa9..b0cfe4295 100644 --- a/man/dot-SubsetMultiPhylo.Rd +++ b/man/dot-SubsetMultiPhylo.Rd @@ -7,6 +7,11 @@ .SubsetMultiPhylo(trees, idx) } \description{ -Subset a multiPhylo preserving attributes +Non-standard attributes describe the whole \code{multiPhylo} object (e.g. +\code{score}, \code{hits_to_best}, \code{replicate_scores}) and are copied over +unchanged, with one exception: \code{firstHit} is a per-\emph{stage} tally computed +from the (pre-subset) set of tree names, so it no longer describes the +returned subset and is dropped rather than carried over stale. +\code{\link[=WhenFirstHit]{WhenFirstHit()}} can recompute it from the subset's own names if needed. } \keyword{internal} diff --git a/man/dot-WideSampleColumnOracle.Rd b/man/dot-WideSampleColumnOracle.Rd index df6292d6e..56eb6b279 100644 --- a/man/dot-WideSampleColumnOracle.Rd +++ b/man/dot-WideSampleColumnOracle.Rd @@ -9,7 +9,7 @@ \description{ Returns a function of one 1-based index \code{i} giving the distances from tree \code{i} to every tree, as required by the distance-column oracle path of -\code{\link[MaxMin:FarFirst]{MaxMin::FarFirst()}}. Probes +\code{\link[Coreset:FarFirst]{Coreset::FarFirst()}}. Probes the \verb{(tree, trees)} calling form once up front and fails clearly if the supplied \code{dist} function does not support it. } diff --git a/man/dot-WideSampleMedoid.Rd b/man/dot-WideSampleMedoid.Rd index c42347a0a..78eb74b45 100644 --- a/man/dot-WideSampleMedoid.Rd +++ b/man/dot-WideSampleMedoid.Rd @@ -14,7 +14,7 @@ Returns the index of the most central tree -- the medoid, minimizing summed distance to all others. Uses the distance matrix when one is available or affordable to build; when only a distance function is supplied for a set too large to build a matrix, the central medoid is not affordable, so the -deterministic peripheral seed (\code{\link[MaxMin:FarFirst]{MaxMin::FarFirst()}} with \code{k = 1}) is returned +deterministic peripheral seed (\code{\link[Coreset:FarFirst]{Coreset::FarFirst()}} with \code{k = 1}) is returned as a matrix-free fallback. } \keyword{internal} diff --git a/src/MaddisonSlatkin.cpp b/src/MaddisonSlatkin.cpp index f02ca098e..753448e89 100644 --- a/src/MaddisonSlatkin.cpp +++ b/src/MaddisonSlatkin.cpp @@ -918,8 +918,47 @@ class SolverT { int s_max_global = 0; // Time budget: abort if computation exceeds this many seconds. - // Legitimate computations complete in <2s; blowups take >100s. + // + // This is a latency promise, and it is deliberately the binding one. It + // caps what a caller waits per character; `.MS_SC_THRESHOLD` only skips work + // that is hopeless enough to be worth not starting. The two could be + // arranged the other way round -- gate on the character's shape, which is a + // machine-independent quantity, and let the clock recede to a backstop -- + // and that would buy exactness that reproduces across machines. It is not + // worth its price. A dataset is hundreds of characters; a budget generous + // enough for the slowest one the gate admits (k=3 (9,9,9), sc=75, measured + // at 12.7 s on a 2021 desktop) is an hour of unresponsiveness in the bad + // case, for a caller who mostly wants a number back. Exactness here is a + // refinement over an already-documented approximation, so it yields. + // + // The consequence, accepted knowingly: whether a given character is scored + // exactly or by Monte Carlo depends on how fast the machine is. The + // fallback is a sampling estimate in any case, so its value was never + // machine-invariant either. `approx = "mc"` is the escape hatch that is + // stable by construction; note that `approx = "exact"` is not one, since it + // waives the gate but is still stopped by this budget. + // + // An instrumented build runs one to two orders of magnitude slower, so the + // budget would fire there on anything at all -- leaving the sanitizer + // checking the bailout path instead of the algorithm it was pointed at. + // Scale by that slowdown rather than disabling, so a genuine blowup is still + // bounded; there is no responsiveness to protect in a sanitizer run, which + // is a nightly check and not a user sitting at a prompt. + // GCC announces ASan through __SANITIZE_ADDRESS__ and clang through + // __has_feature; TS_SANITIZER_BUILD is the manual escape hatch for the + // instrumented builds that announce themselves through neither (valgrind). +#if defined(__SANITIZE_ADDRESS__) || defined(TS_SANITIZER_BUILD) +# define TS_MS_SLOW_BUILD 1 +#elif defined(__has_feature) +# if __has_feature(address_sanitizer) || __has_feature(memory_sanitizer) +# define TS_MS_SLOW_BUILD 1 +# endif +#endif +#ifdef TS_MS_SLOW_BUILD + static constexpr double TIME_BUDGET_S = 200.0; +#else static constexpr double TIME_BUDGET_S = 2.0; +#endif std::chrono::steady_clock::time_point start_time; bool budget_exceeded = false; // Set when we bail because a memo table reached its reserved capacity (as @@ -1315,8 +1354,19 @@ class SolverT { LnRootedCache& lnr) : D(D_), pairs(p), presentBits(presentBits_), lnRooted(lnr) { - logB_cache.reserve(8192); // OAFlatMap: capacity 16384, load <= 0.5 - logPVec_idx.reserve(4096); // OAFlatMap: capacity 8192, load <= 0.5 + // Sized against the worst character `.MS_SC_THRESHOLD` admits to this + // solver, measured at the entry high-water mark rather than guessed: + // + // k=5 (2,2,2,2,1) sc=35 logB 142 logPVec 4990 + // k=4 (4,3,3,3) sc=50 logB 305 logPVec 9555 + // k=3 (8,7,5) sc=42 logB 422 logPVec 12047 + // k=3 (9,9,9) sc=75 logB 990 logPVec 27951 + // + // logPVec_idx previously reserved 4096, so `at_capacity()` bailed on every + // one of them: the exact solver returned NA and every multistate character + // the gate admits fell back to Monte Carlo without the caller asking. + logB_cache.reserve(8192); // OAFlatMap: capacity 16384, bails above 8192 + logPVec_idx.reserve(32768); // OAFlatMap: capacity 65536, bails above 32768 logRD_cache.reserve(1024); validDraws_cache.reserve(256); @@ -1584,7 +1634,7 @@ class Solver { double b = LogB(token0, states); double p = LogP(steps, states, token0); double val; - if (!(p > NEG_INF) || !(p > NEG_INF)) { + if (!(b > NEG_INF) || !(p > NEG_INF)) { val = NEG_INF; } else { val = b + p; diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index cc19df6e8..fb9bb0149 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -590,8 +590,8 @@ BEGIN_RCPP END_RCPP } // ts_collapse_pool -List ts_collapse_pool(List edges, NumericMatrix contrast, IntegerMatrix tip_data, IntegerVector weight, CharacterVector levels, List scoringConfig, Nullable hsjConfig, Nullable xformConfig, Nullable consSplitMatrix, Nullable consZero); -RcppExport SEXP _TreeSearch_ts_collapse_pool(SEXP edgesSEXP, SEXP contrastSEXP, SEXP tip_dataSEXP, SEXP weightSEXP, SEXP levelsSEXP, SEXP scoringConfigSEXP, SEXP hsjConfigSEXP, SEXP xformConfigSEXP, SEXP consSplitMatrixSEXP, SEXP consZeroSEXP) { +List ts_collapse_pool(List edges, NumericMatrix contrast, IntegerMatrix tip_data, IntegerVector weight, CharacterVector levels, List scoringConfig, Nullable hsjConfig, Nullable xformConfig, Nullable consSplitMatrix); +RcppExport SEXP _TreeSearch_ts_collapse_pool(SEXP edgesSEXP, SEXP contrastSEXP, SEXP tip_dataSEXP, SEXP weightSEXP, SEXP levelsSEXP, SEXP scoringConfigSEXP, SEXP hsjConfigSEXP, SEXP xformConfigSEXP, SEXP consSplitMatrixSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -604,8 +604,7 @@ BEGIN_RCPP Rcpp::traits::input_parameter< Nullable >::type hsjConfig(hsjConfigSEXP); Rcpp::traits::input_parameter< Nullable >::type xformConfig(xformConfigSEXP); Rcpp::traits::input_parameter< Nullable >::type consSplitMatrix(consSplitMatrixSEXP); - Rcpp::traits::input_parameter< Nullable >::type consZero(consZeroSEXP); - rcpp_result_gen = Rcpp::wrap(ts_collapse_pool(edges, contrast, tip_data, weight, levels, scoringConfig, hsjConfig, xformConfig, consSplitMatrix, consZero)); + rcpp_result_gen = Rcpp::wrap(ts_collapse_pool(edges, contrast, tip_data, weight, levels, scoringConfig, hsjConfig, xformConfig, consSplitMatrix)); return rcpp_result_gen; END_RCPP } @@ -856,3 +855,18 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// ts_random_constrained_tree +IntegerMatrix ts_random_constrained_tree(NumericMatrix contrast, IntegerMatrix tip_data, IntegerVector weight, CharacterVector levels, Nullable consSplitMatrix); +RcppExport SEXP _TreeSearch_ts_random_constrained_tree(SEXP contrastSEXP, SEXP tip_dataSEXP, SEXP weightSEXP, SEXP levelsSEXP, SEXP consSplitMatrixSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< NumericMatrix >::type contrast(contrastSEXP); + Rcpp::traits::input_parameter< IntegerMatrix >::type tip_data(tip_dataSEXP); + Rcpp::traits::input_parameter< IntegerVector >::type weight(weightSEXP); + Rcpp::traits::input_parameter< CharacterVector >::type levels(levelsSEXP); + Rcpp::traits::input_parameter< Nullable >::type consSplitMatrix(consSplitMatrixSEXP); + rcpp_result_gen = Rcpp::wrap(ts_random_constrained_tree(contrast, tip_data, weight, levels, consSplitMatrix)); + return rcpp_result_gen; +END_RCPP +} diff --git a/src/TreeSearch-init.c b/src/TreeSearch-init.c index ceabefc71..66903e2d7 100644 --- a/src/TreeSearch-init.c +++ b/src/TreeSearch-init.c @@ -60,7 +60,8 @@ extern SEXP _TreeSearch_ts_ev_cache_key_probe(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP extern SEXP _TreeSearch_ts_ls_fit(SEXP, SEXP, SEXP, SEXP); extern SEXP _TreeSearch_ts_ls_search(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _TreeSearch_ts_collapsed_flags_debug(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); -extern SEXP _TreeSearch_ts_collapse_pool(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP _TreeSearch_ts_collapse_pool(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP _TreeSearch_ts_random_constrained_tree(SEXP, SEXP, SEXP, SEXP, SEXP); static const R_CallMethodDef callMethods[] = { {"_TreeSearch_nni", (DL_FUNC) &_TreeSearch_nni, 3}, @@ -116,7 +117,8 @@ static const R_CallMethodDef callMethods[] = { {"_TreeSearch_ts_ls_fit", (DL_FUNC) &_TreeSearch_ts_ls_fit, 4}, {"_TreeSearch_ts_ls_search", (DL_FUNC) &_TreeSearch_ts_ls_search, 6}, {"_TreeSearch_ts_collapsed_flags_debug", (DL_FUNC) &_TreeSearch_ts_collapsed_flags_debug, 6}, - {"_TreeSearch_ts_collapse_pool", (DL_FUNC) &_TreeSearch_ts_collapse_pool, 10}, + {"_TreeSearch_ts_collapse_pool", (DL_FUNC) &_TreeSearch_ts_collapse_pool, 9}, + {"_TreeSearch_ts_random_constrained_tree", (DL_FUNC) &_TreeSearch_ts_random_constrained_tree, 5}, {NULL, NULL, 0} }; diff --git a/src/expected_mi.cpp b/src/expected_mi.cpp index 3e02b6e00..c759a5547 100644 --- a/src/expected_mi.cpp +++ b/src/expected_mi.cpp @@ -6,27 +6,39 @@ #include using namespace Rcpp; -#define MAX_FACTORIAL_LOOKUP 8192 -static double log2_factorial_table[MAX_FACTORIAL_LOOKUP + 1]; -static const double LOG2_E = 1.4426950408889634; - -__attribute__((constructor)) -void initialize_factorial_cache() { - log2_factorial_table[0] = 0.0; - for (int i = 1; i <= MAX_FACTORIAL_LOOKUP; i++) { - log2_factorial_table[i] = log2_factorial_table[i - 1] + std::log2(i); - } +namespace { + +constexpr int MAX_FACTORIAL_LOOKUP = 8192; +constexpr double LOG2_E = 1.4426950408889634; + +// Block-scope static: C++17 guarantees the initialization runs exactly once +// even if several threads reach it together. +const std::vector& log2_factorial_table() { + static const std::vector table = []() { + std::vector t(MAX_FACTORIAL_LOOKUP + 1); + t[0] = 0.0; + for (int i = 1; i <= MAX_FACTORIAL_LOOKUP; ++i) { + t[i] = t[i - 1] + std::log2(i); + } + return t; + }(); + return table; } // Fast lookup with bounds checking inline double l2factorial(int n) { + if (n < 0) { + Rcpp::stop("Factorial undefined for negative arguments."); + } if (n <= MAX_FACTORIAL_LOOKUP) { - return log2_factorial_table[n]; + return log2_factorial_table()[n]; } else { return lgamma(n + 1) * LOG2_E; } } +} // namespace + //' Expected mutual information between two partitions //' //' Computes the mutual information expected purely by chance between two @@ -54,6 +66,9 @@ inline double l2factorial(int n) { //' @export // [[Rcpp::export]] double expected_mi(const IntegerVector &ni, const IntegerVector &nj) { + if (ni.size() != 2) { + Rcpp::stop("ni must be a vector of length 2."); + } // ni and nj are vectors listing the number of entitites in each cluster // ni = {a, N-a}; nj = counts of character states const int a = ni[0]; @@ -77,36 +92,63 @@ double expected_mi(const IntegerVector &ni, const IntegerVector &nj) { if (kmin > kmax) continue; const double log2mj = std::log2(static_cast(mj)); - - // compute P(K=kmin) - double log2P = (l2factorial(mj) - l2factorial(kmin) - l2factorial(mj - kmin)) - + (l2factorial(N - mj) - l2factorial(a - kmin) - l2factorial(N - mj - (a - kmin))) - - log2_denom; - double Pk = std::pow(2.0, log2P); - - for (int k = kmin; k <= kmax; ++k) { - if (Pk > 0.0) { - // contribution from inside the split - if (k > 0) { - double mi_in = std::log2(static_cast(k)) + log2N - (log2a + log2mj); - emi += (static_cast(k) * invN) * mi_in * Pk; - } - // contribution from outside the split - int kout = mj - k; - if (kout > 0) { - double mi_out = std::log2(static_cast(kout)) + log2N - (log2Na + log2mj); - emi += (static_cast(kout) * invN) * mi_out * Pk; - } - } - // Update P(k) → P(k+1) - if (k < kmax) { - double numer = static_cast((mj - k) * (a - k)); - double denom = static_cast((k + 1) * (N - mj - a + k + 1)); - Pk *= numer / denom; - } + + // Mutual information contributed by an overlap of k, per unit probability + const auto cell_mi = [&](int k) { + double contribution = 0.0; + // contribution from inside the split + if (k > 0) { + double mi_in = std::log2(static_cast(k)) + log2N - (log2a + log2mj); + contribution += (static_cast(k) * invN) * mi_in; } + // contribution from outside the split + const int kout = mj - k; + if (kout > 0) { + double mi_out = std::log2(static_cast(kout)) + log2N - (log2Na + log2mj); + contribution += (static_cast(kout) * invN) * mi_out; + } + return contribution; + }; + + // Anchor the recurrence at the mode of the hypergeometric. P(K = kmode) + // is the largest of at most N + 1 probabilities summing to one, so it is + // always representable; P(K = kmin) is not — at N = 1200 it is around + // 2^-1197, and a recurrence seeded with the zero it underflows to stays + // zero for every remaining k. + const int kmode = std::min(kmax, std::max(kmin, static_cast( + (static_cast(mj) + 1.0) * (static_cast(a) + 1.0) / + (static_cast(N) + 2.0)))); + + const double log2Pmode = + (l2factorial(mj) - l2factorial(kmode) - l2factorial(mj - kmode)) + + (l2factorial(N - mj) - l2factorial(a - kmode) + - l2factorial(N - mj - (a - kmode))) + - log2_denom; + const double Pmode = std::exp2(log2Pmode); + + emi += cell_mi(kmode) * Pmode; + + // Walk down: P(k - 1) = P(k) * k(N - mj - a + k) / ((mj - k + 1)(a - k + 1)) + double Pk = Pmode; + for (int k = kmode; k > kmin; --k) { + Pk *= (static_cast(k) * (N - mj - a + k)) / + (static_cast(mj - k + 1) * (a - k + 1)); + // The distribution is unimodal, so once the tail underflows every + // remaining term is likewise negligible. + if (!(Pk > 0.0)) break; + emi += cell_mi(k - 1) * Pk; + } + + // Walk up: P(k + 1) = P(k) * (mj - k)(a - k) / ((k + 1)(N - mj - a + k + 1)) + Pk = Pmode; + for (int k = kmode; k < kmax; ++k) { + Pk *= (static_cast(mj - k) * (a - k)) / + (static_cast(k + 1) * (N - mj - a + k + 1)); + if (!(Pk > 0.0)) break; + emi += cell_mi(k + 1) * Pk; + } } - + return emi; } @@ -116,34 +158,45 @@ std::string mi_key(IntegerVector ni, IntegerVector nj) { Rcpp::stop("ni must be a vector of length 2."); } - std::vector ni_vals = {static_cast(ni[0]), - static_cast(ni[1])}; + // 32 bits spans the whole of `int`, so distinct block sizes always give + // distinct keys. A narrower code aliases: encoded in 16 bits, block sizes + // differing by a multiple of 65536 shared a key, and the cache then served + // one partition's expected mutual information for the other's. + std::vector ni_vals = {static_cast(ni[0]), + static_cast(ni[1])}; std::sort(ni_vals.begin(), ni_vals.end()); - - std::vector nj_vals; + + std::vector nj_vals; nj_vals.reserve(nj.size()); for (int val : nj) { - nj_vals.push_back(static_cast(val)); + nj_vals.push_back(static_cast(val)); } std::sort(nj_vals.begin(), nj_vals.end()); - - // Encode each uint16_t as 4 hex characters — no R allocation needed + + // Encode each value as 8 hex characters — no R allocation needed. Sizing + // the string up front and writing through a pointer beats appending to a + // reserved string, which re-checks capacity on every character. static const char hex[] = "0123456789abcdef"; - std::string key; - key.reserve((2 + nj_vals.size()) * 4); - - for (uint16_t v : ni_vals) { - key += hex[(v >> 12) & 0xF]; - key += hex[(v >> 8) & 0xF]; - key += hex[(v >> 4) & 0xF]; - key += hex[(v) & 0xF]; + std::string key((2 + nj_vals.size()) * 8, '0'); + char *out = &key[0]; + + const auto write_hex = [&out](uint32_t v) { + out[0] = hex[(v >> 28) & 0xF]; + out[1] = hex[(v >> 24) & 0xF]; + out[2] = hex[(v >> 20) & 0xF]; + out[3] = hex[(v >> 16) & 0xF]; + out[4] = hex[(v >> 12) & 0xF]; + out[5] = hex[(v >> 8) & 0xF]; + out[6] = hex[(v >> 4) & 0xF]; + out[7] = hex[(v) & 0xF]; + out += 8; + }; + for (uint32_t v : ni_vals) { + write_hex(v); } - for (uint16_t v : nj_vals) { - key += hex[(v >> 12) & 0xF]; - key += hex[(v >> 8) & 0xF]; - key += hex[(v >> 4) & 0xF]; - key += hex[(v) & 0xF]; + for (uint32_t v : nj_vals) { + write_hex(v); } - + return key; } diff --git a/src/quartet_concordance.cpp b/src/quartet_concordance.cpp index 0f338be6f..107e6ea55 100644 --- a/src/quartet_concordance.cpp +++ b/src/quartet_concordance.cpp @@ -24,7 +24,13 @@ List quartet_concordance(const LogicalMatrix splits, const IntegerMatrix charact for (int t = 0; t < n_taxa; ++t) { int state = characters(t, c); char_col[t] = state; - if (!IntegerVector::is_na(state) && state > max_state) max_state = state; + if (!IntegerVector::is_na(state)) { + // State codes index n0 / n1 directly + if (state < 0) { + Rcpp::stop("`characters` must contain non-negative state codes."); + } + if (state > max_state) max_state = state; + } } // Hoist resize outside split loop: only reallocate when a new character // has states beyond the current buffer capacity. diff --git a/src/rearrange.cpp b/src/rearrange.cpp index 5d4adb6b4..2c6a1c68a 100644 --- a/src/rearrange.cpp +++ b/src/rearrange.cpp @@ -332,8 +332,59 @@ inline IntegerMatrix fuse(const IntegerMatrix& tree_bits, return TreeTools::preorder_edges_and_nodes(new_tree(_, 0), new_tree(_, 1)); } +// Append every move that bisects the root edge -- i.e. tip 1's pendant edge, +// which the tip-1-rooted representation splits into edges 1 and 2. +// +// Bisecting it leaves tip 1 alone on one side. A single vertex admits no +// re-rooting, so the only freedom is where to re-root the fragment, and each +// choice gives the tree in which tip 1 attaches there. SPR and TBR therefore +// coincide on this one edge, and all_spr() and all_tbr() share this code so +// that they cannot silently diverge again (agent-issues/TreeSearch#147). +inline void push_root_edge_moves(List &ret, + const IntegerMatrix &two_bits, + const int16 break_child, + const int16 fragment_root, + const int16 fragment_min_edge, + const int16 fragment_max_edge, + unique_ptr &left_edge, + unique_ptr &parent_edge, + const int16 n_tip) { + const int16 + fragment_base_right = 2, + fragment_base_left = get_child(left_edge, fragment_root, n_tip) + ; -// Assumptions: + for (int16 insertion_point = fragment_min_edge + 2; + insertion_point != fragment_max_edge + 1; insertion_point++) { + if (insertion_point == fragment_base_left) { + continue; + } + + int16 invert_next = insertion_point; + IntegerMatrix rerooted = clone(two_bits); + + rerooted(invert_next, 0) = break_child; // Borrow fragment-root node id + rerooted(invert_next, 1) = two_bits(invert_next, 0); + + do { + invert_next = edge_above(two_bits(invert_next, 0), parent_edge); + rerooted(invert_next, 0) = two_bits(invert_next, 1); + rerooted(invert_next, 1) = two_bits(invert_next, 0); + } while (two_bits(invert_next, 0) != fragment_root); + + const bool new_root_on_right = invert_next == fragment_base_right; + const int16 repurposed_edge = new_root_on_right ? + fragment_base_left : + fragment_base_right; + rerooted(invert_next, 1) = two_bits(repurposed_edge, 1); + rerooted(repurposed_edge, 1) = two_bits(insertion_point, 1); + rerooted = TreeTools::preorder_edges_and_nodes(rerooted(_, 0), rerooted(_, 1)); + ret.push_back(rerooted); + } +} + + +// Assumptions: // * Tree is bifurcating, in preorder; first two edges have root as parent. // [[Rcpp::export]] List all_spr (const IntegerMatrix edge, @@ -433,43 +484,14 @@ List all_spr (const IntegerMatrix edge, get_child(right_node, break_parent, n_tip) : get_child(left_node, break_parent, n_tip); if (break_edge == 1) { - const int16 - fragment_base_right = 2, - fragment_base_left = get_child(left_edge, fragment_root, n_tip); - ; - - for (int16 insertion_point = fragment_min_edge + 2; - insertion_point != fragment_max_edge + 1; insertion_point++) { - if (insertion_point == fragment_base_left) { - continue; - } - - int16 invert_next = insertion_point; - IntegerMatrix rerooted = clone(two_bits); - - rerooted(invert_next, 0) = break_child; // Borrow fragment-root node id - rerooted(invert_next, 1) = two_bits(invert_next, 0); - - do { - invert_next = edge_above(two_bits(invert_next, 0), parent_edge); - rerooted(invert_next, 0) = two_bits(invert_next, 1); - rerooted(invert_next, 1) = two_bits(invert_next, 0); - } while (two_bits(invert_next, 0) != fragment_root); - - const bool new_root_on_right = invert_next == fragment_base_right; - const int16 repurposed_edge = new_root_on_right ? - fragment_base_left : - fragment_base_right; - rerooted(invert_next, 1) = two_bits(repurposed_edge, 1); - rerooted(repurposed_edge, 1) = two_bits(insertion_point, 1); - rerooted = TreeTools::preorder_edges_and_nodes(rerooted(_, 0), rerooted(_, 1)); - ret.push_back(rerooted); - } + push_root_edge_moves(ret, two_bits, break_child, fragment_root, + fragment_min_edge, fragment_max_edge, left_edge, + parent_edge, n_tip); } else { for (int16 graft_edge = n_edge - 1; graft_edge; graft_edge--) { if (graft_edge == fragment_max_edge) { graft_edge = fragment_min_edge; - continue; + continue; } else if (broken_on_left && graft_edge == get_child(right_edge, break_parent, n_tip)) { graft_edge = edge_above(break_parent, parent_edge); continue; @@ -507,10 +529,14 @@ List all_tbr (const IntegerMatrix edge, if (break_order.length()) { break_seq = clone(break_order); } else { - IntegerVector tmp (n_edge - 2); + // Edges 1 and 2 are the two halves of tip 1's pendant edge in the + // tip-1-rooted representation, so breaking edges 2..n_edge visits each of + // the 2n-3 edges of the unrooted tree exactly once. Starting at 3 would + // skip that pendant edge -- and with it every move that relocates tip 1. + IntegerVector tmp (n_edge - 1); break_seq = tmp; - for (int16 i = n_edge - 2; i--; ) { - break_seq[i] = i + 3; + for (int16 i = n_edge - 1; i--; ) { + break_seq[i] = i + 2; } } @@ -574,11 +600,20 @@ List all_tbr (const IntegerMatrix edge, two_bits(edge_above(break_parent, parent_edge), 1) = broken_on_left ? get_child(right_node, break_parent, n_tip) : get_child(left_node, break_parent, n_tip); - if (fragment_leaves < 3) { + if (break_edge == 1) { + // TBR on the root edge is SPR on the root edge: the severed tip 1 has no + // re-rooting freedom. Handled before the fragment_leaves test, which + // would otherwise route this break into the general TBR branch, where + // the fragment spans every edge but the first and the graft loop + // consequently finds nowhere to reattach. + push_root_edge_moves(ret, two_bits, break_child, fragment_root, + fragment_min_edge, fragment_max_edge, left_edge, + parent_edge, n_tip); + } else if (fragment_leaves < 3) { for (int16 graft_edge = n_edge - 1; graft_edge; graft_edge--) { if (graft_edge == fragment_max_edge) { graft_edge = fragment_min_edge; - continue; + continue; } else if (broken_on_left && graft_edge == get_child(right_edge, break_parent, n_tip)) { graft_edge = edge_above(break_parent, parent_edge); continue; diff --git a/src/ts_constraint.cpp b/src/ts_constraint.cpp index 114dc543b..881e7e492 100644 --- a/src/ts_constraint.cpp +++ b/src/ts_constraint.cpp @@ -25,31 +25,33 @@ ConstraintData build_constraint( cd.split_tips.resize( static_cast(n_splits) * cd.n_words, 0ULL); + cd.split_zeros.resize( + static_cast(n_splits) * cd.n_words, 0ULL); cd.constraint_node.assign(n_splits, -1); + cd.constraint_node_hi.assign(n_splits, -1); cd.constraint_complement.assign(n_splits, 0); - // Pack split_matrix rows into bitmasks. + // Pack split_matrix rows into a pair of bitmasks. // split_matrix is column-major (from R): element [s, t] is at - // index s + n_splits * t. + // index s + n_splits * t. 1 -> "together" group, 0 -> "apart" group, + // anything else (NA_INTEGER) -> free, in neither mask (#54). for (int s = 0; s < n_splits; ++s) { - uint64_t* mask = &cd.split_tips[static_cast(s) * cd.n_words]; + uint64_t* ones = &cd.split_tips[static_cast(s) * cd.n_words]; + uint64_t* zeros = &cd.split_zeros[static_cast(s) * cd.n_words]; for (int t = 0; t < n_tips; ++t) { - if (split_matrix[s + n_splits * t]) { - int w = t / 64; - int b = t % 64; - mask[w] |= (1ULL << b); - } + const int v = split_matrix[s + n_splits * t]; + if (v != 1 && v != 0) continue; // free tip + int w = t / 64; + int b = t % 64; + (v == 1 ? ones : zeros)[w] |= (1ULL << b); } - // Canonicalize: tip 0 must be on the "outside" (bit 0 = 0). - // If bit 0 is set, flip the entire mask. - if (mask[0] & 1ULL) { + // Canonicalize: tip 0 must be outside split_tips (bit 0 = 0). The two + // groups of a bipartition are interchangeable, so SWAP them rather than + // complementing either — complementing would swallow the free tips into + // the "apart" group and reinstate the exact-clade reading. + if (ones[0] & 1ULL) { for (int w = 0; w < cd.n_words; ++w) { - mask[w] = ~mask[w]; - } - // Clear bits beyond n_tips - int remainder = n_tips % 64; - if (remainder > 0) { - mask[cd.n_words - 1] &= (1ULL << remainder) - 1; + std::swap(ones[w], zeros[w]); } } } @@ -83,7 +85,23 @@ ConstraintData build_constraint_from_bitsets( // Copy split data size_t total = static_cast(n_splits) * words_per_split; cd.split_tips.assign(split_bits, split_bits + total); + // These splits come from pool bipartitions, which partition every tip: there + // are no free tips, so the "apart" group is exactly the complement and the + // free-taxa machinery collapses back to the exact-clade test (#54). + cd.split_zeros.assign(total, 0ULL); + { + const int rem = n_tips % 64; + const uint64_t top = rem ? ((1ULL << rem) - 1ULL) : ~0ULL; + for (int s = 0; s < n_splits; ++s) { + const size_t off = static_cast(s) * words_per_split; + for (int w = 0; w < words_per_split; ++w) { + cd.split_zeros[off + w] = ~cd.split_tips[off + w]; + if (w == words_per_split - 1) cd.split_zeros[off + w] &= top; + } + } + } cd.constraint_node.assign(n_splits, -1); + cd.constraint_node_hi.assign(n_splits, -1); cd.constraint_complement.assign(n_splits, 0); int n_node = 2 * n_tips - 1; @@ -155,26 +173,71 @@ std::vector compute_node_tips(const TreeState& tree, int n_words) // Map constraint nodes: find which internal node holds each split // ========================================================================= -// Width mask for the highest word of a tip bitmask: node tip sets carry zeros -// above tip n_tip - 1, so a *complemented* split mask has to be trimmed to the -// same width before it can be compared with one. -static inline uint64_t tip_mask_top_word(int n_tip) { - const int rem = n_tip % 64; - return rem ? ((1ULL << rem) - 1ULL) : ~0ULL; -} - -// Does node `node`'s descendant tip set equal `split` (complement = false) or -// the complement of `split` over tips 0..n_tip-1 (complement = true)? -static inline bool node_matches_split( - const uint64_t* nd, const uint64_t* split, int n_words, - uint64_t top_word, bool complement) +// node_displays_split() — the shared "does this node display the split" +// predicate — lives in ts_constraint.h, so the Wagner build and the collapse +// pass answer the question with the same code rather than a lookalike. + +// Tightest and highest node displaying `together` | `apart`, or {-1, -1}. +// +// Every node that displays the split covers `together`, so all of them are +// ancestors of LCA(together) and they form one unbroken upward chain: each +// step up adds tips, and the moment a step adds a tip of `apart` the chain +// ends (higher nodes keep it). So the tight end is the first match in an +// order that visits descendants before ancestors, and the high end is found by +// walking parents from there. Tips are candidates too, for the single-taxon +// group whose "clade" is the tip itself — tree.postorder holds only internal +// nodes, so scanning it alone left those splits unmapped, which +// regraft_violates_constraint() reads as "already violating". +static void find_displaying_chain( + const TreeState& tree, const std::vector& node_tips, + const uint64_t* together, const uint64_t* apart, int n_words, + int& lo, int& hi) { + lo = -1; + hi = -1; + + // Tip candidates without scanning the tips: a tip's set is the singleton + // {t}, so it can only cover `together` when `together` is {t} itself (or, + // degenerately, empty — then the lowest tip outside `apart` wins). + int n_together = 0, lone_together = -1; for (int w = 0; w < n_words; ++w) { - uint64_t want = complement ? ~split[w] : split[w]; - if (complement && w == n_words - 1) want &= top_word; - if (nd[w] != want) return false; + if (together[w]) { + n_together += popcount64(together[w]); + lone_together = w * 64 + ctz64(together[w]); + } + } + if (n_together == 1) { + const uint64_t* nd = &node_tips[static_cast(lone_together) * n_words]; + if (node_displays_split(nd, together, apart, n_words)) lo = lone_together; + } else if (n_together == 0) { + for (int w = 0; w < n_words && lo < 0; ++w) { + uint64_t free_here = ~apart[w]; + const int lim = tree.n_tip - w * 64; + if (lim < 64) free_here &= (1ULL << lim) - 1ULL; + if (free_here) lo = w * 64 + ctz64(free_here); + } + } + if (lo < 0) { + for (int node : tree.postorder) { + const uint64_t* nd = &node_tips[static_cast(node) * n_words]; + if (node_displays_split(nd, together, apart, n_words)) { lo = node; break; } + } + } + if (lo < 0) return; + + // Walk to the top of the chain. Bounded by n_node rather than trusting the + // root to be reachable: impose_one_pass() calls this on trees it is midway + // through repairing, and a parent-ascending loop over a corrupt parent[] is + // exactly the hang T-327/T-333 had to be defended against elsewhere. + hi = lo; + const int root = tree.n_tip; + for (int guard = 0; guard < tree.n_node && hi != root; ++guard) { + const int up = tree.parent[hi]; + if (up < 0 || up >= tree.n_node || up == hi) break; + const uint64_t* nd = &node_tips[static_cast(up) * n_words]; + if (!node_displays_split(nd, together, apart, n_words)) break; + hi = up; } - return true; } void map_constraint_nodes(const TreeState& tree, ConstraintData& cd) @@ -182,7 +245,6 @@ void map_constraint_nodes(const TreeState& tree, ConstraintData& cd) if (!cd.active) return; auto node_tips = compute_node_tips(tree, cd.n_words); - const uint64_t top_word = tip_mask_top_word(tree.n_tip); // For each constraint split, find the node that displays it. // @@ -190,38 +252,35 @@ void map_constraint_nodes(const TreeState& tree, ConstraintData& cd) // a rooted subtree, so the split is displayed whenever EITHER side is a // clade. Exactly one of the two is, except when the split is the root's own // bipartition (then both are): for an edge (parent(v), v) with v != root the - // two sides are desc(v) and its complement, so a tree displays A|B iff some - // node's tip set equals A or equals B. build_constraint() canonicalises A so - // that tip 0 is outside it, which makes A the clade side only when tip 0 sits - // on the root's own edge -- true of a tip-0-rooted tree and of nothing else. - // Testing the complement as well is what makes this mapping rooting-agnostic, - // and it costs one extra scan only for splits that used to map to -1 (which - // regraft_violates_constraint reads as "tree already violates", rejecting - // every move). Phase 1 is run to completion first so that every tree which - // mapped successfully before maps to exactly the same node now. + // two sides are desc(v) and its complement. build_constraint() canonicalises + // A so that tip 0 is outside it, which makes A the clade side only when tip 0 + // sits on the root's own edge -- true of a tip-0-rooted tree and of nothing + // else. Testing the complement as well is what makes this mapping + // rooting-agnostic, and it costs one extra scan only for splits that used to + // map to -1 (which regraft_violates_constraint reads as "tree already + // violates", rejecting every move). Phase 1 is run to completion first so + // that every tree which mapped successfully before maps to exactly the same + // node now. + // + // #54: "is a clade" is the free-taxa reading, not set equality -- see + // node_displays_split(). The chain of displaying nodes is recorded at both + // ends, because a regraft that must land INSIDE the constrained group may use + // the whole chain while one that must land outside may not; see + // regraft_violates_constraint(). for (int s = 0; s < cd.n_splits; ++s) { - const uint64_t* split = &cd.split_tips[static_cast(s) * cd.n_words]; - cd.constraint_node[s] = -1; + const uint64_t* ones = &cd.split_tips[static_cast(s) * cd.n_words]; + const uint64_t* zeros = &cd.split_zeros[static_cast(s) * cd.n_words]; cd.constraint_complement[s] = 0; - for (int node : tree.postorder) { - const uint64_t* nd = &node_tips[static_cast(node) * cd.n_words]; - if (node_matches_split(nd, split, cd.n_words, top_word, false)) { - cd.constraint_node[s] = node; - break; - } - } - if (cd.constraint_node[s] >= 0) continue; - - // Phase 2: the tip-0 side is the clade in this rooting. - for (int node : tree.postorder) { - const uint64_t* nd = &node_tips[static_cast(node) * cd.n_words]; - if (node_matches_split(nd, split, cd.n_words, top_word, true)) { - cd.constraint_node[s] = node; - cd.constraint_complement[s] = 1; - break; - } + int lo = -1, hi = -1; + find_displaying_chain(tree, node_tips, ones, zeros, cd.n_words, lo, hi); + if (lo < 0) { + // Phase 2: the tip-0 side is the clade in this rooting. + find_displaying_chain(tree, node_tips, zeros, ones, cd.n_words, lo, hi); + if (lo >= 0) cd.constraint_complement[s] = 1; } + cd.constraint_node[s] = lo; + cd.constraint_node_hi[s] = hi; } } @@ -318,15 +377,41 @@ void classify_clip_constraints(const TreeState& tree, int clip_node, compute_clip_tip_mask(tree, clip_node, cd.clip_tip_mask); + // "Inside" means the clip holds a tip of the group that must stay together; + // "outside", a tip of the group that must stay apart from it. A clip made + // only of FREE tips is in neither, and lands here as UNCONSTRAINED — the + // whole point of the free-taxa reading, and what lets such a clip be + // regrafted anywhere without breaking the separating edge (#54). Reading + // "outside" as ~split, which is what this did before free tips existed, + // pinned every free tip to the far side of the constraint. for (int s = 0; s < cd.n_splits; ++s) { - const uint64_t* split = + const uint64_t* ones = &cd.split_tips[static_cast(s) * cd.n_words]; + const uint64_t* zeros = + &cd.split_zeros[static_cast(s) * cd.n_words]; + + // The clip carries the constraint with it: its own tip set covers one + // group and holds none of the other. Wherever it is regrafted, the node + // at the attachment point has exactly the clip's tip set, so the split + // stays displayed — and TBR's rerooting of the clip cannot change that, + // since the set is the same however the subtree hangs. Testing this + // first is what unpins a clip that contains the whole displaying chain: + // the anchor is then inside the clipped subtree, no surviving `below` can + // be its descendant, and the MUST_INSIDE test below would reject every + // regraft of a subtree that is in fact free to go anywhere. + if (node_displays_split(cd.clip_tip_mask.data(), ones, zeros, + cd.n_words) || + node_displays_split(cd.clip_tip_mask.data(), zeros, ones, + cd.n_words)) { + cd.clip_zones[s] = ClipZone::UNCONSTRAINED; + continue; + } bool any_inside = false; bool any_outside = false; for (int w = 0; w < cd.n_words; ++w) { - if (cd.clip_tip_mask[w] & split[w]) any_inside = true; - if (cd.clip_tip_mask[w] & ~split[w]) any_outside = true; + if (cd.clip_tip_mask[w] & ones[w]) any_inside = true; + if (cd.clip_tip_mask[w] & zeros[w]) any_outside = true; if (any_inside && any_outside) break; } @@ -339,23 +424,10 @@ void classify_clip_constraints(const TreeState& tree, int clip_node, bool rest_has_in = false; bool rest_has_out = false; for (int w = 0; w < cd.n_words; ++w) { - uint64_t rest = ~cd.clip_tip_mask[w]; - // Mask out bits beyond n_tips in the last word - if (w == cd.n_words - 1) { - int remainder = tree.n_tip % 64; - if (remainder > 0) - rest &= (1ULL << remainder) - 1; - } - if (rest & split[w]) rest_has_in = true; - if (rest & ~split[w]) { - uint64_t out_bits = ~split[w]; - if (w == cd.n_words - 1) { - int remainder = tree.n_tip % 64; - if (remainder > 0) - out_bits &= (1ULL << remainder) - 1; - } - if (rest & out_bits) rest_has_out = true; - } + const uint64_t rest = ~cd.clip_tip_mask[w]; + // No width mask needed: ones/zeros carry zeros above tip n_tip - 1. + if (rest & ones[w]) rest_has_in = true; + if (rest & zeros[w]) rest_has_out = true; } if (rest_has_in && rest_has_out) { cd.clip_zones[s] = ClipZone::FORBIDDEN; @@ -396,13 +468,14 @@ bool regraft_violates_constraint(int below, // can preserve this split — reject unconditionally. if (cd.clip_zones[s] == ClipZone::FORBIDDEN) return true; - int cn = cd.constraint_node[s]; - if (cn < 0) { + const int cn_lo = cd.constraint_node[s]; + if (cn_lo < 0) { // Constraint genuinely not displayed by the current tree (both sides // tested — see map_constraint_nodes). Reject all moves to avoid // entrenching a bad state. return true; } + const int cn_hi = cd.constraint_node_hi[s]; // Which side of the split does cn's subtree hold? Under the canonical // orientation it is the split itself; in a rooting where only the tip-0 @@ -414,18 +487,27 @@ bool regraft_violates_constraint(int below, const ClipZone zone_out = cd.constraint_complement[s] ? ClipZone::MUST_INSIDE : ClipZone::MUST_OUTSIDE; - // Is `below` a descendant of cn (= inside the mapped clade)? - bool inside = is_ancestor_or_equal(cn, below, - cd.dfs_entry, cd.dfs_exit); - - if (cd.clip_zones[s] == zone_in && !inside) { + // The two ends of the displaying chain answer two different questions, and + // each wants the end that permits most (#54; with no free tips the chain + // is one node long and both reduce to the pre-#54 test): + // + // * a clip that must land INSIDE carries tips of the together-group but + // none of the apart-group, so anywhere within the HIGHEST displaying + // node keeps that node covering the group and free of the other. Only + // above cn_hi does the enclosing node pick up an apart-group tip. + // * a clip that must land OUTSIDE carries apart-group tips, so it may go + // anywhere that leaves some displaying node intact — and the TIGHTEST + // is the one hardest to contaminate, so it forbids least. + if (cd.clip_zones[s] == zone_in && + !is_ancestor_or_equal(cn_hi, below, cd.dfs_entry, cd.dfs_exit)) { return true; } // Exclude the boundary edge (above_cn, cn): regrafting an outside-only // clade just above the constraint clade makes it a sibling of that clade, // preserving monophyly. Only reject if the clade would land *strictly // inside* the constraint clade. - if (cd.clip_zones[s] == zone_out && inside && below != cn) { + if (cd.clip_zones[s] == zone_out && below != cn_lo && + is_ancestor_or_equal(cn_lo, below, cd.dfs_entry, cd.dfs_exit)) { return true; } } @@ -715,24 +797,21 @@ static int impose_one_pass(TreeState& tree, ConstraintData& cd, // already displayed every constraint, spending up to n_tip / 4 + 2 arbitrary // SPR moves on it. That mattered most at ts_nni_perturb.cpp's unconditional // impose_constraint() call, which runs after every perturbation cycle. - // The repair below still aims at making the canonical side the clade, which - // displays the split either way. - const uint64_t top_word = tip_mask_top_word(tree.n_tip); + // "Is a clade" is the free-taxa reading (#54), so a tree that satisfies + // what `constraint` documents is likewise left alone. The repair below aims + // at making the canonical side a clade, which displays the split either way. std::vector violated; for (int s = 0; s < cd.n_splits; ++s) { - const uint64_t* split = + const uint64_t* ones = &cd.split_tips[static_cast(s) * n_words]; - bool found = false; - for (int node : tree.postorder) { - const uint64_t* nd = - &node_tips[static_cast(node) * n_words]; - if (node_matches_split(nd, split, n_words, top_word, false) || - node_matches_split(nd, split, n_words, top_word, true)) { - found = true; - break; - } + const uint64_t* zeros = + &cd.split_zeros[static_cast(s) * n_words]; + int lo = -1, hi = -1; + find_displaying_chain(tree, node_tips, ones, zeros, n_words, lo, hi); + if (lo < 0) { + find_displaying_chain(tree, node_tips, zeros, ones, n_words, lo, hi); } - if (!found) violated.push_back(s); + if (lo < 0) violated.push_back(s); } if (violated.empty()) return 0; @@ -754,10 +833,25 @@ static int impose_one_pass(TreeState& tree, ConstraintData& cd, int total_moves = 0; + // Tips that keep node `nd` from displaying the split: those of the + // together-group it is missing, plus those of the apart-group it holds. + // Free tips appear in neither, so the repair never moves one (#54) — they + // may sit on whichever side they already do. + auto repair_cost = [&](const uint64_t* nd, const uint64_t* ones, + const uint64_t* zeros) { + int cost = 0; + for (int w = 0; w < n_words; ++w) { + cost += popcount64(ones[w] & ~nd[w]) + popcount64(zeros[w] & nd[w]); + } + return cost; + }; + for (size_t vi = 0; vi < violated.size(); ++vi) { int s = violated[vi]; const uint64_t* split = &cd.split_tips[static_cast(s) * n_words]; + const uint64_t* split_out = + &cd.split_zeros[static_cast(s) * n_words]; // Rebuild bitmasks after previous split's moves if (vi > 0) { @@ -765,16 +859,13 @@ static int impose_one_pass(TreeState& tree, ConstraintData& cd, node_tips = compute_node_tips(tree, n_words); } - // --- Find best candidate node (min symmetric difference) --- + // --- Find best candidate node (fewest misplaced tips) --- int best_node = -1; int best_cost = tree.n_tip + 1; for (int node : tree.postorder) { const uint64_t* nd = &node_tips[static_cast(node) * n_words]; - int cost = 0; - for (int w = 0; w < n_words; ++w) { - cost += popcount64(nd[w] ^ split[w]); - } + int cost = repair_cost(nd, split, split_out); if (cost < best_cost) { best_cost = cost; best_node = node; @@ -789,7 +880,7 @@ static int impose_one_pass(TreeState& tree, ConstraintData& cd, const uint64_t* best_nt = &node_tips[static_cast(best_node) * n_words]; for (int w = 0; w < n_words; ++w) { - move_out_mask[w] = best_nt[w] & ~split[w]; + move_out_mask[w] = best_nt[w] & split_out[w]; move_in_mask[w] = split[w] & ~best_nt[w]; } @@ -839,10 +930,7 @@ static int impose_one_pass(TreeState& tree, ConstraintData& cd, int bc = tree.n_tip + 1; for (int node : tree.postorder) { const uint64_t* nd = &nt[static_cast(node) * n_words]; - int cost = 0; - for (int w = 0; w < n_words; ++w) { - cost += popcount64(nd[w] ^ split[w]); - } + int cost = repair_cost(nd, split, split_out); if (cost < bc) { bc = cost; bn = node; } } return bn; diff --git a/src/ts_constraint.h b/src/ts_constraint.h index 44e345103..6ffd68e7b 100644 --- a/src/ts_constraint.h +++ b/src/ts_constraint.h @@ -3,10 +3,21 @@ // Topological constraint enforcement (TNT-style locked nodes). // -// A constraint is a set of splits (bipartitions). A tree satisfies the -// constraint iff every constraint split is displayed — i.e., for each -// split there is an internal node whose subtree tip set matches (after -// accounting for unconstrained taxa that may sit on either side). +// A constraint is a set of splits. Each split names two disjoint groups of +// tips — the "1" group and the "0" group of one constraint character — and any +// remaining tips are FREE: coded `?`, or absent from the constraint phyDat +// altogether. A tree satisfies the split iff some edge separates the 1 group +// from the 0 group, free tips falling on either side. That is the contract +// `?MaximizeParsimony`'s `constraint` argument documents, and since +// agent-issues/TreeSearch#54 it is the one enforced here: a node DISPLAYS the +// split when its descendant tip set is a superset of one group and disjoint +// from the other. +// +// Requiring the tip set to EQUAL a group (the pre-#54 test) is strictly +// stronger. It never returned a wrong answer, but a start tree that satisfied +// the documented contract without making either group an exact clade mapped to +// no node at all, which regraft_violates_constraint() reads as "the tree +// already violates" — freezing the replicate on its start. // // Implementation: // 1. At init: store constraint splits as tip bitmasks. @@ -36,18 +47,37 @@ struct ConstraintData { int n_splits = 0; int n_words = 0; // ceil(n_tips / 64) - // Tip bitmasks: split_tips[i * n_words .. (i+1) * n_words - 1] + // Tip bitmasks: split_tips[i * n_words .. (i+1) * n_words - 1]. + // The tips that must end up TOGETHER, on one side of some edge. // Canonical: bit 0 (tip 0) is always on the "outside" (= 0). std::vector split_tips; - // Current mapping: constraint_node[i] = the internal node whose - // subtree tips match split i in the current tree. + // The tips that must end up on the OTHER side of that edge, same layout. + // Disjoint from split_tips; the two need NOT be complements — a tip in + // neither mask is free to fall on either side (#54). When the caller + // supplies no free tips this is exactly ~split_tips, and every check below + // reduces to the pre-#54 exact-clade test. + std::vector split_zeros; + + // Current mapping: constraint_node[i] = the TIGHTEST node (tip or internal) + // that displays split i in the current tree — its descendant tip set covers + // one of the two groups and avoids the other. // -1 if not yet mapped (or the tree does not display split i). std::vector constraint_node; + // The HIGHEST node that displays split i, in the same polarity as + // constraint_node[i]; equal to it when no free tip sits directly above. + // The displaying nodes form an unbroken chain from constraint_node[i] up to + // this one (each step adds only free tips), so the two ends are all a + // regraft test needs — see regraft_violates_constraint(), which uses this + // end for "must land inside" and the tight end for "must land outside". + // -1 exactly when constraint_node[i] is. + std::vector constraint_node_hi; + // Polarity of constraint_node[i] (T-384). 0: the node's descendant tip set - // is split_tips[i] itself. 1: it is the *complement* of split_tips[i], i.e. - // the tip-0 side of the bipartition. A constraint split is an UNROOTED + // covers split_tips[i] and avoids split_zeros[i]. 1: the other way round — + // it covers split_zeros[i], the tip-0 side of the bipartition, and avoids + // split_tips[i]. A constraint split is an UNROOTED // bipartition, so a tree displays it whenever EITHER side is a rooted clade, // and which side that is depends on the rooting alone -- see // map_constraint_nodes(). Consumers that treat constraint_node[i] as "the @@ -73,9 +103,18 @@ struct ConstraintData { std::vector clip_tip_mask; // [n_words] }; -// Build ConstraintData from R-side split bitmask matrix. -// split_matrix: n_splits x n_tips, each row is 0/1 indicating split membership. -// The matrix is canonicalized so tip 0 is always "outside" (= 0). +// Build ConstraintData from R-side split membership matrix. +// split_matrix: n_splits x n_tips, column-major. Element [s, t] is +// 1 tip t is in split s's "together" group; +// 0 tip t is in split s's "apart" group; +// anything else (NA_INTEGER, as .PrepareConstraint() writes for a `?`-coded +// or unconstrained taxon) — tip t is FREE, and may fall on either side. +// A pure 0/1 matrix therefore means "no free tips", i.e. the exact-clade +// reading that predates #54; callers that build one by hand keep it. +// The two groups are swapped where needed so that tip 0 is never in +// split_tips ("outside" the canonical side) — the same invariant the Wagner +// and pool paths have always relied on, and harmless because a split is an +// unrooted bipartition whose two groups are interchangeable. ConstraintData build_constraint( const int* split_matrix, int n_splits, int n_tips); @@ -90,6 +129,29 @@ void build_constraint_posthoc( // --- Node mapping and DFS timestamps --- +// Does the edge above a node whose descendant tip set is `nd` separate +// `together` from `apart`? It does when the set covers every tip of +// `together` and holds none of `apart`; the tips in neither group are free and +// are not looked at. With `apart` the exact complement of `together` the two +// conditions force set equality, which is the exact-clade test this replaced. +// +// THE definition of "displays a constraint split", shared by every entry point +// that has to decide it: the search/TBR mapping (map_constraint_nodes), the +// Wagner build's own check (wagner_tree_displays_constraint, ts_wagner.cpp), +// and the collapse pass's branch protection (ts_collapse_pool, ts_rcpp.cpp). +// They must not drift apart: the stricter of any two would reject trees +// another searches happily, or accept ones it will not move from. +inline bool node_displays_split( + const uint64_t* nd, const uint64_t* together, const uint64_t* apart, + int n_words) +{ + for (int w = 0; w < n_words; ++w) { + if ((together[w] & ~nd[w]) != 0ULL) return false; // a required tip missing + if ((apart[w] & nd[w]) != 0ULL) return false; // an excluded tip present + } + return true; +} + // Find which internal node holds each constraint split in the current tree. // Must be called after each accepted move and at search init. void map_constraint_nodes(const TreeState& tree, ConstraintData& cd); @@ -114,9 +176,16 @@ void classify_clip_constraints(const TreeState& tree, int clip_node, // --- Per-candidate check --- -// Returns true if regrafting at edge (above, below) would violate -// any active constraint given the current clip_zones classification. +// Returns true if regrafting onto the edge whose child endpoint is `below` +// would violate any active constraint, given the current clip_zones +// classification. (Only `below` is needed: the parent endpoint of the target +// edge never changes which side of a constraint clade the clip lands on.) // Uses DFS timestamps for O(1) descendant test per constraint. +// +// Screening only. It classifies against the PRE-clip mapping, so a TBR +// rerooting can still break a split it passed; every caller must re-verify the +// applied move (map_constraint_nodes + constraint_node[s] >= 0) before +// accepting it. bool regraft_violates_constraint(int below, const ConstraintData& cd); @@ -143,9 +212,16 @@ bool violates_constraint_posthoc(const TreeState& tree, std::vector compute_node_tips(const TreeState& tree, int n_words); // Repair constraint violations by minimal SPR moves. -// After return, all constraint splits are displayed and -// update_constraint() has been called. Caller must rescore. -// Returns the number of SPR moves performed (0 if tree was valid). +// +// HEURISTIC, and it can fail: a pass bails out when the repair needs more than +// n_tip / 4 + 2 moves, individual moves are skipped when they would corrupt the +// tree (see try_move), and nothing guarantees the fixed-point is reached within +// the n_splits + 1 pass cap. The return value does NOT distinguish "repaired" +// from "gave up" -- so EVERY caller must re-verify (map_constraint_nodes, then +// constraint_node[s] >= 0 for all s) and discard the tree if it still violates. +// +// update_constraint() has been called on return. Caller must rescore. +// Returns the number of SPR moves performed (0 if tree was already valid). int impose_constraint(TreeState& tree, ConstraintData& cd); } // namespace ts diff --git a/src/ts_driven.cpp b/src/ts_driven.cpp index 7ad7ee982..3a9708eb1 100644 --- a/src/ts_driven.cpp +++ b/src/ts_driven.cpp @@ -54,16 +54,16 @@ ProgressInfo make_progress(int rep, const DrivenParams& params, // // violates_constraint_posthoc() answers that directly, but builds a whole // TreeState and scores it. For a BINARY constraint the locked-node mapping is -// much cheaper and is strictly the stronger test: it asks for the 1 group to be -// a clade exactly, excluding the taxa coded `?`, and a tree that manages that -// necessarily separates the two coded groups. So a full mapping settles the -// case the search puts us in almost every time -- every rearrangement it -// accepts is filtered on that same mapping -- and only an unmapped split pays -// for Fitch. +// much cheaper and asks exactly the same question: since #54 it maps a split to +// any node holding one whole group and none of the other, with the taxa coded +// `?` free to fall on either side, which is the separating edge itself. So a +// full mapping settles the case the search puts us in almost every time -- +// every rearrangement it accepts is filtered on that same mapping -- and only +// an unmapped split pays for Fitch. // -// With a third state the two tests diverge -- its taxa belong to no split_tips -// entry, so the character can sit above its minimum length with every split -// mapped -- and the mapping is the one to follow. It is the standard the rest +// With a third state the two tests diverge -- its taxa belong to neither group, +// so the character can sit above its minimum length with every split mapped -- +// and the mapping is the one to follow. It is the standard the rest // of the engine enforces: the locked-node filter screens rearrangements on it, // and impose_constraint() repairs to it and nothing more, so judging a capture // by the stricter Fitch check would discard every replicate of a search that diff --git a/src/ts_fitch.cpp b/src/ts_fitch.cpp index 7e8a19485..46b001b60 100644 --- a/src/ts_fitch.cpp +++ b/src/ts_fitch.cpp @@ -240,11 +240,14 @@ void fitch_incremental_uppass(TreeState& tree, const DataSet& ds, // Use reverse postorder, but only visit nodes whose ancestor's final // may have changed. We track this with a "dirty" flag per node. - // Reusable per-thread scratch (S-PROF round 3 / Tier 1): this function runs - // once per clip in the TBR hot loop, so a fresh vector here was a - // per-clip heap allocation. thread_local keeps it per-thread-safe (each - // search thread owns its TreeState); char avoids vector proxy-bit - // access in the reverse scan below. assign() reuses capacity after warmup. + // `char` (not vector) avoids proxy-bit access in the reverse scan + // below. NOTE: this was once `static thread_local` scratch (S-PROF round 3 + // / Tier 1) to avoid a per-clip heap allocation in the TBR hot loop, but the + // thread_local was removed in d6fa51293 because MinGW tears down + // thread_local vectors via emutls when each std::thread worker exits, which + // corrupted the heap. So the per-clip allocation + O(n_node) zero-fill is + // back; re-hoisting it needs a TreeState/DataSet-owned buffer (the + // char_steps_scratch / evs_false_cache pattern), NOT thread_local. std::vector dirty; dirty.assign(tree.n_node, 0); diff --git a/src/ts_rcpp.cpp b/src/ts_rcpp.cpp index 50a08ed28..9fcc11bf5 100644 --- a/src/ts_rcpp.cpp +++ b/src/ts_rcpp.cpp @@ -1730,6 +1730,15 @@ static int unpack_runtime(List rt, ts::DrivenParams& params) { } { const int n_edge = mats[0].nrow(); + // A zero-row matrix passes both checks below -- its ncol is 2, and + // every matrix agrees on nrow -- leaves `flat` empty, and then reaches + // `flat.data() + n_edge`: pointer arithmetic on a possibly-null + // pointer, undefined before C++20 and reported by neither UBSan's + // nonnull check nor hardened libstdc++. No tree has zero edges, so + // reject it here alongside the other shape checks. + if (n_edge < 1) { + stop("Each `startEdge` matrix must describe at least one edge."); + } params.start_n_edge = n_edge; params.start_edges.reserve(mats.size()); for (const IntegerMatrix& se : mats) { @@ -2255,8 +2264,7 @@ List ts_collapse_pool( List scoringConfig, Nullable hsjConfig = R_NilValue, Nullable xformConfig = R_NilValue, - Nullable consSplitMatrix = R_NilValue, - Nullable consZero = R_NilValue) + Nullable consSplitMatrix = R_NilValue) { ts::DataSet ds = unpack_scoring(contrast, tip_data, weight, levels, scoringConfig); @@ -2268,48 +2276,29 @@ List ts_collapse_pool( // must stay visible even when its branch is zero-length (it would otherwise be // contracted, leaving the result looking unconstrained). We protect every // constraint split from collapse — the unsupported NON-constraint branches - // still collapse. Store each constraint split as a canonical (tip-0-excluded) - // bitset: trees are re-rooted on tip 0 below, so every internal node's - // descendant set excludes tip 0 and is directly comparable to these. + // still collapse. // - // The canonical bitsets alone protect only a node whose descendant set is the - // 1 group EXACTLY, which is what the search's locked-node machinery enforces. - // The constraint the user is promised is looser: tips ambiguous for the - // constraint character are free to sit on either side, so the split can be - // realised by a node that is not exactly the 1 group, which no exact match - // reaches — and contracting that node's edge takes the enforced grouping with - // it. `cons_one` / `cons_zero` are the raw (uncanonicalised) groups, from - // which the realising node is found per tree below. + // Each split is stored as the pair of groups build_constraint() reads + // (1 = together, 0 = apart, anything else = free; see ts_constraint.cpp). + // Both come out of the one membership matrix, so the protection here cannot + // drift from the constraint the search enforced. A pure 0/1 matrix gives + // apart == the complement, and the test below then fires on exactly the node + // an exact-match test would have found. const int n_tip = tip_data.nrow(); const int wps = (n_tip + 63) / 64; - std::vector> cons_canon; std::vector> cons_one, cons_zero; - auto row_bits = [&](const IntegerMatrix& m, int r) { - std::vector b(wps, 0); - for (int c = 0; c < n_tip && c < m.ncol(); ++c) { - if (m(r, c)) b[c >> 6] |= (1ULL << (c & 63)); - } - return b; - }; if (consSplitMatrix.isNotNull()) { IntegerMatrix cs(consSplitMatrix.get()); for (int r = 0; r < cs.nrow(); ++r) { - std::vector b = row_bits(cs, r); - cons_one.push_back(b); - if (b[0] & 1ULL) { // canonicalize: exclude tip 0 - for (int w = 0; w < wps; ++w) b[w] = ~b[w]; - int rem = n_tip & 63; - if (rem) b[wps - 1] &= ((1ULL << rem) - 1); // clear padding bits + std::vector one(wps, 0), zero(wps, 0); + for (int c = 0; c < n_tip && c < cs.ncol(); ++c) { + const int v = cs(r, c); + if (v != 1 && v != 0) continue; // free tip + (v == 1 ? one : zero)[c >> 6] |= (1ULL << (c & 63)); } - cons_canon.push_back(std::move(b)); + cons_one.push_back(std::move(one)); + cons_zero.push_back(std::move(zero)); } - if (consZero.isNotNull()) { - IntegerMatrix cz(consZero.get()); - for (int r = 0; r < cz.nrow() && r < cs.nrow(); ++r) { - cons_zero.push_back(row_bits(cz, r)); - } - } - cons_zero.resize(cons_one.size(), std::vector(wps, 0)); } // Group sizes depend only on the constraint, so they are counted once here // rather than per tree. A group of fewer than two taxa is skipped below: @@ -2372,11 +2361,11 @@ List ts_collapse_pool( ts::compute_collapsed_flags_aggressive(tree, ds, flags); - // Protect constraint splits: clear the collapse flag of any internal edge - // whose bipartition realises a constraint (keeps the enforced clade - // visible). Per-node descendant tip sets via a postorder OR; rooted on - // tip 0, so every internal set excludes tip 0 == the canonical form above. - if (!cons_canon.empty()) { + // Protect constraint splits: keep an internal edge that realises each + // constraint out of the contraction, so the enforced grouping stays + // visible. Per-node descendant tip sets via a postorder OR; rooted on + // tip 0, so every internal set excludes tip 0. + if (!cons_one.empty()) { std::vector tb(static_cast(tree.n_node) * wps, 0); for (int tp = 0; tp < n_tip; ++tp) { tb[static_cast(tp) * wps + (tp >> 6)] = 1ULL << (tp & 63); @@ -2390,23 +2379,16 @@ List ts_collapse_pool( const uint64_t* R = &tb[static_cast(tree.right[ni]) * wps]; for (int w = 0; w < wps; ++w) dst[w] = L[w] | R[w]; } - for (int v = n_tip + 1; v < tree.n_node; ++v) { - if (v >= static_cast(flags.size()) || !flags[v]) continue; - const uint64_t* nb = &tb[static_cast(v) * wps]; - for (const auto& cb : cons_canon) { - bool eq = true; - for (int w = 0; w < wps; ++w) { - if (nb[w] != cb[w]) { eq = false; break; } - } - if (eq) { flags[v] = 0; break; } - } - } - - // A split can also be realised by a node that is not the 1 group exactly, - // and that node needs protecting too — but only when nothing else keeps - // the split visible. A node realises the split when it holds one whole - // group and none of the other; every such node's own edge displays it, so - // if any of them already survives the contraction there is nothing to do. + // A node realises the split when it holds one whole group and none of the + // other -- ts::node_displays_split() (ts_constraint.h), the same predicate + // the search's mapping and the Wagner build read, so the branch protected + // here is the branch they enforce. With free tips that node is generally + // NOT the 1 group exactly, and the exact-match test this replaced then + // protected nothing at all (agent-issues/TreeSearch#54). + // + // Protect one such node, and only when nothing else keeps the split + // visible: every realising node's own edge displays the split, so if any + // of them already survives the contraction there is nothing to do. // Protecting unconditionally would instead force the resolution of a // branch the constraint does not ask for, which is the "unsupported // non-constraint branches still collapse" half of the promise. @@ -2423,20 +2405,13 @@ List ts_collapse_pool( bool survives = false; int to_protect = -1; for (int side = 0; side < 2 && !survives; ++side) { - const std::vector& in = *grp[side]; - const std::vector& out = *grp[1 - side]; + const uint64_t* in = grp[side]->data(); + const uint64_t* out = grp[1 - side]->data(); for (size_t pi = 0; pi < tree.postorder.size(); ++pi) { const int v = tree.postorder[pi]; if (v <= n_tip || v >= static_cast(flags.size())) continue; const uint64_t* nb = &tb[static_cast(v) * wps]; - bool realises = true; - for (int w = 0; w < wps; ++w) { - if ((nb[w] & in[w]) != in[w] || (nb[w] & out[w])) { - realises = false; - break; - } - } - if (!realises) continue; + if (!ts::node_displays_split(nb, in, out, wps)) continue; if (!flags[v]) { survives = true; break; } if (to_protect < 0) to_protect = v; // the MRCA, in postorder } @@ -2945,6 +2920,46 @@ List ts_bench_tbr_phases( } bool use_iw = std::isfinite(ds.concavity); + // A dataset can leave the Fitch kernel nothing to do -- every character + // constant or autapomorphic gives zero blocks -- so `total_words == 0` and + // `n_blocks == 0`, and `tree.prelim`, `vroot_cache` and the snapshot buffers + // are all empty. The phase loops below would work them anyway: + // `&tree.prelim[sc_base]` and `&vroot_cache[ei * total_words]` take the + // address of element 0 of an empty vector (what `_GLIBCXX_ASSERTIONS` + // traps), and the snapshot benchmark's `memcpy` passes a null `.data()` to a + // parameter declared `nonnull` (what UBSan reports). Both are undefined + // behaviour, and neither stops the function: it completes every clip and + // every snapshot iteration. + // + // Guard at entry rather than per site. This is a benchmark harness, and + // with no Fitch words there is no per-phase work to time -- zero is the + // honest answer, where the numbers it used to report were timings of + // zero-byte copies. Phase A above is safe at zero words (the HSJ search + // path scores that way by design), so the score is still real. + if (tree.total_words == 0) { + return List::create( + Named("n_tips") = tree.n_tip, + Named("n_node") = tree.n_node, + Named("n_blocks") = ds.n_blocks, + Named("total_words") = tree.total_words, + Named("total_chars") = 0, + Named("block_n_states") = IntegerVector(0), + Named("has_na") = has_na, + Named("use_iw") = use_iw, + Named("score") = score, + Named("time_full_rescore_us") = time_full_rescore_us, + Named("time_clip_incr_us") = 0.0, + Named("time_indirect_us") = 0.0, + Named("time_unclip_us") = 0.0, + Named("time_snapshot_save_us") = 0.0, + Named("time_snapshot_restore_us") = 0.0, + Named("snapshot_bytes") = 0.0, + Named("n_clips") = 0, + Named("n_candidates") = 0, + Named("n_snapshot_iters") = 0 + ); + } + // Seed RNG std::mt19937 rng = ts::make_rng(); @@ -3838,3 +3853,30 @@ std::string ts_ev_cache_key_probe( std::snprintf(buf, sizeof(buf), "%016llx", (unsigned long long)key); return std::string(buf); } + +// Sample one start tree from the RANDOM_TREE strategy's constrained generator. +// +// A thin wrapper over random_constrained_tree() (ts_wagner.cpp) so that tests +// can inspect the tree the search STARTS from. Going through +// MaximizeParsimony() cannot: TBR rearranges whatever it is handed, so the +// returned tree says nothing about where the generator put the free tips. +// Draws from R's RNG, so set.seed() reproduces a sample. +// [[Rcpp::export]] +IntegerMatrix ts_random_constrained_tree( + NumericMatrix contrast, + IntegerMatrix tip_data, + IntegerVector weight, + CharacterVector levels, + Nullable consSplitMatrix = R_NilValue) +{ + validate_tip_data_values(INTEGER(tip_data), tip_data.nrow(), tip_data.ncol(), + contrast.nrow()); + ts::DataSet ds = make_dataset(contrast, tip_data, weight, levels); + ts::ConstraintData cd = build_constraint_from_r( + tip_data.nrow(), consSplitMatrix, R_NilValue, R_NilValue, + R_NilValue, R_NilValue, 0); + + ts::TreeState tree; + ts::random_constrained_tree(tree, ds, cd); + return tree_to_edge(tree); +} diff --git a/src/ts_tbr.cpp b/src/ts_tbr.cpp index a912e1778..019594853 100644 --- a/src/ts_tbr.cpp +++ b/src/ts_tbr.cpp @@ -349,36 +349,63 @@ struct StateSnapshot { postorder.resize(tree.postorder.size()); } + // Every copy below is guarded on a non-zero length. A dataset can leave the + // Fitch kernel nothing to do -- HSJ data whose characters all belong to a + // hierarchy is the case observed -- giving `total_words == 0` and + // `n_blocks == 0`, which sizes prelim/final_/local_cost to zero. An empty + // vector's `.data()` is then permitted to be null, and `memcpy`'s `nonnull` + // parameters forbid that even for a zero-length copy: benign on the + // toolchains we target, but UBSan reports it and a compiler is entitled to + // infer non-nullness from the attribute. Same guard as + // `TreeState::load_tip_states()` and `::save_node_state()`. + // + // `has_na_arrays` and `postorder` were not implicated -- NA arrays are sized + // from the same `state_sz`, and postorder is never empty -- but they are + // guarded on the same footing so a future zero-length case cannot reopen it. + void save(const TreeState& tree) { size_t state_bytes = prelim.size() * sizeof(uint64_t); size_t cost_bytes = local_cost.size() * sizeof(uint64_t); - std::memcpy(prelim.data(), tree.prelim.data(), state_bytes); - std::memcpy(final_.data(), tree.final_.data(), state_bytes); - std::memcpy(local_cost.data(), tree.local_cost.data(), cost_bytes); - if (has_na_arrays) { + if (state_bytes > 0) { + std::memcpy(prelim.data(), tree.prelim.data(), state_bytes); + std::memcpy(final_.data(), tree.final_.data(), state_bytes); + } + if (cost_bytes > 0) { + std::memcpy(local_cost.data(), tree.local_cost.data(), cost_bytes); + } + if (has_na_arrays && state_bytes > 0) { std::memcpy(down2.data(), tree.down2.data(), state_bytes); std::memcpy(subtree_actives.data(), tree.subtree_actives.data(), state_bytes); } - std::memcpy(postorder.data(), tree.postorder.data(), - tree.postorder.size() * sizeof(int)); + if (!tree.postorder.empty()) { + std::memcpy(postorder.data(), tree.postorder.data(), + tree.postorder.size() * sizeof(int)); + } } void restore(TreeState& tree) const { size_t state_bytes = prelim.size() * sizeof(uint64_t); size_t cost_bytes = local_cost.size() * sizeof(uint64_t); - std::memcpy(tree.prelim.data(), prelim.data(), state_bytes); - std::memcpy(tree.final_.data(), final_.data(), state_bytes); - std::memcpy(tree.local_cost.data(), local_cost.data(), cost_bytes); - if (has_na_arrays) { + if (state_bytes > 0) { + std::memcpy(tree.prelim.data(), prelim.data(), state_bytes); + std::memcpy(tree.final_.data(), final_.data(), state_bytes); + } + if (cost_bytes > 0) { + std::memcpy(tree.local_cost.data(), local_cost.data(), cost_bytes); + } + if (has_na_arrays && state_bytes > 0) { std::memcpy(tree.down2.data(), down2.data(), state_bytes); std::memcpy(tree.subtree_actives.data(), subtree_actives.data(), state_bytes); } - // Restore postorder size AND data (clip may have shrunk the vector) + // Restore postorder size AND data (clip may have shrunk the vector). The + // resize is unconditional; only the copy needs the guard. tree.postorder.resize(postorder.size()); - std::memcpy(tree.postorder.data(), postorder.data(), - postorder.size() * sizeof(int)); + if (!postorder.empty()) { + std::memcpy(tree.postorder.data(), postorder.data(), + postorder.size() * sizeof(int)); + } } }; diff --git a/src/ts_wagner.cpp b/src/ts_wagner.cpp index ecd2ddcaa..451c62462 100644 --- a/src/ts_wagner.cpp +++ b/src/ts_wagner.cpp @@ -346,8 +346,8 @@ static int wagner_smallest_containing_node( // neither side is a clade, the partial tree does not display the split, and no // further insertion can make it. static int wagner_map_complement( - const TreeState& tree, int n_tip, int nw, - const std::vector& node_tips, const uint64_t* split, + const TreeState& tree, int nw, + const std::vector& node_tips, const uint64_t* split_out, const std::vector& added_tips, WagnerConstraintScratch& scratch) { @@ -355,12 +355,10 @@ static int wagner_map_complement( int n_out = 0; int lone_out = -1; for (int w = 0; w < nw; ++w) { - uint64_t outside_mask = ~split[w]; - if (w == nw - 1) { - const int rem = n_tip % 64; - if (rem > 0) outside_mask &= (1ULL << rem) - 1; - } - const uint64_t owd = outside_mask & added_tips[w]; + // #54: the outside group is cd.split_zeros, not ~split_tips. A `?`-coded + // tip is in neither, so it never pulls this LCA about — which is what lets + // it be placed on either side of the constraint, as documented. + const uint64_t owd = split_out[w] & added_tips[w]; needed_out[w] = owd; if (owd) { n_out += popcount64(owd); @@ -369,7 +367,7 @@ static int wagner_map_complement( } const int on = wagner_smallest_containing_node( tree, nw, node_tips, needed_out, n_out, lone_out); - return (on == n_tip) ? -1 : on; + return (on == tree.n_tip) ? -1 : on; } // Wagner-specific constraint node mapping. @@ -426,6 +424,8 @@ static void wagner_map_constraint_nodes( for (int s = 0; s < cd.n_splits; ++s) { const uint64_t* split = &cd.split_tips[static_cast(s) * nw]; + const uint64_t* split_out = + &cd.split_zeros[static_cast(s) * nw]; // Once the inside LCA has reached the root it can never come back down — // grafting a leaf preserves ancestor relations among existing nodes, so the @@ -441,9 +441,13 @@ static void wagner_map_constraint_nodes( // keep ConstraintData's T-384 flag at its "names the split itself" // default so a value left over from an earlier map_constraint_nodes() // cannot reach regraft_violates_constraint() before the next full remap. + // constraint_node_hi is pinned to constraint_node for the same reason: + // Wagner's LCA mapping has no displaying-chain, so the tight end is the + // only anchor it can honestly offer (#54). cd.constraint_complement[s] = 0; + cd.constraint_node_hi[s] = cd.constraint_node[s]; scratch.outside_node[s] = wagner_map_complement( - tree, n_tip, nw, node_tips, split, added_tips, scratch); + tree, nw, node_tips, split_out, added_tips, scratch); continue; } @@ -466,6 +470,7 @@ static void wagner_map_constraint_nodes( tree, nw, node_tips, needed, n_needed, lone_needed); cd.constraint_node[s] = inside_node; cd.constraint_complement[s] = 0; // see the latched branch above + cd.constraint_node_hi[s] = inside_node; // A split is an *unrooted* bipartition, but a clade is a rooted subtree, so // "inside is monophyletic" is only one of the two ways this tree can display @@ -485,7 +490,7 @@ static void wagner_map_constraint_nodes( if (inside_node == n_tip) { scratch.use_complement[s] = 1; scratch.outside_node[s] = wagner_map_complement( - tree, n_tip, nw, node_tips, split, added_tips, scratch); + tree, nw, node_tips, split_out, added_tips, scratch); } } } @@ -534,8 +539,18 @@ static void wagner_collect_active_splits( for (int s = 0; s < cd.n_splits; ++s) { const uint64_t* split = &cd.split_tips[static_cast(s) * cd.n_words]; + const uint64_t* split_out = + &cd.split_zeros[static_cast(s) * cd.n_words]; - bool tip_inside = (split[tw] >> tb) & 1; + const bool tip_inside = (split[tw] >> tb) & 1; + const bool tip_outside = (split_out[tw] >> tb) & 1; + + // #54: a tip in neither group is FREE — the constraint says nothing + // about which side of the separating edge it belongs on, so no edge is + // barred to it. Reading "outside" as ~split_tips, as this did before free + // tips were represented, forced every `?`-coded taxon out of the + // constrained group and could leave the filter with no legal edge at all. + if (!tip_inside && !tip_outside) continue; // Split constrains placement when the opposite side of the new tip // has at least one previously-added tip. An inside tip is only @@ -544,15 +559,10 @@ static void wagner_collect_active_splits( for (int w = 0; w < cd.n_words; ++w) { uint64_t prev = added_tips[w]; if (prev & split[w]) has_prev_inside = true; - uint64_t outside_mask = ~split[w]; - if (w == cd.n_words - 1) { - int rem = tree.n_tip % 64; - if (rem > 0) outside_mask &= (1ULL << rem) - 1; - } - if (prev & outside_mask) has_prev_outside = true; + if (prev & split_out[w]) has_prev_outside = true; } if (tip_inside && !has_prev_outside) continue; - if (!tip_inside && !has_prev_inside) continue; + if (tip_outside && !has_prev_inside) continue; // The constraint is active. constraint_node[s] is the LCA of // added inside tips (set by wagner_map_constraint_nodes). @@ -586,12 +596,26 @@ static void wagner_collect_active_splits( // Does the finished tree display every constraint split? // -// A bipartition is displayed iff some edge separates its two sides, i.e. iff -// some node's subtree tip set equals one side exactly. Only non-root nodes are -// candidates: the root subtends every tip, and its two children already cover -// the single edge the degree-two root sits on. Tips are included so trivial -// (single-taxon) splits are recognised. Orientation-agnostic by construction, -// so it stays correct however the tree happens to be rooted. +// A split is displayed iff some edge separates its two groups, which is +// node_displays_split() (ts_constraint.h) in one polarity or the other. This +// runs before any of map_constraint_nodes()'s machinery is valid, but it calls +// the same predicate rather than restating it: this is the gate that decides +// whether the caller reshuffles and rebuilds, and the stricter of the two entry +// points would reject trees the other then searches happily (or, worse, accept +// ones it will not move from). +// +// Every node is a candidate, tips and root alike. Tips matter for a +// single-taxon group, whose "clade" is the tip itself. The root looks +// redundant — it subtends every tip, and its two children already cover the +// single edge the degree-two root sits on — but excluding it made this test +// STRICTER than find_displaying_chain(), which scans tree.postorder and so +// does reach the root: a split whose apart-group is empty maps there and +// nowhere else, and the two entry points then disagreed about a tree that +// every constraint is satisfied by. Including it costs one comparison and +// can never accept a violation, since the root displays a split only when the +// apart-group is empty, and then so does every tree. +// Orientation-agnostic by construction, so it stays correct however the tree +// happens to be rooted. static bool wagner_tree_displays_constraint(const TreeState& tree, const ConstraintData& cd) { const int n_tip = tree.n_tip; @@ -612,22 +636,15 @@ static bool wagner_tree_displays_constraint(const TreeState& tree, for (int s = 0; s < cd.n_splits; ++s) { const uint64_t* split = &cd.split_tips[static_cast(s) * nw]; + const uint64_t* split_out = &cd.split_zeros[static_cast(s) * nw]; bool found = false; for (int node = 0; node < tree.n_node && !found; ++node) { - if (node == n_tip) continue; // root subtends everything const uint64_t* nd = &node_tips[static_cast(node) * nw]; - bool eq = true, eqCompl = true; - for (int w = 0; w < nw; ++w) { - uint64_t tip_mask = ~0ULL; - if (w == nw - 1) { - int rem = n_tip % 64; - if (rem > 0) tip_mask = (1ULL << rem) - 1; - } - if (nd[w] != (split[w] & tip_mask)) eq = false; - if (nd[w] != (~split[w] & tip_mask)) eqCompl = false; - if (!eq && !eqCompl) break; + // Either group may be the clade side. + if (node_displays_split(nd, split, split_out, nw) || + node_displays_split(nd, split_out, split, nw)) { + found = true; } - if (eq || eqCompl) found = true; } if (!found) return false; } @@ -868,11 +885,14 @@ WagnerResult wagner_tree(TreeState& tree, const DataSet& ds, // been exhaustive. `constraint_fallback` alone is not enough: it only fires // when the filter rejected *every* edge, which the T-364/T-370 leak never did // -- it returned violating trees mutely. Nor is the caller's post-hoc check - // enough, because AdditionTree() never sets `has_posthoc` (it is built only - // at the search entry, ts_rcpp.cpp), so on that path there is no reshuffle to - // fall back on -- including for the both-sides-straddle case above. This - // check holds for every cause, known or not. The caller reports it: - // Rf_warning() is not safe from a search worker thread. + // enough: AdditionTree() reaches ts_wagner_tree(), which calls this function + // directly and so never runs random_wagner_tree()'s reshuffle loop. (It does + // build the posthoc DataSet -- R/AdditionTree.R splices the whole + // .PrepareConstraint() list through -- but nothing on that path consults it.) + // So on that path there is no retry to fall back on, including for the + // both-sides-straddle case above. This check holds for every cause, known or + // not. The caller reports it: Rf_warning() is not safe from a search worker + // thread. if (constrained) { result.constraint_violated = constraint_fallback || !wagner_tree_displays_constraint(tree, *cd); @@ -1175,7 +1195,12 @@ void random_topology_tree(TreeState& tree, const DataSet& ds) { // Random constrained tree // ========================================================================= // -// Algorithm: +// Two samplers, chosen by whether the constraint leaves any tip free. +// +// WITH NO FREE TIPS every split names every tip, so the "together" groups nest +// exactly as their clades must, and the clade of each split is exactly its +// group. random_constrained_backbone() builds that nesting directly: +// // 1. Identify constraint splits ordered from largest to smallest (by // popcount of the "inside" set). Larger splits enclose smaller ones. // 2. Assign each tip to its tightest (smallest) enclosing constraint @@ -1186,13 +1211,53 @@ void random_topology_tree(TreeState& tree, const DataSet& ds) { // 4. Finally, wire all root-level items (unconstrained tips + top-level // split roots) into the tree. // -// The result is a uniformly random binary tree among those that satisfy -// all constraint splits. (Uniform conditional on the split nesting -// structure, which determines the partition of items across polytomy -// resolution steps.) +// Every compliant tree has those clades and no others, and each polytomy is +// resolved by uniform random insertion, so the result is a uniformly random +// tree among the compliant ones. This is the path the pool/consensus caller +// (build_constraint_from_bitsets) takes, and it is unchanged. +// +// WITH FREE TIPS -- `?`-coded, or unnamed by a character -- that reasoning +// fails. A clade may take on any tip the split does not name, two splits with +// disjoint groups may nest either way round or not at all, and the backbone +// above can build only one of those arrangements: of the 1155 compliant trees +// on eight taxa constrained by two characters ({a,b}|{c,d} and {e,f}|{g,h}) it +// reaches 105, and so did the pre-#121 code that also pinned the free tips +// outside every group. On six taxa with one character and two free tips, where +// there is only one clade to arrange, the two differ: 35 of 35 against 15. +// random_constrained_by_insertion() below drops the backbone and grows the tree +// a tip at a time instead, each at a uniformly random edge among those that +// keep the tree compliant -- which reaches all 1155. See its own comment. +// +// Those counts are from exhaustive enumeration, checked against every edge +// INCLUDING the pendant ones: a group of one taxon is separated from the rest +// by its own pendant edge, so a checker that looks only at non-trivial splits +// (as.Splits() omits them) reads such a character as unsatisfiable and +// undercounts the compliant set. An earlier revision of this comment quoted +// figures measured that way; they were wrong. +// +// Making each together-group an exact clade is not always *possible*: the +// R-side gate (.PrepareConstraint) admits four-gamete-compatible splits that +// are not laminar, and those cannot all be clades at once. That case is +// handled by the collapse path below (a split that loses every tip to tighter +// non-laminar splits gets split_root == -1 and is skipped, T-329) and caught +// afterwards by the caller's post-hoc check, not by this comment's claim. namespace { +// Fisher-Yates shuffle of a range of node indices, drawing from the search RNG. +void shuffle_items(std::vector::iterator first, + std::vector::iterator last) { + for (int i = static_cast(last - first) - 1; i > 0; --i) { + int j = static_cast(ts::thread_safe_unif() * (i + 1)); + if (j > i) j = i; // guard the thread_safe_unif() == 1 corner + std::swap(first[i], first[j]); + } +} + +void shuffle_items(std::vector& items) { + shuffle_items(items.begin(), items.end()); +} + // Randomly resolve a set of items into a binary subtree. // `items` are node indices (tips or internal subtree roots). // Returns the root node of the resolved subtree. @@ -1202,12 +1267,7 @@ int resolve_randomly(TreeState& tree, std::vector& items, int& next_internal) { if (items.size() == 1) return items[0]; - // Shuffle items - for (int i = static_cast(items.size()) - 1; i > 0; --i) { - int j = static_cast(ts::thread_safe_unif() * (i + 1)); - if (j > i) j = i; - std::swap(items[i], items[j]); - } + shuffle_items(items); if (items.size() == 2) { int nd = next_internal++; @@ -1302,13 +1362,10 @@ bool tip_in_split(int t, const uint64_t* mask) { } // anonymous namespace -void random_constrained_tree(TreeState& tree, const DataSet& ds, - ConstraintData& cd) { - if (!cd.active || cd.n_splits == 0) { - random_topology_tree(tree, ds); - return; - } - +// Nesting-of-groups construction; correct only when no tip is free of a split. +// See the block comment above for why, and for the step numbering. +static void random_constrained_backbone(TreeState& tree, const DataSet& ds, + ConstraintData& cd) { int n_tip = ds.n_tips; check_wagner_precondition(n_tip); init_wagner_state(tree, ds); @@ -1416,12 +1473,7 @@ void random_constrained_tree(TreeState& tree, const DataSet& ds, } } - // Shuffle root items - for (int i = static_cast(root_items.size()) - 1; i > 0; --i) { - int j = static_cast(ts::thread_safe_unif() * (i + 1)); - if (j > i) j = i; - std::swap(root_items[i], root_items[j]); - } + shuffle_items(root_items); if (root_items.size() >= 2) { // Wire first two items as root's children @@ -1484,4 +1536,292 @@ void random_constrained_tree(TreeState& tree, const DataSet& ds, update_constraint(tree, cd); } +// ========================================================================= +// Random constrained tree, by legality-filtered tip insertion +// ========================================================================= +// +// Grow the tree one tip at a time, each at a uniformly random edge among those +// that leave every constraint still displayed. No backbone, so nothing about +// the arrangement of the clades is decided in advance: two splits with disjoint +// groups may come out nested either way round or as siblings, and a clade may +// take on any tip its split does not name. +// +// EVERY compliant topology is reachable. Two facts make that so: +// +// * a partial tree that displays every split RESTRICTED to the tips placed so +// far can always be extended -- a new tip of the "together" group goes on +// the together side of the displaying edge, one of the "apart" group on the +// other side, a free one anywhere -- so filtering on that restricted +// condition never paints the construction into a corner; and +// * the filter rules out only edges that break it, so every compliant tree is +// built by whichever insertion order matches it. +// +// Uniformity needs more, because the number of legal edges varies with the +// partial topology, which draws some trees more often than others. So the +// named tips get a rejection pass FIRST: an unconstrained random tree on them +// is uniform, and keeping the first compliant one is uniform over the compliant +// trees exactly. That lands whenever a decent fraction of trees comply -- the +// loose or small constraints a user typically writes -- and never for one that +// pins down most of the tree, so it is bounded and falls through to the +// filtered pass, which always lands. +// +// The tips no character names are inserted afterwards with no filter at all, +// which keeps their placement exactly uniform whichever pass built the rest. +// So a constraint on a handful of taxa in a large matrix -- the usual case -- +// is sampled uniformly end to end. +// +// Legality of inserting tip `t` at the edge above node `v`, per split s, in the +// partial tree's own terms: +// +// t in "together" -> v must be the highest node displaying s, or below it: +// landing there leaves the together side still together. +// t in "apart" -> v must be the tightest displaying node, or outside it. +// t free of s -> anywhere. +// +// which is exactly what regraft_violates_constraint() already decides for a +// TBR clip, so this reuses it with the "clip" being the single tip. The masks +// handed to map_constraint_nodes() are the constraint restricted to the placed +// tips; without that restriction no node would cover a group whose tips have +// not all arrived, and every edge would look illegal. +static void random_constrained_by_insertion(TreeState& tree, const DataSet& ds, + ConstraintData& cd) { + const int n_tip = ds.n_tips; + check_wagner_precondition(n_tip); + init_wagner_state(tree, ds); + + const int n_words = cd.n_words; + const int n_splits = cd.n_splits; + const int root = n_tip; + + // Named tips first: they are the only ones an edge can be illegal for. The + // rest go in afterwards, unfiltered, which is what keeps their placement + // exactly uniform. + std::vector named(n_words, 0ULL); + for (int s = 0; s < n_splits; ++s) { + const size_t off = static_cast(s) * n_words; + for (int w = 0; w < n_words; ++w) { + named[w] |= cd.split_tips[off + w] | cd.split_zeros[off + w]; + } + } + std::vector order, free_tips; + for (int t = 0; t < n_tip; ++t) { + (tip_in_split(t, named.data()) ? order : free_tips).push_back(t); + } + const int n_named = static_cast(order.size()); + + ts::rng_state_begin(); + shuffle_items(order); + shuffle_items(free_tips); + order.insert(order.end(), free_tips.begin(), free_tips.end()); + + // The constraint as it applies to the tips placed so far. Rebuilt each + // insertion; everything else here is scratch that map_constraint_nodes() and + // regraft_violates_constraint() need. + ConstraintData pcd; + pcd.active = true; + pcd.n_splits = n_splits; + pcd.n_words = n_words; + pcd.split_tips.assign(static_cast(n_splits) * n_words, 0ULL); + pcd.split_zeros.assign(static_cast(n_splits) * n_words, 0ULL); + pcd.constraint_node.assign(n_splits, -1); + pcd.constraint_node_hi.assign(n_splits, -1); + pcd.constraint_complement.assign(n_splits, 0); + pcd.dfs_entry.assign(2 * n_tip - 1, 0); + pcd.dfs_exit.assign(2 * n_tip - 1, 0); + pcd.clip_zones.assign(n_splits, ClipZone::UNCONSTRAINED); + pcd.clip_tip_mask.assign(n_words, 0ULL); + + std::vector placed(n_words, 0ULL); + auto mark_placed = [&](int t) { placed[t / 64] |= 1ULL << (t % 64); }; + + // Nodes heading an edge. The root's two children head the two halves of ONE + // unrooted edge, so only one is listed; `unlisted_half` is the other, and + // moves as insertions change the root's children. + std::vector edges; + edges.reserve(static_cast(2 * n_tip - 3)); + int unlisted_half = -1; + int next_internal = n_tip + 1; + + // Seed with the first two tips as the root's children. Any tree on two tips + // displays every split it can see, so there is nothing to filter yet. + auto seed_two = [&]() { + std::fill(placed.begin(), placed.end(), 0ULL); + edges.clear(); + next_internal = n_tip + 1; + tree.parent[root] = root; + tree.left[0] = order[0]; + tree.right[0] = order[1]; + tree.parent[order[0]] = root; + tree.parent[order[1]] = root; + mark_placed(order[0]); + mark_placed(order[1]); + edges.push_back(order[0]); + unlisted_half = order[1]; + }; + + // Restrict the constraint to the placed tips and re-map. Without the + // restriction no node would cover a group whose tips have not all arrived. + auto remap_partial = [&]() { + for (int s = 0; s < n_splits; ++s) { + const size_t off = static_cast(s) * n_words; + for (int w = 0; w < n_words; ++w) { + pcd.split_tips[off + w] = cd.split_tips[off + w] & placed[w]; + pcd.split_zeros[off + w] = cd.split_zeros[off + w] & placed[w]; + } + } + tree.build_postorder(); + update_constraint(tree, pcd); + }; + + // Insert `t` above `below`, keeping `edges` and the root-edge bookkeeping + // straight. + auto insert_at = [&](int t, int below) { + const int above = tree.parent[below]; + const int new_nd = next_internal++; + const int new_ni = new_nd - n_tip; + tree.parent[new_nd] = above; + tree.left[new_ni] = t; + tree.right[new_ni] = below; + tree.parent[t] = new_nd; + tree.parent[below] = new_nd; + + const int ai = above - n_tip; + if (tree.left[ai] == below) { + tree.left[ai] = new_nd; + } else { + tree.right[ai] = new_nd; + } + + if (above == root && below == unlisted_half) { + // The new node takes over as the unlisted half of the root edge, and the + // edge below it -- which was that half -- becomes one in its own right. + unlisted_half = new_nd; + edges.push_back(below); + } else { + edges.push_back(new_nd); + } + edges.push_back(t); + mark_placed(t); + }; + + auto draw_edge = [&](const std::vector& pool) { + const int n_edges = static_cast(pool.size()); + int idx = static_cast(ts::thread_safe_unif() * n_edges); + if (idx >= n_edges) idx = n_edges - 1; + return pool[idx]; + }; + + // ---- Pass 1: rejection, for exact uniformity where it is affordable ---- + // + // An unconstrained random tree on the named tips is uniform, and keeping the + // first compliant one leaves it uniform over the compliant trees -- which the + // filtered pass below is not. Whether that lands depends on how much of the + // tree the constraint pins down: it is most of the time for the loose or + // small constraints a user typically writes, and essentially never for a + // large one, hence the bounded try count and the fallback. + bool uniform = false; + if (n_named >= 2) { + for (int attempt = 0; attempt < 64 && !uniform; ++attempt) { + shuffle_items(order.begin(), order.begin() + n_named); + seed_two(); + for (int k = 2; k < n_named; ++k) insert_at(order[k], draw_edge(edges)); + remap_partial(); + uniform = true; + for (int s = 0; s < n_splits && uniform; ++s) { + if (pcd.constraint_node[s] < 0) uniform = false; + } + } + } + + // ---- Pass 2: legality-filtered insertion, which always lands ---- + std::vector legal; + if (!uniform) seed_two(); + for (int k = uniform ? n_named : 2; k < n_tip; ++k) { + const int t = order[k]; + const std::vector* pool = &edges; + + if (k < n_named) { + remap_partial(); + + // This tip as a one-node "clip": inside the split's group, outside it, or + // neither. The polarity flip is regraft_violates_constraint()'s job. + // + // A split with no placed tip in one of its groups rules nothing out yet: + // once this tip arrives that group is a single tip, and a single tip is + // separated from everything by its own pendant edge. Saying so here also + // keeps map_constraint_nodes()'s empty-group fallback -- which answers + // with the lowest tip outside the other group, placed or not -- from + // anchoring the test on a tip that is not in the tree. + for (int s = 0; s < n_splits; ++s) { + const size_t off = static_cast(s) * n_words; + bool has_one = false, has_zero = false; + for (int w = 0; w < n_words; ++w) { + if (pcd.split_tips[off + w]) has_one = true; + if (pcd.split_zeros[off + w]) has_zero = true; + } + if (!has_one || !has_zero) { + pcd.clip_zones[s] = ClipZone::UNCONSTRAINED; + } else if (tip_in_split(t, &cd.split_tips[off])) { + pcd.clip_zones[s] = ClipZone::MUST_INSIDE; + } else if (tip_in_split(t, &cd.split_zeros[off])) { + pcd.clip_zones[s] = ClipZone::MUST_OUTSIDE; + } else { + pcd.clip_zones[s] = ClipZone::UNCONSTRAINED; + } + } + + legal.clear(); + for (int below : edges) { + bool ok = !regraft_violates_constraint(below, pcd); + // The two root children are one unrooted edge seen from its two ends, + // and the ancestry test answers for the end it is given: whichever end + // is listed, the edge is legal if EITHER end says so. + if (!ok && tree.parent[below] == root) { + ok = !regraft_violates_constraint(unlisted_half, pcd); + } + if (ok) legal.push_back(below); + } + // Never empty for a compatible constraint (see above); fall back rather + // than lose the tip if one slips past the R-side four-gamete gate. + if (!legal.empty()) pool = &legal; + } + + insert_at(t, draw_edge(*pool)); + } + + ts::rng_state_end(); + + tree.build_postorder(); + update_constraint(tree, cd); +} + +void random_constrained_tree(TreeState& tree, const DataSet& ds, + ConstraintData& cd) { + if (!cd.active || cd.n_splits == 0) { + random_topology_tree(tree, ds); + return; + } + + // Does any split leave a tip free? If not, the clades are pinned and the + // backbone construction samples them uniformly at a fraction of the cost. + const int n_words = cd.n_words; + const int rem = ds.n_tips % 64; + const uint64_t top = rem ? ((1ULL << rem) - 1ULL) : ~0ULL; + bool any_free = false; + for (int s = 0; s < cd.n_splits && !any_free; ++s) { + const size_t off = static_cast(s) * n_words; + for (int w = 0; w < n_words; ++w) { + uint64_t unnamed = ~(cd.split_tips[off + w] | cd.split_zeros[off + w]); + if (w == n_words - 1) unnamed &= top; + if (unnamed) { any_free = true; break; } + } + } + + if (any_free) { + random_constrained_by_insertion(tree, ds, cd); + } else { + random_constrained_backbone(tree, ds, cd); + } +} + } // namespace ts diff --git a/src/ts_wagner.h b/src/ts_wagner.h index 9d0342094..ab5d786f1 100644 --- a/src/ts_wagner.h +++ b/src/ts_wagner.h @@ -80,9 +80,22 @@ std::vector wagner_entropy_scores(const DataSet& ds); void random_topology_tree(TreeState& tree, const DataSet& ds); // Build a random tree topology that satisfies topological constraints. -// Constructs the constraint backbone (one node per constraint split), -// then randomly resolves all multifurcations by uniform random binary -// insertion. Like random_topology_tree(), the result is NOT scored. +// Every compliant topology is reachable; see ts_wagner.cpp for why, and for +// where the sampling is exactly uniform and where it is not. +// Like random_topology_tree(), the result is NOT scored. +// +// Two constructions, picked by whether any split leaves a tip free: +// +// * no free tips — the constraint pins every clade, so this builds the nesting +// of the "together" groups directly and resolves each polytomy by uniform +// random insertion. Cheap. This is the path consensus constraints +// (build_constraint_from_bitsets) take. +// * any free tip — no backbone at all: the tree is grown a tip at a time, each +// at a uniformly random edge among those that keep the constraint displayed. +// Costs a constraint re-map per named tip, plus a bounded rejection pass +// ahead of it (agent-issues/TreeSearch#128), so it is much the dearer of the +// two. Building a backbone here instead would reach only a fraction of the +// legal topologies (agent-issues/TreeSearch#121). // // Falls back to random_topology_tree() if no constraints are active. void random_constrained_tree(TreeState& tree, const DataSet& ds, diff --git a/tests/testthat/helper-ts.R b/tests/testthat/helper-ts.R index d121a8ded..2a714a1d3 100644 --- a/tests/testthat/helper-ts.R +++ b/tests/testthat/helper-ts.R @@ -100,3 +100,24 @@ validate_result <- function(result, n_tip) { tips <- sort(children[children <= n_tip]) testthat::expect_equal(tips, seq_len(n_tip)) } + +#' Run a constrained driven search with NOTHING but TBR enabled. +#' +#' Every phase that could rescue a replicate that cannot rearrange its start is +#' switched off, so `best_score` is what TBR alone achieved from `startEdge`: +#' a Wagner start is re-rooted on tip 0 (796a29d3), fuse re-roots its recipient, +#' and nni-perturb calls impose_constraint(), which repairs a start as a +#' side-effect. Used by the constraint tests that assert the search MOVES. +tbrOnlyRun <- function(ds, startEdge, splitMatrix) { + TreeSearch:::ts_driven_search( + ds$contrast, ds$tip_data, ds$weight, ds$levels, + maxReplicates = 1L, targetHits = 99L, tbrMaxHits = 1L, + ratchetCycles = 0L, driftCycles = 0L, nniPerturbCycles = 0L, + xssRounds = 0L, rssRounds = 0L, cssRounds = 0L, + pruneReinsertCycles = 0L, fuseInterval = 0L, + outerCycles = 1L, maxOuterResets = 0L, + nniFirst = FALSE, sprFirst = FALSE, + poolMaxSize = 100L, poolSuboptimal = 0, maxSeconds = 0, verbosity = 0L, + nThreads = 1L, startEdge = startEdge, consSplitMatrix = splitMatrix + ) +} diff --git a/tests/testthat/test-Bootstrap.R b/tests/testthat/test-Bootstrap.R new file mode 100644 index 000000000..51044df6d --- /dev/null +++ b/tests/testthat/test-Bootstrap.R @@ -0,0 +1,66 @@ +test_that("BootstrapTree() avoids the sample() length-1 vector trap", { + # When only one character carries nonzero weight and that character's index + # is not 1, deindexedChars is a length-1 vector holding that index (say 2). + # sample(deindexedChars, ...) then samples from 1:2 rather than always + # returning 2, so a zero-weight character could spuriously be resampled. + captured <- new.env() + mockSearch <- function(edgeList, dataset, ...) { + captured$dataset <- dataset + list(edgeList[[1]], edgeList[[2]]) + } + testthat::local_mocked_bindings(EdgeListSearch = mockSearch, + .package = "TreeSearch") + + dataset <- list(original_weight = c(0, 1)) + edgeList <- list(1, 2, 3) + set.seed(1) + reps <- replicate(50, { + BootstrapTree(edgeList, dataset, maxIter = 1, maxHits = 1) + captured$dataset[["weight"]] + }) + + expect_true(all(reps[1, ] == 0)) + expect_true(all(reps[2, ] == 1)) + +}) + +test_that("BootstrapTree() resamples fractional weights without degenerating (#139)", { + # Regression test: fractional character weights used to be truncated to + # integer in `original_weight`, which for uniform sub-1 weights floors + # every value to zero. tabulate(sample(integer(0), ...)) then produced an + # all-zero resampled weight vector with no error, warning or message, so + # the search accepted every rearrangement as tied (see #139). + dataset <- TreeTools::StringToPhyDat( + "1100000 1110000 1111000 1111100 1100000 1110000 1111000 1111100 1001000", + 1:7, + byTaxon = FALSE + ) + names(dataset) <- c(LETTERS[1:6], "out") + attr(dataset, "weight") <- rep(0.5, length(attr(dataset, "weight"))) + + preparedData <- PrepareData(dataset) + expect_true(sum(preparedData[["original_weight"]]) > 0) + + start_tree <- ape::read.tree(text = "(((((A,D),B),E),(C,F)),out);") + start_tree <- TreeTools::RenumberTips(start_tree, names(dataset)) + edgeList <- TreeTools::RenumberEdges(start_tree[["edge"]][, 1], + start_tree[["edge"]][, 2]) + + withr::local_rng_version("3.5.0") + set.seed(0) + res <- BootstrapTree(edgeList[1:2], preparedData, + maxIter = 8L, maxHits = 4L, verbosity = 0L) + expect_type(res, "list") + expect_length(res, 2L) +}) + +test_that("BootstrapTree() and JackknifeTree() refuse a zeroed original_weight", { + dataset <- TreeTools::StringToPhyDat("1100000 1110000", 1:2, byTaxon = FALSE) + names(dataset) <- paste0("t", seq_along(dataset)) + obj <- PrepareData(dataset) + obj[["original_weight"]] <- integer(length(obj[["original_weight"]])) + + edgeList <- list(integer(0), integer(0)) + expect_error(BootstrapTree(edgeList, obj), "sums to zero") + expect_error(JackknifeTree(edgeList, obj), "sums to zero") +}) diff --git a/tests/testthat/test-ClusterStrings.R b/tests/testthat/test-ClusterStrings.R index 074314eba..8687a6265 100644 --- a/tests/testthat/test-ClusterStrings.R +++ b/tests/testthat/test-ClusterStrings.R @@ -4,11 +4,41 @@ skip_if_not_installed("protoclust") test_that("ClusterStrings() works", { x <- rep(letters[1:6], 1:6) expect_equal(ClusterStrings(x), - structure(rep(1:6, 1:6), "med" = letters[1:6])) + structure(rep(1:6, 1:6), "med" = letters[1:6], + silhouette = NA_real_)) expect_error(ClusterStrings(x, 1), "`maxCluster` must be at least two.") - expect_equal(range(ClusterStrings(x, 2)), 1:2) + # Silhouette now computed on the true dissimilarity matrix (#97); the old + # pam(dists, k) call clustered on Euclidean distance between rows of + # `dists` instead, inflating this above the 0.5 "structure" threshold. + expect_equal(range(ClusterStrings(x, 2)), c(1L, 1L)) expect_equal(ClusterStrings(paste0(c("aaaa", "bbb", "cccccc"), 1:20)), structure(rep_len(1:3, 20), - silhouette = 0.7955785, # copied, not calculated - med = paste0(c("aaaa", "bbb", "cccccc"), 1:3))) + # was 0.7955785 pre-fix + silhouette = 0.727540221, + med = paste0(c("aaaa", "bbb", "cccccc"), 1:3)), + tolerance = 1e-6) +}) + +test_that("ClusterStrings() handles a singleton cluster (#96)", { + # Pre-fix: colSums(dists[these, these]) drops to a scalar when the winning + # clustering contains a singleton, erroring "'x' must be an array of at + # least two dimensions". + x <- c(paste0("aaaa", 1:5), paste0("bbbbbbbb", 1:5), paste0("cccccccccc", 1:5), + "This is a totally different weird string zzzzzzzzzzzzzzzzzzzzzz") + res <- expect_silent(ClusterStrings(x)) + expect_equal(length(res), length(x)) + expect_true(any(tabulate(res) == 1)) +}) + +test_that("ClusterStrings() 'no structure' branch returns a per-element vector (#113)", { + # Pre-fix: switch(..., 1) collapsed to a bare scalar `1` instead of + # rep(1L, length(x)), violating the documented return contract. + set.seed(42) + x <- vapply(1:15, function(i) { + paste(sample(letters, 6), collapse = "") + }, character(1)) + res <- ClusterStrings(x) + expect_equal(length(res), length(x)) + expect_true(all(res == 1L)) + expect_false(is.na(attr(res, "silhouette"))) }) diff --git a/tests/testthat/test-Concordance.R b/tests/testthat/test-Concordance.R index 05a75f53f..7d218dc4a 100644 --- a/tests/testthat/test-Concordance.R +++ b/tests/testthat/test-Concordance.R @@ -285,6 +285,225 @@ test_that("ConcordantInformation() works", { }) +test_that("ClusteringConcordance() aligns splits to dataset tips (#86)", { + # `tree` carries an extra tip (t8) absent from `dataset`; MatchStrings() + # drops it from `keep`, but the unpruned `splits` matrix previously kept + # all 8 tip-columns, so indexing it by the 7-taxon `aChar` mask recycled + # silently rather than raising an error -- length(keep) = 7 divides NTip(tree) = 8's + # neighbouring 4 non-trivial splits into 5, corrupting every value, not + # just misaligning a few. + tree <- ape::read.tree(text = "(((t1,t2),(t3,t4)),((t5,t6),(t7,t8)));") + m <- matrix(c(0, 0, 0, 0, 1, 1, 1, + 0, 0, 1, 1, 0, 0, 1, + 0, 1, 0, 1, 0, 1, 0, + 1, 0, 1, 0, 1, 0, 1, + 0, 0, 0, 1, 1, 1, 0), 7, 5, + dimnames = list(paste0("t", 1:7), NULL)) + dat <- MatrixToPhyDat(m) + + expect_warning(unalignedTip <- ClusteringConcordance(tree, dat), + "Could not find 't8'") + # A 7-tip unrooted tree has 4 non-trivial splits, not the 8-tip tree's 5: + # a length-only check would pass on any value as long as there are 4 of + # them, so also check against an independently pre-pruned computation. + expect_length(unalignedTip, 4) + expect_equal( + unname(unalignedTip), + unname(ClusteringConcordance(KeepTip(tree, paste0("t", 1:7)), dat)) + ) + expect_equal( + unname(unalignedTip), + c(0.109967375127757, 0.033229499076686, 0.00282104205138079, + 0.133541001846628), + tolerance = 1e-8 + ) + # Split names must stay keyed to `tree`'s OWN node numbering (not a pruned + # copy's renumbered nodes): ConcordanceTable() and PaintCharacters() later + # match these names against the caller's unpruned `tree$edge`, so a + # renumbering would silently misattribute values to the wrong edge. + expect_true(all(names(unalignedTip) %in% names(as.Splits(tree)))) + + # ConcordanceTable()'s paint feature and PaintCharacters() both re-derive + # `tree$edge`-based node lookups from ClusteringConcordance()'s split names; + # confirm they still run (rather than silently misattributing colours) when + # `tree` carries a tip absent from `dataset`. + pdf(NULL) + on.exit(dev.off()) + expect_warning( + ConcordanceTable(tree, dat, paintSize = 1), + "Could not find 't8'" + ) + expect_warning(cols <- PaintCharacters(dat, tree), "Could not find 't8'") + expect_length(cols, 5L) +}) + +test_that("ConcordanceTable() handles 1-split trees and 1-pattern datasets (#92)", { + tree4 <- BalancedTree(4) + dat3 <- MatrixToPhyDat(matrix(c(0, 0, 1, 1, + 0, 1, 0, 1, + 0, 0, 0, 1), 4, 3, + dimnames = list(tree4$tip.label, NULL))) + # Previously: "non-numeric matrix extent" (cc["hBest", , ] drops to a + # vector once the split axis has extent 1). + pdf(NULL) + on.exit(dev.off()) + ret <- ConcordanceTable(tree4, dat3) + expect_equal(dim(ret$quality), c(1L, 3L)) + + tree6 <- BalancedTree(6) + dat1 <- MatrixToPhyDat(matrix(c(0, 0, 1, 1, 0, 1), 6, 1, + dimnames = list(tree6$tip.label, NULL))) + ret1 <- ConcordanceTable(tree6, dat1) + expect_equal(dim(ret1$quality), c(3L, 1L)) + # rownames(info) feeds `largeClade`'s node lookup; must survive the drop. + expect_setequal(rownames(ret1$info), rownames(as.logical(as.Splits(tree6)))) + + # The margin-strip branch takes an independent `cc["hSplit", , ]` slice. + retMargin <- ConcordanceTable(tree6, dat1, marginSize = c(1, 1, 0, 0)) + expect_equal(dim(retMargin$quality), c(3L, 1L)) +}) + +test_that("ClusteringConcordance(return = 'char') handles 1-pattern data (#93)", { + tree <- BalancedTree(6) + dat1 <- MatrixToPhyDat(matrix(c(0, 0, 1, 1, 0, 1), 6, 1, + dimnames = list(tree$tip.label, NULL))) + # Previously: "dim(X) must have a positive length" + # (apply(hh["miRand", , ], 2, max) drops to a vector when nPattern == 1). + ret <- ClusteringConcordance(tree, dat1, return = "char") + expect_length(ret, 1L) + expect_true(is.finite(ret)) +}) + +test_that("QuartetConcordance() handles a {0,-} contrast level (#108)", { + # A level combining an applicable state with "-" (e.g. `{0-}`) sets exactly + # one non-"-" contrast column, so it was misclassified as a pure + # single-state (grouping) level; `which()` then returned two column + # indices for it, making `groupingCols` ragged and + # `as.integer(groupingCols)` fail. + tree <- BalancedTree(6) + m <- matrix(c("0", "1", "0", "1", "{0-}", "1", + "0", "0", "1", "1", "0", "1"), 6, 2, + dimnames = list(tree$tip.label, NULL)) + dat <- MatrixToPhyDat(m) + expect_no_error(ret <- QuartetConcordance(tree, dat)) + expect_length(ret, length(as.Splits(tree))) + expect_true(all(is.na(ret) | (ret >= 0 & ret <= 1))) + + # `{0-}` must convey no grouping information, exactly like `?` -- not + # merely avoid crashing. + mAmbig <- m + mAmbig[mAmbig == "{0-}"] <- "?" + expect_equal(ret, QuartetConcordance(tree, MatrixToPhyDat(mAmbig))) +}) + +test_that("QuartetConcordance(return = ) rejects typos and finds 'edge' (#109)", { + tree <- BalancedTree(6) + dat <- MatrixToPhyDat(matrix(c(0, 0, 1, 1, 0, 1, + 0, 1, 0, 1, 0, 1), 6, 2, + dimnames = list(tree$tip.label, NULL))) + # Previously: `pmatch(nomatch = 3)` silently fell through to the "default" + # (edge) branch for both `"edge"` (the documented, default value) and any + # typo, so no input to `return` could ever raise an error. + edgeExplicit <- QuartetConcordance(tree, dat, return = "edge") + edgeDefault <- QuartetConcordance(tree, dat) + expect_equal(edgeExplicit, edgeDefault) + + expect_error(QuartetConcordance(tree, dat, return = "typo"), + "must .* match") + expect_error(QuartetConcordance(tree, dat, return = "site"), + "must .* match") +}) + +test_that("Concordance functions document NaN for uninformative pairs (#110)", { + # No character is informative for any split (a single variable character, + # rest ambiguous), so `support[, 2]` (possible information) is zero: a + # 0 / 0 division that was returned but not documented as possible. + tree <- BalancedTree(8) + mataset <- matrix(c(0, 0, 0, 0, 0, 0, 0, 1, + rep("?", 8)), 8, + dimnames = list(paste0("t", 1:8), NULL)) + dat <- MatrixToPhyDat(mataset) + expect_true(all(is.nan(PhylogeneticConcordance(tree, dat)))) + + # That behaviour is unchanged by design (#110 asks only that it be + # documented); check the documentation itself names the NaN case for all + # three affected functions. Read from the installed Rd database, not + # `man/` in the source tree: under `R CMD check`, tests run from an + # isolated copy that does not include `man/` as a sibling directory. + rd <- tools::Rd_db("TreeSearch")[["SiteConcordance.Rd"]] + rdConn <- textConnection("rdLines", "w", local = TRUE) + tools::Rd2txt(rd, out = rdConn) + close(rdConn) + rdText <- gsub("\\s+", " ", paste(rdLines, collapse = " ")) + expect_match(rdText, "NaN.*is returned for a character") + expect_match(rdText, "NaN.*is returned for a split") + # One mention for each of MutualClusteringConcordance, PhylogeneticConcordance + # and SharedPhylogeneticConcordance. + expect_length(regmatches(rdText, gregexpr("NaN", rdText))[[1]], 3L) +}) + +test_that("ConcordantInformation() warning names every affected character (#111)", { + # Characters 2 and 4 are identical, so they compress to the same pattern; + # mock `StepInformation()` to return a profile too short to index at the + # pattern's actual extra-step count, forcing `signal[i]` to go out of + # bounds (NA) for that pattern alone. The warning previously used + # `match(which(na), index)`, which reports only the first character + # sharing an affected pattern (2), silently omitting the second (4). + tree <- PectinateTree(6) + m <- matrix(c(0, 0, 0, 0, 0, 0, + 0, 1, 0, 1, 0, 1, + 1, 1, 1, 1, 1, 1, + 0, 1, 0, 1, 0, 1, + 0, 0, 0, 0, 0, 0), 6, 5, + dimnames = list(tree$tip.label, NULL)) + dataset <- MatrixToPhyDat(m) + index <- attr(dataset, "index") + extraSteps <- CharacterLength(tree, dataset, compress = TRUE) - + MinimumLength(dataset, compress = TRUE) + # Sanity-check the fixture: characters 2 & 4 share a pattern requiring + # extra steps; the other characters' patterns require none. + expect_equal(index, c(1L, 2L, 3L, 2L, 1L)) + expect_equal(unname(extraSteps), c(0, 2, 0)) + + testthat::local_mocked_bindings( + StepInformation = function(...) c("0" = 0), + .package = "TreeSearch" + ) + expect_warning( + suppressMessages(ConcordantInformation(tree, dataset)), + "characters 2, 4;" + ) +}) + +test_that(".ExpectedMICache is bounded (#106)", { + # `mi_key()` sorts and encodes `b` as uint16_t (src/expected_mi.cpp), so a + # naive `i %% k`/`i %/% k` split can still collide: swapping the two parts + # sorts to the same key, and the parts' ranges must not overlap or two + # different `i` produce the same unordered pair. Offsetting `hi` well + # clear of `lo`'s range keeps every (lo, hi) pair -- and so every key -- + # distinct across `limit + 5` iterations, genuinely exercising eviction + # (rather than plateauing below `limit` on collisions and never firing it). + cache <- TreeSearch:::.ExpectedMICache + size <- TreeSearch:::.ExpectedMICacheSize + limit <- TreeSearch:::.ExpectedMICacheLimit + rm(list = ls(cache, all.names = TRUE), envir = cache) + size$n <- 0L + on.exit({ + rm(list = ls(cache, all.names = TRUE), envir = cache) + size$n <- 0L + }) + + n <- limit + 5L + for (i in seq_len(n)) { + TreeSearch:::.ExpectedMI(c(1L, 2L), c(1L, 2L, i %% 320L, 1000L + i %/% 320L)) + } + expect_lte(length(cache), limit) + expect_lte(size$n, limit) + # The policy wipes on overflow, so what's left is `n - limit` entries from + # after the (one) wipe -- not merely "some number under the limit". + expect_equal(size$n, n - limit) +}) + test_that("QACol() handles input", { expect_equal(is.na(QACol(c(0, 1, NA, NA, 0), c(0, 1, NA, 0, NA))), c(FALSE, FALSE, TRUE, diff --git a/tests/testthat/test-Consistency.R b/tests/testthat/test-Consistency.R index 42f2cf43c..5a73ebb9a 100644 --- a/tests/testthat/test-Consistency.R +++ b/tests/testthat/test-Consistency.R @@ -30,7 +30,7 @@ test_that("CI & RI calculated correctly", { r <- (g - s) / (g - m) expect_equal( Consistency(StringToPhyDat(char, TipLabels(tree)), tree, nRelabel = 0), - c(ci = m / s, ri = r, rc = r * m / s, rhi = NA) + rbind(c(ci = m / s, ri = r, rc = r * m / s, rhi = NA), deparse.level = 0) ) }) @@ -58,7 +58,8 @@ test_that("RHI calculated okay", { # RHI uses leaf rearrangement, not randomization expect_equal( Consistency(StringToPhyDat(char, TipLabels(tree)), tree, nRelabel = 100), - c(ci = m / s, ri = r, rc = r * m / s, rhi = h / (null - m)) + rbind(c(ci = m / s, ri = r, rc = r * m / s, rhi = h / (null - m)), + deparse.level = 0) ) }) @@ -92,6 +93,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 +134,154 @@ 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))) - +}) + +test_that(".SortTokens() keeps a present-only partial-ambiguity token", { + # "-" = 1, "0" = 2, "1" = 4, "2" = 8, "?" = 15 (fully ambiguous), + # "(01)" = 6 (ambiguous over states 0 and 1 only) + contr <- c(1, 2, 4, 8, 15, 6) + # Character uses only "-", "0", "1" and "(01)" -- token 5 ("?") never + # appears, so the dataset-wide ambiguous set {15, 6} is broader than the + # ambiguous tokens actually present in this character ({6}) + char <- rep(c(2, 3, 6), c(3, 3, 3)) + + # "(01)" must be rewritten to the union of its own two present states' + # new codes (0 -> 2, 1 -> 4; union = 6), not corrupted by "?" + expect_equal(TreeSearch:::.SortTokens(char, contr, inapp = 1), + rep(c(2, 4, 6), c(3, 3, 3))) + + # A second contrast in which the only ambiguous token present ("?", fully + # ambiguous) sits at a different position from the unused ambiguous token + # ("(01)", contr[5]) + expect_equal( + TreeSearch:::.SortTokens(c(1, 1, 3, 3, 3, 3, 3, 3, 3, 2, 2, 1), + c(7, 1, 2, 4, 3)), + c(14, 14, 2, 2, 2, 2, 2, 2, 2, 4, 4, 14) + ) +}) + +test_that("ExpectedLength() cache does not collide across tree topologies", { + tips <- paste0("t", 1:16) + bal <- TreeTools::BalancedTree(tips) + pec <- TreeTools::PectinateTree(tips) + charDat <- StringToPhyDat("0000000000011111", tips) + + set.seed(999) + balLength <- ExpectedLength(charDat, bal, 500) + # Scoring `bal` first populates .CharLengthCache; the pectinate query below + # must not silently reuse `bal`'s cache entry + set.seed(999) + pecLength <- ExpectedLength(charDat, pec, 500) + + expect_equal(balLength, 4) + expect_equal(pecLength, 5) + + # Re-querying `bal` (without resetting the seed) must still return its own + # cached value, confirming the cache is actually being hit and not merely + # avoiding collisions by chance + expect_equal(ExpectedLength(charDat, bal, 500), balLength) +}) + +test_that("ExpectedLength() cache key is invariant to edge order and labels", { + tips <- paste0("t", 1:10) + tree <- TreeTools::BalancedTree(tips) + charDat <- StringToPhyDat("0000011111", tips) + + set.seed(101) + postLength <- ExpectedLength(charDat, TreeTools::Postorder(tree), 200) + nKeys <- length(ls(TreeSearch:::.CharLengthCache)) + + # Each of these presents the same rooted shape, so each must reuse the + # existing entry rather than add one. Asserting the key count, rather than + # the returned value, is what makes this a regression test: the median is + # stable enough that a recomputation would return the same number. + expect_equal(ExpectedLength(charDat, TreeTools::Preorder(tree), 200), + postLength) + expect_equal(ExpectedLength(charDat, ape::rotate(tree, length(tips) + 2L), + 200), postLength) + # A different labelling of the same shape samples the same distribution, so + # it shares the entry too + relabelled <- TreeTools::RenumberTips( + TreeTools::BalancedTree(sample(tips)), tips) + expect_equal(ExpectedLength(charDat, relabelled, 200), postLength) + + expect_equal(length(ls(TreeSearch:::.CharLengthCache)), nKeys) +}) + +test_that(".ShapeKey() identifies rooted shapes", { + tips <- paste0("t", 1:12) + bal <- TreeTools::BalancedTree(tips) + pec <- TreeTools::PectinateTree(tips) + + # Invariant to edge order, node rotation and labelling; distinguishes shape + expect_equal(TreeSearch:::.ShapeKey(TreeTools::Preorder(bal)), + TreeSearch:::.ShapeKey(TreeTools::Postorder(bal))) + expect_equal(TreeSearch:::.ShapeKey(ape::rotate(bal, 15L)), + TreeSearch:::.ShapeKey(bal)) + expect_equal(TreeSearch:::.ShapeKey(TreeTools::RenumberTips( + TreeTools::BalancedTree(rev(tips)), tips)), + TreeSearch:::.ShapeKey(bal)) + expect_false(TreeSearch:::.ShapeKey(pec) == TreeSearch:::.ShapeKey(bal)) + + # Agrees with TreeTools' independent enumeration as an equivalence relation + set.seed(2) + trees <- lapply(1:60, function(i) TreeTools::RandomTree(9, root = TRUE)) + mine <- vapply(trees, TreeSearch:::.ShapeKey, character(1)) + theirs <- vapply(trees, function(tr) { + as.character(TreeTools::RootedTreeShape(tr)) + }, character(1)) + expect_equal(as.integer(factor(mine, levels = unique(mine))), + as.integer(factor(theirs, levels = unique(theirs)))) + + # Unlike RootedTreeShape(), no leaf-count ceiling + expect_error(TreeTools::RootedTreeShape(TreeTools::BalancedTree(56))) + expect_type(TreeSearch:::.ShapeKey(TreeTools::BalancedTree(56)), "character") + # Leaf counts whose codes pad to the same length stay distinct + expect_false(TreeSearch:::.ShapeKey(TreeTools::BalancedTree(55)) == + TreeSearch:::.ShapeKey(TreeTools::BalancedTree(56))) +}) + +test_that("Consistency() returns a matrix, not a vector, for one character", { + tree <- ape::read.tree( + text = ("((a1, a2), (((b1, b2), (c, d)), ((e1, e2), (f, g))));")) + charDat <- StringToPhyDat("0102220333", TipLabels(tree)) + + res <- Consistency(charDat, tree, nRelabel = 0) + expect_true(is.matrix(res)) + expect_equal(dim(res), c(1, 4)) + expect_equal(colnames(res), c("ci", "ri", "rc", "rhi")) +}) + +test_that("Consistency() returns the documented NaN for degenerate chars", { + tree <- TreeTools::BalancedTree(6) + tips <- TipLabels(tree) + + # Constant character: no informative variation, so observed and minimum + # length are both zero -> ci is 0/0 + constDat <- StringToPhyDat("000000", tips) + constRes <- Consistency(constDat, tree, nRelabel = 0) + expect_true(is.nan(constRes[, "ci"])) + expect_true(is.nan(constRes[, "ri"])) + expect_true(is.nan(constRes[, "rc"])) + + # Autapomorphy: a single tip differs, so maximum and minimum length + # coincide -> ri and rc are 0/0 + autDat <- StringToPhyDat("000001", tips) + autRes <- Consistency(autDat, tree, nRelabel = 0) + expect_true(is.nan(autRes[, "ri"])) + expect_true(is.nan(autRes[, "rc"])) + + # Median null length equals the minimum length -> rhi is 0/0 + set.seed(1) + rhiRes <- Consistency(autDat, tree, nRelabel = 50) + expect_true(is.nan(rhiRes[, "rhi"])) + + # 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)) }) diff --git a/tests/testthat/test-MaddisonSlatkin.R b/tests/testthat/test-MaddisonSlatkin.R index 00519984c..7e126826d 100644 --- a/tests/testthat/test-MaddisonSlatkin.R +++ b/tests/testthat/test-MaddisonSlatkin.R @@ -136,11 +136,13 @@ test_that("MaddisonSlatkin with 5 states", { n <- sum(states) # min steps = 4 (one fewer than number of states) ms <- MaddisonSlatkin(4:(n - 1L), states) - # On slow CI machines the 2s budget may be exceeded, yielding NA. - # Skip the value checks in that case — the budget itself is correct - # behaviour; we just can't verify the math when it fires. + # Either resource guard -- the wall-clock budget or a memo table's reserved + # capacity -- yields NA, and both are correct behaviour; the value checks + # simply cannot run when one fires. Name neither: this skipped on every + # machine for as long as the capacity was the binding guard, and a message + # that blamed the budget was part of what made that look expected. if (any(is.na(ms))) { - skip("MaddisonSlatkin 5-state computation hit time budget") + skip("MaddisonSlatkin 5-state computation hit a resource guard") } expect_equal(sum(exp(ms[is.finite(ms)])), 1, tolerance = 1e-10) @@ -192,18 +194,42 @@ test_that("StepInformation() falls back instead of hanging when the exact memo c # (observed as a 6 h --run-donttest CI timeout). The solver must now detect # the impending overflow and fall back to the MC approximation instead. # - # Two guards can trigger that fallback, and which fires is a timing-dependent - # race: the capacity guard once a memo table hits its reserved size, or the - # 2 s wall-clock budget. A fast machine reaches the capacity first (cache - # warning); a slow one reaches 2 s first (time-budget warning). Both warnings - # contain "exceeded" and both are correct outcomes -- the only wrong outcome is - # a hang. So assert completion with finite values (the anti-hang property) and - # that *some* fallback warning fired, without pinning which guard won the race. + # This character no longer overflows a memo table -- its peak demand is ~12k + # entries, within the capacity the tables now reserve -- but neither does it + # fit the 2 s budget, so it still falls back, now by the clock rather than by + # the table. Which guard wins is deliberately not asserted, nor that one + # wins at all: that is a property of how fast the machine is, and a quick + # enough one will simply finish. A fallback warning is likewise NOT + # required; requiring one would fail on exactly the machines that need no + # fallback. What the hang violated -- terminates, with usable values -- is + # what is asserted. char <- rep(c("0", "1", "2"), c(42L, 9L, 2L)) # == inapplicable Agnarsson2004 col 83 - # capture_warnings() evaluates its argument in this frame, so `si` is assigned - # here, and it collects every warning without pinning which guard won the race. + si <- StepInformation(char, n_mc = 1000L) + expect_type(si, "double") + expect_true(length(si) >= 1L && all(is.finite(si))) +}) + + +test_that("An oversized exact recursion falls back rather than running away", { + # Tier 3: this is the one case that must actually drive the recursion until a + # guard stops it, so it spends the whole budget before it can assert anything. + skip_extended() + + # sc = 52 is inside `.MS_SC_THRESHOLD[3]`, but on 75 tips the recursion is far + # more work than the gate's split-count predicts. `approx = "exact"` waives + # the gate -- and, importantly, does NOT waive the budget, which is the + # behaviour pinned here: an oversized recursion is stopped even when the + # caller has asked for exactness. + # + # Which guard stops it is not pinned. Since the memo tables were sized to the + # gate, the wall-clock budget is the one that fires in practice and the + # capacity guard has receded to what it was added for -- a backstop against + # the probe_slot() spin, which no input reachable through StepInformation now + # gets near. The wrong outcome is that spin, not which guard wins. + char <- rep(c("0", "1", "2"), c(60L, 12L, 3L)) si <- NULL - warningsSeen <- capture_warnings(si <- StepInformation(char, n_mc = 1000L)) + warningsSeen <- capture_warnings( + si <- StepInformation(char, approx = "exact", n_mc = 1000L)) expect_type(si, "double") expect_true(length(si) >= 1L && all(is.finite(si))) expect_match(paste(warningsSeen, collapse = "\n"), "exceeded") diff --git a/tests/testthat/test-ParsSim.R b/tests/testthat/test-ParsSim.R index d543b92ea..8c068b577 100644 --- a/tests/testthat/test-ParsSim.R +++ b/tests/testthat/test-ParsSim.R @@ -307,6 +307,55 @@ test_that("All characters saturated triggers warning", { expect_s3_class(result, "phyDat") }) +test_that("bitwShiftL overflow at >= 31 states errors clearly (#118)", { + # Pre-fix: bitwShiftL(1L, tip_states) silently returns NA for state codes + # >= 31, corrupting the Fitch score instead of erroring. + tree <- TreeTools::BalancedTree(8) + nChar <- c(rep(0L, 30), 1L) # a single 32-state character + expect_error(ParsSim(tree, nChar = nChar, nExtraSteps = 0L), + "at most 31 states") +}) + +test_that(".pars_sim_init_char() errors clearly when the tree cannot host the requested states (#99)", { + # Pre-fix: .safe_sample_idx(0) reached sample.int(0, 1), erroring + # opaquely ("invalid first argument" / "cannot take a sample larger than + # the population") instead of explaining why. + tree <- TreeTools::BalancedTree(2) # a single internal edge pair + expect_error(ParsSim(tree, nChar = c(0L, 0L, 1L), nExtraSteps = 0L), + "No candidate edges are available") +}) + +test_that("saturation caching reuses the step-loop result unchanged (#100)", { + # Pre-fix and post-fix must agree exactly: the fix only removes a + # redundant recompute, it must not change which characters are reported + # as saturated/exhausted or how many extra steps were placed. + tree <- TreeTools::BalancedTree(6) + set.seed(2024) + expect_warning( + result <- ParsSim(tree, nChar = c(6L), nExtraSteps = 12L), + "saturated" + ) + + expect_equal(attr(result, "saturated"), rep(TRUE, 6L)) + expect_equal(attr(result, "steps_exhausted"), rep(TRUE, 6L)) + expect_equal(attr(result, "extra_steps"), c(2L, 2L, 1L, 2L, 1L, 2L)) +}) + +test_that("saturation caching invalidates on the character's last move (#100)", { + # A character whose most recent loop iteration APPLIED a move (rather than + # finding none) must not reuse a stale cached legal-edges result at + # return: its state changed after that result was computed. Deleting the + # `legal_cache_valid[char_idx] <- FALSE` invalidation line after applying + # a transition passes every other test in this file, but silently + # reports character 4 as unsaturated here when it is, in fact, saturated. + tree <- TreeTools::BalancedTree(6) + set.seed(2) + result <- ParsSim(tree, nChar = c(4L), nExtraSteps = 1L) + + expect_equal(attr(result, "saturated"), c(FALSE, FALSE, FALSE, TRUE)) + expect_equal(attr(result, "extra_steps"), c(0L, 0L, 0L, 1L)) +}) + # --- Profile parsimony tests ------------------------------------------------ test_that("Profile mode produces valid phyDat", { diff --git a/tests/testthat/test-PrepareData.R b/tests/testthat/test-PrepareData.R index 517d9427c..93201eeb8 100644 --- a/tests/testthat/test-PrepareData.R +++ b/tests/testthat/test-PrepareData.R @@ -71,6 +71,22 @@ test_that("Resampling weights change the score", { expect_lte(TreeScore(tree, dropOne), full) }) +test_that("original_weight is not truncated for fractional weights (#139)", { + # Regression test: BootstrapTree()/JackknifeTree() resample from + # `original_weight`. If fractional character weights were floored to + # integer instead of scaled like `weight`, every value would floor to + # zero (or be biased relative to the user's specified weights), and + # resampling would silently degenerate. + tokens <- matrix(c(0, 1, 1, 0, 1, 0, 0, 1), byrow = TRUE, nrow = 4L, + dimnames = list(letters[1:4], NULL)) + pd <- TreeTools::MatrixToPhyDat(tokens) + attr(pd, "weight") <- rep(0.5, length(attr(pd, "weight"))) + + obj <- PrepareData(pd) + expect_true(all(obj[["original_weight"]] > 0)) + expect_equal(obj[["original_weight"]], obj[["weight"]]) +}) + test_that("Deprecated Morphy aliases still work", { pd <- TreeTools::MatrixToPhyDat(matrix( c("-", "-", 0, 0), byrow = TRUE, nrow = 4L, diff --git a/tests/testthat/test-QuartetResolution.R b/tests/testthat/test-QuartetResolution.R index d65eac7a2..6d6a63552 100644 --- a/tests/testthat/test-QuartetResolution.R +++ b/tests/testthat/test-QuartetResolution.R @@ -13,3 +13,18 @@ test_that("QuartetResolution()", { c("Nemertean", "Halkieria", "Wiwaxia", "Acaenoplax")) ) }) + +test_that("QuartetResolution() handles an unresolved (star) quartet", { + library("TreeTools", quietly = TRUE) + # A collapsed polytomy across all four focal tips, the shape + # MaximizeParsimony(collapse = TRUE) produces when no character resolves + # their relationship. + tips <- c("Lingula", "Halkieria", "Wiwaxia", "Acaenoplax") + tree <- as.phylo(0, 4) + tree$tip.label <- tips + internalNode <- tree$edge[tree$edge[, 2] > 4, 2] + starTree <- CollapseNode(tree, internalNode) + trees <- structure(list(starTree), class = "multiPhylo") + + expect_equal(QuartetResolution(trees, tips), NA_real_) +}) diff --git a/tests/testthat/test-Ratchet.R b/tests/testthat/test-Ratchet.R new file mode 100644 index 000000000..738596d15 --- /dev/null +++ b/tests/testthat/test-Ratchet.R @@ -0,0 +1,64 @@ +library("TreeTools", quietly = TRUE) + +# Issue #136 (A15-04): Ratchet()'s early-exit paths (stopAtScore= met either +# before or during search) skipped the bookkeeping that its return value +# depends on, so the returned tree and its "score" attribute could disagree. +# The property that must hold on every exit path: a tree's own recomputed +# TreeLength() must equal its "score" attribute. + +trueTree <- ape::read.tree(text = "(((((1,2),3),4),5),6);") +dataset <- TreeTools::StringToPhyDat("110000 111000 111100", 1:6, byTaxon = FALSE) +startTree <- TreeTools::RenumberTips(ape::read.tree( + text = "(((1, 6), 3), (2, (4, 5)));"), trueTree$tip.label) +startScore <- TreeLength(startTree, dataset) +trueScore <- TreeLength(trueTree, dataset) +preparedData <- PrepareData(dataset) + +test_that("Ratchet(stopAtScore=) already met on entry returns a consistent tree", { + result <- Ratchet(startTree, preparedData, stopAtScore = startScore, + verbosity = 0) + expect_false(is.null(attr(result, "score"))) + expect_equal(TreeLength(result, dataset), attr(result, "score")) + expect_equal(attr(result, "score"), startScore) + + resultAll <- Ratchet(startTree, preparedData, stopAtScore = startScore, + returnAll = TRUE, verbosity = 0) + expect_s3_class(resultAll, "multiPhylo") + expect_length(resultAll, 1) + expect_equal(TreeLength(resultAll[[1]], dataset), attr(resultAll[[1]], "score")) +}) + +test_that("Ratchet(stopAtScore=) met mid-search returns a consistent tree", { + oldSeed <- if (exists(".Random.seed", .GlobalEnv)) .GlobalEnv[[".Random.seed"]] else NULL + on.exit(if (is.null(oldSeed)) rm(".Random.seed", envir = .GlobalEnv) else + assign(".Random.seed", oldSeed, envir = .GlobalEnv)) + set.seed(1) + + result <- Ratchet(startTree, preparedData, stopAtScore = trueScore, + swappers = list(TBRSwap, SPRSwap, NNISwap), + ratchIter = 3, searchHits = 5, verbosity = 0) + expect_equal(attr(result, "score"), trueScore) + # This is the assertion that failed pre-fix: the tree returned carried the + # improved score but was, independently, the untouched input tree. + expect_equal(TreeLength(result, dataset), attr(result, "score")) + + resultAll <- Ratchet(startTree, preparedData, stopAtScore = trueScore, + swappers = list(TBRSwap, SPRSwap, NNISwap), + ratchIter = 3, searchHits = 5, returnAll = TRUE, + verbosity = 0) + expect_s3_class(resultAll, "multiPhylo") + # A stopAtScore hit mid-search can only ever bank the single hitting + # candidate: every earlier iteration scored above stopAtScore + suboptimal, + # so only the BREAK-path forest slot survives the keepers filter. + expect_length(resultAll, 1) + expect_equal(TreeLength(resultAll[[1]], dataset), attr(resultAll[[1]], "score")) +}) + +test_that("MultiRatchet() survives an already-met stopAtScore", { + result <- MultiRatchet(startTree, preparedData, stopAtScore = startScore, + nSearch = 2, verbosity = 0) + expect_s3_class(result, "multiPhylo") + for (phy in result) { + expect_equal(TreeLength(phy, dataset), attr(phy, "score")) + } +}) diff --git a/tests/testthat/test-TaxonInfluence.R b/tests/testthat/test-TaxonInfluence.R index 80cb60f6a..3599c2c95 100644 --- a/tests/testthat/test-TaxonInfluence.R +++ b/tests/testthat/test-TaxonInfluence.R @@ -47,3 +47,32 @@ test_that("TaxonInfluence() saves intermediate trees", { useCache = TRUE, verbosity = 1L)), inf) }) + +test_that("TaxonInfluence() normalizes Distance() matrix orientation", { + library("TreeTools", quietly = TRUE) + tree <- as.phylo(1:2, nTip = 4) # stands in for the reference trees + resultTrees <- as.phylo(1:3, nTip = 4) # stands in for a leave-one-out re-search + + # A `Distance` whose two-argument form returns dim(x) x dim(y) -- the + # "matched labels" convention -- rather than TaxonInfluence's real + # (mismatched-label) dim(y) x dim(x). Exercises the shape-normalization + # rather than assuming either orientation. + mockDistance <- function(x, y = NULL) { + if (is.null(y)) { + n <- length(x) + if (n == 2) return(matrix(c(1, 2, 0, 0), 2, 2)) # rowSums = c(1, 2) + if (n == 3) return(diag(c(1, 10, 100))) # colSums = c(1, 10, 100) + stop("unexpected call") + } + matrix(seq_len(length(x) * length(y)), nrow = length(x), ncol = length(y)) + } + testthat::local_mocked_bindings( + MaximizeParsimony = function(...) resultTrees, .package = "TreeSearch" + ) + + dataset <- list(a = 1, b = 2) + inf <- TaxonInfluence(dataset, tree = tree, Distance = mockDistance, + calcWeighted = TRUE, verbosity = 0L) + + expect_equal(unname(inf["dwMean", "a"]), 1815 / 333) +}) diff --git a/tests/testthat/test-WhenFirstHit.R b/tests/testthat/test-WhenFirstHit.R index 989fc2aff..17625e3c8 100644 --- a/tests/testthat/test-WhenFirstHit.R +++ b/tests/testthat/test-WhenFirstHit.R @@ -22,3 +22,17 @@ test_that("WhenFirstHit()", { noInfo <- as.phylo(1:10, 8) expect_equal(WhenFirstHit(noInfo), noInfo) }) + +test_that("WhenFirstHit() does not produce spurious labels from an unanchored match", { + library("TreeTools", quietly = TRUE) + # "notseed_01_extra" merely contains the "seed_\\d+" pattern; it should not + # be treated as a well-formed stage name. + trees <- list( + seed_00 = as.phylo(1, 8), + notseed_01_extra = as.phylo(2, 8) + ) + result <- WhenFirstHit(trees) + # Not every name matches the anchored pattern, so firstHit stays unset + # rather than reporting a garbled "notseed_extra" stage. + expect_null(attr(result, "firstHit")) +}) diff --git a/tests/testthat/test-WideSample.R b/tests/testthat/test-WideSample.R index 6ee593535..b2249f4c4 100644 --- a/tests/testthat/test-WideSample.R +++ b/tests/testthat/test-WideSample.R @@ -1,6 +1,6 @@ # Tier 1: runs on CRAN # Tests for WideSample() — Max-Min diversity (MMDP) tree subsampling -skip_if_not_installed("MaxMin") +skip_if_not_installed("Coreset") test_that("n >= length(trees) returns all trees", { trees <- as.phylo(0:9, nTip = 8) @@ -82,6 +82,33 @@ test_that("attributes are preserved", { expect_equal(attr(result, "hits_to_best"), 5L) }) +test_that("effort = 1 (FarFirst) preserves ascending input order", { + trees <- as.phylo(0:99, nTip = 8) + names(trees) <- paste0("tree", 0:99) + result <- WideSample(trees, 6, effort = 1) + idx <- match(names(result), names(trees)) + expect_equal(idx, sort(idx)) +}) + +test_that("firstHit is dropped rather than carried over stale", { + trees <- as.phylo(0:9, nTip = 8) + names(trees) <- paste0("tree", seq_along(trees)) + attr(trees, "firstHit") <- table(rep("seed", length(trees))) + result <- WideSample(trees, 3, effort = 1) + expect_null(attr(result, "firstHit")) +}) + +test_that("a whole-object attribute is copied unsubsetted, even if its length coincides with n", { + trees <- as.phylo(0:9, nTip = 8) + # `replicate_scores` is indexed by search replicate, not by tree, so its + # length has no relationship to length(trees); here it coincides with the + # requested subset size (3) purely to check that coincidence isn't + # mistaken for a per-tree vector and scrambled. + attr(trees, "replicate_scores") <- c(50, 48, 45) + result <- WideSample(trees, 3, effort = 1) + expect_equal(attr(result, "replicate_scores"), c(50, 48, 45)) +}) + test_that("WideSample is deterministic on the RNG-free tiers", { skip_if_not_installed("TreeDist") trees <- as.phylo(0:49, nTip = 10) @@ -135,6 +162,24 @@ test_that("bad dist argument is caught", { # Solver tiers ------------------------------------------------------------ +test_that("FarFirst() is called with named arguments, robust to formal order", { + # A stub with formals in a different order to Coreset::FarFirst()'s + # (k, d, N, ...): only fully-named call sites bind correctly regardless of + # the package's chosen formal order. + mockFarFirst <- function(d, k, N, ...) { + stopifnot(is.numeric(k), length(k) == 1, is.function(d), is.numeric(N)) + seq_len(k) + } + testthat::local_mocked_bindings(FarFirst = mockFarFirst, .package = "Coreset") + + trees <- as.phylo(0:9, nTip = 8) + expect_length(WideSample(trees, 3, effort = 1), 3) # tier-1 selection + expect_length(TreeSearch:::.WideSampleMedoid( + dist = function(a, b) rep(0, length(trees)), + trees = trees, nTrees = length(trees), dmat = NULL, buildCeiling = 0L + ), 1) +}) + test_that("effort 1/2/3 return valid diverse subsets", { skip_if_not_installed("TreeDist") trees <- as.phylo(0:39, nTip = 10) diff --git a/tests/testthat/test-expected-mi.R b/tests/testthat/test-expected-mi.R new file mode 100644 index 000000000..f7f995a1c --- /dev/null +++ b/tests/testthat/test-expected-mi.R @@ -0,0 +1,145 @@ +# Tier 1: arithmetic only, no search, whole file under a second. +# +# An independent reference for the expected mutual information under the +# hypergeometric null. lchoose() works in log space, so unlike the C++ +# recurrence it cannot underflow at the tails of the distribution. +ReferenceEmi <- function(ni, nj) { + a <- ni[[1]] + n <- sum(ni) + emi <- 0 + for (mj in nj) { + k <- max(0, a + mj - n):min(a, mj) + logP <- lchoose(mj, k) + lchoose(n - mj, a - k) - lchoose(n, a) + p <- exp(logP) + kOut <- mj - k + emi <- emi + + sum(p * ifelse(k > 0, (k / n) * log2(k * n / (a * mj)), 0)) + + sum(p * ifelse(kOut > 0, (kOut / n) * log2(kOut * n / ((n - a) * mj)), 0)) + } + emi +} + +test_that("expected_mi() is correct for large balanced partitions", { + # P(K = kmin) is around 2^-1197 at N = 1200; a recurrence seeded there + # returns exactly zero for every k. + expect_equal(expected_mi(c(550L, 550L), c(550L, 550L)), + ReferenceEmi(c(550L, 550L), c(550L, 550L)), tolerance = 1e-9) + expect_equal(expected_mi(c(600L, 600L), c(600L, 600L)), + ReferenceEmi(c(600L, 600L), c(600L, 600L)), tolerance = 1e-9) + expect_equal(expected_mi(c(1000L, 1000L), c(1000L, 1000L)), + ReferenceEmi(c(1000L, 1000L), c(1000L, 1000L)), tolerance = 1e-9) + + # `nj` as ClusteringConcordance() supplies it: a tabulate() over states, + # which need not be two + expect_equal(expected_mi(c(600L, 600L), c(300L, 300L, 300L, 300L)), + ReferenceEmi(c(600L, 600L), c(300L, 300L, 300L, 300L)), + tolerance = 1e-9) + expect_equal(expected_mi(c(437L, 1063L), c(211L, 396L, 893L)), + ReferenceEmi(c(437L, 1063L), c(211L, 396L, 893L)), + tolerance = 1e-9) + + # The value the caller that motivated the fix actually receives + expect_equal(TreeSearch:::.ExpectedMI(c(600L, 600L), c(600L, 600L)), + ReferenceEmi(c(600L, 600L), c(600L, 600L)), tolerance = 1e-9) + + # Chance-corrected mutual information is positive and decreases with N + balanced <- vapply(c(500L, 1000L, 1100L, 1200L, 2000L), function(n) { + expected_mi(c(n %/% 2L, n %/% 2L), c(n %/% 2L, n %/% 2L)) + }, double(1)) + expect_true(all(balanced > 0)) + expect_true(all(diff(balanced) < 0)) +}) + +test_that("expected_mi() is unchanged for small partitions", { + # Values produced before the recurrence was re-anchored at the mode, + # in the regime where seeding it at kmin was safe. + expect_equal(expected_mi(c(3L, 4L), c(2L, 5L)), + 0.15383715015513183, tolerance = 1e-10) + expect_equal(expected_mi(c(9L, 11L), c(4L, 7L, 9L)), + 0.084112593221791668, tolerance = 1e-10) + expect_equal(expected_mi(c(50L, 50L), c(50L, 50L)), + 0.007323652940324857, tolerance = 1e-10) + expect_equal(expected_mi(c(37L, 163L), c(11L, 60L, 129L)), + 0.0077921375666311615, tolerance = 1e-10) + expect_equal(expected_mi(c(500L, 500L), c(500L, 500L)), + 0.00072243147032421289, tolerance = 1e-10) + expect_equal(expected_mi(c(400L, 800L), c(300L, 400L, 500L)), + 0.0012047105794341356, tolerance = 1e-10) + expect_equal(expected_mi(c(1L, 6L), c(3L, 4L)), 0.15809905413668374, + tolerance = 1e-10) + expect_equal(expected_mi(c(0L, 7L), c(3L, 4L)), 0) + expect_equal(expected_mi(c(7L, 0L), c(3L, 4L)), 0) +}) + +test_that("expected_mi() rejects an `ni` that is not a pair", { + expect_error(expected_mi(3L, c(2L, 5L)), "length 2") + expect_error(expected_mi(integer(0), c(2L, 5L)), "length 2") + expect_error(expected_mi(c(1L, 2L, 4L), c(2L, 5L)), "length 2") +}) + +test_that("expected_mi() agrees across the factorial lookup boundary", { + # N exceeds the 8192-entry log-factorial table, so l2factorial() must + # return matching values from the table and from its lgamma() fallback. + expect_equal(expected_mi(c(4500L, 4500L), c(4500L, 4500L)), + ReferenceEmi(c(4500L, 4500L), c(4500L, 4500L)), + tolerance = 1e-8) + expect_equal(expected_mi(c(3000L, 7000L), c(4096L, 5904L)), + ReferenceEmi(c(3000L, 7000L), c(4096L, 5904L)), + tolerance = 1e-8) +}) + +test_that("mi_key() distinguishes block sizes above 65535", { + # Sorting is only sound because expected_mi() is invariant under both + # canonicalizations the key applies. + expect_equal(expected_mi(c(3L, 61L), c(30L, 31L)), + expected_mi(c(61L, 3L), c(31L, 30L))) + expect_identical(TreeSearch:::mi_key(c(3L, 61L), c(30L, 31L)), + TreeSearch:::mi_key(c(61L, 3L), c(31L, 30L))) + + # Fixed-width hex of the sorted values. 0x12345678 has eight distinct + # nibbles, so an emit that mis-shifts one is caught here; injectivity + # alone would not notice. + expect_identical( + TreeSearch:::mi_key(c(65597L, 3L), c(305419896L, 30L)), + paste(sprintf("%08x", c(3L, 65597L, 30L, 305419896L)), collapse = "") + ) + + # Block sizes differing by a multiple of 65536 must not share a key + aliases <- c(60L, 61L, 65596L, 65597L, 131133L) + keys <- vapply(aliases, function(n) { + TreeSearch:::mi_key(c(3L, n), c(30L, 31L)) + }, character(1)) + expect_equal(anyDuplicated(keys), 0L) + + # The cached value must belong to the partition asked for. Populate the + # small key first, so a colliding key would return it. + expect_equal(TreeSearch:::.ExpectedMI(c(3L, 61L), c(30L, 31L)), + expected_mi(c(3L, 61L), c(30L, 31L))) + expect_equal(TreeSearch:::.ExpectedMI(c(3L, 65597L), c(30L, 31L)), + expected_mi(c(3L, 65597L), c(30L, 31L))) +}) + +test_that("quartet_concordance() rejects negative state codes", { + splits <- matrix(c(TRUE, TRUE, FALSE, FALSE), ncol = 1) + characters <- matrix(c(1L, 1L, 2L, 2L), ncol = 1) + counts <- TreeSearch:::quartet_concordance(splits, characters) + expect_equal(counts[["concordant"]], matrix(1)) + expect_equal(counts[["decisive"]], matrix(1)) + + negative <- matrix(c(1L, -1L, 2L, 2L), ncol = 1) + expect_error(TreeSearch:::quartet_concordance(splits, negative), + "non-negative") + + # NA marks the absence of a state, and is not a negative code: a taxon + # scored NA counts as if it were not in the matrix at all. Six taxa give + # a quartet count that a dropped taxon could change, unlike three. + sixSplits <- matrix(c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), ncol = 1) + sixChars <- matrix(c(1L, 1L, 2L, 2L, 1L, 2L), ncol = 1) + sixCounts <- TreeSearch:::quartet_concordance(sixSplits, sixChars) + expect_equal(sixCounts[["concordant"]], matrix(1)) + expect_equal(sixCounts[["decisive"]], matrix(5)) + expect_equal( + TreeSearch:::quartet_concordance(rbind(sixSplits, TRUE), + rbind(sixChars, NA_integer_)), + sixCounts) +}) diff --git a/tests/testthat/test-rearrange.cpp.R b/tests/testthat/test-rearrange.cpp.R index e8caa0f34..4669d5e5a 100644 --- a/tests/testthat/test-rearrange.cpp.R +++ b/tests/testthat/test-rearrange.cpp.R @@ -24,30 +24,70 @@ test_that("TBR working", { expect_equal(8, length(x <- TreeSearch:::all_tbr(tr$edge, 7))) expect_equal(8, length(x <- TreeSearch:::all_tbr(tr$edge, 6))) expect_equal(8, length(x <- TreeSearch:::all_tbr(tr$edge, 3))) - + + # Move tip 1, by bisecting the root edge. Edges 1 and 2 are the two halves + # of tip 1's pendant edge, so this is a bisection like any other: the + # fragment has n - 1 = 6 leaves and hence 2 * 6 - 3 = 9 places to re-root, + # one of which recreates `tr`. + expect_equal(2 * (7 - 1) - 3 - 1, length(TreeSearch:::all_tbr(tr$edge, 2))) + # The severed tip 1 admits no re-rooting, so TBR and SPR coincide here. + expect_identical(TreeSearch:::all_tbr(tr$edge, 2), + TreeSearch:::.all_spr(tr$edge, 2)) + # Move cherry expect_equal(6, length(x <- TreeSearch:::all_tbr(tr$edge, 9))) expect_equal(6, length(x <- TreeSearch:::all_tbr(tr$edge, 5))) expect_equal(6, length(TBRMoves(tr, 5))) - + # Move more expect_equal(6, length(unique(x <- TreeSearch:::all_tbr(tr$edge, 4)))) expect_equal(3 * 4 + 2, length(unique(x <- TreeSearch:::all_tbr(tr$edge, 8)))) - - # All moves - expect_equal(6*8 + 12+ 6 + 14, length(x <- TreeSearch:::all_tbr(tr$edge, integer(0)))) - expect_equal(58, length(unique(x <- TreeSearch:::all_tbr(tr$edge, integer(0))))) # 58 not formally calculated - expect_equal(58, length(TBRMoves(tr))) - + + # All moves: seven single-leaf bisections (six pendant edges plus the root + # edge) at eight apiece, then the two cherries, the third-from-root edge, + # and the deepest internal edge. + expect_equal(7*8 + 12+ 6 + 14, length(x <- TreeSearch:::all_tbr(tr$edge, integer(0)))) + # 64 = size of the complete TBR neighbourhood of this tree, from the + # independent oracle in dev/tbr-root-edge/, which agrees with an exhaustive + # TBRSwap() sweep and with every unrooted seven-leaf topology. + expect_equal(64, length(unique(x <- TreeSearch:::all_tbr(tr$edge, integer(0))))) + expect_equal(64, length(TBRMoves(tr))) + + # TBR contains SPR by definition; omitting a break edge from either + # enumerator breaks this (agent-issues/TreeSearch#147). Key on split + # membership by tip label, which is injective over unrooted tree space and + # blind to where a tree happens to be rooted. + Key <- function (trees) { + unique(vapply(trees, function (tree) { + splits <- TreeTools::as.Splits(tree) + members <- as.logical(splits) + if (is.null(dim(members))) members <- matrix(members, nrow = 1) + colnames(members) <- attr(splits, "tip.label") + members <- members[, order(colnames(members)), drop = FALSE] + tips <- colnames(members) + paste(sort(apply(members, 1, function (inSplit) { + # Complement so that the first tip is always outside the split + if (inSplit[[1]]) inSplit <- !inSplit + paste0(tips[inSplit], collapse = ",") + })), collapse = "|") + }, character(1))) + } + expect_true(all(Key(SPRMoves(tr)) %in% Key(TBRMoves(tr)))) + tr <- Preorder(root(TreeTools::BalancedTree(14), 't1', resolve.root = TRUE)) desc <- TreeTools::CladeSizes(tr) - + external <- c(3, 6, 7, 11, 12, 13, 17, 18, 20, 21, 24:26) # Move single for (leaf in external) { expect_equal(22, length(x <- TreeSearch:::all_tbr(tr$edge, leaf))) } - + # Moving tip 1 by bisecting the root edge costs the same, for the same + # reason: 2 * 13 - 3 re-rootings of the 13-leaf fragment, less the identity. + expect_equal(2 * (14 - 1) - 3 - 1, length(TreeSearch:::all_tbr(tr$edge, 2))) + expect_identical(TreeSearch:::all_tbr(tr$edge, 2), + TreeSearch:::.all_spr(tr$edge, 2)) + Test <- function (edge) { nDesc <- desc[tr$edge[edge, 2]] expected <- (2 * nDesc - 3) * (22 - (2 * nDesc - 3)) - 1 @@ -59,9 +99,13 @@ test_that("TBR working", { }) test_that("SPR fails gracefully", { - expect_error(.TreeSearch:::all_spr(as.phylo(1, 3)$edge, integer(0))) - expect_error(.TreeSearch:::all_spr(Postorder(as.phylo(1, 6))$edge, integer(0))) - expect_error(.TreeSearch:::all_spr(SortTree(as.phylo(1, 6))$edge, integer(0))) + # `.all_spr` guards the conditions that ASAN dislikes seeing Rcpp::stop() on. + expect_error(TreeSearch:::.all_spr(as.phylo(1, 3)$edge, integer(0)), + "< 5 edges") + expect_error(TreeSearch:::.all_spr(Postorder(as.phylo(1, 6))$edge, integer(0)), + "must connect root to leaf") + expect_error(TreeSearch:::.all_spr(SortTree(as.phylo(1, 6))$edge, integer(0)), + "must connect root to leaf") }) test_that("SPR works", { diff --git a/tests/testthat/test-ts-constraint-free-taxa.R b/tests/testthat/test-ts-constraint-free-taxa.R new file mode 100644 index 000000000..805eaf2e3 --- /dev/null +++ b/tests/testthat/test-ts-constraint-free-taxa.R @@ -0,0 +1,296 @@ +# Tier 2: skipped on CRAN; see tests/testing-strategy.md +skip_on_cran() + +## agent-issues/TreeSearch#54: the constraint the search enforces must +## be the one `?MaximizeParsimony`'s `constraint` argument documents. +## +## The documented contract is the phyDat reading: a returned tree is compliant +## when some edge separates the taxa coded `1` from those coded `0`, with +## `?`-coded taxa free to fall on either side. The locked-node machinery used +## to enforce a strictly stronger one — some node's tip set had to EQUAL the 1 +## group (or its exact complement), free taxa excluded. +## +## Strict implies loose, so no wrong answer was ever returned. What broke was +## movement: a tree that satisfies the documented contract without making +## either group an exact clade mapped to no node at all, which +## regraft_violates_constraint() reads as "the tree already violates" and +## answers by rejecting EVERY rearrangement. The replicate froze on its start. +## +## So these tests assert two things together, and neither alone is the fix: +## that the search MOVES from such a start, and that what it returns is still +## compliant. + +library("TreeTools") + +# 8 taxa; three characters agree on {a,b,e,f} | {c,d,g,h} and one cuts across +# it, so the start tree below is a local optimum only for a search that cannot +# move. +freeTaxaData <- function() { + taxa <- letters[1:8] + phangorn::phyDat( + matrix(c("0", "0", "1", "1", "0", "0", "1", "1", + "0", "0", "1", "1", "0", "0", "1", "1", + "1", "1", "0", "0", "1", "1", "0", "0", + "0", "1", "0", "1", "0", "1", "0", "1", + "0", "1", "0", "1", "0", "1", "0", "1"), + nrow = 8, dimnames = list(taxa, NULL)), + type = "USER", levels = c("0", "1") + ) +} + +# c(a = 1, b = 1, c = 0, d = 0, e:h = "?") +freeTaxaConstraint <- function() { + phangorn::phyDat( + matrix(c("1", "1", "0", "0", "?", "?", "?", "?"), + nrow = 8, dimnames = list(letters[1:8], NULL)), + type = "USER", levels = c("0", "1") + ) +} + +# `{a,e,b,f}` | `{c,d,g,h}` separates {a,b} from {c,d}, so this satisfies the +# documented constraint — but {a,b} is not a clade, and neither is {c,d}. +freeTaxaStart <- function() { + ape::read.tree(text = "(((a,e),(b,f)),(c,(d,(g,h))));") +} + +# Does `tree` display a split with every tip of `inGroup` on one side and every +# tip of `outGroup` on the other? Tips in neither group are ignored — this is +# the documented contract, spelled out independently of the engine. +SeparatesGroups <- function(tree, labels, inGroup, outGroup) { + splits <- as.logical(as.Splits(tree, tipLabels = labels)) + if (!is.matrix(splits)) splits <- matrix(splits, nrow = 1) + isIn <- labels %in% inGroup + isOut <- labels %in% outGroup + any(apply(splits, 1, function(row) { + (all(row[isIn]) && !any(row[isOut])) || + (!any(row[isIn]) && all(row[isOut])) + })) +} + +# The engine hands back bare edge matrices for rooted binary trees. +EdgeSeparatesGroups <- function(edge, labels, inGroup, outGroup) { + tree <- structure( + list(edge = edge, Nnode = max(edge) - length(labels), tip.label = labels), + class = "phylo") + SeparatesGroups(tree, labels, inGroup, outGroup) +} + +test_that("free `?` taxa do not freeze a compliant start tree", { + dataset <- freeTaxaData() + labels <- names(dataset) + ds <- make_ts_data(dataset) + start <- Preorder(RenumberTips(freeTaxaStart(), labels)) + startScore <- TreeLength(start, dataset) + + # Premise: the start satisfies the documented constraint but neither group is + # a clade, so the pre-#54 exact-clade test could not map it. + expect_true(SeparatesGroups(start, labels, c("a", "b"), c("c", "d"))) + expect_false(SeparatesGroups(start, labels, c("a", "b"), + setdiff(labels, c("a", "b")))) + + # Take the split matrix from .PrepareConstraint rather than writing it out, + # so this exercises the same R -> C++ contract the user's `constraint =` + # phyDat travels along: pre-#54 it coded the free taxa 0 (making {a,b} an + # exact clade), now it codes them NA. + free <- TreeSearch:::.PrepareConstraint( + freeTaxaConstraint(), dataset)[["consSplitMatrix"]] + expect_equal(as.vector(free), c(1L, 1L, 0L, 0L, NA, NA, NA, NA)) + + set.seed(386) + result <- tbrOnlyRun(ds, start[["edge"]], free) + + # The defect: every regraft was rejected and the start came back unimproved. + expect_lt(result$best_score, startScore) + + # ... and what comes back still honours the documented constraint. + expect_true(all(vapply(result$trees, EdgeSeparatesGroups, logical(1), + labels = labels, inGroup = c("a", "b"), + outGroup = c("c", "d")))) +}) + +test_that("a 0/1 constraint matrix still enforces the exact clade", { + # Guard against over-loosening: with no free tips the two groups are + # complements, and every check must collapse back to the exact-clade test. + dataset <- freeTaxaData() + labels <- names(dataset) + ds <- make_ts_data(dataset) + start <- Preorder(RenumberTips( + ape::read.tree(text = "(((a,b),(e,f)),(c,(d,(g,h))));"), labels)) + + strict <- matrix(c(1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L), nrow = 1) + set.seed(386) + result <- tbrOnlyRun(ds, start[["edge"]], strict) + + # Guard the guard: a search that froze would satisfy the compliance test + # below for the wrong reason, since the start already has {a,b} as a clade. + expect_lt(result$best_score, TreeLength(start, dataset)) + expect_true(all(vapply(result$trees, EdgeSeparatesGroups, logical(1), + labels = labels, inGroup = c("a", "b"), + outGroup = setdiff(labels, c("a", "b"))))) +}) + +test_that("MaximizeParsimony honours and searches under a `?` constraint", { + # End to end. Unlike the TBR-only test above this cannot isolate the freeze + # — ratchet, drift and nni-perturb all get a replicate moving again by other + # means — so what it adds is that the whole pipeline still returns compliant + # trees once every entry point reads the constraint the same way. + dataset <- freeTaxaData() + labels <- names(dataset) + start <- freeTaxaStart() + + set.seed(386) + result <- suppressWarnings( + MaximizeParsimony(dataset, tree = start, + constraint = freeTaxaConstraint(), + maxReplicates = 4L, verbosity = 0L)) + expect_lt(attr(result, "score"), TreeLength(start, dataset)) + + expect_true(all(vapply(result, SeparatesGroups, logical(1), + labels = labels, inGroup = c("a", "b"), + outGroup = c("c", "d")))) +}) + +test_that("the collapse pass keeps the enforced grouping visible", { + # The one place the strict reading did return a wrong answer. A constraint + # is external evidence for a grouping, so ts_collapse_pool() protects the + # branch that realises it from contraction — but it identified that branch by + # matching a node's tip set to the `1` group EXACTLY. With free taxa the + # realising node is generally not that set, so nothing was protected and the + # separating edge was contracted away: the returned tree broke the documented + # constraint even though every tree the search visited satisfied it. + labels <- letters[1:6] + # Two characters support (a,e), two support (b,f); none supports (c,d), so + # the branch that separates {a,b} from {c,d} is unsupported and collapses + # unless it is protected. + charDat <- StringToPhyDat( + c("100010", "100010", "010001", "010001", "000000"), labels) + at <- attributes(charDat) + scoringConfig <- list( + min_steps = integer(0), concavity = Inf, xpiwe = FALSE, + xpiwe_r = 0.5, xpiwe_max_f = 5.0, obs_count = integer(0), + infoAmounts = NULL + ) + # {a,e,b,f} | {c,d} separates {a,b} from {c,d}; neither group is a clade. + tree <- Preorder(RenumberTips( + ape::read.tree(text = "(((a,e),(b,f)),(c,d));"), labels)) + cons <- phangorn::phyDat( + matrix(c("1", "1", "0", "0", "?", "?"), nrow = 6, + dimnames = list(labels, NULL)), + type = "USER", levels = c("0", "1")) + + collapsed <- TreeSearch:::ts_collapse_pool( + list(tree[["edge"]]), at$contrast, + matrix(unlist(charDat, use.names = FALSE), nrow = 6, byrow = TRUE), + at$weight, at$levels, scoringConfig, NULL, NULL, + TreeSearch:::.PrepareConstraint(cons, charDat)[["consSplitMatrix"]]) + + out <- structure( + list(edge = collapsed$trees[[1]], tip.label = labels, + Nnode = max(collapsed$trees[[1]]) - 6L), + class = "phylo") + expect_true(SeparatesGroups(Renumber(out), labels, c("a", "b"), c("c", "d"))) +}) + +test_that(".PrepareConstraint codes free taxa as NA and drops vacuous rows", { + dataset <- freeTaxaData() + + consArgs <- TreeSearch:::.PrepareConstraint(freeTaxaConstraint(), dataset) + expect_equal(nrow(consArgs[["consSplitMatrix"]]), 1L) + expect_equal(as.vector(consArgs[["consSplitMatrix"]]), + c(1L, 1L, 0L, 0L, NA, NA, NA, NA)) + + # A taxon on the tree but absent from the constraint is free too. + partial <- phangorn::phyDat( + matrix(c("1", "1", "0", "0"), nrow = 4, + dimnames = list(letters[1:4], NULL)), + type = "USER", levels = c("0", "1")) + consArgs <- TreeSearch:::.PrepareConstraint(partial, dataset) + expect_equal(as.vector(consArgs[["consSplitMatrix"]]), + c(1L, 1L, 0L, 0L, NA, NA, NA, NA)) + + # A group of fewer than two taxa is separated from the rest by every tree, so + # such a character constrains nothing under the documented contract and must + # not be enforced as a clade. It is dropped, but not silently: coding only + # `1` and `?` almost always means "group these taxa", which is not what it + # says, and the alternative reading is the one that froze replicates. + Inert <- function(...) { + phangorn::phyDat(matrix(c(...), nrow = 8, + dimnames = list(letters[1:8], NULL)), + type = "USER", levels = c("0", "1")) + } + # No `0` group at all. + expect_warning( + dropped <- TreeSearch:::.PrepareConstraint( + Inert("1", "1", "?", "?", "?", "?", "?", "?"), dataset), + "trivial constraint") + expect_equal(dropped, list()) + # A `0` group of one. The two groups are interchangeable, so this must be + # treated exactly like its mirror image below -- which the old + # `1`-group-only test did not do. + expect_warning( + TreeSearch:::.PrepareConstraint( + Inert("1", "1", "0", "?", "?", "?", "?", "?"), dataset), + "trivial constraint") + expect_warning( + TreeSearch:::.PrepareConstraint( + Inert("0", "0", "1", "?", "?", "?", "?", "?"), dataset), + "trivial constraint") + # Two and two: kept, and kept silently. + expect_silent(TreeSearch:::.PrepareConstraint( + Inert("1", "1", "0", "0", "?", "?", "?", "?"), dataset)) + + # The loudest case of all, and the one the group-size test never sees: a + # constraint with a single state, which is what MatrixToPhyDat() returns for + # the `c(a = 1, b = 1, c = 1)` "make these a clade" idiom. It reaches the + # `nConsStates < 2` early return, so it must warn there. + expect_warning( + TreeSearch:::.PrepareConstraint( + TreeTools::MatrixToPhyDat(c(a = "1", b = "1", c = "1")), dataset), + "empty constraint") +}) + +test_that("the Wagner build places free taxa freely", { + # wagner_tree_displays_constraint() and wagner_collect_active_splits() are a + # second, independent implementation of the same reading. AdditionTree() is + # the path with no post-hoc retry to fall back on (has_posthoc is set only at + # the search entry), so a Wagner build that read the constraint strictly + # would warn here — and, before the fix, was forced to place every `?` taxon + # outside the constrained group. + dataset <- freeTaxaData() + labels <- names(dataset) + cons <- freeTaxaConstraint() + + for (seed in 1:8) { + set.seed(seed) + tree <- expect_silent(AdditionTree(dataset, constraint = cons)) + expect_true(SeparatesGroups(tree, labels, c("a", "b"), c("c", "d")), + info = paste("seed", seed)) + } + + # A free taxon is genuinely free. `wagner_collect_active_splits()` used to + # read "outside the split" as ~split_tips, which put every `?` taxon in the + # apart group and forced it out of the constrained clade: the tightest node + # covering {a,b} and avoiding {c,d} was EXACTLY {a,b} in 25 of 25 seeds. It + # now holds at least one free taxon in all 25. Asserting only that {a,b} and + # {c,d} end up separated would not detect this -- an exact {a,b} clade + # separates them too. + tightest <- vapply(1:12, function(seed) { + set.seed(seed) + splits <- as.logical(as.Splits(AdditionTree(dataset, constraint = cons), + tipLabels = labels)) + isOne <- labels %in% c("a", "b") + isZero <- labels %in% c("c", "d") + sizes <- c( + rowSums(splits)[apply(splits, 1, function(r) { + all(r[isOne]) && !any(r[isZero]) + })], + (length(labels) - rowSums(splits))[apply(splits, 1, function(r) { + !any(r[isOne]) && all(r[isZero]) + })] + ) + if (length(sizes)) min(sizes) else NA_integer_ + }, numeric(1)) + # Compliant in every seed (no NA), and never pinned to the bare `1` group. + expect_false(anyNA(tightest)) + expect_true(all(tightest > 2)) +}) diff --git a/tests/testthat/test-ts-constraint-rooting.R b/tests/testthat/test-ts-constraint-rooting.R index 2ac2da24f..66cc9ebed 100644 --- a/tests/testthat/test-ts-constraint-rooting.R +++ b/tests/testthat/test-ts-constraint-rooting.R @@ -24,23 +24,8 @@ skip_on_cran() library("TreeTools") -# Everything that could rescue a rooting-dependent TBR is switched off: a Wagner -# start is re-rooted on tip 0 (796a29d3), fuse re-roots its recipient, and -# nni-perturb calls impose_constraint(), which repairs the rooting as a -# side-effect of repairing the split. -tbrOnlyRun <- function(ds, startEdge, splitMatrix) { - TreeSearch:::ts_driven_search( - ds$contrast, ds$tip_data, ds$weight, ds$levels, - maxReplicates = 1L, targetHits = 99L, tbrMaxHits = 1L, - ratchetCycles = 0L, driftCycles = 0L, nniPerturbCycles = 0L, - xssRounds = 0L, rssRounds = 0L, cssRounds = 0L, - pruneReinsertCycles = 0L, fuseInterval = 0L, - outerCycles = 1L, maxOuterResets = 0L, - nniFirst = FALSE, sprFirst = FALSE, - poolMaxSize = 100L, poolSuboptimal = 0, maxSeconds = 0, verbosity = 0L, - nThreads = 1L, startEdge = startEdge, consSplitMatrix = splitMatrix - ) -} +# tbrOnlyRun() lives in helper-ts.R: everything that could rescue a +# rooting-dependent TBR is switched off there, so the scores below are TBR's. # Phases whose timing must be zero, so a passing test cannot be one that quietly # searched its way around the mapping. Each is guarded by an explicit `> 0` diff --git a/tests/testthat/test-ts-degenerate-shapes.R b/tests/testthat/test-ts-degenerate-shapes.R new file mode 100644 index 000000000..70e2a6af6 --- /dev/null +++ b/tests/testthat/test-ts-degenerate-shapes.R @@ -0,0 +1,306 @@ +# Tier 2: skipped on CRAN; see tests/testing-strategy.md +skip_on_cran() + +# ========================================================================= +# Degenerate dataset shapes, driven through every dataset-taking entry point +# ========================================================================= +# These tests exist to be RUN UNDER A SANITIZER, not for their expectations. +# Two CI legs give the coverage: +# +# * `glibcxx-assertions` (agent-check.yml) builds with +# `-D_GLIBCXX_ASSERTIONS`, which aborts on out-of-range container +# *address formation* -- `&v[0]` on an empty vector, `v.back()` on an +# empty vector -- with no load or store required. Plain builds and +# ASan are both blind to that. +# * `gcc-ASAN` runs UBSan, which reports `memcpy`'s `nonnull` parameters +# receiving the null `.data()` of an empty vector. Hardened libstdc++ +# is blind to *that*. +# +# Every historical instance of both classes was reached by a dataset that +# left the Fitch kernel nothing to do -- `DataSet::total_words == 0` and +# `n_blocks == 0`, so the per-word state vectors are empty: +# agent-issues/TreeSearch#51 (wagner_tree), #60 (no assertions leg at all), +# #124 (TbrSnapshot save/restore), #151 (ts_bench_tbr_phases). Each was +# found by a sanitizer stumbling into the shape, never by a test aimed at +# it; this file aims at it. +# +# The expectations below are contract checks, deliberately shallow: an +# entry point that swallows a degenerate dataset silently is as much a bug +# as one that aborts, so each call asserts something the API *promises*. +# The deep check is that the process is still alive to run them. + +Rp <- function(x, n) rep(x, n) + +DegenerateDat <- function(nTip, cols) { + mat <- do.call(cbind, cols) + rownames(mat) <- paste0("t", seq_len(nTip)) + MatrixToPhyDat(mat) +} + +# Bridge arguments in the form every ts_* entry point takes. +DatBits <- function(dataset) { + at <- attributes(dataset) + list(contrast = at$contrast, + tipData = matrix(unlist(dataset, use.names = FALSE), + nrow = length(dataset), byrow = TRUE), + weight = at$weight, levels = at$levels) +} + +nTip <- 8L +zeroWordSets <- list( + allConstant = DegenerateDat( + nTip, list(Rp("0", nTip), Rp("0", nTip), Rp("0", nTip))), + allConstantOnes = DegenerateDat(nTip, list(Rp("1", nTip), Rp("1", nTip))), + allAutapomorphic = DegenerateDat( + nTip, list(c("1", Rp("0", nTip - 1)), c(Rp("0", nTip - 1), "1"))), + allInapplicable = DegenerateDat(nTip, list(Rp("-", nTip), Rp("-", nTip))), + ambiguousPlusConstant = DegenerateDat( + nTip, list(Rp("?", nTip), Rp("0", nTip))), + minimumTips = DegenerateDat(3L, list(Rp("0", 3L), Rp("0", 3L))) +) + + +test_that("uninformative datasets really do leave the Fitch kernel empty", { + # The premise the rest of this file rests on. If simplification ever + # stops collapsing these to zero blocks, the shapes below stop testing + # what they were written to test, and this expectation says so loudly + # rather than letting the file quietly go vacuous. + for (nm in names(zeroWordSets)) { + dataset <- zeroWordSets[[nm]] + tree <- FixedTree(dataset, 1L) + bits <- DatBits(dataset) + phases <- TreeSearch:::ts_bench_tbr_phases( + tree$edge, bits$contrast, bits$tipData, bits$weight, bits$levels) + expect_equal(phases$total_words, 0L, info = nm) + expect_equal(phases$n_blocks, 0L, info = nm) + } +}) + + +test_that("zero-Fitch-word datasets score correctly", { + # A zero-word dataset is not necessarily a zero-score dataset: + # autapomorphies are dropped from the kernel but each still contributes + # its one inevitable step to the total. + Score <- function(dataset) { + bits <- DatBits(dataset) + TreeSearch:::ts_tbr_search(FixedTree(dataset, 1L)$edge, bits$contrast, + bits$tipData, bits$weight, bits$levels)$score + } + expect_equal(Score(zeroWordSets$allConstant), 0) + expect_equal(Score(zeroWordSets$allInapplicable), 0) + expect_equal(Score(zeroWordSets$ambiguousPlusConstant), 0) + # Two autapomorphic characters, one step each, on any topology. + expect_equal(Score(zeroWordSets$allAutapomorphic), 2) + + autapomorphic <- zeroWordSets$allAutapomorphic + tree <- FixedTree(autapomorphic, 1L) + expect_equal(TreeLength(tree, autapomorphic), 2) + expect_equal(unname(CharacterLength(tree, autapomorphic)), c(1, 1)) + expect_equal(unname(CharacterLength(FixedTree(zeroWordSets$allConstant, 1L), + zeroWordSets$allConstant)), + c(0, 0, 0)) +}) + + +test_that("every dataset-taking entry point survives zero Fitch words", { + for (nm in names(zeroWordSets)) { + dataset <- zeroWordSets[[nm]] + tree <- FixedTree(dataset, 1L) + edge <- tree$edge + bits <- DatBits(dataset) + co <- bits$contrast + tp <- bits$tipData + wt <- bits$weight + lv <- bits$levels + nTaxa <- length(dataset) + + for (concavity in c(-1, 10)) { + expect_type(TreeSearch:::ts_fitch_score(edge, co, tp, wt, lv, + concavity = concavity), "double") + expect_type(TreeSearch:::ts_tbr_search(edge, co, tp, wt, lv, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_spr_search(edge, co, tp, wt, lv, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_nni_search(edge, co, tp, wt, lv, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_ratchet_search(edge, co, tp, wt, lv, + nCycles = 2L, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_drift_search(edge, co, tp, wt, lv, + nCycles = 2L, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_rss_search(edge, co, tp, wt, lv, + ratchetCycles = 2L, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_xss_search(edge, co, tp, wt, lv, + ratchetCycles = 2L, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_tbr_diagnostics(edge, co, tp, wt, lv, + concavity = concavity), + "list") + expect_type(TreeSearch:::ts_wagner_tree(co, tp, wt, lv, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_random_wagner_tree(co, tp, wt, lv, + concavity = concavity), + "list") + expect_type(TreeSearch:::ts_tree_fuse(edge, co, tp, wt, lv, + pool_edges = list(edge, edge), + pool_scores = c(0, 0), + max_rounds = 2L, + concavity = concavity), "list") + expect_type(TreeSearch:::ts_resample_search(co, tp, wt, lv, + maxReplicates = 2L, + ratchetCycles = 1L, + concavity = concavity), + "list") + expect_type(TreeSearch:::ts_successive_approx(co, tp, wt, lv, + maxSAIter = 2L, + maxReplicates = 2L, + ratchetCycles = 1L, + concavity = concavity), + "list") + expect_type(TreeSearch:::ts_parallel_resample(co, tp, wt, lv, + nReplicates = 2L, + nThreads = 2L, + maxReplicates = 2L, + ratchetCycles = 1L, + concavity = concavity), + "list") + } + + expect_type(TreeSearch:::ts_char_steps(edge, co, tp, wt, lv), "integer") + expect_type(TreeSearch:::ts_na_char_steps(edge, co, tp, wt, lv), "list") + expect_type(TreeSearch:::ts_simplify_diag(co, tp, wt, lv), "list") + expect_type(TreeSearch:::ts_collapsed_flags_debug(edge, co, tp, wt, lv, + TRUE), "list") + expect_type(TreeSearch:::ts_collapsed_flags_debug(edge, co, tp, wt, lv, + FALSE), "list") + expect_type(TreeSearch:::ts_debug_clip(edge, co, tp, wt, lv, nTaxa + 2L), + "list") + expect_type(TreeSearch:::ts_sector_diag(edge, co, tp, wt, lv, nTaxa + 2L), + "list") + expect_type(TreeSearch:::ts_pool_test(list(edge, edge), c(0, 0), nTaxa), + "list") + + # The benchmark harness reports no per-phase work rather than timing + # zero-byte copies over empty buffers (agent-issues/TreeSearch#151). + phases <- TreeSearch:::ts_bench_tbr_phases(edge, co, tp, wt, lv) + expect_equal(phases$n_clips, 0L, info = nm) + expect_equal(phases$n_snapshot_iters, 0L, info = nm) + } +}) + + +test_that("the user-facing API survives zero Fitch words", { + # Three taxa have exactly one topology, so search is refused outright. + expect_error( + MaximizeParsimony(zeroWordSets$minimumTips, + tree = FixedTree(zeroWordSets$minimumTips, 1L), + maxReplicates = 2L, verbosity = 0L), + "at least 4 taxa" + ) + + for (nm in setdiff(names(zeroWordSets), "minimumTips")) { + dataset <- zeroWordSets[[nm]] + tree <- FixedTree(dataset, 1L) + for (concavity in list(Inf, 10, "profile")) { + trees <- suppressWarnings( + MaximizeParsimony(dataset, tree = tree, concavity = concavity, + maxReplicates = 2L, verbosity = 0L)) + expect_s3_class(trees[[1]], "phylo") + expect_setequal(trees[[1]]$tip.label, names(dataset)) + expect_true(is.numeric(TreeLength(tree, dataset, concavity = concavity))) + } + # One length per character, not per distinct pattern. + expect_length(CharacterLength(tree, dataset), + sum(attr(dataset, "weight"))) + expect_type(Consistency(dataset, tree), "double") + if (sum(attr(dataset, "weight")) >= 3) { + # Jackknifing a two-character matrix deletes nothing and is rejected + # before any C++ runs, so it would test nothing here. + expect_s3_class(suppressWarnings(Resample(dataset, tree, + maxReplicates = 2L)), + "multiPhylo") + } + } +}) + + +test_that("all-hierarchy data (zero Fitch words) survives HSJ and XFORM", { + # Complements test-ts-hsj.R's search-level regression: HSJ and XFORM both + # zero-weight every hierarchy character, so a dataset whose characters are + # ALL hierarchical empties the equal-weights kernel while the search must + # still work from the hierarchy term alone. + mat <- matrix(c( + "1", "0", "0", "-", "-", + "1", "1", "1", "0", "1", + "0", "-", "1", "1", "0", + "1", "0", "1", "0", "0", + "0", "-", "0", "-", "-", + "1", "1", "0", "-", "-" + ), nrow = 6, byrow = TRUE, dimnames = list(paste0("t", 1:6), NULL)) + dataset <- phangorn::phyDat(mat, type = "USER", levels = c("-", "0", "1"), + ambiguity = "?") + hierarchy <- CharacterHierarchy("1" = 2L, "3" = 4:5) + expect_length(setdiff(seq_len(5L), HierarchyChars(hierarchy)), 0L) + tree <- FixedTree(dataset, 1L) + + for (mode in c("hsj", "xform")) { + expect_true(is.numeric(TreeLength(tree, dataset, hierarchy = hierarchy, + inapplicable = mode))) + # The x-transformation's score is rooting-dependent, so on all-hierarchy + # data its MPT set can hold trees of differing length at a common + # rooting; the search is required to say so rather than report the set + # as if it were homogeneous (see ?MaximizeParsimony). + trees <- suppressWarnings( + MaximizeParsimony(dataset, tree = tree, hierarchy = hierarchy, + inapplicable = mode, hsj_alpha = 1, + maxReplicates = 3L, targetHits = 2L, verbosity = 0L)) + expect_s3_class(trees[[1]], "phylo") + expect_setequal(trees[[1]]$tip.label, names(dataset)) + } +}) + + +test_that("L3b incremental edge sets survive degenerate data", { + # `l3b_active` (ts_tbr.cpp) needs `tree.n_tip >= 150` unless + # TS_L3B_INCREMENTAL forces it, so its six memcpy sites and its + # `&edge_set_buf[db]` address formations are unreachable from any + # ordinarily-sized test. Force the path on a small tree instead of + # paying for 150 tips. That the knob is sufficient here was checked, not + # assumed -- `l3b_active` also requires a null sector mask, no tabu and no + # pool collection, and this call satisfies all of them: run it with + # TS_L3B_STATS=1 and the stats line reports patch_clips = 36. + # + # The two zero-word datasets below are the complementary case: L3b is + # correctly *inert* for them, because `l3b_active` requires + # `use_directional`, which requires `total_words > 0`. Between them the + # two halves cover both sides of that guard. + original <- Sys.getenv("TS_L3B_INCREMENTAL", unset = NA) + on.exit({ + if (is.na(original)) { + Sys.unsetenv("TS_L3B_INCREMENTAL") + } else { + Sys.setenv(TS_L3B_INCREMENTAL = original) + } + }, add = TRUE) + Sys.setenv(TS_L3B_INCREMENTAL = "1") + + informative <- DegenerateDat(12L, list( + c(Rp("0", 6), Rp("1", 6)), c(Rp("0", 5), Rp("1", 7)), + c(Rp("1", 3), Rp("0", 9)), rep(c("0", "1"), 6) + )) + for (dataset in list(informative, zeroWordSets$allConstant, + zeroWordSets$allAutapomorphic)) { + tree <- FixedTree(dataset, 1L) + bits <- DatBits(dataset) + result <- TreeSearch:::ts_tbr_search(tree$edge, bits$contrast, + bits$tipData, bits$weight, + bits$levels) + expect_true(is.numeric(result$score)) + expect_type(TreeSearch:::ts_ratchet_search(tree$edge, bits$contrast, + bits$tipData, bits$weight, + bits$levels, nCycles = 2L), + "list") + } +}) diff --git a/tests/testthat/test-ts-driven.R b/tests/testthat/test-ts-driven.R index 1802bd44a..b70955978 100644 --- a/tests/testthat/test-ts-driven.R +++ b/tests/testthat/test-ts-driven.R @@ -297,6 +297,11 @@ test_that("startEdge accepts a bare matrix or a list of matrices", { expect_error(Run(list(edges[[1]][, 1, drop = FALSE])), "exactly 2 columns") expect_error(Run(list()), "supplies no edge matrices") + # A 0 x 2 matrix satisfies every check above, then reaches + # `flat.data() + n_edge` on an empty vector -- pointer arithmetic that is + # undefined before C++20 and that neither sanitizer leg reports. + expect_error(Run(list(edges[[1]][0, , drop = FALSE])), + "at least one edge") }) test_that("MaximizeParsimony() uses C++ engine", { diff --git a/tests/testthat/test-ts-memory-layout.R b/tests/testthat/test-ts-memory-layout.R index 13da94fc1..72e5587b7 100644 --- a/tests/testthat/test-ts-memory-layout.R +++ b/tests/testthat/test-ts-memory-layout.R @@ -195,3 +195,45 @@ test_that("Bench function works with synthetic binary data", { expect_true(result$n_blocks > 0) expect_true(result$n_candidates > 0) }) + +test_that("ts_bench_tbr_phases stops rather than benchmarking zero Fitch words", { + # An all-constant matrix simplifies away every Fitch block, so total_words + # and n_blocks are both zero and prelim / vroot_cache / the snapshot buffers + # are empty vectors. The function used to run its whole clip loop and + # snapshot benchmark over them -- 18 clips and 434 snapshot iterations on a + # 12-tip tree -- indexing element 0 of empty vectors and memcpy'ing null + # pointers. Both are undefined behaviour; neither aborted a release build, + # which is why this went unnoticed. + # + # Assert the contract, not the timings: with no Fitch words there is no + # per-phase work, so the counts are zero and the structural fields still + # describe the input. The Phase A score is computed before the guard and + # remains real. + set.seed(1) + nTip <- 12L + tree <- RandomTree(paste0("t", seq_len(nTip)), root = TRUE) + mat <- matrix("0", nrow = nTip, ncol = 3, + dimnames = list(tree$tip.label, NULL)) + ds <- MatrixToPhyDat(mat) + at <- attributes(ds) + tipData <- matrix(unlist(ds, use.names = FALSE), + nrow = length(ds), byrow = TRUE) + + result <- TreeSearch:::ts_bench_tbr_phases( + tree$edge, at$contrast, tipData, at$weight, at$levels + ) + + expect_equal(result$total_words, 0L) + expect_equal(result$n_blocks, 0L) + + # The phases did not run. + expect_equal(result$n_clips, 0L) + expect_equal(result$n_candidates, 0L) + expect_equal(result$n_snapshot_iters, 0L) + expect_equal(result$snapshot_bytes, 0) + + # Structure is unchanged, so a caller reading these fields still works. + expect_equal(result$n_tips, nTip) + expect_false(result$has_na) + expect_true(result$time_full_rescore_us >= 0) +}) diff --git a/tests/testthat/test-ts-na-oracle.R b/tests/testthat/test-ts-na-oracle.R new file mode 100644 index 000000000..b143dfd0d --- /dev/null +++ b/tests/testthat/test-ts-na-oracle.R @@ -0,0 +1,171 @@ +# Tier 2: skipped on CRAN; see tests/testing-strategy.md +skip_on_cran() + +# Independent-reference oracle for the Brazeau, Guillerme and Smith (2019) +# three-pass inapplicable algorithm (src/ts_fitch_na.h). +# +# Every other NA test in the suite compares one TreeSearch code path against +# another (incremental vs full rescore, cached vs bounded candidate scorers). +# Such relative checks cannot see a defect shared by BOTH sides. This file +# closes that gap: it reimplements the CRITERION from first principles in R, +# with no code path in common with src/ts_fitch*, and asserts that the engine +# reproduces it exactly. +# +# Criterion, as BGS define it operationally: +# length = min, over applicability reconstructions that are FITCH-OPTIMAL +# for the binary applicable/inapplicable character, of +# sum(within-region Fitch length) + (tip-bearing regions - 1) +# +# The reference brute-forces every applicability labelling of the internal +# nodes, keeps those with the fewest applicability changes, and scores each by +# an explicit dynamic program over the resulting regions. Tips are either "-" +# (inapplicable) or an applicable state, so their applicability is fixed: this +# is the regime in which the criterion is tie-break-free. With partially +# ambiguous {-,X} tips BGS additionally prefers the APPLICABLE resolution on a +# tie (maximise homology; see test-ts-na-ambig.R), so the engine may +# legitimately exceed this minimum there -- hence the second test asserts only +# the one-sided bound that holds in every regime. + +.NaRefPostorder <- function(kids, root) { + out <- integer(0) + stack <- root + while (length(stack)) { + nd <- stack[[length(stack)]] + stack <- stack[-length(stack)] + out <- c(nd, out) + stack <- c(stack, kids[[nd]]) + } + out +} + +.NaRefLabelCost <- function(app, postorder, kids, parentOf, tipStates, nTip, k) { + nNode <- length(app) + cost <- matrix(Inf, nNode, k) + hasTip <- logical(nNode) + for (nd in postorder) { + if (!app[[nd]]) next + if (nd <= nTip) { + cost[nd, tipStates[[nd]]] <- 0 + hasTip[[nd]] <- TRUE + } else { + accum <- rep(0, k) + anyTip <- FALSE + for (kd in kids[[nd]]) { + if (!app[[kd]]) next + child <- cost[kd, ] + accum <- accum + vapply(seq_len(k), + function(s) min(child + (seq_len(k) != s)), 0) + anyTip <- anyTip || hasTip[[kd]] + } + cost[nd, ] <- accum + hasTip[[nd]] <- anyTip + } + } + total <- 0 + nRegion <- 0L + for (nd in seq_len(nNode)) { + if (!app[[nd]]) next + pa <- parentOf[[nd]] + if (is.na(pa) || !app[[pa]]) { + total <- total + min(cost[nd, ]) + if (hasTip[[nd]]) nRegion <- nRegion + 1L + } + } + total + max(0L, nRegion - 1L) +} + +.NaRefLength <- function(edge, nTip, tipStates, k) { + nNode <- max(edge) + parentOf <- rep(NA_integer_, nNode) + parentOf[edge[, 2]] <- edge[, 1] + kids <- lapply(seq_len(nNode), function(nd) edge[edge[, 1] == nd, 2]) + root <- setdiff(edge[, 1], edge[, 2])[[1]] + postorder <- .NaRefPostorder(kids, root) + tipApp <- vapply(tipStates, function(s) length(s) > 0L, TRUE) + + internals <- seq.int(nTip + 1L, nNode) + grid <- as.matrix(expand.grid(rep(list(c(FALSE, TRUE)), length(internals)))) + changes <- integer(nrow(grid)) + costs <- numeric(nrow(grid)) + for (r in seq_len(nrow(grid))) { + app <- logical(nNode) + app[seq_len(nTip)] <- tipApp + app[internals] <- grid[r, ] + changes[[r]] <- sum(app[edge[, 1]] != app[edge[, 2]]) + costs[[r]] <- .NaRefLabelCost(app, postorder, kids, parentOf, + tipStates, nTip, k) + } + min(costs[changes == min(changes)]) +} + +test_that("NA three-pass matches an independent brute-force reference", { + library("TreeTools", quietly = TRUE) + lvls <- c("-", "1", "2", "3") + set.seed(20260805) + for (case in seq_len(40L)) { + nTip <- 6L + mat <- matrix(sample(lvls, nTip, TRUE, c(0.4, 0.22, 0.2, 0.18)), + nTip, 1L, dimnames = list(paste0("t", seq_len(nTip)), NULL)) + dataset <- phangorn::phyDat(mat, type = "USER", levels = lvls) + at <- attributes(dataset) + tree <- RenumberTips(RandomTree(rownames(mat), root = TRUE), names(dataset)) + edge <- Preorder(tree)[["edge"]] + tipData <- matrix(unlist(dataset, use.names = FALSE), + nrow = length(dataset), byrow = TRUE) + engine <- TreeSearch:::ts_fitch_score(edge, at[["contrast"]], tipData, + as.integer(at[["weight"]]), + at[["levels"]], concavity = -1) + tipStates <- lapply(seq_len(nTip), function(i) { + allowed <- which(at[["contrast"]][tipData[i, 1], ] > 0) + as.integer(allowed[allowed > 1L] - 1L) + }) + reference <- .NaRefLength(edge, nTip, tipStates, length(lvls) - 1L) + expect_equal(as.numeric(engine), as.numeric(reference), + info = paste0("case ", case, ": ", + paste(mat[, 1], collapse = " "))) + } +}) + +test_that("BGS length never falls below the best possible reconstruction", { + # One-sided invariant that holds however ambiguity ties are broken: the + # reported length is the cost of SOME reconstruction, so it can never be + # cheaper than the unconstrained minimum over all node labellings. + library("TreeTools", quietly = TRUE) + lvls <- c("-", "1", "2") + ambig <- list("{-1}" = c("-", "1"), "{-2}" = c("-", "2"), + "{12}" = c("1", "2")) + allTok <- c(lvls, names(ambig)) + contrast <- matrix(0, length(allTok), length(lvls), + dimnames = list(allTok, lvls)) + for (s in lvls) contrast[s, s] <- 1 + for (nm in names(ambig)) contrast[nm, ambig[[nm]]] <- 1 + + set.seed(1234L) + for (case in seq_len(25L)) { + nTip <- 6L + mat <- matrix(sample(allTok, nTip, TRUE), nTip, 1L, + dimnames = list(paste0("t", seq_len(nTip)), NULL)) + dataset <- phangorn::phyDat(mat, type = "USER", levels = lvls, + ambiguity = names(ambig), contrast = contrast) + at <- attributes(dataset) + tree <- RenumberTips(RandomTree(rownames(mat), root = TRUE), names(dataset)) + edge <- Preorder(tree)[["edge"]] + tipData <- matrix(unlist(dataset, use.names = FALSE), + nrow = length(dataset), byrow = TRUE) + engine <- TreeSearch:::ts_fitch_score(edge, at[["contrast"]], tipData, + as.integer(at[["weight"]]), + at[["levels"]], concavity = -1) + nNode <- max(edge) + opts <- lapply(seq_len(nNode), function(nd) { + if (nd > nTip) return(0:2) + as.integer(which(at[["contrast"]][tipData[nd, 1], ] > 0) - 1L) + }) + g <- as.matrix(do.call(expand.grid, opts)) + pa <- g[, edge[, 1], drop = FALSE] + ch <- g[, edge[, 2], drop = FALSE] + bothApp <- (pa > 0) & (ch > 0) + lower <- min(rowSums(bothApp & (pa != ch)) + + pmax(0, rowSums(g > 0) - rowSums(bothApp) - 1)) + expect_gte(as.numeric(engine), lower) + } +}) diff --git a/tests/testthat/test-ts-random-constrained-free.R b/tests/testthat/test-ts-random-constrained-free.R new file mode 100644 index 000000000..53750a487 --- /dev/null +++ b/tests/testthat/test-ts-random-constrained-free.R @@ -0,0 +1,276 @@ +## agent-issues/TreeSearch#54 (follow-up): random_constrained_tree() must +## sample the trees the constraint contract ALLOWS, not the corner of them in +## which every free taxon sits outside every constrained group. +## +## The contract (`?MaximizeParsimony`, `@param constraint`) is that a tree +## complies when some edge separates the taxa coded 1 from those coded 0, +## `?`-coded taxa falling on either side. The generator built its backbone from +## the "together" group alone and made every free tip a root-level item, so the +## group always came out as an EXACT clade and no free tip ever started inside +## it. Compliant, but only a fraction of the compliant trees were reachable. + +skip_on_cran() +library("TreeTools") + +## Edge matrix (as returned by the C++ generator) -> phylo. +rctPhylo <- function(edge, tips) { + structure(list(edge = edge, tip.label = tips, + Nnode = length(tips) - 1L), + class = "phylo") +} + +## Split membership matrix, columns in `tips` order. +## +## as.Splits() reports NON-TRIVIAL splits only: it omits the pendant edge of +## each tip. Every helper below inherits that, so see rctSeparates(). +rctSplits <- function(tree, tips) { + sp <- as.Splits(tree, tipLabels = tips) + m <- as.logical(sp) + if (!is.matrix(m)) m <- matrix(m, nrow = 1) + colnames(m) <- attr(sp, "tip.label") + m[, tips, drop = FALSE] +} + +## Does some edge put all of `together` on one side and all of `apart` on the +## other? This is the documented contract, stated without reference to which +## group the machinery happens to canonicalise as "inside". +## +## Both groups must hold at least two taxa, and that is checked rather than +## assumed. A group of one is separated from everything by its own pendant +## edge, so EVERY tree satisfies such a character -- but the pendant edges are +## not in rctSplits(), so this would answer FALSE for all of them and report a +## correct sampler as broken. Measuring coverage that way is what produced the +## retracted figures this file's comments used to quote. A test that wants a +## one-taxon group must add the trivial splits first. +rctSeparates <- function(tree, tips, together, apart) { + stopifnot(length(together) > 1, length(apart) > 1) + m <- rctSplits(tree, tips) + any(apply(m, 1, function(r) { + all(r[together] == r[together][[1]]) && + all(r[apart] == r[apart][[1]]) && + r[together][[1]] != r[apart][[1]] + })) +} + +## Size of the smallest clade that holds every tip of `together` and none of +## `apart`; NA if no edge separates them. Equals length(together) exactly when +## the group is an exact clade, i.e. when no free tip sits inside it. +rctTightest <- function(tree, tips, together, apart) { + m <- rctSplits(tree, tips) + sizes <- apply(m, 1, function(r) { + for (side in list(r, !r)) { + if (all(side[together]) && !any(side[apart])) return(sum(side)) + } + NA_integer_ + }) + sizes <- sizes[!is.na(sizes)] + if (length(sizes)) min(sizes) else NA_integer_ +} + +rctDataset <- function(tips) { + n <- length(tips) + phangorn::phyDat( + matrix(c(rep_len(c("0", "1"), n), rep_len(c("1", "0"), n)), + nrow = n, dimnames = list(tips, NULL)), + type = "USER", levels = c("0", "1") + ) +} + +rctDraw <- function(tsd, splitMatrix, tips) { + rctPhylo( + TreeSearch:::ts_random_constrained_tree( + tsd$contrast, tsd$tip_data, tsd$weight, tsd$levels, + consSplitMatrix = splitMatrix), + tips) +} + +## Exhaustive: 6 taxa is small enough to enumerate every unrooted binary tree +## and say exactly which ones the constraint allows, so "does it sample at +## random from the legal set" has a yes/no answer rather than a distributional +## one. 35 of the 105 trees separate {c,d} from {a,b}. Before the fix the +## generator could return only 15 of them; the other 20 were unreachable at +## every seed. +test_that("random_constrained_tree samples every legal topology", { + tips <- letters[1:6] + ds <- rctDataset(tips) + tsd <- make_ts_data(ds) + # {c,d} together, {a,b} apart, {e,f} free. Coded 1/0/NA exactly as + # .PrepareConstraint() writes it. + splitMatrix <- matrix(c(0L, 0L, 1L, 1L, NA_integer_, NA_integer_), nrow = 1) + + treeNo <- function(tree) as.character(as.numeric(as.TreeNumber(tree))) + everyTree <- lapply(seq_len(105) - 1, + function(i) as.phylo(i, nTip = 6, tipLabels = tips)) + legal <- vapply(everyTree, rctSeparates, logical(1), + tips = tips, together = c("c", "d"), apart = c("a", "b")) + expect_equal(sum(legal), 35L) + legalNos <- vapply(everyTree[legal], treeNo, character(1)) + + seen <- character(2000) + for (s in seq_along(seen)) { + set.seed(s) + seen[[s]] <- treeNo(rctDraw(tsd, splitMatrix, tips)) + } + + # Sound: never a tree the constraint forbids. + expect_equal(setdiff(seen, legalNos), character(0)) + # Complete: every tree the constraint permits is reachable. This is what + # fails pre-fix -- 20 of the 35 never appear. + expect_equal(sort(setdiff(legalNos, seen)), character(0)) + # ...and reachable at a comparable rate, not merely grazed. Expectation is + # 2000 / 35 = 57 draws each. + hits <- as.vector(table(factor(seen, levels = legalNos))) + expect_gt(min(hits), 20) + expect_lt(max(hits), 120) +}) + +## The user-facing route in: `?`-coded taxa in a constraint phyDat, through +## .PrepareConstraint(), with the group the machinery canonicalises as "inside" +## chosen by tip 0's coding rather than by the test. +test_that("`?` taxa start inside a constrained group as well as outside", { + tips <- letters[1:8] + ds <- rctDataset(tips) + cons <- phangorn::phyDat( + matrix(c("1", "1", "0", "0", "?", "?", "?", "?"), + ncol = 1, dimnames = list(tips, NULL)), + type = "USER", levels = c("0", "1") + ) + splitMatrix <- TreeSearch:::.PrepareConstraint(cons, ds)$consSplitMatrix + tsd <- make_ts_data(ds) + + # build_constraint() swaps the groups so that tip 0 (a) is never in the + # "inside" mask, so {c,d} is the group this builds as a clade. That is the + # one a free tip could never join. + tightest <- integer(50) + for (s in seq_along(tightest)) { + set.seed(s) + tree <- rctDraw(tsd, splitMatrix, tips) + expect_true(rctSeparates(tree, tips, c("a", "b"), c("c", "d")), + info = paste("seed", s)) + tightest[[s]] <- rctTightest(tree, tips, c("c", "d"), c("a", "b")) + } + # Pre-fix this is 2 at every seed: {c,d} is always exactly a clade. + expect_gt(max(tightest), 2L) + expect_equal(min(tightest), 2L) # and still sometimes exactly a clade +}) + +## Two characters with disjoint groups. Neither clade encloses the other's +## group, so the contract lets them come out nested either way round, or as +## siblings -- and lets each take on the taxa the other names. A generator that +## derives its shape from the nesting of the "together" groups can build only +## the sibling arrangement, which is what both earlier versions did. +## +## 1155 of the 10395 unrooted trees on 8 taxa comply. Enumerating them all is +## too slow for a test, so this asserts how many DISTINCT ones 6000 draws reach: +## the sibling-only generators top out at 105 of them. +test_that("two constraints nest either way round", { + tips <- letters[1:8] + ds <- rctDataset(tips) + tsd <- make_ts_data(ds) + na <- NA_integer_ + splitMatrix <- matrix(c(1L, 1L, 0L, 0L, na, na, na, na, + na, na, na, na, 1L, 1L, 0L, 0L), + nrow = 2, byrow = TRUE) + + # One split matrix per draw, then every question answered from it: the + # per-draw work, not the sampling, is what makes this test's runtime. + sepM <- function(m, g1, g2) { + any(apply(m, 1, function(r) { + all(r[g1] == r[g1][[1]]) && all(r[g2] == r[g2][[1]]) && + r[g1][[1]] != r[g2][[1]] + })) + } + holdsM <- function(m, want, avoid, other) { + any(apply(m, 1, function(r) { + for (side in list(r, !r)) { + if (all(side[want]) && !any(side[avoid]) && all(side[other])) return(TRUE) + } + FALSE + })) + } + + nDraw <- 4000L + seen <- character(nDraw) + nest <- character(nDraw) + compliant <- logical(nDraw) + for (s in seq_len(nDraw)) { + set.seed(s) + tree <- rctDraw(tsd, splitMatrix, tips) + m <- rctSplits(tree, tips) + compliant[[s]] <- sepM(m, c("a", "b"), c("c", "d")) && + sepM(m, c("e", "f"), c("g", "h")) + seen[[s]] <- as.character(as.numeric(as.TreeNumber(tree))) + # Which clade, if either, holds the other constraint's group? + nest[[s]] <- if (holdsM(m, c("c", "d"), c("a", "b"), c("g", "h"))) { + "gh-in-cd" + } else if (holdsM(m, c("g", "h"), c("e", "f"), c("c", "d"))) { + "cd-in-gh" + } else { + "siblings" + } + } + + expect_equal(sum(!compliant), 0L) + # Both nesting orders occur, not just the sibling arrangement the backbone + # construction is limited to. + expect_setequal(unique(nest), c("gh-in-cd", "cd-in-gh", "siblings")) + # ...and the reachable set is the whole compliant one, near enough that this + # many draws find the great majority of its 1155 members. Both earlier + # versions of the generator top out at 105. + expect_gt(length(unique(seen)), 1050) +}) + +## Guard against over-loosening: a constraint that names every taxon has no +## free tips, so the generator must behave exactly as it always did. +test_that("a constraint with no free taxa still builds exact clades", { + tips <- letters[1:6] + ds <- rctDataset(tips) + tsd <- make_ts_data(ds) + splitMatrix <- matrix(c(0L, 0L, 1L, 1L, 0L, 0L), nrow = 1) + + for (s in 1:25) { + set.seed(s) + tree <- rctDraw(tsd, splitMatrix, tips) + expect_equal( + rctTightest(tree, tips, c("c", "d"), c("a", "b", "e", "f")), 2L, + info = paste("seed", s) + ) + } +}) + +## Structural validity with free tips present. Scattering them consumes +## internal node indices that the backbone did not, so the node budget +## (n_tip - 1 internal nodes, none allocated twice, none left dangling) is worth +## pinning: an over-run would corrupt the tree rather than fail loudly. +## Two splits, and a free tip 0 -- the tip whose position build_constraint() +## canonicalises the split masks around. +test_that("scattered free tips leave a well-formed tree", { + tips <- paste0("t", 1:9) + ds <- rctDataset(tips) + tsd <- make_ts_data(ds) + nTip <- 9L + nNode <- 2L * nTip - 1L + # t1 (tip 0) free in both splits; {t2,t3} vs {t4,t5}; {t6,t7} vs {t8,t9}. + na <- NA_integer_ + splitMatrix <- matrix(c( + na, 1L, 1L, 0L, 0L, na, na, na, na, + na, na, na, na, na, 1L, 1L, 0L, 0L + ), nrow = 2, byrow = TRUE) + + for (s in 1:25) { + set.seed(s) + edge <- TreeSearch:::ts_random_constrained_tree( + tsd$contrast, tsd$tip_data, tsd$weight, tsd$levels, + consSplitMatrix = splitMatrix) + expect_equal(nrow(edge), 2L * nTip - 2L, info = paste("seed", s)) + expect_true(all(edge >= 1L & edge <= nNode), info = paste("seed", s)) + # Every node but the root is somebody's child, exactly once. + expect_equal(sort(edge[, 2]), setdiff(seq_len(nNode), nTip + 1L), + info = paste("seed", s)) + tree <- rctPhylo(edge, tips) + expect_true(rctSeparates(tree, tips, c("t2", "t3"), c("t4", "t5")), + info = paste("seed", s)) + expect_true(rctSeparates(tree, tips, c("t6", "t7"), c("t8", "t9")), + info = paste("seed", s)) + } +}) diff --git a/vignettes/search-algorithm.Rmd b/vignettes/search-algorithm.Rmd index 605633638..b10751cdb 100644 --- a/vignettes/search-algorithm.Rmd +++ b/vignettes/search-algorithm.Rmd @@ -217,6 +217,36 @@ Per-strategy attempt and success counts are returned in the `strategy_diagnostics` attribute of the search result for post-hoc inspection. +## Topological constraints + +A tree satisfies a constraint character when some edge separates the taxa +coded `1` from those coded `0`. +Taxa coded `?`, and taxa that the constraint does not mention at all, are +*free*: the constraint says nothing about which side of that edge they belong +on, and a tree is compliant however they fall. +This is what `constraint` promises the user, and every part of the search reads +it the same way -- the locked-node filter that screens individual +rearrangements, the check that gates a finished replicate on its way into the +pool, the constrained Wagner build, and the minimal-SPR repair that fixes a +violating start. + +Reading a constraint more strictly -- as "the `1` group is a clade exactly", +excluding the free taxa -- never returns a wrong answer, because every +strictly-compliant tree also satisfies the user's constraint. +It does, however, cost search: a tree that satisfies the constraint the user +wrote, without making either group an exact clade, matches no node under the +stricter reading, and is then treated exactly like a violating start (below) -- +frozen, or repaired to a topology it did not need to be moved to. +Enforcing one reading everywhere is therefore a search-quality matter rather +than a correctness one. + +The free-taxa reading also determines which rearrangements are legal, not just +which trees are. +A subtree made only of free taxa may be regrafted anywhere, since moving it +cannot disturb the separating edge; and a subtree carrying `1`-group taxa may +be regrafted anywhere within the largest clade that still covers the `1` group +and excludes the `0` group, not merely within the smallest one. + ### Starting trees under a constraint Whatever its source -- a Wagner build, a random topology, or a tree supplied @@ -238,16 +268,29 @@ so a tree that breaks the constraint is never returned; and the enforced splits are protected from the final collapse pass, whichever branch happens to realise them. -"Satisfies the constraint" here means what `constraint` promises the user: some -edge separates the taxa coded `1` for a constraint character from those coded -`0`, with `?` taxa free to sit on either side. -Note that the locked-node filter used to screen individual rearrangements reads -the constraint more strictly, as "the `1` group is a clade exactly", excluding -the free taxa. -Every strictly-compliant tree satisfies the user's constraint, so the search -never returns a tree that breaks it; but a start that satisfies the user's -constraint without satisfying the stricter form maps to no node, and the -replicate makes no moves from it. +A start that already separates the two groups is left alone, however its free +taxa happen to fall; the repair fires only on a start that genuinely violates +the constraint. + +The free-taxa reading also decides *which* legal starts a replicate can begin +from. +The random-topology strategy grows a tree one taxon at a time, each at a +uniformly chosen edge among those that leave every constraint character still +satisfied, so that every topology the constraint permits can be drawn. +Building instead from a backbone of the constrained groups -- one clade per +character, nested as their groups are nested -- also gives a compliant tree, but +only ever one in which each group is an exact clade with the `?`-coded taxa +outside it: 15 of the 35 compliant topologies on six taxa constrained by one +character, and 105 of the 1155 on eight taxa constrained by two. +A replicate would never begin at any of the rest. + +Sampling is uniform where it can be: the taxa a constraint does not name are +inserted last and unfiltered, and the named ones are drawn by rejection when a +workable fraction of trees comply, so a constraint on a handful of taxa is +sampled uniformly end to end. +A constraint that pins down most of a large tree falls back to filtered +insertion, which still reaches every legal topology but favours some over +others. ## The driven search pipeline