tests/testthat/test-Arborescence.R

In rdecision: Decision Analytic Modelling in Health Economics

# 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)
})