data("sq_trees")
ref_tree <- sq_trees$ref_tree
Metrics <- list(DoNotConflict, ExplicitlyAgree, StrictJointAssertions,
SemiStrictJointAssertions, SymmetricDifference,
MarczewskiSteinhaus, SteelPenny, QuartetDivergence,
SimilarityToReference)
test_that("Quartets are counted correctly", {
easyTreesy <- list(
ape::read.tree(text="((1, 2), ((3, 4), (6, 5)));"),
ape::read.tree(text="((1, 5), (3, (4, (2, 6))));"))
expect_identical(c(15L, 2L), QuartetStatus(easyTreesy)[, "s"])
quartet_matches <- QuartetStatus(sq_trees)
expected_identical <- c(330L, 322L, 278L, 254L, 306L, 252L, 238L,
322L, 207L, 270L, 213L, 244L, 125L, 86L,
244L, 122L, 85L, # Values for these three new trees copied without checking
104L)
expected_ambiguous <- c(rep(0L, 7), 8L, 123L, 8L, 65L, 8L, 205L, rep(0L, 5L))
names(expected_identical) <- names(expected_ambiguous) <- names(sq_trees)
expect_identical(expected_identical, quartet_matches[, "s"])
expect_identical(expected_ambiguous, quartet_matches[, "r2"])
})
test_that("Quartet metrics are sane", {
sq_status <- QuartetStatus(sq_trees)
sims <- SimilarityMetrics(sq_status)
dists <- SimilarityMetrics(sq_status, similarity = FALSE)
expect_true(all(sims <= 1))
expect_true(all(sims + dists == 1)[-4]) # SSJA doesn't sum to 1
expect_true(all(dists["ref_tree", ] == 0))
expect_equivalent(sims[, "DoNotConflict"], DoNotConflict(sq_status))
expect_equivalent(sims[, "ExplicitlyAgree"], ExplicitlyAgree(sq_status))
expect_equivalent(sims[, "StrictJointAssertions"], StrictJointAssertions(sq_status))
expect_equivalent(sims[, "SemiStrictJointAssertions"], SemiStrictJointAssertions(sq_status))
expect_equivalent(sims[, "SymmetricDifference"], SymmetricDifference(sq_status))
expect_equivalent(sims[, "MarczewskiSteinhaus"], MarczewskiSteinhaus(sq_status))
expect_equivalent(sims[, "SteelPenny"], SteelPenny(sq_status))
expect_equivalent(sims[, "QuartetDivergence"], QuartetDivergence(sq_status))
expect_equivalent(sims[, "SimilarityToReference"], SimilarityToReference(sq_status))
sim6 <- SimilarityMetrics(sq_status[6, ])
expect_equivalent(sims[6, ], sim6)
testData <- c(N = 16L, Q = 8, s = 1, d = 2, r1 = 1, r2 = 1, u = 3)
expect_equal(c(tree = 2/8), DoNotConflict(testData, FALSE))
expect_equal(c(tree = 7/8), ExplicitlyAgree(testData, FALSE))
expect_equal(c(tree = 2/3), StrictJointAssertions(testData, FALSE))
expect_equal(c(tree = 2/6), SemiStrictJointAssertions(testData, FALSE))
expect_equal(c(tree = 6/8), SymmetricDifference(testData, FALSE))
expect_equal(c(tree = 6/7), MarczewskiSteinhaus(testData, FALSE))
expect_equal(c(tree = 4/8), SteelPenny(testData, FALSE))
expect_equal(c(tree = 6/16), QuartetDivergence(testData, FALSE))
expect_equal(c(tree = 1), SimilarityToReference(testData, FALSE, TRUE))
expect_equal(c(tree = 0), SimilarityToReference(testData, TRUE, TRUE)) # rounding?
# Metrics should be identical with bifurcating trees.
treeNodes <- vapply(sq_trees, function (tr) tr$Nnode, double(1))
n_tip <- 11L
bifurcators <- treeNodes == n_tip - 1L
expect_true(all(apply(sims[bifurcators, colnames(sims) != "MarczewskiSteinhaus"],
1, var) < 1e-08))
fncs <- vapply(Metrics, function (X) X(sq_status), double(length(sq_trees)))
expect_true(all(fncs - sims < 1e-08))
})
test_that("Three-dimensional calculation is correct", {
testTrees <- sq_trees[11:18]
test2 <- sq_trees[5:6]
lapply(Metrics, function (Func) {
expect_equal(Func(QuartetStatus(testTrees)),
Func(ManyToManyQuartetAgreement(testTrees))[, 1])
expect_equal(Func(QuartetStatus(testTrees, test2[[1]])),
Func(TwoListQuartetAgreement(testTrees, test2))[, 1])
})
})
test_that("Quartet metrics handle polytomous pairs", {
polytomous <- list(
ape::read.tree(text="(A, (B, (C, (D, (E, F, G)))));"),
ape::read.tree(text="(A, (B, (G, (C, E, F, D))));"),
ape::read.tree(text='(A, (B, (C, (D, (E, (F, G))))));'),
ape::read.tree(text='(A, (B, (C, ((D, E), (F, G)))));')
)
polyStates <- QuartetStates(polytomous)
expect_equal(c(rep(3, 19), 0, rep(3, 9), 0, 3, 3, 3, 0, 0), polyStates[1, ])
expect_equal(c(rep(3, 10), 0, 0, 1, 0, 1, 1, 0, 1,
1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, rep(0, 5)), polyStates[2, ])
qStat <- QuartetStatus(polytomous)
expect_identical(qStat[1, ], c(N=70L, Q=35L, s=31L, d=0L, r1=0L, r2=0L, u=4L))
expect_identical(qStat[2, ], c(N=70L, Q=35L, s=10L, d=10L, r1=2L, r2=11L, u=2L))
expect_identical(qStat[3, ], c(N=70L, Q=35L, s=31L, d=0L, r1=4L, r2=0L, u=0L))
expect_identical(qStat[4, ], c(N=70L, Q=35L, s=25L, d=6L, r1=4L, r2=0L, u=0L))
})
test_that("Random trees are 1/3 similar", {
for (n_tip in c(7, 13, 26)) {
random_trees <- lapply(rep(n_tip, 50), ape::rtree, tip.label=seq_len(n_tip), br=NULL)
n_quartets <- choose(n_tip, 4)
sq_matches <- QuartetStatus(random_trees)
expect_equal(0, sum(sq_matches[, c('r1', 'r2', 'u')]))
expect_true(t.test(sq_matches[, 's'], mu=n_quartets * 1 / 3)$p.value > 0.01)
tq_distances <- TQDist(random_trees)
tq_unique <- tq_distances[upper.tri(tq_distances)]
expect_true(t.test(tq_unique, mu=n_quartets * 2 / 3)$p.value > 0.01)
expect_equal(tq_distances[1, ], n_quartets - sq_matches[, 's'])
}
})
test_that("Incomparable trees fail gracefully", {
# Must have same number of tips
expect_error(QuartetStatus(list(ref_tree, ape::rtree(6))))
# Can't do SSJA for partitions
expect_equal(NA, SemiStrictJointAssertions(SplitStatus(sq_trees)))
})
test_that("Cleanup was successful", {
expect_identical(character(0), list.files(pattern='~temp.*'))
})
test_that ("Partitions are counted correctly", {
p_dist <- SplitStatus(sq_trees)
unrooted_trees <- lapply(sq_trees, ape::unroot)
rf_dist <- as.integer(lapply(unrooted_trees, ape::dist.topo, ape::unroot(sq_trees$ref_tree)))
expect_true(all(p_dist[, 's'] + p_dist[, 'd1'] <= p_dist[, 'P2']))
expect_true(all(p_dist[, 's'] + p_dist[, 'd2'] <= p_dist[, 'P1']))
expect_true(all(rowSums(p_dist[, c('s', 'd1', 'r1')]) == p_dist[, 'P1']))
expect_true(all(rowSums(p_dist[, c('s', 'd2', 'r2')]) == p_dist[, 'P2']))
expect_equal(rf_dist, as.integer(RawSymmetricDifference(p_dist)))
expect_equal(rf_dist,
as.integer(p_dist[, 'N'] -
RawSymmetricDifference(p_dist, similarity = TRUE)))
expect_equal(sum(p_dist['move_one_mid' , c('r1', 'd1')]),
sum(p_dist['m1mid_col1' , c('r1', 'd1')]),
sum(p_dist['m1mid_colsome', c('r1', 'd1')]))
expect_equal(1L, sum(p_dist['m1mid_col1' , c('d2', 'r2')],
-p_dist['m1mid_col1' , c('d1', 'r1')]))
expect_equal(3L, sum(p_dist['m1mid_colsome', c('d2', 'r2')],
- p_dist['m1mid_colsome', c('d1', 'r1')]))
expect_equal(sum(p_dist['move_two_mid', c('d1', 'r1')]),
sum(p_dist['m2mid_col1', c('d1', 'r1')]))
expect_equal(1L, sum(p_dist['m2mid_col1', c('d2', 'r2')],
- p_dist['m2mid_col1', c('d1', 'r1')]))
expect_equal(5L, sum(p_dist['m2mid_colsome', c('d2', 'r2')],
- p_dist['m2mid_colsome', c('d1', 'r1')]))
})
test_that("Incomparable trees fail gracefully", {
# Must have same number of tips
expect_error(SplitStatus(list(ref_tree, ape::rtree(6))))
})
test_that(".StatusToArray()", {
mqa <- ManyToManyQuartetAgreement(sq_trees[5:6])
mqaNQ <- mqa[, , -c(1, 2)]
qNames <- dimnames(.StatusToArray(mqa))
status <- aperm(vapply(sq_trees[5:6],
function (x) SplitStatus(sq_trees[5:6], x),
SplitStatus(sq_trees[5:6], sq_trees[[1]])),
c(1, 3, 2))
sNames <- dimnames(.StatusToArray(status))
expect_true(all(c("N", "Q", "s", "d", "r1", "r2", "u", "2d") %in%
qNames[[3]]))
expect_true(all(c("N", "Q", "s", "d", "r1", "r2", "u", "2d") %in%
dimnames(.StatusToArray(mqaNQ))[[3]]))
expect_true(all(c("N", "P1", "P2", "s", "d1", "d2", "r1", "r2", "2d") %in%
sNames[[3]]))
expect_true(all(c("N", "P1", "P2", "s", "d1", "d2", "r1", "r2", "2d") %in%
dimnames(.StatusToArray(status[, , -1]))[[3]]))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.