Nothing
if ("package:igraph" %in% search()) {
detach("package:igraph")
}
skip_if(!rq(network))
skip_if(!rq(sna))
skip_if(!rq(maps))
skip_if(!rq(ggplot2))
skip_if(!rq(intergraph)) # test igraph conversion
skip_if_not_installed("geosphere")
# first 500 rows of http://datasets.flowingdata.com/tuts/maparcs/airports.csv
# avoids downloading the dataset to test the package
airports <- read.csv(test_path("data/airports.csv"), header = TRUE)
rownames(airports) <- airports$iata
# select some random flights
set.seed(123)
flights <- data.frame(
origin = sample(airports[200:400, ]$iata, 200, replace = TRUE),
destination = sample(airports[200:400, ]$iata, 200, replace = TRUE)
)
# convert to network
flights <- network(flights, directed = TRUE)
# add geographic coordinates
flights %v% "lat" <- airports[network.vertex.names(flights), "lat"] # nolint
flights %v% "lon" <- airports[network.vertex.names(flights), "long"] # nolint
# drop isolated airports
delete.vertices(flights, which(degree(flights) < 2))
# compute degree centrality
flights %v% "degree" <- degree(flights, gmode = "digraph")
# add random groups
flights %v% "mygroup" <- sample(letters[1:4], network.size(flights), replace = TRUE)
# create a map of the USA
usa <- ggplot(map_data("usa"), aes(x = long, y = lat)) +
geom_polygon(aes(group = group),
color = "grey65",
fill = "#f9f9f9", linewidth = 0.2
)
test_that("basic drawing", {
# no map
p <- ggnetworkmap(net = flights, size = 2)
expect_true(is.null(nrow(p$data)))
# overlay network data to map
p <- ggnetworkmap(usa, flights, size = 2)
expect_false(is.null(nrow(p$data)))
})
test_that("great circles", {
p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE)
expect_equal(length(p$layers), 3)
expect_equal(get("aes_params", envir = p$layers[[3]])$colour, "black")
})
test_that("node groups", {
p <- ggnetworkmap(usa, flights,
size = 2, great.circles = TRUE,
node.group = degree
)
expect_equal(length(p$layers), 3)
expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour))
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".ngroup")
p <- ggnetworkmap(usa, flights, size = 2, great.circles = TRUE, node.color = "red")
expect_equal(mapping_string(get("aes_params", envir = p$layers[[3]])$colour), "\"red\"")
})
test_that("ring groups", {
p <- ggnetworkmap(usa, flights,
size = 2, great.circles = TRUE,
node.group = degree, ring.group = mygroup
)
expect_equal(length(p$layers), 3)
expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour))
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup")
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup")
})
test_that("segment color", {
p <- ggnetworkmap(usa, flights,
size = 2,
great.circles = TRUE, node.group = degree,
ring.group = mygroup,
segment.color = "cornflowerblue"
)
expect_equal(length(p$layers), 3)
expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour))
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup")
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup")
expect_equal(
mapping_string(get("aes_params", envir = p$layers[[2]])$colour),
"\"cornflowerblue\""
)
})
test_that("weight", {
p <- ggnetworkmap(usa, flights,
size = 2, great.circles = TRUE, node.group = degree,
ring.group = mygroup,
segment.color = "cornflowerblue",
weight = degree
)
expect_equal(length(p$layers), 3)
expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour))
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup")
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup")
expect_equal(
mapping_string(get("aes_params", envir = p$layers[[2]])$colour),
"\"cornflowerblue\""
)
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$size), ".weight")
})
test_that("labels", {
p <- ggnetworkmap(usa, flights,
size = 2, great.circles = TRUE,
node.group = degree, ring.group = mygroup,
segment.color = "cornflowerblue", weight = degree,
label.nodes = TRUE
)
expect_equal(length(p$layers), 4)
expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour))
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup")
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup")
expect_equal(
mapping_string(get("aes_params", envir = p$layers[[2]])$colour),
"\"cornflowerblue\""
)
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$size), ".weight")
expect_equal(mapping_string(get("mapping", envir = p$layers[[4]])$label), ".label")
expect_true(is.null(get("aes_params", envir = p$layers[[2]])$arrow))
})
test_that("arrows", {
p <- ggnetworkmap(usa, flights,
size = 2, great.circles = TRUE,
node.group = degree, ring.group = mygroup,
segment.color = "cornflowerblue", weight = degree,
label.nodes = TRUE, arrow.size = 0.2
)
expect_equal(length(p$layers), 4)
expect_true(is.null(get("aes_params", envir = p$layers[[3]])$colour))
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$colour), ".rgroup")
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$fill), ".ngroup")
expect_equal(
mapping_string(get("aes_params", envir = p$layers[[2]])$colour),
"\"cornflowerblue\""
)
expect_equal(mapping_string(get("mapping", envir = p$layers[[3]])$size), ".weight")
expect_equal(mapping_string(get("mapping", envir = p$layers[[4]])$label), ".label")
# look at geom_params for arrow info
expect_true(is.list(get("geom_params", envir = p$layers[[2]])$arrow))
})
test_that("labels", {
expect_error(ggnetworkmap(usa, flights, label.nodes = c("A", "B")))
testLabels <- paste("L", 1:network.size(flights), sep = "")
# does logical check
p <- ggnetworkmap(usa, flights, label.nodes = testLabels)
## PROBLEM HERE: why would vertex.names be equal to testLabels?
## expect_equal(get("data", p$layers[[4]])$.label, testLabels)
# does vertex.names check
p <- ggnetworkmap(usa, flights, label.nodes = TRUE)
expect_true(!is.null(get("data", p$layers[[4]])$.label))
# does id check
flights2 <- flights
flights2 %v% "id" <- testLabels
p <- ggnetworkmap(usa, flights2, label.nodes = TRUE)
expect_true(!is.null(get("data", p$layers[[4]])$.label))
})
### --- test arrow.size
test_that("arrow.size", {
expect_error(ggnetworkmap(net = flights, arrow.size = -1), "incorrect arrow.size")
expect_warning(ggnetworkmap(
net = network(as.matrix(flights), directed = FALSE),
arrow.size = 1
), "arrow.size ignored")
})
### --- test network coercion
test_that("network coercion", {
expect_warning(
ggnetworkmap(net = network(matrix(1, nrow = 2, ncol = 2), loops = TRUE)),
"self-loops"
)
expect_error(ggnetworkmap(net = 1:2), "network object")
expect_error(ggnetworkmap(net = network(data.frame(1:2, 3:4), hyper = TRUE)), "hyper")
expect_error(
ggnetworkmap(net = network(data.frame(1:2, 3:4), multiple = TRUE)),
"multiplex graphs"
)
})
### --- test igraph functionality
test_that("igraph conversion", {
if (rq(igraph) && rq(intergraph)) {
n <- asIgraph(flights)
p <- ggnetworkmap(net = n)
expect_equal(length(p$layers), 2)
}
})
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.