From 1e05259b708a53360a61023447cef6956e144572 Mon Sep 17 00:00:00 2001 From: Freguglia Date: Mon, 27 Apr 2026 16:34:04 -0300 Subject: [PATCH] Remove treeFromContexts function and add activateFromContexts method to ContextTree for improved context activation handling Co-authored-by: Copilot --- NAMESPACE | 1 - NEWS.md | 6 +++ R/ContextTree.R | 45 ++++++++++++++++++++ R/treeFromContexts.R | 47 -------------------- README.Rmd | 27 +++++++----- README.md | 25 ++++++----- man/ContextTree.Rd | 22 ++++++++++ man/baConTree.Rd | 1 + man/treeFromContexts.Rd | 22 ---------- tests/testthat/test-ContextTree.R | 59 ++++++++++++++++++++++++++ tests/testthat/test-treeFromContexts.R | 55 ------------------------ 11 files changed, 164 insertions(+), 146 deletions(-) delete mode 100644 R/treeFromContexts.R delete mode 100644 man/treeFromContexts.Rd delete mode 100644 tests/testthat/test-treeFromContexts.R diff --git a/NAMESPACE b/NAMESPACE index c084cae..7f7a5fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,7 +9,6 @@ export(baConTree) export(fit_vlmc) export(metropolis_vlmc) export(rvlmc) -export(treeFromContexts) importFrom(Brobdingnag,as.brob) importFrom(Brobdingnag,cbrob) importFrom(R6,R6Class) diff --git a/NEWS.md b/NEWS.md index db31f9b..c5f6f40 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,12 @@ ## New features +* `treeFromContexts()` has been removed. Instead, `ContextTree` now exposes an + `$activateFromContexts(contexts)` method that activates a specific tree on an + existing `ContextTree` object. It accepts the same input format as the old + function (a character vector of context paths, or a single brace-enclosed + comma-separated string). + * `baConTree` nodes now store `priorBranchingProbability` and `posteriorBranchingProbability` in their `extra` list. These are computed during initialisation as `prod(children sigmaPrior) / sigmaPrior` (and the diff --git a/R/ContextTree.R b/R/ContextTree.R index 0943ff3..dac61f1 100644 --- a/R/ContextTree.R +++ b/R/ContextTree.R @@ -23,6 +23,7 @@ #' #' @importFrom purrr map_chr map_lgl map map_int #' @importFrom glue glue +#' @importFrom stringr str_split str_replace_all str_count #' @export ContextTree <- R6Class( "ContextTree", @@ -178,6 +179,50 @@ ContextTree <- R6Class( })]) }, + #' @description + #' Sets the active tree to match a specified set of contexts, given as a + #' character vector or a brace-enclosed comma-separated string. The contexts + #' must be compatible with the tree's existing alphabet and maximal depth. + #' @param contexts Character vector or string. A vector of context paths + #' (e.g., \code{c("*.a", "*.b.a", "*.b.b")}) or a single brace-enclosed + #' string (e.g., \code{"\{*.a, *.b.a, *.b.b\}"}). + activateFromContexts = function(contexts) { + if (length(contexts) == 1) { + raw <- str_replace_all(contexts, "\\{|\\}", "") + parts <- str_split(string = raw, pattern = ",")[[1]] + contexts <- trimws(parts) + contexts <- contexts[nzchar(contexts)] + } + + if (!validate_tree_string(contexts)) { + stop("Contexts do not correspond to a full tree.") + } + + context_alphabet <- setdiff(unique(unlist(str_split(contexts, "\\."))), "*") + if (!all(context_alphabet %in% private$Alphabet$symbols)) { + stop("Contexts use symbols not in the tree's alphabet.") + } + + max_depth <- max(str_count(contexts, "\\.")) + if (max_depth > private$maximalDepth) { + stop("Contexts require a greater depth than the tree's maximal depth.") + } + + self$activateRoot() + current_depth <- 0 + while (length(setdiff(self$getActiveNodes(idx = TRUE), contexts)) > 0) { + subcontexts <- substr(contexts, start = 1, stop = current_depth * 2 + 1) + for (sc in unique(subcontexts)) { + if (!sc %in% contexts) { + self$growActive(sc) + } + } + current_depth <- current_depth + 1 + } + + invisible(self) + }, + #' @return Returns the leaf nodes of the maximal Context Tree (regardless of #' the current active tree). getLeaves = function(idx = TRUE) { diff --git a/R/treeFromContexts.R b/R/treeFromContexts.R deleted file mode 100644 index ac8e014..0000000 --- a/R/treeFromContexts.R +++ /dev/null @@ -1,47 +0,0 @@ -#' @title Create ContextTree from Context Vector -#' -#' @description -#' Constructs a `ContextTree` object from a vector or string of context paths, initializing the tree to match the specified contexts. -#' -#' @param contexts Character vector or string. Contexts separated by commas, or a vector of context strings (e.g., "*.a", "*.b", ...). -#' -#' @return A `ContextTree` object with maximal length equal to the largest depth among specified contexts and active tree equal to the specified contexts. -#' -#' @examples -#' treeFromContexts(c("*.0", "*.1.0", "*.1.1")) -#' treeFromContexts("{*.a, *.b, *.c.a, *.c.b, *.c.c}") -#' -#' @importFrom stringr str_split str_replace_all str_count -#' @export -treeFromContexts <- function(contexts){ - if(length(contexts) == 1){ - raw <- str_replace_all(contexts, "\\{|\\}", "") - parts <- str_split(string = raw, pattern = ",")[[1]] - contexts <- trimws(parts) - contexts <- contexts[ nzchar(contexts) ] - } - - if(!validate_tree_string(contexts)){ - stop("Contexts do no correspond to a full tree.") - } - - max_depth <- max(str_count(contexts, "\\.")) - alphabet <- unique(unlist(str_split(contexts, "\\."))) - alphabet <- setdiff(alphabet, "*") - - ct <- ContextTree$new(alphabet = alphabet, maximalDepth = max_depth) - ct$activateRoot() - - current_depth <- 0 - while(length(setdiff(ct$getActiveNodes(idx = TRUE), contexts)) > 0){ - subcontexts <- substr(contexts, start = 1, stop = current_depth*2 + 1) - for(sc in unique(subcontexts)){ - if(!sc %in% contexts){ - ct$growActive(sc) - } - } - current_depth <- current_depth + 1 - } - - ct -} diff --git a/README.Rmd b/README.Rmd index 3a5cc25..8bb05a0 100644 --- a/README.Rmd +++ b/README.Rmd @@ -30,8 +30,7 @@ the order of dependence can vary with the observed past. `bacontrees` provides: - A **Bayesian** method: `metropolis_vlmc()` (and the `baConTree` class) runs a Metropolis-Hastings MCMC sampler to obtain a full posterior distribution over context trees. -- Simulation utilities (`rvlmc()`) and construction helpers - (`treeFromContexts()`). +- Simulation utilities (`rvlmc()`). - R6 classes (`ContextTree`, `baConTree`) that expose the full tree structure for building custom algorithms. @@ -101,15 +100,17 @@ head(seq1, 20) ### Building a context tree manually -`treeFromContexts()` creates a `ContextTree` whose active nodes exactly match a -supplied set of contexts. +`ContextTree$activateFromContexts()` sets the active nodes of an existing tree +to match a supplied set of contexts. -```{r treeFromContexts} -ct <- treeFromContexts(c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) -ct$getActiveNodes() +```{r activateFromContexts} +tree <- ContextTree$new(alphabet = c("a", "b", "c"), maximalDepth = 2) +tree$activateFromContexts(c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) +tree$getActiveNodes() ``` -You can also create a `ContextTree` directly and manipulate it: +You can also use `$activateMaximal()` or `$activateRoot()` to switch between +the deepest and shallowest trees: ```{r ContextTree} tree <- ContextTree$new(abc_list, maximalDepth = 3) @@ -151,7 +152,7 @@ with_progress({ n_steps = 2000, max_depth = 3, alpha = 0.01, - context_weights = function(node) -node$getDepth() / 3, + context_weights = function(node) exp(-node$getDepth() / 3), burnin = 200 ) }) @@ -174,7 +175,7 @@ For more control, use the `baConTree` R6 class directly. ```{r baConTree} bt <- baConTree$new(abc_list, maximalDepth = 3, alpha = 0.01, - priorWeights = function(node) -node$getDepth() / 3) + priorWeights = function(node) exp(-node$getDepth() / 3)) with_progress(bt$runMetropolisHastings(2000)) @@ -198,6 +199,7 @@ The core data structure. Manages the maximal suffix tree, tracks which nodes are | `$activateRoot()` | Set active tree to root-only | | `$activateMaximal()` | Set active tree to all maximal leaves | | `$activateByCode(code)` | Restore a previously stored tree code | +| `$activateFromContexts(contexts)` | Set active tree to match a context vector or string | | `$growActive(path)` | Grow the active tree at a given node | | `$pruneActive(path)` | Prune the active tree at a given node | | `$setData(dataset)` | Attach sequence data and compute counts | @@ -213,7 +215,10 @@ Extends `ContextTree` with Bayesian machinery. | Method | Description | |--------|-------------| -| `$new(data, maximalDepth, alpha, priorWeights)` | Construct a Bayesian context tree | +| `$new(data, maximalDepth, alpha, priorWeights, initialTree)` | Construct a Bayesian context tree | | `$runMetropolisHastings(steps)` | Run the MCMC sampler | | `$getChain()` | Retrieve the sampled chain as a data frame | +| `$activateMap()` | Set active tree to the MAP tree | +| `$sampleTree(type)` | Sample a tree from the prior or posterior | +| `$getMarginalLikelihood(log)` | Return the marginal likelihood of the data | diff --git a/README.md b/README.md index c0b560d..f073407 100644 --- a/README.md +++ b/README.md @@ -21,8 +21,7 @@ past. `bacontrees` provides: - A **Bayesian** method: `metropolis_vlmc()` (and the `baConTree` class) runs a Metropolis-Hastings MCMC sampler to obtain a full posterior distribution over context trees. -- Simulation utilities (`rvlmc()`) and construction helpers - (`treeFromContexts()`). +- Simulation utilities (`rvlmc()`). - R6 classes (`ContextTree`, `baConTree`) that expose the full tree structure for building custom algorithms. @@ -98,16 +97,18 @@ head(seq1, 20) ### Building a context tree manually -`treeFromContexts()` creates a `ContextTree` whose active nodes exactly -match a supplied set of contexts. +`ContextTree$activateFromContexts()` sets the active nodes of an +existing tree to match a supplied set of contexts. ``` r -ct <- treeFromContexts(c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) -ct$getActiveNodes() +tree <- ContextTree$new(alphabet = c("a", "b", "c"), maximalDepth = 2) +tree$activateFromContexts(c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) +tree$getActiveNodes() #> [1] "*.c.b" "*.c.c" "*.a" "*.b" "*.c.a" ``` -You can also create a `ContextTree` directly and manipulate it: +You can also use `$activateMaximal()` or `$activateRoot()` to switch +between the deepest and shallowest trees: ``` r tree <- ContextTree$new(abc_list, maximalDepth = 3) @@ -158,7 +159,7 @@ with_progress({ n_steps = 2000, max_depth = 3, alpha = 0.01, - context_weights = function(node) -node$getDepth() / 3, + context_weights = function(node) exp(-node$getDepth() / 3), burnin = 200 ) }) @@ -187,7 +188,7 @@ For more control, use the `baConTree` R6 class directly. ``` r bt <- baConTree$new(abc_list, maximalDepth = 3, alpha = 0.01, - priorWeights = function(node) -node$getDepth() / 3) + priorWeights = function(node) exp(-node$getDepth() / 3)) with_progress(bt$runMetropolisHastings(2000)) @@ -219,6 +220,7 @@ attachment. | `$activateRoot()` | Set active tree to root-only | | `$activateMaximal()` | Set active tree to all maximal leaves | | `$activateByCode(code)` | Restore a previously stored tree code | +| `$activateFromContexts(contexts)` | Set active tree to match a context vector or string | | `$growActive(path)` | Grow the active tree at a given node | | `$pruneActive(path)` | Prune the active tree at a given node | | `$setData(dataset)` | Attach sequence data and compute counts | @@ -234,6 +236,9 @@ Extends `ContextTree` with Bayesian machinery. | Method | Description | |----|----| -| `$new(data, maximalDepth, alpha, priorWeights)` | Construct a Bayesian context tree | +| `$new(data, maximalDepth, alpha, priorWeights, initialTree)` | Construct a Bayesian context tree | | `$runMetropolisHastings(steps)` | Run the MCMC sampler | | `$getChain()` | Retrieve the sampled chain as a data frame | +| `$activateMap()` | Set active tree to the MAP tree | +| `$sampleTree(type)` | Sample a tree from the prior or posterior | +| `$getMarginalLikelihood(log)` | Return the marginal likelihood of the data | diff --git a/man/ContextTree.Rd b/man/ContextTree.Rd index b0eed22..d8c6e85 100644 --- a/man/ContextTree.Rd +++ b/man/ContextTree.Rd @@ -36,6 +36,7 @@ print(tree) \item \href{#method-ContextTree-activateRoot}{\code{ContextTree$activateRoot()}} \item \href{#method-ContextTree-activateMaximal}{\code{ContextTree$activateMaximal()}} \item \href{#method-ContextTree-activateByCode}{\code{ContextTree$activateByCode()}} +\item \href{#method-ContextTree-activateFromContexts}{\code{ContextTree$activateFromContexts()}} \item \href{#method-ContextTree-getLeaves}{\code{ContextTree$getLeaves()}} \item \href{#method-ContextTree-getInnerNodes}{\code{ContextTree$getInnerNodes()}} \item \href{#method-ContextTree-nodeExists}{\code{ContextTree$nodeExists()}} @@ -207,6 +208,27 @@ from the \code{activeTreeCode} method. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ContextTree-activateFromContexts}{}}} +\subsection{Method \code{activateFromContexts()}}{ +Sets the active tree to match a specified set of contexts, given as a +character vector or a brace-enclosed comma-separated string. The contexts +must be compatible with the tree's existing alphabet and maximal depth. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ContextTree$activateFromContexts(contexts)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{contexts}}{Character vector or string. A vector of context paths +(e.g., \code{c("*.a", "*.b.a", "*.b.b")}) or a single brace-enclosed +string (e.g., \code{"\{*.a, *.b.a, *.b.b\}"}).} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ContextTree-getLeaves}{}}} \subsection{Method \code{getLeaves()}}{ diff --git a/man/baConTree.Rd b/man/baConTree.Rd index 7665e1b..bc1ad26 100644 --- a/man/baConTree.Rd +++ b/man/baConTree.Rd @@ -47,6 +47,7 @@ chain <- bt$getChain()
Inherited methods
  • bacontrees::ContextTree$activateByCode()
    • +
  • bacontrees::ContextTree$activateFromContexts()
  • bacontrees::ContextTree$activateMaximal()
  • bacontrees::ContextTree$activateRoot()
  • bacontrees::ContextTree$activeTreeCode()
    • diff --git a/man/treeFromContexts.Rd b/man/treeFromContexts.Rd deleted file mode 100644 index 2234616..0000000 --- a/man/treeFromContexts.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/treeFromContexts.R -\name{treeFromContexts} -\alias{treeFromContexts} -\title{Create ContextTree from Context Vector} -\usage{ -treeFromContexts(contexts) -} -\arguments{ -\item{contexts}{Character vector or string. Contexts separated by commas, or a vector of context strings (e.g., "\emph{.a", "}.b", ...).} -} -\value{ -A \code{ContextTree} object with maximal length equal to the largest depth among specified contexts and active tree equal to the specified contexts. -} -\description{ -Constructs a \code{ContextTree} object from a vector or string of context paths, initializing the tree to match the specified contexts. -} -\examples{ -treeFromContexts(c("*.0", "*.1.0", "*.1.1")) -treeFromContexts("{*.a, *.b, *.c.a, *.c.b, *.c.c}") - -} diff --git a/tests/testthat/test-ContextTree.R b/tests/testthat/test-ContextTree.R index 94c77d3..6a3535f 100644 --- a/tests/testthat/test-ContextTree.R +++ b/tests/testthat/test-ContextTree.R @@ -159,3 +159,62 @@ test_that("Initialization errors when alphabet is incompatible with data", { expect_error(ContextTree$new(abc_vec, maximalDepth = 2, alphabet = bad_alphabet)) }) +# activateFromContexts --------------------------------------------------------- + +test_that("activateFromContexts activates the correct nodes from a vector", { + tree <- ContextTree$new(alphabet = c("0", "1"), maximalDepth = 2) + contexts <- c("*.0", "*.1.0", "*.1.1") + tree$activateFromContexts(contexts) + expect_setequal(tree$getActiveNodes(), contexts) +}) + +test_that("activateFromContexts parses a brace-enclosed comma-separated string", { + tree <- ContextTree$new(alphabet = c("a", "b", "c"), maximalDepth = 2) + tree$activateFromContexts("{*.a, *.b, *.c.a, *.c.b, *.c.c}") + expect_setequal(tree$getActiveNodes(), c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) +}) + +test_that("activateFromContexts handles extra whitespace in brace string", { + tree <- ContextTree$new(alphabet = c("x", "y", "z"), maximalDepth = 1) + tree$activateFromContexts("{ *.x ,*.y, *.z }") + expect_setequal(tree$getActiveNodes(), c("*.x", "*.y", "*.z")) +}) + +test_that("activateFromContexts errors on invalid (incomplete) tree", { + tree <- ContextTree$new(alphabet = c("0", "1", "2"), maximalDepth = 3) + expect_error( + tree$activateFromContexts(c("*.0", "*.1.0", "*.1.1", "*.2.0.1")), + regexp = "full tree" + ) +}) + +test_that("activateFromContexts errors when contexts use unknown symbols", { + tree <- ContextTree$new(alphabet = c("a", "b"), maximalDepth = 2) + expect_error( + tree$activateFromContexts(c("*.x", "*.y")), + regexp = "alphabet" + ) +}) + +test_that("activateFromContexts errors when contexts exceed maximal depth", { + tree <- ContextTree$new(alphabet = c("0", "1"), maximalDepth = 1) + expect_error( + tree$activateFromContexts(c("*.0.0", "*.0.1", "*.1.0", "*.1.1")), + regexp = "depth" + ) +}) + +test_that("activateFromContexts can be called on a tree that already has data", { + tree <- ContextTree$new(abc_list, maximalDepth = 2) + contexts <- c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c") + tree$activateFromContexts(contexts) + expect_setequal(tree$getActiveNodes(), contexts) +}) + +test_that("activateFromContexts returns the tree invisibly for chaining", { + tree <- ContextTree$new(alphabet = c("a", "b", "c"), maximalDepth = 2) + result <- tree$activateFromContexts(c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) + expect_identical(result, tree) +}) + + diff --git a/tests/testthat/test-treeFromContexts.R b/tests/testthat/test-treeFromContexts.R deleted file mode 100644 index 7da7052..0000000 --- a/tests/testthat/test-treeFromContexts.R +++ /dev/null @@ -1,55 +0,0 @@ -# tests/testthat/test-treeFromContexts.R - -test_that("treeFromContexts parses vector input correctly", { - contexts <- c("*.0", "*.1.0", "*.1.1") - tree <- treeFromContexts(contexts) - - expect_s3_class(tree, "ContextTree") - expect_setequal(tree$getAlphabet()$symbols, c("0", "1")) - - expect_equal(tree$getMaximalDepth(), 2) - - active <- tree$getActiveNodes(idx = TRUE) - expect_setequal(active, contexts) -}) - -test_that("treeFromContexts parses a single string with braces and commas", { - input <- "{*.a, *.b, *.c.a, *.c.b, *.c.c}" - tree <- treeFromContexts(input) - - expect_s3_class(tree, "ContextTree") - - expect_setequal(tree$getAlphabet()$symbols, c("a", "b", "c")) - - expect_equal(tree$getMaximalDepth(), 2) - - active <- tree$getActiveNodes(idx = TRUE) - expect_setequal(active, c("*.a", "*.b", "*.c.a", "*.c.b", "*.c.c")) -}) - -test_that("treeFromContexts handles whitespace and varying spacing robustly", { - input <- "{ *.x ,*.y, *.z }" - tree <- treeFromContexts(input) - - expect_setequal(tree$getAlphabet()$symbols, c("x", "y", "z")) - expect_equal(tree$getMaximalDepth(), 1) - - expect_setequal(tree$getActiveNodes(idx = TRUE), c("*.x", "*.y", "*.z")) -}) - -test_that("invalid trees fail", { - contexts <- c("*.0", "*.1.0", "*.1.1", "*.2.0.1") - expect_error(tree <- treeFromContexts(contexts), regexp = "full") -}) - -test_that("treeFromContexts returns identical output for equivalent inputs", { - x1 <- c("*.a", "*.b.a", "*.b.b") - x2 <- "{*.a, *.b.a, *.b.b}" - - t1 <- treeFromContexts(x1) - t2 <- treeFromContexts(x2) - - expect_equal(t1$getAlphabet()$symbols, t2$getAlphabet()$symbols) - expect_equal(t1$getMaximalDepth(), t2$getMaximalDepth()) - expect_setequal(t1$getActiveNodes(idx = TRUE), t2$getActiveNodes(idx = TRUE)) -})