tests/testthat/test-root_tree.h.R

In TreeTools: Create, Modify and Analyse Phylogenetic Trees

ApeRoot <- function(tree, root, rr = TRUE) ape::root(tree, root, resolve.root = rr)

test_that("Memory leak not encountered", {
  # Example from TreeDist::ClusterTable
  tree1 <- ape::read.tree(text = "(A, (B, (C, (D, E))));");
  tree2 <- ape::read.tree(text = "(A, (B, (D, (C, E))));");
  # as.ClusterTable(tree1) calls:
  expect_equal(tree1, root_on_node(tree1, 1))

  # Check for memory leaks...
  root_on_node(RenumberTips(Preorder(tree2), LETTERS[1:5]), 1)[]
  root_on_node(RenumberTips(StarTree(LETTERS[5:1]), LETTERS[1:5]), 1)[]

  expect_error(root_on_node(tree1, 0), "`outgroup` must be a positive integer")
  expect_error(root_on_node(tree1, 999), "`outgroup` exceeds number of nodes")
})

test_that("Big trees don't fail", {
  # 2^14 + 1 is too big for int16
  expect_equal(root_on_node(PectinateTree(2^14 + 1), 1),
               PectinateTree(2^14 + 1))
})

test_that("Binary trees are rootable", {
  Test <- function(tree, root) {
    expect_equal(Preorder(ApeRoot(tree, tree$tip.label[root]))$edge,
                 root_binary(tree$edge, root))
  }
  Test(BalancedTree(9), 3)
  Test(BalancedTree(9), 1)
  Test(PectinateTree(9), 1)
  Test(PectinateTree(9), 7)
  ed9 <- PectinateTree(9)$edge
  expect_equal(root_binary(ed9, 10), ed9)
  expect_equal(root_binary(ed9, 1), ed9)
})

test_that("Polytomous trees are rootable", {
  Test <- function(tree, root) {
    expect_equal(Preorder(ApeRoot(tree, tree$tip.label[root])),
                 root_on_node(tree, root))
  }
  bt <- BalancedTree(9)
  pt <- PectinateTree(9)
  Test(CollapseNode(bt, 12), 1)
  Test(CollapseNode(bt, 12), 3)
  Test(CollapseNode(bt, 11), 1)
  Test(CollapseNode(pt, 11), 1)
  Test(CollapseNode(pt, c(11, 12)), 1)
  Test(CollapseNode(pt, c(11, 12)), 3)
  Test(CollapseNode(pt, c(11, 12)), 5)
  Test(CollapseNode(pt, c(11, 13, 15)), 5)
  Test(CollapseNode(pt, c(11:13, 15)), 9)
  Test(StarTree(8), 1)

  # Day 1985 examples
  t1 <- Preorder(ape::read.tree(
    text = "((10, 7), (6, (8, 11)), (12, (4, (2, 1))), 14, (5, 9, 13), 3);"))
  Test(t1, 1)
  t2 <- Preorder(ape::read.tree(
    text = "(((2, 4, 5, 7, 9, 10, 12, 13), (1, 14)), (6, (8, 11)), 3);"))
  Test(t2, 1)
})

test_that("Rooted trees report preorder accurately", {
  set.seed(1)
  nTips <- 8
  edge <- do.call(cbind,
                  RenumberEdges(.RandomParent(nTips),
                                seq_len(nTips + nTips - 2L)))
  
  expect_preorder <- function(x) {
    expect_equal(x, Preorder(`attr<-`(x, "order", "unknown")))
  }
  
  # Check that we are in preorder
  expect_preorder(edge)
  
  expect_preorder(root_binary(edge, 2))
  expect_preorder(root_binary(edge, 6))
  
  tree <- structure(list(edge = edge,
                         Nnode = nTips - 1L,
                         tip.label = TipLabels(nTips)),
                    order = "preorder",
                    class = "phylo")
  
  rootNode <- nTips + 1L
  expect_preorder(root_on_node(tree, rootNode))
  deepNode <- 2 * nTips - 2
  expect_preorder(root_on_node(tree, deepNode))
  
  weighted <- tree
  weights <- seq_len(dim(edge)[[1]])
  weighted[["edge.length"]] <- weights
  expect_equal(sort(root_on_node(weighted, rootNode)[["edge.length"]]),
                    weighted[["edge.length"]])
  expect_preorder(root_on_node(weighted, rootNode))
  expect_preorder(root_on_node(weighted, deepNode))
})