context("ggnetworkmap") if ("package:igraph" %in% search()) { detach("package:igraph") } rq <- function(...) { suppressWarnings(require(..., quietly = TRUE)) } 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 (requireNamespace("igraph", quietly = TRUE)) { library(igraph) n <- asIgraph(flights) p <- ggnetworkmap(net = n) expect_equal(length(p$layers), 2) } }) expect_true(TRUE)