Nothing
# tests of arborescence creation
test_that("incorrect node and edge types are rejected", {
n1 <- Node$new()
n2 <- Node$new()
a1 <- Arrow$new(n1, n2)
expect_error(Arborescence$new(n1, list(a1)), class = "non-list_vertices")
expect_error(Arborescence$new(list(n1, n2), a1), class = "non-list_arrows")
expect_error(
Arborescence$new(list(n1, 42L), list(a1)),
class = "non-Node_vertex"
)
expect_error(
Arborescence$new(list(n1, n2), list(a1, 42L)),
class = "non-Arrow_edge"
)
})
test_that("graphs that are not trees are rejected", {
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Arrow$new(n1, n2)
e2 <- Arrow$new(n1, n3)
expect_silent(Arborescence$new(V = list(n1, n2, n3), A = list(e1, e2)))
#
e3 <- Arrow$new(n2, n3)
expect_error(
Arborescence$new(V = list(n1, n2, n3), A = list(e1, e2, e3)),
class = "not_arborescence"
)
})
test_that("graphs that are not arborescences are rejected", {
# out tree (single root)
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Arrow$new(n1, n2)
e2 <- Arrow$new(n1, n3)
a <- Arborescence$new(V = list(n1, n2, n3), A = list(e1, e2))
expect_true(a$is_tree())
expect_identical(a$root(), n1)
expect_true(a$is_root(n1))
expect_identical(a$is_root(list(n1, n2, n3)), c(TRUE, FALSE, FALSE))
# out tree (single root) with nodes and edges in different order
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Arrow$new(n1, n2)
e2 <- Arrow$new(n1, n3)
g <- Digraph$new(V = list(n2, n3, n1), A = list(e1, e2))
expect_true(g$is_weakly_connected())
expect_true(g$is_tree())
a <- Arborescence$new(V = list(n2, n3, n1), A = list(e1, e2))
expect_true(a$is_tree())
expect_identical(a$root(), n1)
expect_true(a$is_root(n1))
# in tree (2 roots)
e1 <- Arrow$new(n2, n1)
e2 <- Arrow$new(n3, n1)
expect_error(
Arborescence$new(V = list(n1, n2, n3), A = list(e1, e2)),
class = "not_arborescence"
)
})
test_that("parent, sibling and drawing functions are correct", {
# create the tree using example from Walker (1989), fig 12
nO <- Node$new("O")
nE <- Node$new("E")
nF <- Node$new("F")
nN <- Node$new("N")
nA <- Node$new("A")
nD <- Node$new("D")
nG <- Node$new("G")
nM <- Node$new("M")
nB <- Node$new("B")
nC <- Node$new("C")
nH <- Node$new("H")
nI <- Node$new("I")
nJ <- Node$new("J")
nK <- Node$new("K")
nL <- Node$new("L")
eOE <- Arrow$new(nO, nE)
eOF <- Arrow$new(nO, nF)
eON <- Arrow$new(nO, nN)
eEA <- Arrow$new(nE, nA)
eED <- Arrow$new(nE, nD)
eDB <- Arrow$new(nD, nB)
eDC <- Arrow$new(nD, nC)
eNG <- Arrow$new(nN, nG)
eNM <- Arrow$new(nN, nM)
eMH <- Arrow$new(nM, nH)
eMI <- Arrow$new(nM, nI)
eMJ <- Arrow$new(nM, nJ)
eMK <- Arrow$new(nM, nK)
eML <- Arrow$new(nM, nL)
A <- Arborescence$new(
V = list(nA, nB, nC, nD, nE, nF, nG, nH, nI, nJ, nK, nL, nM, nN, nO),
A = list(
eOE, eOF, eON, eEA, eED, eDB, eDC, eNG, eNM, eMH, eMI, eMJ, eMK, eML
)
)
# check the tree size
expect_identical(A$order(), 15L)
# check parents
expect_identical(A$parent(nE), nO)
expect_identical(A$parent(nO), NA)
expect_identical(A$parent(list(nE, nA, nO)), list(nO, nE, NA))
expect_identical(A$parent(list()), list())
# check parent status
expect_false(A$is_parent(nA))
expect_identical(A$is_parent(list()), vector(mode = "logical"))
expect_identical(A$is_parent(list(nE, nA, nD)), c(TRUE, FALSE, TRUE))
expect_true(A$is_parent(nO))
# check leaf status
expect_false(A$is_leaf(nO))
expect_true(A$is_leaf(nA))
expect_identical(A$is_leaf(list()), vector(mode = "logical"))
expect_identical(A$is_leaf(list(nE, nA, nD)), c(FALSE, TRUE, FALSE))
# check siblings
expect_length(A$siblings(nO), 0L)
expect_error(A$siblings(list(nA, nE)), class = "invalid_argument")
expect_r6_setequal(A$siblings(nE), list(nF, nN))
expect_r6_setequal(A$siblings(nA), list(nD))
expect_r6_setequal(A$siblings(nJ), list(nH, nI, nK, nL))
# check root-to-leaf paths
paths <- A$root_to_leaf_paths()
expect_length(paths, 10L)
# check postree arguments
expect_error(
A$postree(SiblingSeparation = "x"),
class = "non-numeric_SiblingSeparation"
)
expect_error(
A$postree(SubtreeSeparation = "x"),
class = "non-numeric_SubtreeSeparation"
)
expect_error(
A$postree(LevelSeparation = "x"),
class = "non-numeric_LevelSeparation"
)
expect_error(
A$postree(RootOrientation = 90.0),
class = "non-character_RootOrientation"
)
expect_error(
A$postree(RootOrientation = "SOUTHWEST"),
class = "invalid_RootOrientation"
)
expect_error(
A$postree(MaxDepth = FALSE),
class = "invalid_MaxDepth"
)
# check for coverage
expect_silent(A$postree(RootOrientation = "NORTH"))
expect_silent(A$postree(RootOrientation = "WEST"))
# check max depth exceeded is detected
expect_error(A$postree(MaxDepth = 2L), class = "POSITIONTREE_error")
# check the node coordinates
XY <- A$postree()
XY$Label <- A$vertex_label(XY$n)
expect_identical(nrow(XY), A$order())
rownames(XY) <- A$vertex_label(A$vertex_along())
expect_identical(XY["O", "x"], 13.5)
expect_identical(XY["E", "x"], 3.0)
expect_identical(XY["A", "x"], 0.0)
expect_identical(XY["D", "x"], 6.0)
expect_identical(XY["B", "x"], 3.0)
expect_identical(XY["C", "x"], 9.0)
expect_identical(XY["F", "x"], 13.5)
expect_identical(XY["N", "x"], 24.0)
expect_identical(XY["G", "x"], 21.0)
expect_identical(XY["M", "x"], 27.0)
expect_identical(XY["H", "x"], 15.0)
expect_identical(XY["I", "x"], 21.0)
expect_identical(XY["J", "x"], 27.0)
expect_identical(XY["K", "x"], 33.0)
expect_identical(XY["L", "x"], 39.0)
expect_identical(XY["O", "y"], 0.0)
expect_identical(XY["E", "y"], 1.0)
expect_identical(XY["F", "y"], 1.0)
expect_identical(XY["N", "y"], 1.0)
expect_identical(XY["A", "y"], 2.0)
expect_identical(XY["D", "y"], 2.0)
expect_identical(XY["G", "y"], 2.0)
expect_identical(XY["M", "y"], 2.0)
expect_identical(XY["B", "y"], 3.0)
expect_identical(XY["C", "y"], 3.0)
expect_identical(XY["H", "y"], 3.0)
expect_identical(XY["I", "y"], 3.0)
expect_identical(XY["J", "y"], 3.0)
expect_identical(XY["K", "y"], 3.0)
expect_identical(XY["L", "y"], 3.0)
})
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.