Nothing
expect_splits_equal <- function(s1, s2, ...) {
expect_equal(as.character(PolarizeSplits(s1)),
as.character(PolarizeSplits(s2)), ...)
}
test_that("as.Splits()", {
A <- FALSE
B <- TRUE
expect_equal(as.Splits(BalancedTree(0)), as.Splits(logical(0)))
expect_equal(TipsInSplits(as.Splits(logical(0))), integer(0))
expect_equal(strsplit(capture_output(summary(as.Splits(c(A, A, B, B)))),
"\n")[[1]],
c("1 bipartition split dividing 4 tips, t1 .. t4",
" 1234",
" ..**", "",
" Tip 1: t1\t Tip 2: t2\t Tip 3: t3\t Tip 4: t4\t"))
logical80 <- c(rep(TRUE, 40), rep(FALSE, 16), rep(TRUE, 24))
expect_equal(strsplit(capture_output(print(
as.Splits(logical80), detail = TRUE)), "\n")[[1]][3],
paste0(c(" ", ifelse(logical80, "*", ".")), collapse = "")
)
expect_equal(as.logical(as.logical(as.Splits(logical80))), logical80)
expect_equal(as.logical(as.Splits(c(A, A, B, B))),
t(matrix(c(A, A, B, B), dimnames = list(paste0("t", 1:4)))))
tree1 <- BalancedTree(letters[1:5])
splits1 <- as.Splits(tree1)
expect_equal(as.character(splits1),
c("7" = "a b c | d e", "8" = "a b | c d e"))
logicalSplits <- as.Splits(matrix(c(B, B, B, A, A, B, B, A, A, A),
nrow = 2, byrow = TRUE),
tipLabels = letters[1:5])
rownames(logicalSplits) <- rownames(splits1)
expect_equal(splits1, logicalSplits)
expect_equal(splits1, as.Splits(splits1))
pec6 <- as.Splits(PectinateTree(letters[1:6]))
expect_equal(as.character(as.Splits(pec6)),
c("9" = "c d e f | a b",
"10" = "d e f | a b c",
"11" = "e f | a b c d"))
splitsC <- as.Splits(ape::read.tree(text = "(((a, d), e), (b, (f, c)));"))
splitsD <- as.Splits(ape::read.tree(text = "((a, b, c), (d, (e, f)));"))
splitsU <- as.Splits(ape::read.tree(text = "(a, b, c, d, e, f);"))
oneSplit <- as.Splits(ape::read.tree(text = "((a, b, c), (d, e, f));"))
expect_equal(attr(splitsC, "tip.label"),
attr(as.Splits(splitsU, splitsC), "tip.label"))
expect_equal(attr(splitsC, "tip.label"),
attr(as.Splits(oneSplit, splitsC), "tip.label"))
expect_equal(as.Splits(splitsD, splitsC),
as.Splits(list(splitsC, splitsD, splitsU, oneSplit))[[2]])
expect_equal(letters[1:5], colnames(as.logical(logicalSplits)))
polytomy <- ape::read.tree(text = "(a, b, c, d, e);")
expect_equal("0 bipartition splits dividing 5 tips, a .. e",
capture_output(print(as.Splits(polytomy))))
notPreorder <- structure(list(
edge = structure(c(6L, 9L, 8L, 7L, 7L, 8L, 9L, 6L,
9L, 8L, 7L, 2L, 3L, 5L, 4L, 1L), .Dim = c(8L, 2L)),
Nnode = 4L, tip.label = 1:5), class = "phylo", order = "cladewise")
expect_equal(c("7" = packBits(c(A, B, B, A, A, rep(FALSE, 3))),
"8" = packBits(c(A, B, B, A, B, rep(FALSE, 3)))),
as.Splits(notPreorder)[, 1])
expect_equal(as.Splits(list(BalancedTree(3:9), BalancedTree(7:1))),
list(as.Splits(BalancedTree(3:9)),
as.Splits(BalancedTree(7:1),
tipLabels = as.character(c(3:7, 2:1)))))
expect_equal(as.Splits(c(BalancedTree(3:9), BalancedTree(7:1))),
list(as.Splits(BalancedTree(3:9)),
as.Splits(BalancedTree(7:1),
tipLabels = as.character(c(3:7, 2:1)))))
})
test_that("as.Splits.phylo()", {
rootedStar <- structure(list(edge = structure(c(7L, 8L, 8L, 8L, 8L, 8L, 7L,
8L, 1L, 2L, 3L, 4L, 5L, 6L),
.Dim = c(7L, 2L)), Nnode = 2L,
tip.label = letters[1:6]), class = "phylo")
rootedStar2 <- structure(list(edge = structure(c(8L, 8L, 8L, 8L, 8L, 7L, 7L,
1L, 2L, 3L, 4L, 5L, 6L, 8L),
.Dim = c(7L, 2L)), Nnode = 2L,
tip.label = letters[1:6]), class = "phylo")
nasty <- structure(list(edge = structure( # Danger: Do not plot!
c(9, 12, 10, 13, 11, 10, 11, 13, 10, 13, 12, 9,
5, 10, 1, 2, 3, 13, 9, 4, 11, 7, 8, 6),
.Dim = c(12, 2)), Nnode = 5L, tip.label = letters[1:8]), class = "phylo")
expect_equal(c(0L, 1L), dim(as.Splits(rootedStar)))
expect_equal(c(0L, 1L), dim(as.Splits(rootedStar2)))
expected <- as.raw(as.Splits(Preorder(nasty)))
actual <- as.raw(as.Splits(nasty))
expect_equal(length(expected), length(actual))
expect_equal(length(actual), length(unique(actual)))
expect_true(all(actual %in% expected))
expect_true(all(expected %in% actual))
expect_equal(c(2L, 1L), dim(as.Splits(PectinateTree(5L))))
expect_equal(c(2L, 1L), dim(as.Splits(UnrootTree(PectinateTree(5L)))))
twoCherriesInGrass <- PectinateTree(3) + PectinateTree(3)
expect_equal(c(2L, 1L), dim(as.Splits(twoCherriesInGrass)))
unresolvedRoot <- CollapseNode(twoCherriesInGrass, 8)
expect_equal(c(1L, 1L), dim(as.Splits(unresolvedRoot)))
expect_equal(c(3L, 1L), dim(as.Splits(BalancedTree(6))))
expect_equal(c(61L, 8L), dim(as.Splits(PectinateTree(64L))))
expect_equal(c(62L, 9L), dim(as.Splits(PectinateTree(65L))))
expect_equal(c(125L, 16L), dim(as.Splits(PectinateTree(128L))))
expect_equal(as.Splits(Postorder(PectinateTree(64L))),
as.Splits(PectinateTree(64L)))
expect_true(all(
as.Splits(ape::reorder.phylo(BalancedTree(66L), "postorder")) %in%
as.Splits(BalancedTree(66L))))
expect_false(all(
as.Splits(ape::reorder.phylo(PectinateTree(66L), "postorder")) %in%
as.Splits(BalancedTree(66L))))
# Should be viable on 32-bit systems
expect_equal(c(7997L, 1000L), dim(as.Splits(PectinateTree(8000L))))
bigTree <- PectinateTree(16384L) # Max size with int16_t on 64-bit systems
bigMemory <- try(Postorder(bigTree$edge), silent = TRUE)
if (inherits(bigMemory, "try-error")) {
expect_error(dim(as.Splits(bigTree))) # Likely on 32-bit systems
} else {
rm(bigMemory)
gc()
expect_equal(c(16381L, 2048L), dim(as.Splits(bigTree)))
}
})
test_that("as.Splits.multiPhylo()", {
randomTreeIds <- c(30899669, 9149275, 12823175, 19740197, 31296318,
6949843, 30957991, 32552966, 22770711, 21678908)
randomTrees <- as.phylo(randomTreeIds, 11L, seq_len(11L))
expect_equal(as.Splits(randomTrees[[1]]),
as.Splits(randomTrees)[[1]])
})
test_that("as.Splits.Splits()", {
# n tip > 8L
splitsA <- as.Splits(ape::read.tree(text="((((a, b, c, c2), g), h), (d, (e, f)));"))
splitsB <- as.Splits(ape::read.tree(text="(((((a, b), (c, c2)), h), g), (d, e, f));"))
expectedSplits <- structure(matrix(as.raw(c(0x3f, 0x2f, 0x0f, 0x03, 0x0c, 0,
0, 0, 0, 0)), ncol=2), nTip = 9,
tip.labels = TipLabels(splitsA), class="Splits")
actualSplits <- as.Splits(splitsB, splitsA)
expect_true(all(expectedSplits %in% actualSplits))
expect_true(all(actualSplits %in% expectedSplits))
expect_equal(NSplits(expectedSplits), NSplits(actualSplits))
splitsABare <- splitsA
attr(splitsABare, "tip.label") <- NULL
expect_error(as.Splits(splitsABare, 1:2))
expect_equal(splitsA, as.Splits(splitsABare, splitsA))
})
test_that("as.Splits.matrix()", {
expect_error(as.Splits(matrix(1, 3, 3)))
expect_error(as.Splits(matrix(1, 2, 2,
dimnames = list(c("edge", "Nnode"), NULL))))
trees <- list(BalancedTree(8), PectinateTree(8),
CollapseNode(BalancedTree(8), 10:13))
arr <- sapply(1:3, function(i) trees[[i]])
expect_error(as.Splits(arr[-2, ]))
expect_equal(as.Splits(trees), as.Splits(arr))
for (i in seq_along(trees)) {
trees[[i]]$tip.label <- 1:8
}
expect_equal(as.Splits(trees), as.Splits(arr[-3, ]))
exp <- as.Splits(BalancedTree(8))
attr(exp, "tip.label") <- NULL
expect_equal("Tips not labelled.", capture.output(summary(exp))[9])
expect_equal(exp, as.Splits(BalancedTree(8)$edge))
})
test_that("as.Splits.edge()", {
# From https://stackoverflow.com/questions/71082379
expect_one_of <- function(object, options) {
# 1. Capture object and label
act <- quasi_label(rlang::enquo(object), arg = "object")
# 2. Call expect()
compResults <- purrr::map_lgl(options, ~identical(act$val, .x))
expect(
any(compResults),
sprintf(
"Input (%s) is not one of the accepted options: %s",
toString(act$val),
paste(purrr::map_chr(options, toString), collapse = ", ")
)
)
# 3. Invisibly return the value
invisible(act$val)
}
# Test expect_one_of
expect_success(expect_one_of(1, list(1, 2)))
expect_failure(expect_one_of(0, list(1, 2)), "not one of")
test <- unname(as.Splits(BalancedTree(4), asSplits = FALSE))
expect_one_of(test, list(matrix(as.raw(0x0c)), matrix(as.raw(0x03))))
})
test_that("Logical splits don't get caught by as.matrix", {
expect_equal(as.raw(as.Splits(matrix(FALSE, 2, 2))), raw(2))
expect_equal(as.raw(as.Splits(matrix(TRUE, 3, 3))), as.raw(rep(7, 3)))
})
test_that("as.Splits.logical()", {
FFTT <- c(FALSE, FALSE, TRUE, TRUE)
a..d <- letters[1:4]
expect_splits_equal(unname(as.Splits(BalancedTree(a..d))),
as.Splits(!FFTT, a..d))
expect_splits_equal(as.Splits(FFTT, a..d), as.Splits(t(matrix(FFTT)), a..d))
expect_splits_equal(as.Splits(FFTT), as.Splits(t(matrix(FFTT))))
})
test_that("as.Splits.character()", {
a..f <- letters[1:6]
a..i <- letters[1:9]
. <- FALSE
X <- TRUE
expect_splits_equal(
as.Splits("...***", a..f),
as.Splits(c(., ., ., X, X, X), a..f)
)
expect_splits_equal(
as.Splits(c("...***", "*.*.*."), a..f),
as.Splits(rbind(c(., ., ., X, X, X), c(X, ., X, ., X, .)), a..f)
)
expect_splits_equal(
as.Splits("****.....", a..i),
as.Splits(c(X, X, X, X, ., ., ., ., .), a..i)
)
expect_splits_equal(
as.Splits(c("****.....", ".*.*.*.*."), a..i),
as.Splits(rbind(c(X, X, X, X, ., ., ., ., .),
c(., X, ., X, ., X, ., X, .)),
a..i)
)
expect_equal(TipLabels(as.Splits("...***")), paste0("t", 1:6))
expect_equal(
TipLabels(as.Splits(structure("...***", tip.label = letters[1:6]))),
letters[1:6]
)
})
test_that("!.Splits() errors", {
skip_if(Sys.getenv("USING_ASAN") != "")
x <- as.Splits(as.phylo(8, 7))
expect_error(!(structure(x, nTip = NULL)),
"lacks nTip attrib")
})
test_that("xor, |, &.Splits()", {
splits <- structure(as.raw(c(0x07, 0x03, 0x18, 0xe0, 0x60, 0x80)),
.Dim = c(3L, 2L), nTip = 9L, class = "Splits")
expect_equal(splits & splits, splits)
expect_equal(splits | splits, splits)
expect_equal(xor(splits, splits),
structure(matrix(raw(6), 3, 2), nTip = 9, class = "Splits"))
mask <- structure(as.raw(c(0x0f, 0x00)), .Dim = c(1L, 2L), nTip = 9L,
class = "Splits")
mask <- c(mask, mask, mask)
expect_equal(t(splits[] & mask[]),
structure(as.raw(c(0x07, 0x00, 0x03, 0x00, 0x08, 0x00)),
.Dim = c(2L, 3L)))
expect_equal(splits & mask,
structure(as.raw(c(0x07, 0x03, 0x08, 0x00, 0x00, 0x00)),
.Dim = c(3L, 2L), nTip = 9L, class = "Splits"))
expect_equal(splits | mask,
structure(unclass(splits) | unclass(mask),
nTip = 9L, class = "Splits"))
expect_equal(xor(splits, mask),
(splits | mask) & !(splits & mask))
Test <- function (s1, s2) {
s1 <- as.Splits(s1)
s2 <- as.Splits(s2)
expect_equal((s1 & s2)[], s2[] & s1[], ignore_attr = TRUE)
expect_equal((s1 | s2)[], s2[] | s1[], ignore_attr = TRUE)
expect_equal(xor(s1, s2)[], xor(s2[], s1[]), ignore_attr = TRUE)
expect_equal((!s1)[], mask_splits(!(s1[])))
expect_equal(attributes(!s1), attributes(s1))
expect_equal(attributes(s1 | s2), attributes(s1))
expect_equal(attributes(s1 & s2), attributes(s1))
expect_equal(attributes(xor(s1, s2)), attributes(s1))
}
Test(PectinateTree(145), BalancedTree(145))
Test(PectinateTree(64 * 3), BalancedTree(64 * 3))
Test(PectinateTree(64 * 3 + 1), BalancedTree(64 * 3 + 1))
Test(PectinateTree(64 * 3 - 1), BalancedTree(64 * 3 - 1))
})
test_that("empty as.X.Splits()", {
someSplit <- as.Splits(BalancedTree(6))
noSplit <- someSplit[[logical(0)]]
expect_equal(matrix(logical(0), 0, 6,
dimnames = list(NULL, paste0("t", 1:6))),
as.logical(noSplit))
expect_equal(character(0), as.character(noSplit))
})
test_that("Renaming splits", {
tree1 <- PectinateTree(1:8)
tree2 <- BalancedTree(8:1)
splits1 <- as.Splits(tree1)
splits2 <- as.Splits(tree2)
expect_error(as.Splits(splits1, tipLabel = 1:4))
expect_error(as.Splits(splits1, tipLabel = LETTERS[1:8]))
expect_equal(as.Splits(tree1, tipLabel = as.character(8:1)),
as.Splits(tree1, tipLabel = tree2))
expect_equal(as.Splits(tree1, tipLabel = tree2),
as.Splits(as.Splits(tree1), tipLabel = tree2))
as.Splits(tree1, tipLabel = tree2)[]
as.Splits(as.Splits(tree1), tipLabel = tree2)[]
})
test_that("match.Splits()", {
tree1 <- PectinateTree(1:8)
tree2 <- PectinateTree(8:1)
col2 <- as.Splits(CollapseNode(tree2, 13))
expect_equal(5:1, match(as.Splits(tree1), as.Splits(tree2, tree1)))
expect_equal(c(4, 3, NA, 2, 1), match(as.Splits(tree1, tree2), col2))
expect_equal(c(4, 3, 999, 2, 1),
match(as.Splits(tree1, tree2), col2, nomatch = 999))
expect_equal(c(5, 4, 2, 1), match(col2, as.Splits(tree1, tree2)))
})
test_that("duplicated.Splits(internal)", {
for (nTip in c(7:8, 23:26)) { # n %% BIN_SIZE ==0, ==1, >1
x <- c(as.Splits(PectinateTree(nTip)), !as.Splits(BalancedTree(nTip)))
expect_equal(duplicated(x, withNames = FALSE),
duplicated(x, FALSE, withNames = FALSE))
expect_equal(as.logical(duplicated(x, fromLast = TRUE)),
as.logical(duplicated(x, FALSE, fromLast = TRUE)))
expect_equal(names(duplicated(x, fromLast = TRUE)),
names(duplicated(x, FALSE, fromLast = TRUE)))
expect_equal(duplicated(PolarizeSplits(x, nTip / 2)), duplicated(x))
expect_equal(duplicated(x, fromLast = TRUE),
rev(duplicated(rev(x), fromLast = FALSE)))
}
})
test_that("%in%.Splits()", {
splits5 <- as.Splits(PectinateTree(5))
x <- splits5
table <- splits5[[-1]]
expect_null(dim(duplicated(c(splits5, splits5[[-1]]))))
expect_equal(names(splits5 %in% splits5[[-1]]), names(splits5))
splits9 <- as.Splits(PectinateTree(9))
expect_equal(names(splits9 %in% splits9[[-4]]), names(splits9))
})
test_that("print.Splits()", {
sp4 <- as.Splits(BalancedTree(4))
num <- names(sp4)
expect_equal(
capture.output(print(PolarizeSplits(sp4, 1), details = TRUE)),
c( "1 bipartition split dividing 4 tips, t1 .. t4", " 1234",
paste0(" ", num, " **..")))
expect_equal(capture.output(print(PolarizeSplits(sp4, 4), details = TRUE)),
c( "1 bipartition split dividing 4 tips, t1 .. t4", " 1234",
paste0(" ", num, " ..**")))
})
test_that("head,tail.Splits()", {
sp12 <- as.Splits(BalancedTree(12)) # 9 splits
expect_equal(head(sp12), sp12[[1:6]])
expect_equal(head(sp12, 2), sp12[[1:2]])
expect_equal(head(sp12, 24), sp12)
expect_equal(head(sp12, -7), sp12[[1:2]])
expect_equal(tail(sp12), sp12[[4:9]])
expect_equal(tail(sp12, 2), sp12[[8:9]])
expect_equal(tail(sp12, 24), sp12)
expect_equal(tail(sp12, -7), sp12[[8:9]])
sp0 <- sp12 - sp12
expect_equal(head(sp0), sp0)
expect_equal(head(sp0, 1), sp0)
expect_equal(tail(sp0), sp0)
expect_equal(tail(sp0, 1), sp0)
expect_equal(head(sp12, -24), sp0)
expect_equal(tail(sp12, -24), sp0)
})
test_that("Split operations", {
split1 <- as.Splits(c(rep(TRUE, 30), rep(FALSE, 70), rep(TRUE, 20)))
notSplit1 <- as.Splits(c(rep(FALSE, 30), rep(TRUE, 70), rep(FALSE, 20)))
expect_equal(!split1, notSplit1)
expect_equal(split1, !notSplit1)
expect_equal(notSplit1[1, ], (split1 + notSplit1)[2, ])
expect_equal(split1 + notSplit1, !(notSplit1 + split1))
expect_equal(notSplit1, (split1 + notSplit1)[[2]])
expect_equal(notSplit1 + split1 + split1, (split1 + notSplit1)[[c(2, 1, 1)]])
split2 <- as.Splits(c(rep(TRUE, 4), FALSE, FALSE))
notSplit2 <- as.Splits(c(rep(FALSE, 4), TRUE, TRUE))
expect_equal(split2, !notSplit2)
expect_equal(!split2, notSplit2)
expect_equal(notSplit2[1, ], (split2 + notSplit2)[2, ])
expect_equal(split2 + notSplit2, !(notSplit2 + split2))
expect_error(split1 + split2)
namedSplits <- as.Splits(BalancedTree(8))
if (isTRUE(all.equal(rownames(namedSplits),
as.character(c(10:12, 14:15))))) {
expect_true(TRUE)
} else {
expect_equal(rownames(namedSplits), as.character(c(11:15)))
}
expect_equal(split1[], `[[.Splits`(split1))
expect_error(c(split1, notSplit1)[[2:1, 1]])
})
test_that("Split subtraction", {
splits <- as.Splits(BalancedTree(8))
expect_equal(splits[[c(1, 2, 4, 5)]], splits - splits[[3]])
})
test_that("unique.Splits()", {
noSplits <- WithoutTrivialSplits(as.Splits(matrix(FALSE, 2, 2)))
expect_equal(duplicated(noSplits), logical(0))
expect_equal(unique(noSplits), noSplits)
})
test_that("Split combination", {
tree1 <- BalancedTree(letters[1:5])
splits1 <- as.Splits(tree1)
tree2 <- PectinateTree(letters[1:5])
splits12 <- c(splits1, as.Splits(tree2))
tree3 <- PectinateTree(letters[c(1:3, 5, 4)])
tree4 <- PectinateTree(letters[c(1:4, 6)])
tree5 <- PectinateTree(letters[1:6])
expect_equal(4L, length(splits12))
expect_equal(c(FALSE, FALSE, TRUE, TRUE), as.logical(duplicated(splits12)))
expect_equal(2L, length(unique(c(splits1, as.Splits(tree3)))))
expect_error(c(splits1, as.Splits(tree4)))
expect_error(c(splits1, as.Splits(tree5)))
expect_equal(c(as.raw(splits1), as.raw(as.Splits(PectinateTree(5)))),
unname(c(splits1,
as.Splits(RenumberTips(tree3, letters[1:5])))[, 1]))
expect_equal(2L, length(unique(c(splits1, as.Splits(tree2)))))
#TODO: Fully test splits with large (> 8 tip) trees
})
test_that("as.phylo.Splits() fails gracefully", {
expect_error(
as.phylo(as.Splits(BalancedTree(3000))),
"many leaves cannot be supported"
)
})
test_that("as.phylo.Splits()", {
Test <- function(tr) {
expect_true(all.equal(as.phylo(as.Splits(tr)), UnrootTree(tr)))
}
Test(read.tree(text = "((a, b, c), (d, e, f, g));"))
Test(read.tree(text = "((a, b, c), (d, e, (f, g)));"))
Test(BalancedTree(64))
Test(BalancedTree(65)) # multiple bins
Test(PectinateTree(65*6)) # big!
A <- FALSE
B <- TRUE
splits <- as.Splits(matrix(c(A, B, A, A, A, A, A, B,
A, B, A, A, A, A, B, B,
A, B, A, A, A, B, B, B,
A, B, A, A, B, B, B, B), 4, byrow = TRUE),
tipLabels = letters[1:8])
expect_true(all.equal(as.phylo(splits),
read.tree(text = "(a, c, d, (e, (f, (g, (h, b)))));")))
})
test_that("PolarizeSplits()", {
bal6 <- as.Splits(BalancedTree(6))
expect_error(PolarizeSplits(bal6, "ERROR"))
expect_error(PolarizeSplits(bal6, 0))
expect_error(PolarizeSplits(bal6, 7))
})
test_that(".MaskSplits()", {
x <- as.Splits(as.phylo(5, 5))
expect_equal(.MaskSplits(x), mask_splits(x))
skip_if(Sys.getenv("USING_ASAN") != "")
expect_error(mask_splits(structure(x, nTip = NULL)),
"lacks nTip attrib")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.