Nothing
# tests of graph creation
test_that("incorrect node and edge types are rejected", {
n1 <- Node$new()
n2 <- Node$new()
e1 <- Edge$new(n1, n2)
#
expect_error(Graph$new(n1, list(e1)), class = "non-list_vertices")
expect_error(Graph$new(list(n1, n2), e1), class = "non-list_edges")
expect_error(Graph$new(list(n1, 42L), list(e1)), class = "non-Node_vertex")
expect_error(Graph$new(list(n1, n2), list(e1, 42L)), class = "non-Edge_edge")
expect_error(
Graph$new(V = list(n1, n1), E = list(e1)), class = "repeated_nodes"
)
expect_error(
Graph$new(V = list(n1, n2), E = list(e1, e1)),
class = "repeated_edges"
)
#
n3 <- Node$new()
e2 <- Edge$new(n1, n3)
expect_error(
Graph$new(V = list(n1, n2), E = list(e1, e2)), class = "not_in_graph"
)
#
n1 <- Node$new("n1")
n2 <- Node$new("n1")
n3 <- Node$new()
e1 <- Edge$new(n1, n2, "e1")
expect_silent(Graph$new(V = list(n1, n2), E = list(e1)))
expect_silent(Graph$new(V = list(n1, n2, n3), E = list(e1)))
#
n1 <- Node$new("n1")
n2 <- Node$new("n2")
e1 <- Edge$new(n1, n2, "e1")
e2 <- Edge$new(n2, n1, "e1")
e3 <- Edge$new(n1, n2)
expect_silent(Graph$new(V = list(n1, n2), E = list(e1, e2)))
expect_silent(Graph$new(V = list(n1, n2), E = list(e1, e2, e3)))
})
# tests of simple graph properties
test_that("basic graph properties are set and got", {
#
n1 <- Node$new()
n2 <- Node$new()
e1 <- Edge$new(n1, n2)
# empty graph
V <- list()
E <- list()
G <- Graph$new(V, E)
expect_identical(G$order(), 0L)
expect_identical(G$size(), 0L)
expect_length(G$vertex_along(), 0L)
expect_length(G$edge_along(), 0L)
# a graph with 2 nodes and an edge
V <- list(n1, n2)
E <- list(e1)
G <- Graph$new(V, E)
expect_identical(G$order(), length(V))
expect_identical(G$size(), length(E))
expect_length(G$vertex_along(), 2L)
expect_length(G$edge_along(), 1L)
# a graph with one node
V <- list(n1)
E <- list()
G <- Graph$new(V, E)
expect_identical(G$order(), 1L)
expect_identical(G$size(), 0L)
expect_length(G$vertex_along(), 1L)
expect_length(G$edge_along(), 0L)
})
# tests of vertex and edge properties
test_that("vertex and edge properties are set and got", {
# create graph
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Edge$new(n1, n2, label = "e1")
e2 <- Edge$new(n1, n3)
G <- Graph$new(V = list(n1, n2), E = list(e1))
# check that valid vertices in the graph are identified
expect_false(G$has_vertex(42L))
expect_true(G$has_vertex(n1))
expect_true(G$has_vertex(n2))
expect_false(G$has_vertex(n3))
# check that valid edges in the graph are identified
expect_false(G$has_edge(42L))
expect_true(G$has_edge(e1))
# tests of vertex indices
in1 <- G$vertex_index(n1)
expect_identical(G$vertex_at(in1), n1)
in2 <- G$vertex_index(n2)
expect_identical(G$vertex_at(in2), n2)
in3 <- G$vertex_index(n3)
expect_true(is.na(in3))
expect_error(G$vertex_at(in3), class = "invalid_index")
expect_error(G$vertex_at(42L), class = "invalid_index")
expect_error(G$vertex_at("42"), class = "invalid_index")
expect_length(G$vertex_along(), 2L)
# tests of edge indexes
ie1 <- G$edge_index(e1)
expect_identical(G$edge_at(ie1), e1)
ie2 <- G$edge_index(e2)
expect_true(is.na(ie2))
ie3 <- G$edge_index(42L)
expect_true(is.na(ie3))
expect_length(G$edge_index(list()), 0L)
# test of finding edges, given index
expect_error(G$edge_at(42L), class = "invalid_index")
expect_error(G$edge_at("42"), class = "invalid_index")
expect_error(G$edge_at(ie2), class = "invalid_index")
expect_error(G$edge_at(-1L, class = "invalid_index"))
# tests of degree function
expect_error(G$degree(42L), class = "invalid_vertex")
expect_error(G$degree(n3), class = "invalid_vertex")
expect_error(G$degree(e1), class = "invalid_vertex")
expect_identical(G$degree(n1), 1L)
})
# tests of node and edge indexes in vector mode
test_that("vectorized node and edge indexes are as expected", {
# create graph
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Edge$new(n1, n2, label = "e1")
e2 <- Edge$new(n1, n3)
G <- Graph$new(V = list(n1, n2, n3), E = list(e1, e2))
# vertexes
v <- G$vertexes()
expect_r6_setequal(v, list(n1, n2, n3))
# vertex indexes
in1 <- G$vertex_index(n1)
in2 <- G$vertex_index(n2)
in3 <- G$vertex_index(n3)
expect_identical(G$vertex_index(list(n1, n2, n3)), c(in1, in2, in3))
expect_identical(G$vertex_index(list(n1, 42L)), c(in1, NA_integer_))
expect_identical(G$vertex_index(G$vertexes()), G$vertex_along())
# vertexes at given indexes
expect_length(G$vertex_at(vector(mode = "integer", length = 0L)), 0L)
expect_identical(G$vertex_at(c(in1, in2)), c(n1, n2))
expect_identical(G$vertex_at(c(in2, in1)), c(n2, n1))
expect_identical(G$vertex_at(list(in1, in2)), c(n1, n2))
expect_identical(G$vertex_at(list(in1, in1)), c(n1, n1))
expect_r6_setequal(G$vertex_at(c(in1, in2, in3)), list(n1, n2, n3))
expect_error(G$vertex_at(c(in1, NA_integer_)), class = "invalid_index")
expect_error(G$vertex_at(c(in1, G$order() + 1L)), class = "invalid_index")
# test vertex_at with single index forced to a list
expect_false(is.list(G$vertex_at(in1)))
expect_identical(G$vertex_at(in1), n1)
expect_type(G$vertex_at(in1, as_list = TRUE), "list")
expect_identical(G$vertex_at(in1, as_list = TRUE), list(n1))
# vertex existence
expect_identical(G$has_vertex(list(n1, n2)), c(TRUE, TRUE))
expect_identical(G$has_vertex(list(n1, n1, n2)), c(TRUE, TRUE, TRUE))
expect_identical(G$has_vertex(list(n1, n2, 42L)), c(TRUE, TRUE, FALSE))
# edges
e <- G$edges()
expect_r6_setequal(e, list(e1, e2))
# edge indexes
ie1 <- G$edge_index(e1)
ie2 <- G$edge_index(e2)
expect_identical(G$edge_index(list(e1, e2)), c(ie1, ie2))
expect_identical(G$edge_index(list(e1, 42L)), c(ie1, NA_integer_))
expect_identical(G$edge_index(G$edges()), G$edge_along())
# edges at given indexes
expect_length(G$edge_at(vector(mode = "integer", length = 0L)), 0L)
expect_identical(G$edge_at(c(ie1, ie2)), c(e1, e2))
expect_identical(G$edge_at(c(ie2, ie1)), c(e2, e1))
expect_identical(G$edge_at(list(ie1, ie2)), c(e1, e2))
expect_identical(G$edge_at(list(ie1, ie1)), c(e1, e1))
expect_error(G$edge_at(c(ie1, NA_integer_)), class = "invalid_index")
expect_error(G$edge_at(c(ie1, G$size() + 1L)), class = "invalid_index")
# test edge_at with single index forced to a list
expect_false(is.list(G$edge_at(ie1)))
expect_identical(G$edge_at(ie1), e1)
expect_type(G$edge_at(ie1, as_list = TRUE), "list")
expect_identical(G$edge_at(ie1, as_list = TRUE), list(e1))
# edge existence
expect_identical(G$has_edge(list(e1, e2)), c(TRUE, TRUE))
expect_identical(G$has_edge(list(e1, e1, e2)), c(TRUE, TRUE, TRUE))
expect_identical(G$has_edge(list(e1, e2, 42L)), c(TRUE, TRUE, FALSE))
})
# tests of node and edge labels
test_that("node and edge label indexes are as expected", {
# create graph
n1 <- Node$new()
n2 <- Node$new(label = "n2")
n3 <- Node$new(label = "n3")
e1 <- Edge$new(n1, n2, label = "e1")
e2 <- Edge$new(n1, n3)
G <- Graph$new(V = list(n1, n2, n3), E = list(e1, e2))
# indexes
in1 <- G$vertex_index(n1)
in2 <- G$vertex_index(n2)
in3 <- G$vertex_index(n3)
ie1 <- G$edge_index(e1)
ie2 <- G$edge_index(e2)
# tests of edge labels
expect_identical(e1$label(), "e1")
expect_identical(e2$label(), "")
expect_identical(G$edge_label(ie1), "e1")
expect_identical(G$edge_label(ie2), "")
expect_error(G$edge_label(42L), class = "invalid_index")
expect_identical(G$edge_label(c(ie1, ie2)), c("e1", ""))
expect_error(G$edge_label(c(ie1, as.numeric(ie2))), class = "invalid_index")
expect_identical(G$edge_label(list(ie1, ie2)), c("e1", ""))
# tests of vertex labels
expect_identical(n1$label(), "")
expect_identical(n2$label(), "n2")
expect_identical(n3$label(), "n3")
expect_identical(G$vertex_label(in1), "")
expect_identical(G$vertex_label(in2), "n2")
expect_identical(G$vertex_label(in3), "n3")
expect_error(G$vertex_label(42L), class = "invalid_index")
expect_identical(G$vertex_label(c(in1, in2)), c("", "n2"))
expect_error(G$vertex_label(c(in1, as.numeric(in2))), class = "invalid_index")
expect_identical(G$vertex_label(list(in1, in2, in3)), c("", "n2", "n3"))
})
# tests of adjacency matrix
test_that("adjacency matrix has correct properties", {
# empty graph
G <- Graph$new(V = list(), E = list())
expect_error(G$graph_adjacency_matrix(42L), class = "non-logical_boolean")
A <- G$graph_adjacency_matrix()
expect_true(is.matrix(A))
expect_identical(nrow(A), 0L)
expect_identical(ncol(A), 0L)
# trivial graph
n1 <- Node$new()
G <- Graph$new(V = list(n1), E = list())
A <- G$graph_adjacency_matrix()
expect_true(is.matrix(A))
expect_identical(nrow(A), 1L)
expect_identical(ncol(A), 1L)
expect_identical(A[[1L, 1L]], 0L)
# graph with some labelled nodes should have indices as labels
n1 <- Node$new("n1")
n2 <- Node$new()
e1 <- Edge$new(n1, n2)
G <- Graph$new(V = list(n1, n2), E = list(e1))
A <- G$graph_adjacency_matrix()
dn <- dimnames(A)
expect_setequal(names(dn), c("out.node", "in.node"))
expect_setequal(dn$out.node, as.character(G$vertex_along()))
expect_setequal(dn$in.node, as.character(G$vertex_along()))
# graph with all nodes named should have node names as labels
n1 <- Node$new("n1")
n2 <- Node$new("n2")
e1 <- Edge$new(n1, n2)
G <- Graph$new(V = list(n1, n2), E = list(e1))
A <- G$graph_adjacency_matrix()
dn <- dimnames(A)
expect_setequal(names(dn), c("out.node", "in.node"))
expect_setequal(dn$out.node, c("n1", "n2"))
expect_setequal(dn$in.node, c("n1", "n2"))
expect_identical(sum(A - matrix(c(0L, 1L, 0L, 1L), nrow = 2L)), 0L)
# binary
n1 <- Node$new("n1")
n2 <- Node$new("n2")
e1 <- Edge$new(n1, n2)
e2 <- Edge$new(n1, n1)
G <- Graph$new(V = list(n1, n2), E = list(e1, e2))
A <- G$graph_adjacency_matrix(boolean = FALSE)
expect_identical(A[["n1", "n1"]], 2L)
A <- G$graph_adjacency_matrix(boolean = TRUE)
expect_true(A[["n1", "n1"]])
})
# tests of graph algorithms
test_that("simple and non-simple graphs are detected", {
n1 <- Node$new()
n2 <- Node$new()
e1 <- Edge$new(n1, n2)
#
G <- Graph$new(V = list(n1, n2), E = list(e1))
expect_true(G$is_simple())
#
e2 <- Edge$new(n1, n1)
G <- Graph$new(V = list(n1, n2), E = list(e1, e2))
expect_false(G$is_simple())
#
e2 <- Edge$new(n2, n1)
G <- Graph$new(V = list(n1, n2), E = list(e1, e2))
expect_false(G$is_simple())
})
test_that("connected and non-connected graphs are identified", {
#
G <- Graph$new(V = list(), E = list())
expect_false(G$is_connected())
#
n1 <- Node$new()
G <- Graph$new(V = list(n1), E = list())
expect_true(G$is_connected())
e1 <- Edge$new(n1, n1)
G <- Graph$new(V = list(n1), E = list(e1))
expect_true(G$is_connected())
#
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Edge$new(n1, n2)
e2 <- Edge$new(n3, n3)
G <- Graph$new(V = list(n1, n2, n3), E = list(e1, e2))
expect_false(G$is_connected())
#
n1 <- Node$new()
n2 <- Node$new()
n3 <- Node$new()
e1 <- Edge$new(n1, n2)
e2 <- Edge$new(n1, n3)
G <- Graph$new(V = list(n2, n3, n1), E = list(e1, e2))
expect_true(G$is_connected())
})
test_that("cyclic and acyclic graphs are identified", {
#
G <- Graph$new(V = list(), E = list())
expect_true(G$is_simple())
expect_true(G$is_acyclic())
#
n1 <- Node$new()
G <- Graph$new(V = list(n1), E = list())
expect_true(G$is_acyclic())
#
n1 <- Node$new()
e1 <- Edge$new(n1, n1)
G <- Graph$new(V = list(n1), E = list(e1))
expect_false(G$is_acyclic())
#
n0 <- Node$new("0")
n1 <- Node$new("1")
n2 <- Node$new("2")
n3 <- Node$new("3")
e1 <- Edge$new(n0, n1)
e2 <- Edge$new(n1, n2)
e3 <- Edge$new(n2, n3)
#
G <- Graph$new(V = list(n0, n1, n2, n3), E = list(e1, e2, e3))
expect_true(G$is_acyclic())
#
e4 <- Edge$new(n0, n2)
G <- Graph$new(V = list(n0, n1, n2, n3), E = list(e1, e2, e3, e4))
expect_false(G$is_acyclic())
})
# Published examples
test_that("Fig 1.1.1 from Gross & Yellen (2013)", {
# the graph
u <- Node$new("u")
v <- Node$new("v")
w <- Node$new("w")
x <- Node$new("x")
a <- Edge$new(u, v, "a")
b <- Edge$new(v, u, "b")
c <- Edge$new(x, x, "c")
d <- Edge$new(x, w, "d")
e <- Edge$new(x, v, "e")
f <- Edge$new(w, v, "f")
G <- Graph$new(V = list(u, v, w, x), E = list(a, b, c, d, e, f))
# counts
expect_identical(G$order(), 4L)
expect_identical(G$size(), 6L)
expect_identical(G$degree(u), 2L)
expect_identical(G$degree(v), 4L)
expect_identical(G$degree(w), 2L)
expect_identical(G$degree(x), 4L)
# adjacency, noting that nodes may not be in the same order as supplied
nodenames <- c("u", "v", "w", "x")
EA <- matrix(
data = c(
0L, 2L, 0L, 0L, 2L, 0L, 1L, 1L,
0L, 1L, 0L, 1L, 0L, 1L, 1L, 2L
),
nrow = 4L, byrow = TRUE,
dimnames = list(out.node = nodenames, in.node = nodenames)
)
A <- G$graph_adjacency_matrix()
A <- A[nodenames, nodenames]
expect_identical(A, EA)
# neighbours
XX <- Node$new("XX")
expect_error(G$neighbours(XX), class = "invalid_argument")
expect_r6_setequal(G$neighbours(u), list(v))
expect_r6_setequal(G$neighbours(v), list(u, w, x))
expect_r6_setequal(G$neighbours(w), list(v, x))
expect_r6_setequal(G$neighbours(x), list(v, w))
expect_error(G$neighbours(list(u, v)), class = "invalid_argument")
# connected
expect_true(G$is_connected())
# cycle
expect_false(G$is_acyclic())
# tree
expect_false(G$is_tree())
})
test_that("Fig 1.1.1 from Gross & Yellen (2013) is drawn correctly", {
# the graph
u <- Node$new("u")
v <- Node$new("v")
w <- Node$new("w")
x <- Node$new("x")
a <- Edge$new(u, v, "a")
b <- Edge$new(v, u, "b")
c <- Edge$new(x, x, "c")
d <- Edge$new(x, w, "d")
e <- Edge$new(x, v, "e")
f <- Edge$new(w, v, "f")
G <- Graph$new(V = list(u, v, w, x), E = list(a, b, c, d, e, f))
# draw it
expect_silent(G$as_DOT())
})
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.