Nothing
#
# --- Test treewalk.R ---
#
# Create sample phylo4 tree for testing
tr <- read.tree(text="(((spA:0.2,(spB:0.1,spC:0.1):0.15):0.5,spD:0.7):0.2,spE:1):0.4;")
phytr <- as(tr, "phylo4")
# create phylo4 object with a full complement of valid slots
ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
edge <- cbind(ancestor, descendant)
nid.tip <- 1:5
nid.int <- 6:9
nid.all <- c(nid.tip, nid.int)
lab.tip <- paste("t", nid.tip, sep="")
lab.int <- paste("n", nid.int, sep="")
lab.all <- c(lab.tip, lab.int)
eid <- paste(ancestor, descendant, sep="-")
elen <- descendant/10
elab <- paste("e", eid, sep="")
phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
edge.length=elen, edge.label=elab)
# create altered version such that each slot is out of order with
# respect to all others; methods should be able to handle this
phy.alt <- phy
phy.alt@label <- rev(phy@label)
phy.alt@edge <- phy@edge[c(6:9, 1:5), ]
phy.alt@edge.length <- phy@edge.length[c(7:9, 1:6)]
phy.alt@edge.label <- phy@edge.label[c(8:9, 1:7)]
# update test targets for edge-related slots
ancestor <- ancestor[c(6:9, 1:5)]
descendant <- descendant[c(6:9, 1:5)]
edge <- cbind(ancestor, descendant)
eid <- eid[c(6:9, 1:5)]
elen <- elen[c(6:9, 1:5)]
elab <- elab[c(6:9, 1:5)]
#-----------------------------------------------------------------------
## Note: we're not explicitly testing missing="warn" condition below;
## however, if "OK" and "fail" both work as expected, then so must "warn"
#test.getNode <- function() {
context("getNode")
test_that("getNode works when nodes provided only has valid characters", {
expect_that(getNode(phytr, "spA"), equals(c(spA=1)))
expect_that(getNode(phytr, c("spA", "spC")), equals(c(spA=1, spC=3)))
})
test_that("getNode works when nodes provided only has valid integers", {
ans <- 4
names(ans) <- "spD"
expect_that(getNode(phytr, 4), equals(ans))
ans <- c(4,6)
names(ans) <- c("spD", NA)
expect_that(getNode(phytr, c(4,6)), equals(ans))
})
test_that("getNode works when node includes only missing characters (names), but missing=OK", {
ans <- rep(NA_integer_, 2) # return values should be NA
names(ans) <- rep(NA, 2) # return values should have NA names
expect_that(getNode(phytr, c("xxx", "yyy"), missing="OK"), equals(ans))
# now missing = "fail"
expect_error(getNode(phytr, c("xxx", "yyy"), missing="fail"))
})
test_that("getNode works wehn node includes only missing numbers (IDs), but missing=OK", {
ans <- rep(NA_integer_, 3) # return values should be NA
names(ans) <- rep(NA, 3) # return values should have NA names
expect_that(getNode(phytr, c(-9, 0, 50), missing="OK"), equals(ans))
# now missing = "fail"
expect_error(getNode(phytr, c(-9, 0, 50), missing="fail"))
})
test_that("getNode works when node includes NAs, but missing = \"OK\"", {
expect_true(is.na(getNode(phytr, NA_integer_, missing="OK")))
expect_true(is.na(getNode(phytr, NA_character_, missing="OK")))
})
test_that("getNode works when node includes mixture of valid values and NAs", {
ans <- c(2, NA)
names(ans) <- c("spB", NA)
expect_that(getNode(phytr, c("spB", NA), missing="OK"), equals(ans))
expect_that(getNode(phytr, c(2, NA), missing="OK"), equals(ans))
})
test_that("getNode throws exception when node is neither integer-like nor character",
expect_error(getNode(phytr, 1.5)))
test_that("getNode works even when a tip is labeled as \"0\"", {
phyTmp <- phytr
tipLabels(phyTmp)[1] <- "0"
ans <- 1
names(ans) <- "0"
expect_that(getNode(phyTmp, "0"), equals(ans))
})
## TODO context("ancestor function")
## TODO context("children function")
context("descendants function")
phytr <- phylo4(read.tree(text="((t3,t4),(t1,(t2,t5)));"))
test_that("descendants() works with tips", {
expect_identical(descendants(phytr, 5), setNames(5L, "t5"))
expect_identical(descendants(phytr, 5, "tips"), setNames(5L, "t5"))
expect_identical(descendants(phytr, 5, "children"),
setNames(integer(0), character(0)))
expect_identical(descendants(phytr, 5, "all"), setNames(5L, "t5"))
expect_identical(descendants(phytr, 5, "ALL"), setNames(5L, "t5"))
})
test_that("descendants() works when provided with a vector of nodes", {
expect_identical(descendants(phytr, 5:7),
list("5" = c(t5 = 5L),
"6" = c(t3 = 1L, t4 = 2L, t1 = 3L, t2 = 4L, t5 = 5L),
"7" = c(t3 = 1L, t4 = 2L)))
expect_identical(descendants(phytr, 5:7, "tips"),
list("5" = c(t5 = 5L),
"6" = c(t3 = 1L, t4 = 2L, t1 = 3L, t2 = 4L, t5 = 5L),
"7" = c(t3 = 1L, t4 = 2L)))
expect_identical(descendants(phytr, 5:7, "children"),
list("5" = setNames(integer(0), character(0)),
"6" = setNames(c(7L, 8L), c(NA, NA)),
"7" = c(t3 = 1L, t4 = 2L))
)
expect_identical(descendants(phytr, 5:7, "ALL"),
list("5" = c(t5 = 5L),
"6" = setNames(c(6L, 7L, 1L, 2L, 8L, 3L, 9L, 4L, 5L),
c(NA, NA, "t3", "t4", NA, "t1", NA, "t2", "t5")),
"7" = setNames(c(7L, 1L, 2L), c(NA, "t3", "t4")))
)
})
test_that("descendants() works with internal nodes", {
expect_identical(descendants(phytr, 8),
setNames(c(3L, 4L, 5L), c("t1", "t2", "t5")))
expect_identical(descendants(phytr, 8, "tips"),
setNames(c(3L, 4L, 5L), c("t1", "t2", "t5")))
expect_identical(descendants(phytr, 8, "children"),
setNames(c(3L, 9L), c("t1", NA)))
expect_identical(descendants(phytr, 8, "all"),
setNames(c(3L, 9L, 4L, 5L), c("t1", NA, "t2", "t5")))
expect_identical(descendants(phytr, 8, "ALL"),
setNames(c(8L, 3L, 9L, 4L, 5L),
c(NA, "t1", NA, "t2", "t5")))
})
## TODO siblings # function(phy, node, include.self=FALSE)
## TODO ancestors # function (phy, node, type=c("all","parent","ALL"))
## TODO MRCA # function(phy, ...)
## TODO shortestPath # function(phy, node1, node2)
context("test on getEdge with nodes as descendants")
## function(phy, node, type=c("descendant", "ancestor"),
## missing=c("warn", "OK", "fail"))
test_that("getEdge works when node only has valid descendants, as characters", {
expect_identical(getEdge(phy.alt, "t1"), setNames("7-1", 1))
expect_identical(getEdge(phy.alt, c("t1", "t3")),
setNames(c("7-1", "8-3"), c(1,3)))
})
test_that("getEdge works when node only has valid descendants, as integers", {
expect_identical(getEdge(phy.alt, 1), setNames("7-1", 1))
expect_identical(getEdge(phy.alt, c(1,3)),
setNames(c("7-1", "8-3"), c(1,3)))
})
test_that("node includes only missing characters (labels), missing=OK", {
expect_identical(getEdge(phy.alt, c("x", "y", "z"), missing="OK"),
setNames(rep(NA, 3), rep(NA, 3)))
})
test_that("node includes only missing characters (labels), missing=fail", {
expect_error(getEdge(phy.alt, c("x", "y", "z"), missing="fail"))
})
test_that("node includes only missing numbers (IDs), but missing=OK",
expect_identical(getEdge(phy.alt, c(-9, 0, 50), missing="OK"),
setNames(rep(NA, 3), rep(NA, 3))))
test_that("node includes only missing numbers (IDs), but missing=fail",
expect_error(getEdge(phy, c(-9, 0, 50), missing="fail")))
test_that("node includes NAs, but missing = OK", {
expect_true(is.na(getEdge(phy, NA_integer_, missing="OK")))
expect_true(is.na(getEdge(phy, NA_character_, missing="OK")))
})
test_that("node includes mixture of valid values and NAs", {
expect_identical(getEdge(phy, c("t3", NA), missing="OK"),
setNames(c("8-3", NA), c(3, NA)))
expect_identical(getEdge(phy, c(3, NA), missing="OK"),
setNames(c("8-3", NA), c(3, NA)))
})
test_that("node is neither integer-like nor character", {
expect_error(getEdge(phy, 1.5))
})
context("test on getEdge with nodes as ancestors")
test_that("node only has valid ancestors, as characters", {
expect_identical(getEdge(phy.alt, "n6", type="ancestor"),
setNames(c("6-7", "6-8"), c(6, 6)))
expect_identical(getEdge(phy.alt, c("n6", "n8"), type="ancestor"),
setNames(c("6-7", "6-8", "8-9", "8-3"), c(6, 6, 8, 8)))
})
test_that("node only has valid ancestors, as integers", {
expect_identical(getEdge(phy.alt, 6, type="ancestor"),
setNames(c("6-7", "6-8"), c(6, 6)))
expect_identical(getEdge(phy.alt, c(6, 8), type="ancestor"),
setNames(c("6-7", "6-8", "8-9", "8-3"), c(6, 6, 8, 8)))
})
test_that("node includes only missing characters (labels), but missing=OK", {
expect_identical(getEdge(phy.alt, c("x", "y", "z"), type="ancestor",
missing="OK"), setNames(rep(NA, 3), rep(NA, 3)))
})
test_that("node includes only tips (labels), but missing=OK", {
expect_identical(
getEdge(phy.alt, c("t1", "t3"), type="ancestor", missing="OK"),
setNames(rep(NA, 2), c(1, 3)))
})
test_that("node includes only tips (labels), now missing = fail", {
expect_error(getEdge(phy.alt, c("x", "y", "z"), missing="fail"))
expect_error(getEdge(phy.alt, c("t1", "t3"), type="ancestor",
missing="fail"))
})
test_that("node includes only missing numbers (IDs), but missing=OK", {
expect_identical(
getEdge(phy.alt, c(-9, 0, 50), type="ancestor", missing="OK"),
setNames(rep(NA, 3), rep(NA, 3)))
})
test_that("node includes only tips (labels), but missing=OK", {
expect_identical(
getEdge(phy.alt, c(1, 3), type="ancestor", missing="OK"),
setNames(rep(NA, 2), c(1, 3)))
})
test_that("node includes only tips (labels), but missing=fail", {
expect_error(getEdge(phy.alt, c(-9, 0, 50), missing="fail"))
expect_error(getEdge(phy.alt, c(1, 3), type="ancestor",
missing="fail"))
})
test_that("node includes NAs, but missing = OK", {
expect_true(is.na(getEdge(phy.alt, NA_integer_, type="ancestor",
missing="OK")))
expect_true(is.na(getEdge(phy.alt, NA_character_, type="ancestor",
missing="OK")))
})
test_that("node includes mixture of valid values and NAs", {
expect_identical(
getEdge(phy.alt, c("t3", "n8", NA), type="ancestor", missing="OK"),
setNames(c(NA, "8-9", "8-3", NA), c(3, 8, 8, NA)))
expect_identical(
getEdge(phy.alt, c(3, 8, NA), type="ancestor", missing="OK"),
setNames(c(NA, "8-9", "8-3", NA), c(3, 8, 8, NA)))
})
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.