tests/testthat/test-Support.R

In TreeTools: Create, Modify and Analyse Phylogenetic Trees

test_that("Node supports calculated correctly", {
  treeSample <- list(
    correct = ape::read.tree(text = "((((((A,B),C),D),E),F),out);"),
    swapFE  = ape::read.tree(text = "((((((A,B),C),D),F),E),out);"),
    DEClade = ape::read.tree(text = "(((((A,B),C),(D,E)),F),out);"),
    swapBC  = ape::read.tree(text = "((((((A,C),B),D),E),F),out);"),
    DbyA    = ape::read.tree(text = "((((((A,D),C),B),E),F,G),out);")
  )
  expect_equal(
    SplitFrequency(treeSample$correct, treeSample),
    c("10" = 4, "11" = 4, "12" = 4, "13" = 3)
   )
  
  expect_error(SplitFrequency(NULL, treeSample), "must bear identical")
  sameTips <- KeepTip(treeSample, TipLabels(treeSample$correct))
  sameSplits <- do.call(c, as.Splits(sameTips))
  
  expect_equal(
    unname(sort(PolarizeSplits(pole = 1,
    SplitFrequency(sameTips) 
    ))),
    unname(sort(PolarizeSplits(pole = 1,
    structure(sameSplits[[!duplicated(sameSplits)]],
              count = c(4, 4, 4, 3, 1, 1, 1, 1, 1))
    )))
  )
  
  
  monoSplit <- ape::read.tree(text = "((a, b, c, d), (e, f, g));")
  expect_equal(SplitFrequency(monoSplit),
               structure(unname(as.Splits(monoSplit)), count = 1))
  
  expect_equal(SplitFrequency(SingleTaxonTree()),
               structure(as.Splits(SingleTaxonTree()), count = integer()))
  
  expect_equal(SplitFrequency(as.Splits(monoSplit)[[FALSE]]),
               structure(as.Splits(monoSplit)[[FALSE]], count = integer()))
  
  expect_equal(SplitFrequency(StarTree(67)),
               structure(as.Splits(StarTree(67)), count = integer()))
  
  # Internal nodes on each side of root
  balanced <- ape::read.tree(text="((D, (E, (F, out))), (C, (A, B)));")
  freq <- SplitFrequency(balanced, treeSample)
  expect_equal(freq,
               c("9" = 4, "10" = 4, "11" = 4, "12" = 4, "13" = 3)[names(freq)])

  skip_if(!isTRUE(options("runSlowTests")))
  expect_equal(SplitFrequency(c(PectinateTree(8200), PectinateTree(8200))),
               structure(as.Splits(PectinateTree(8200)), count = rep(2, 8197)))
})

test_that("SplitFrequency() exact and hashed counts agree", {
  set.seed(2)
  freqKey <- function(sf) sort(paste(as.character(sf), attr(sf, "count")))
  forests <- list(
    c(PectinateTree(16), PectinateTree(16)),
    lapply(1:10, function(i) RandomTree(13, root = TRUE)),
    lapply(1:30, function(i) RandomTree(8, root = TRUE))
  )
  for (f in forests) {
    expect_equal(freqKey(SplitFrequency(f)),
                 freqKey(SplitFrequency(f, hash = FALSE)))
  }
})

test_that("Node support colours consistent", {
  expect_equal(SupportColour(NA), "red")
  expect_equal(SupportColour(1:2, show1 = FALSE), c("#ffffff00", "red"))
  expect_equal(SupportColor(-2), "red") # Check alternative spelling
  expect_equal(SupportColour(1, show1 = FALSE), "#ffffff00")
  expect_equal(SupportColour((-1):3 / 3, scale = 1:101, outOfRange = "oor"),
               c("oor", "1", "34", "67", "101"))
})

test_that("normalize_splits() covers all branches", {
  # n_spare == 0 (nTip multiple of 8): complement without trailing-bit mask
  trees16 <- c(PectinateTree(16), PectinateTree(16))
  freq16 <- SplitFrequency(trees16)
  expect_equal(length(freq16), NSplits(trees16[[1]]))
  expect_true(all(attr(freq16, "count") == 2L))

  # Trivial splits are filtered: a star tree produces no non-trivial splits
  star <- c(StarTree(10), StarTree(10))
  freq_star <- SplitFrequency(star)
  expect_equal(length(freq_star), 0)
})

test_that("SplitFrequency() handles four-split trees", {
  trees <- AddTipEverywhere(BalancedTree(3))
  trees <- c(trees[1], trees)
  expect_equal(c("7" = 2L), SplitFrequency(trees[[1]], trees))
})

test_that("LabelSplits()", {
  expect_error(LabelSplits(BalancedTree(8), 1:8))
  skip_if_not_installed("vdiffr", minimum_version = "1.0.0")
  skip_if(packageVersion("graphics") < "4.1.0")
  vdiffr::expect_doppelganger("LabelSplits()",  function() {
    tree <- BalancedTree(9)
    plot(tree)
    labs <- letters[6:1]
    names(labs) <- rev(names(as.Splits(tree)))
    LabelSplits(tree, labs, frame = "circ", cex = 2, bg = "orange")
  })
  vdiffr::expect_doppelganger("LabelSplits()-nameless", function() {
    tree <- BalancedTree(9)
    plot(tree)
    LabelSplits(tree, bg = "orange")
    expect_warning(LabelSplits(BalancedTree(9), setNames(letters[11:16], 1:6)))
  })
  vdiffr::expect_doppelganger("LabelSplits()-names", function() {
    tree <- BalancedTree(9)
    plot(tree)
    labs <- letters[1:6]
    LabelSplits(tree, labs, bg = "orange")
  })
})