tests/testthat/test-rearrange.cpp.R

In TreeSearch: Phylogenetic Analysis with Discrete Character Data

library("TreeTools")

test_that("TBR errors", {
  tr <- Preorder(root(TreeTools::BalancedTree(7), 't1', resolve.root = TRUE))
  expect_equal(0, length(expect_warning(all_tbr(tr$edge, -1))))
  expect_equal(0, length(expect_warning(all_tbr(tr$edge, 1))))
  expect_equal(0, length(expect_warning(all_tbr(tr$edge, 111))))
})

test_that("SPR errors", {
  tr <- Preorder(root(TreeTools::BalancedTree(7), 't1', resolve.root = TRUE))
  expect_equal(0, length(expect_warning(all_spr(tr$edge, -1))))
  expect_equal(0, length(expect_warning(all_spr(tr$edge, 1))))
  expect_equal(0, length(expect_warning(all_spr(tr$edge, 111))))
})

test_that("TBR working", {
  tr <- Preorder(root(TreeTools::BalancedTree(7), 't1', resolve.root = TRUE))

  # Move single tip
  expect_equal(8, length(x <- all_tbr(tr$edge, 12)))
  expect_equal(8, length(x <- all_tbr(tr$edge, 11)))
  expect_equal(8, length(x <- all_tbr(tr$edge, 10)))
  expect_equal(8, length(x <- all_tbr(tr$edge, 7)))
  expect_equal(8, length(x <- all_tbr(tr$edge, 6)))
  expect_equal(8, length(x <- all_tbr(tr$edge, 3)))
  
  # Move cherry
  expect_equal(6, length(x <- all_tbr(tr$edge, 9)))
  expect_equal(6, length(x <- all_tbr(tr$edge, 5)))
  expect_equal(6, length(TBRMoves(tr, 5)))
  
  # Move more
  expect_equal(6, length(unique(x <- all_tbr(tr$edge, 4))))
  expect_equal(3 * 4 + 2, length(unique(x <- all_tbr(tr$edge, 8))))
  
  # All moves
  expect_equal(6*8 + 12+ 6 + 14, length(x <- all_tbr(tr$edge, integer(0))))
  expect_equal(58, length(unique(x <- all_tbr(tr$edge, integer(0))))) # 58 not formally calculated
  expect_equal(58, length(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 <- all_tbr(tr$edge, leaf)))
  }
  
  Test <- function (edge) {
    nDesc <- desc[tr$edge[edge, 2]]
    expected <- (2 * nDesc - 3) * (22 - (2 * nDesc - 3)) - 1
    expect_equal(expected, length(all_tbr(tr$edge, edge)))
  }
  for (internal in which(!1:26 %in% external)[-(1:2)]) {
    Test(internal)
  }
})

test_that("SPR fails gracefully", {
  expect_error(.all_spr(as.phylo(1, 3)$edge, integer(0)))
  expect_error(.all_spr(Postorder(as.phylo(1, 6))$edge, integer(0)))
  expect_error(.all_spr(SortTree(as.phylo(1, 6))$edge, integer(0)))
})

test_that("SPR works", {
  t2 <- as.phylo(518, 7) # (t1, ((t2, t3), ((t4, t5), (t6, t7))))
  expect_equal(8, length(all_spr(t2$edge, 2)))
  
  tr <- Preorder(root(TreeTools::BalancedTree(7), 't1', resolve.root = TRUE))

  # Move single tip
  expect_equal(8, length(all_spr(tr$edge, 12)))
  expect_equal(8, length(all_spr(tr$edge, 11)))
  expect_equal(8, length(all_spr(tr$edge, 10)))
  expect_equal(8, length(all_spr(tr$edge, 7)))
  expect_equal(8, length(all_spr(tr$edge, 6)))
  expect_equal(8, length(all_spr(tr$edge, 3)))
  expect_equal(8, length(all_spr(tr$edge, 2)))
  
  # Move cherry
  expect_equal(6, length(all_spr(tr$edge, 9)))
  expect_equal(6, length(all_spr(tr$edge, 5)))
  expect_equal(12, length(all_spr(tr$edge, c(9, 5))))
  
  # Move more
  expect_equal(0, length(unique(all_spr(tr$edge, 4))))
  expect_equal(4, length(unique(all_spr(tr$edge, 8))))
  
  # All moves
  expect_equal(7*8 + 2*6 + 4, length(all_spr(tr$edge, integer(0))))
  uniqueMoves <- length(unique(all_spr(tr$edge, integer(0))))
  expect_equal(54, # Not formally calculated
               uniqueMoves)
  expect_equal(uniqueMoves, length(SPRMoves(tr)))
  
  tr <- Preorder(root(TreeTools::BalancedTree(14), 't1', resolve.root = TRUE))
  tr$edge
  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 <- all_spr(tr$edge, leaf)))
  }
  
  Test <- function (edge) {
    nDesc <- desc[tr$edge[edge, 2]]
    expected <- (22 - (2 * nDesc - 3)) - 1
    expect_equal(expected, length(all_spr(tr$edge, edge)))
  }
  for (internal in which(!1:26 %in% external)[-(1:2)]) {
    Test(internal)
  }
  
  expect_equal(SPRMoves(tr)[[428]]$edge, SPRMoves(tr$edge)[[428]])
  
  tr <- BalancedTree(7)
  expect_equal(SPRMoves(tr)[[54]]$edge, SPRMoves(tr$edge)[[54]])
})

if (FALSE) test_that("SPR works", {
  testTree <- Preorder(root(TreeTools::BalancedTree(7), 't1', resolve.root = TRUE))
  plot(testTree); nodelabels(); edgelabels()
  edge <- testTree$edge
  
  t2 <- testTree
  #t2$edge = root_on_node(edge, 11)
  plot(t2)
  
  1L + tbr_moves(edge)
  
  Test <- function (m, p1, r1) {
    test.tr <- testTree
    test.tr$edge <- spr(edge, m)
    plot(test.tr)
    
    oldWay <- SortTree(root(SPR(testTree, p1, r1), 't1', resolve.root = TRUE))
    expect_equal(oldWay, SortTree(test.tr))
  }
  Test(0, 1, 5)
  Test(1, 1, 6)
  Test(2, 1, 7)
  Test(3, 1, 8)
  Test(4, 1, 9)
  Test(5, 1, 10)
  Test(6, 1, 11)
  Test(7, 1, 12)
  
  Test(8 , 3, 5)
  Test(9 , 3, 6)
  Test(10, 3, 7)
  Test(11, 3, 8)
  Test(12, 3, 9)
  Test(13, 3, 10)
  Test(14, 3, 11)
  Test(15, 3, 12)
  

})