Nothing
test_that("BFS uses 1-based root vertex index", {
g <- make_ring(3)
expect_that(bfs(g, root = 1)$root, equals(1))
})
test_that("BFS works from multiple root vertices", {
g <- make_ring(10) %du% make_ring(10)
expect_that(
as.vector(bfs(g, 1)$order),
equals(c(1, 2, 10, 3, 9, 4, 8, 5, 7, 6, 11, 12, 20, 13, 19, 14, 18, 15, 17, 16))
)
expect_that(
as.vector(bfs(g, 1, unreachable = FALSE)$order),
equals(c(1, 2, 10, 3, 9, 4, 8, 5, 7, 6, rep(NA, 10)))
)
expect_that(
as.vector(bfs(g, c(1, 12), unreachable = FALSE)$order),
equals(c(1, 2, 10, 3, 9, 4, 8, 5, 7, 6, 12, 11, 13, 20, 14, 19, 15, 18, 16, 17))
)
expect_that(
as.vector(bfs(g, c(12, 1, 15), unreachable = FALSE)$order),
equals(c(12, 11, 13, 20, 14, 19, 15, 18, 16, 17, 1, 2, 10, 3, 9, 4, 8, 5, 7, 6))
)
})
test_that("issue 133", {
g <- graph_from_edgelist(matrix(c(1, 2, 2, 3), ncol = 2, byrow = TRUE))
expect_equal(
ignore_attr = TRUE,
bfs(g, 1, restricted = c(1, 2), unreachable = FALSE)$order,
V(g)[c(1, 2, NA_real_), na_ok = TRUE]
)
})
test_that("BFS callback works", {
env <- new.env()
env$history <- list()
callback <- function(graph, data, extra) {
env$history <- append(env$history, list(data))
FALSE
}
g <- make_ring(5, directed = TRUE)
bfs(g, root = 3, mode = "out", callback = callback)
names <- c("vid", "pred", "succ", "rank", "dist")
expect_equal(
env$history,
list(
setNames(c(3, 0, 4, 1, 0), names),
setNames(c(4, 3, 5, 2, 1), names),
setNames(c(5, 4, 1, 3, 2), names),
setNames(c(1, 5, 2, 4, 3), names),
setNames(c(2, 1, 0, 5, 4), names)
)
)
})
test_that("BFS callback does not blow up when an invalid value is returned", {
env <- new.env()
env$history <- list()
callback <- function(graph, data, extra) {
env$history <- append(env$history, list(data))
data
}
g <- make_ring(5, directed = TRUE)
bfs(g, root = 3, mode = "out", callback = callback)
# returned value is coerced to TRUE so it should terminate the search after
# one step
names <- c("vid", "pred", "succ", "rank", "dist")
expect_equal(
env$history,
list(setNames(c(3, 0, 4, 1, 0), names))
)
})
test_that("BFS callback does not blow up when an error is raised within the callback", {
callback <- function(graph, data, extra) {
stop("test")
FALSE
}
g <- make_ring(5, directed = TRUE)
expect_error(bfs(g, root = 3, mode = "out", callback = callback), "test")
expect_true(TRUE)
})
test_that("BFS callback does not blow up when another igraph function is raised within the callback", {
skip("nested igraph call handling not implemented yet")
callback <- function(graph, data, extra) {
neighbors(graph, 1)
FALSE
}
g <- make_ring(5, directed = TRUE)
bfs(g, root = 3, mode = "out", callback = callback)
expect_true(TRUE)
})
test_that("snapshot test", {
local_igraph_options(print.id = FALSE)
expect_snapshot({
g <- graph_from_literal(a -+ b -+ c)
bfs(
g,
root = 2,
mode = "out",
unreachable = FALSE,
order = TRUE,
rank = TRUE,
father = TRUE,
pred = TRUE,
succ = TRUE,
dist = TRUE
)
})
})
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.