Nothing
context ("dodgr_dists")
test_all <- (identical (Sys.getenv ("MPADGE_LOCAL"), "true") |
identical (Sys.getenv ("GITHUB_WORKFLOW"), "test-coverage"))
if (!test_all) {
RcppParallel::setThreadOptions (numThreads = 2)
}
test_that ("dists", {
expect_silent (graph <- weight_streetnet (hampi))
nf <- 100
nt <- 50
set.seed (1)
from <- sample (graph$from_id, size = nf)
to <- sample (graph$to_id, size = nt)
expect_silent (d <- dodgr_distances (graph, from = from, to = to))
expect_equal (nrow (d), nf)
expect_equal (ncol (d), nt)
expect_true (all (d [!is.na (d)] >= 0))
expect_message (
d2 <- dodgr_dists (graph, from = from, to = to, quiet = FALSE),
"Calculating shortest paths ..."
)
expect_identical (d, d2)
from [1] <- "not_a_vertex_id"
expect_error (
d <- dodgr_distances (graph, from = from, to = to),
"from/to are not numeric yet can not be matched onto graph vertices"
)
# dists from coordinates:
bb <- attr (hampi$geometry, "bbox")
fromx <- bb [1] + (bb [3] - bb [1]) * runif (nf)
fromy <- bb [2] + (bb [4] - bb [2]) * runif (nf)
tox <- bb [1] + (bb [3] - bb [1]) * runif (nt)
toy <- bb [2] + (bb [4] - bb [2]) * runif (nt)
from <- data.frame (x = fromx, y = fromy, id = paste0 ("f", 1:nf))
to <- data.frame (x = tox, y = toy, id = paste0 ("t", 1:nt))
d <- dodgr_dists (graph, from = from, to = to)
expect_equal (nrow (d), nf)
expect_equal (ncol (d), nt)
expect_true (all (d [!is.na (d)] >= 0))
# from as vector
from <- c (as.numeric (from [1, 1:2]), 1)
names (from) <- c ("x", "y", "id")
expect_silent (d <- dodgr_dists (graph, from = from, to = to))
from <- as.numeric (from [1:2])
expect_silent (d <- dodgr_dists (graph, from = from, to = to))
# from as matrix
from <- cbind (fromx, fromy, 1:nf)
colnames (from) <- c ("x", "y", "id")
d <- dodgr_dists (graph, from = from, to = to)
from <- from [, 1:2]
expect_silent (d <- dodgr_dists (graph, from = from, to = to))
rownames (from) <- 1:nf
expect_silent (d <- dodgr_dists (graph, from = from, to = to))
from <- data.frame (x = fromx, y = fromy, id = paste0 ("f", 1:nf))
to <- data.frame (x = tox, y = toy, id = paste0 ("t", 1:nt))
from <- cbind (from, "x2" = from$x)
expect_error (
d <- dodgr_dists (graph, from = from, to = to),
"Unable to determine geographical coordinates in from/to"
)
# from <- sample (graph$from_id, size = nf)
# to <- sample (graph$to_id, size = nt)
# graph0 <- graph
# graph <- graph0
# graph$from_id <- graph$to_id <- NULL
# find_spatial_cols (graph)
})
test_that ("dists-pairwise", {
expect_silent (graph <- weight_streetnet (hampi))
n <- 50
set.seed (1)
from <- sample (graph$from_id, size = n)
to <- sample (graph$to_id, size = n)
expect_silent (d <- dodgr_distances (graph, from = from, to = to))
expect_equal (dim (d), c (n, n))
expect_silent (d <- dodgr_distances (graph,
from = from, to = to,
pairwise = TRUE
))
expect_equal (dim (d), c (50, 1))
})
test_that ("times", {
graph <- weight_streetnet (hampi)
nf <- 100
nt <- 50
set.seed (1)
from <- sample (graph$from_id, size = nf)
to <- sample (graph$to_id, size = nt)
expect_silent (d0 <- dodgr_dists (graph,
from = from, to = to,
shortest = TRUE
)) # default
expect_silent (d1 <- dodgr_dists (graph,
from = from, to = to,
shortest = FALSE
))
expect_silent (t0 <- dodgr_times (graph,
from = from, to = to,
shortest = TRUE
))
expect_silent (t1 <- dodgr_times (graph,
from = from, to = to,
shortest = FALSE
)) # default
expect_true (!identical (d0, d1))
expect_true (!identical (d0, t0))
expect_true (!identical (d0, t1))
expect_true (!identical (d1, t0))
expect_true (!identical (d1, t1))
expect_true (!identical (t0, t1))
# times are just dists using different columns:
grapht <- graph
grapht$d <- grapht$time
grapht$d_weighted <- grapht$time_weighted
grapht$time_weighted <- NULL
expect_silent (t0 <- dodgr_times (grapht,
from = from, to = to,
shortest = TRUE
))
expect_error (
t0 <- dodgr_times (grapht,
from = from, to = to,
shortest = FALSE
),
"Graph does not contain a weighted time column"
)
expect_error (
d0 <- dodgr_dists (grapht,
from = from, to = to,
shortest = FALSE
),
"Graph does not contain a weighted time column"
)
expect_silent (d1 <- dodgr_dists (grapht,
from = from, to = to,
shortest = TRUE
))
expect_identical (t0, d1)
grapht$time <- NULL
expect_error (
t0 <- dodgr_times (grapht,
from = from, to = to,
shortest = TRUE
),
"graph has no time column"
)
expect_error (
t0 <- dodgr_times (grapht,
from = from, to = to,
shortest = FALSE
),
"graph has no time column"
)
expect_error (
t0 <- dodgr_dists (grapht,
from = from, to = to,
shortest = FALSE
),
"Graph does not contain a weighted time column"
)
expect_silent (t2 <- dodgr_dists (grapht,
from = from, to = to,
shortest = TRUE
))
expect_identical (t2, t0)
})
test_that ("all dists", {
graph <- weight_streetnet (hampi)
graph <- graph [graph$component == 2, ]
expect_silent (d <- dodgr_dists (graph))
v <- dodgr_vertices (graph)
expect_equal (nrow (d), ncol (d))
expect_equal (nrow (d), nrow (v))
})
test_that ("to-from-cols", {
graph <- weight_streetnet (hampi)
nf <- 100
nt <- 50
set.seed (1)
v <- dodgr_vertices (graph)
from <- sample (v$id, size = nf)
to <- sample (v$id, size = nt)
expect_silent (d0 <- dodgr_dists (graph, from = from, to = to))
fromi <- match (from, v$id)
toi <- match (to, v$id)
expect_silent (d1 <- dodgr_dists (graph, from = fromi, to = toi))
expect_identical (d0, d1)
fromm <- as.matrix (fromi, ncol = 1)
tom <- as.matrix (toi, ncol = 1)
expect_silent (d2 <- dodgr_dists (graph, from = fromm, to = tom))
expect_identical (d0, d2)
fromm [1] <- -1
expect_error (
d2 <- dodgr_dists (graph, from = fromm, to = tom),
"points exceed numbers of vertices"
)
fromf <- as.factor (fromi)
expect_error (
d2 <- dodgr_dists (graph, from = fromf, to = toi),
paste0 (
"routing points are of unknown form; ",
"must be either character, matrix, or integer"
)
)
from <- sample (nrow (v), size = nf)
to <- sample (nrow (v), size = nt)
to [1] <- nrow (v) + 1L
expect_error (
d2 <- dodgr_dists (graph, from = from, to = to),
"Unable to match all routing points to graph vertices"
)
to <- sample (nrow (v), size = nt)
graph$from_id <- graph$from_lon <- NULL
expect_error (
d3 <- dodgr_dists (graph, from = from, to = to),
"Graph appears to be spatial yet unable to extract coordinates"
)
})
test_that ("dists with no edge ids", {
graph <- weight_streetnet (hampi)
nf <- 100
nt <- 50
set.seed (1)
from <- sample (graph$from_id, size = nf)
to <- sample (graph$to_id, size = nt)
expect_silent (d0 <- dodgr_distances (graph, from = from, to = to))
# from/to as coordinates only:
v <- dodgr_vertices (graph)
from <- v [match (from, v$id), c ("x", "y")]
to <- v [match (to, v$id), c ("x", "y")]
expect_silent (d1 <- dodgr_distances (graph, from = from, to = to))
expect_identical (as.vector (d0), as.vector (d1))
# remove from_id/to_id from graph. Now coordinates will be matched on to
# **first** occurrence in dodgr_vertices, which may not be actual one, so
# distances won't necessarily be equal
graph$from_id <- graph$to_id <- NULL
expect_silent (d2 <- dodgr_distances (graph, from = from, to = to))
expect_identical (as.vector (d0), as.vector (d2))
})
test_that ("heaps", {
graph <- weight_streetnet (hampi)
nf <- 100
nt <- 50
from <- sample (graph$from_id, size = nf)
to <- sample (graph$to_id, size = nt)
expect_error (
dodgr_dists (graph, from = from, to = to, heap = "wrong heap"),
"'arg' should be one of"
)
expect_silent (d0 <- dodgr_dists (graph,
from = from,
to = to,
heap = "BHeap"
))
expect_silent (d1 <- dodgr_dists (graph,
from = from,
to = to,
heap = "FHeap"
))
expect_silent (d3 <- dodgr_dists (graph,
from = from,
to = to,
heap = "TriHeap"
))
expect_silent (d4 <- dodgr_dists (graph,
from = from,
to = to,
heap = "TriHeapExt"
))
# This is a compound message that starts "Calculating shortest paths ..."
# and then "Extended TriHeaps can not be calculated in parallel
# That can't be tested, so just generic expect_message here
expect_message (d4a <- dodgr_dists (graph,
from = from, to = to,
heap = "TriHeapExt", quiet = FALSE
))
expect_silent (d5 <- dodgr_dists (graph, from = from, to = to, heap = "Heap23"))
d4 <- dodgr_dists (graph,
from = from,
to = to,
heap = "TriHeapExt",
quiet = FALSE
)
expect_identical (d0, d1)
expect_identical (d0, d3)
expect_identical (d0, d4)
expect_identical (d0, d5)
# std::set is only applied to non-spatial graphs:
graph$from_lon <- graph$from_lat <- graph$to_lon <- graph$to_lat <- NULL
expect_silent (d6 <- dodgr_dists (graph, from = from, to = to, heap = "set"))
expect_silent (d7 <- dodgr_dists (graph, from = from, to = to, heap = "BHeap"))
# expect_identical (d0, d6)
expect_identical (d0, d7)
})
test_that ("graph columns", {
expect_silent (graph <- weight_streetnet (hampi))
nf <- 100
nt <- 50
set.seed (1)
v <- dodgr_vertices (graph)
index_f <- sample (nrow (v), size = nf)
index_t <- sample (nrow (v), size = nt)
from <- v$id [index_f]
to <- v$id [index_t]
expect_silent (d0 <- dodgr_distances (graph, from = from, to = to))
from <- v [index_f, c ("x", "y")]
to <- v [index_t, c ("x", "y")]
expect_silent (d1 <- dodgr_distances (graph, from = from, to = to))
colnames (d0) <- colnames (d1) <- rownames (d0) <- rownames (d1) <- NULL
expect_identical (d0, d1)
graph$from_lon <- NULL
expect_error (
d2 <- dodgr_distances (graph, from = from, to = to),
"Cannot determine geographical coordinates against which to match pts"
)
expect_silent (graph <- weight_streetnet (hampi))
graph$d_weighted <- graph$d
expect_silent (d3 <- dodgr_distances (graph, from = from, to = to))
expect_false (identical (d0, d3))
})
test_that ("negative weights", {
expect_silent (graph <- weight_streetnet (hampi))
nf <- 100
nt <- 50
set.seed (1)
from <- sample (graph$from_id, size = nf)
to <- sample (graph$to_id, size = nt)
expect_silent (d0 <- dodgr_distances (graph, from = from, to = to))
nneg <- 100
graph$d_weighted [sample (nrow (graph), nneg)] <- -runif (nneg)
expect_silent (d1 <- dodgr_distances (graph, from = from, to = to))
})
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.