TreeTools
Create, Modify and Analyse Phylogenetic Trees

Package index
Search the TreeTools package
Vignettes
Functions
832
Source code
100
Man pages
106
Home
/
CRAN
/
TreeTools
/
tests/testthat/test-ImposeConstraint.R

tests/testthat/test-ImposeConstraint.R
In TreeTools: Create, Modify and Analyse Phylogenetic Trees 

test_that("AddUnconstrained() works", {
  tips <- letters[1:9]
  constraint <- StringToPhyDat("0000?1111 000111111 0000??110", tips, FALSE)
  expect_equal(
    AddUnconstrained(constraint, letters[10:12], FALSE),
    PhyDatToMatrix(AddUnconstrained(constraint, letters[10:12], TRUE))
  )
  expect_equal(
    PhyDatToMatrix(AddUnconstrained(constraint, letters[8:12], TRUE)),
    AddUnconstrained(constraint, letters[10:12], FALSE)
  )
  
  noConstraint <- matrix(NA_character_, 6, 0,
                         dimnames = list(letters[1:6], NULL))
  expect_equal(
    AddUnconstrained(SingleTaxonTree("a"), letters[2:6], FALSE),
    noConstraint
  )
  
  expect_equal(AddUnconstrained(c(), letters[1:6], FALSE), noConstraint)
  expect_equal(AddUnconstrained(NULL, letters[1:6], FALSE), noConstraint)
  
  noNode <- structure(
    list(edge = structure(integer(0), dim = c(0L, 2L)),
         Nnode = 0L, tip.label = "a"), order = "preorder", class = "phylo")
  expect_equal(AddUnconstrained(noNode, letters[1:6], FALSE), noConstraint)
  
})

test_that("ImposeConstraint() works", {
  tips <- letters[1:9]
  tree <- as.phylo(1, 9, tips)
  tree[["node.label"]] <- paste("Node", 10:17)
  
  expect_equal(ImposeConstraint(tree, c()), tree)
  expect_equal(ImposeConstraint(tree, KeepTip(tree, character(0))), tree)
  
  # Weak constraint, test node labels
  constraint <- StringToPhyDat("000000011", tips, FALSE)
  constrained <- ImposeConstraint(tree, constraint)
  expect_true(all.equal(
    constrained,
    read.tree(text = "(a, ((c, d), (e, (f, (g, (b, (h, i)))))));")))
  expect_equal(constrained[["node.label"]],
               c(paste("Node", 10:15), NA, "Node 17"))

  # Strong constraint for very different tree
  constraint <- StringToPhyDat("0000?1111 000111111 0000??110", tips, FALSE)
  constrained <- ImposeConstraint(tree, constraint)
  expect_true(all.equal(
    constrained,
    read.tree(text = "((a, (b, c)), (d, (e, (f, (i, (g, h))))));")))
  expect_equal(constrained[["node.label"]], c("Node 10", rep(NA, 7)))

  expect_equal(ImposeConstraint(tree, constraint),
               ImposeConstraint(tree, PhyDatToMatrix(constraint)))
  
  expect_equal(
    ImposeConstraint(tree, setNames(c(rep(0, 3), rep(1, 6)), tips)),
    ImposeConstraint(tree, StringToPhyDat("000111111", tips, FALSE))
  )

  constraint <- StringToPhyDat("00001111 00011111 0000?110", tips[-5], FALSE)
  expect_true(all.equal(
    ImposeConstraint(tree, constraint),
    read.tree(text = "((a, (b, c)), (d, (e, (f, (i, (g, h))))));")))

  constraint <- ape::read.tree(text = "(a, b, c, (d, (f, (g, h), i)));")
  expect_true(all.equal(
    ImposeConstraint(tree, constraint),
    read.tree(text = "((a, (b, c)), (d, (e, (f, (i, (g, h))))));")))
  
  constraint <- MatrixToPhyDat(matrix(
    c(0, 0, "?", "?", 1, 1,
      1, 1,   1, "?", 0, 0), ncol = 2,
    dimnames = list(letters[1:6], NULL)))

  expect_warning({out <- ImposeConstraint(NJTree(constraint), constraint)})
  expect_true(inherits(out, "phylo"))

  # Need to collapse splits intelligently to avoid error.  From Joe Moysiuk.
  constraint <- MatrixToPhyDat(
    structure(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L,
                1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L,
                1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L,
                1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L,
                1L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
              .Dim = c(38L, 15L),
              .Dimnames = list(c("t1", "t2", "t3", "t4", "t5", "t6", "t7", "t8",
                                 "t9", "t10", "t11", "t12", "t13", "t14", "t15",
                                 "t16", "t17", "t18", "t19", "t20", "t21",
                                 "t22", "t23", "t24", "t25", "t26", "t27",
                                 "t28", "t29", "t30", "t31", "t32", "t33",
                                 "t34", "t35", "t36", "t37", "t38"), NULL)))
  ImposeConstraint(NJTree(constraint), constraint)
})

Try the TreeTools package in your browser

Any scripts or data that you put into this service are public.

TreeTools documentation built on June 22, 2024, 9:27 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close