context("BFS")
test_that("BFS works from multiple root vertices", {
library(igraph)
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(NaN, 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(
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)
})
Generated by dwww version 1.15 on Sun Jun 16 14:10:56 CEST 2024.