diff --git a/tests/testthat/_snaps/conversion.md b/tests/testthat/_snaps/conversion.md index 2e552572ea..fb33adaa55 100644 --- a/tests/testthat/_snaps/conversion.md +++ b/tests/testthat/_snaps/conversion.md @@ -20,3 +20,35 @@ Output [1] FALSE +# as_adjacency_matrix() errors well -- sparse + + Code + as_adjacency_matrix(g, attr = "bla") + Condition + Error in `get.adjacency.sparse()`: + ! no such edge attribute + +--- + + Code + as_adjacency_matrix(g, attr = "bla") + Condition + Error in `get.adjacency.sparse()`: + ! Matrices must be either numeric or logical, and the edge attribute is not + +# as_adjacency_matrix() errors well -- dense + + Code + as_adjacency_matrix(g, attr = "bla", sparse = FALSE) + Condition + Error in `get.adjacency.dense()`: + ! no such edge attribute + +--- + + Code + as_adjacency_matrix(g, attr = "bla", sparse = FALSE) + Condition + Error in `get.adjacency.dense()`: + ! Matrices must be either numeric or logical, and the edge attribute is not + diff --git a/tests/testthat/test-conversion.R b/tests/testthat/test-conversion.R index 27ec7370e5..aa8ca51fe7 100644 --- a/tests/testthat/test-conversion.R +++ b/tests/testthat/test-conversion.R @@ -69,3 +69,189 @@ test_that("as_undirected() keeps attributes", { expect_equal(df3[order(df3[, 1], df3[, 2]), ]$weight, c(1, 3, 2, 4, 5)) expect_equal(df4[order(df4[, 1], df4[, 2]), ]$weight, c(4, 9)) }) + +test_that("as_adjacency_matrix() works -- sparse", { + g <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + basic_adj_matrix <- as_adjacency_matrix(g) + expect_s4_class(basic_adj_matrix, "dgCMatrix") + expected_matrix <- matrix( + c(0, 1, 0, 0, 1, 1, 0, 3, 0, 0, 2, 0, 0, 0, 1, 0), + nrow = 4L, ncol = 4L + ) + basic_adj_matrix <- as.matrix(basic_adj_matrix) + dimnames(basic_adj_matrix) <- NULL + expect_equal(basic_adj_matrix, expected_matrix) + + V(g)$name <- letters[1:vcount(g)] + letter_adj_matrix <- as_adjacency_matrix(g) + expect_s4_class(letter_adj_matrix, "dgCMatrix") + expect_setequal(rownames(letter_adj_matrix), letters[1:vcount(g)]) + letter_adj_matrix <- as.matrix(letter_adj_matrix) + dimnames(letter_adj_matrix) <- NULL + expect_equal(basic_adj_matrix, letter_adj_matrix) + + E(g)$weight <- c(1.2, 3.4, 2.7, 5.6, 6.0, 0.1, 6.1, 3.3, 4.3) + weight_adj_matrix <- as_adjacency_matrix(g, attr = "weight") + expect_s4_class(weight_adj_matrix, "dgCMatrix") + expect_equal(as.matrix(weight_adj_matrix), + matrix( + c(0, 3.4, 0, 0, 1.2, 2.7, 0, 13.7, 0, 0, 11.6, 0, 0, 0, 0.1, 0), + nrow = 4L, + ncol = 4L, + dimnames = list(c("a", "b", "c", "d"), c("a", "b", "c", "d")) + )) +}) + +test_that("as_adjacency_matrix() works -- sparse + not both", { + dg <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + g <- as_undirected(dg, mode = "each") + + lower_adj_matrix <- as_adjacency_matrix(g, type = "lower") + expect_s4_class(lower_adj_matrix, "dgCMatrix") + lower_expected_matrix <- matrix( + c(0, 2, 0, 0, 0, 1, 0, 3, 0, 0, 2, 1, 0, 0, 0, 0), + nrow = 4L, ncol = 4L + ) + lower_expected_matrix <- as.matrix(lower_expected_matrix) + dimnames(lower_expected_matrix) <- NULL + expect_equal(lower_expected_matrix, lower_expected_matrix) + + upper_adj_matrix <- as_adjacency_matrix(g, type = "upper") + expect_s4_class(upper_adj_matrix, "dgCMatrix") + upper_expected_matrix <- matrix( + c(0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 2, 0, 0, 3, 1, 0), + nrow = 4L, ncol = 4L + ) + upper_adj_matrix <- as.matrix(upper_adj_matrix) + dimnames(upper_adj_matrix) <- NULL + expect_equal(upper_adj_matrix, upper_expected_matrix) +}) + +test_that("as_adjacency_matrix() errors well -- sparse", { + g <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + expect_snapshot(as_adjacency_matrix(g, attr = "bla"), error = TRUE) + + E(g)$bla <- letters[1:ecount(g)] + expect_snapshot(as_adjacency_matrix(g, attr = "bla"), error = TRUE) + +}) + +test_that("as_adjacency_matrix() works -- sparse undirected", { + dg <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + ug <- as_undirected(dg, mode = "each") + adj_matrix <- as_adjacency_matrix(ug) + expect_s4_class(adj_matrix, "dgCMatrix") + + adj_matrix <- as.matrix(adj_matrix) + dimnames(adj_matrix) <- NULL + expect_equal( + adj_matrix, + matrix( + c(0, 2, 0, 0, 2, 1, 0, 3, 0, 0, 2, 1, 0, 3, 1, 0), + nrow = 4L, + ncol = 4L + ) + ) +}) + +test_that("as_adjacency_matrix() works -- dense", { + g <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + + basic_adj_matrix <- as_adjacency_matrix(g, sparse = FALSE) + expected_matrix <- matrix( + c(0, 1, 0, 0, 1, 1, 0, 3, 0, 0, 2, 0, 0, 0, 1, 0), + nrow = 4L, ncol = 4L + ) + expect_equal(basic_adj_matrix, expected_matrix) + + V(g)$name <- letters[1:vcount(g)] + letter_adj_matrix <- as_adjacency_matrix(g, sparse = FALSE) + expect_true(inherits(letter_adj_matrix, "matrix")) + expect_setequal(rownames(letter_adj_matrix), letters[1:vcount(g)]) + expect_equal(basic_adj_matrix, unname(letter_adj_matrix)) + + E(g)$weight <- c(1.2, 3.4, 2.7, 5.6, 6.0, 0.1, 6.1, 3.3, 4.3) + weight_adj_matrix <- as_adjacency_matrix(g, attr = "weight", sparse = FALSE) + expect_equal( + weight_adj_matrix, + matrix( + c(0, 3.4, 0, 0, 1.2, 2.7, 0, 4.3, 0, 0, 6, 0, 0, 0, 0.1, 0), + nrow = 4L, + ncol = 4L, + dimnames = list(c("a", "b", "c", "d"), c("a", "b", "c", "d")) + ) + ) +}) + +test_that("as_adjacency_matrix() errors well -- dense", { + g <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + expect_snapshot(as_adjacency_matrix(g, attr = "bla", sparse = FALSE), error = TRUE) + + E(g)$bla <- letters[1:ecount(g)] + expect_snapshot(as_adjacency_matrix(g, attr = "bla", sparse = FALSE), error = TRUE) + +}) + + +test_that("as_adjacency_matrix() works -- dense undirected", { + dg <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + ug <- as_undirected(dg, mode = "each") + # no different treatment than undirected if no attribute?! + adj_matrix <- as_adjacency_matrix(ug, sparse = FALSE) + expect_equal( + adj_matrix, + matrix( + c(0, 2, 0, 0, 2, 1, 0, 3, 0, 0, 2, 1, 0, 3, 1, 0), + nrow = 4L, ncol = 4L + ) + ) + + E(ug)$weight <- c(1.2, 3.4, 2.7, 5.6, 6.0, 0.1, 6.1, 3.3, 4.3) + weight_adj_matrix <- as_adjacency_matrix(ug, sparse = FALSE, attr = "weight") + expect_equal( + weight_adj_matrix, + matrix( + c(0, 3.4, 0, 0, 3.4, 2.7, 0, 4.3, 0, 0, 6, 0.1, 0, 4.3, 0.1, 0), + nrow = 4L, + ncol = 4L + ) + ) +}) + +test_that("as_adjacency_matrix() works -- dense + not both", { + dg <- make_graph(c(1,2, 2,1, 2,2, 3,3, 3,3, 3,4, 4,2, 4,2, 4,2), directed = TRUE) + g <- as_undirected(dg, mode = "each") + E(g)$attribute <- c(1.2, 3.4, 2.7, 5.6, 6.0, 0.1, 6.1, 3.3, 4.3) + + lower_adj_matrix <- as_adjacency_matrix( + g, + type = "lower", + sparse = FALSE, + attr = "attribute" + ) + + expect_equal( + lower_adj_matrix, + matrix( + c(0, 3.4, 0, 0, 0, 2.7, 0, 4.3, 0, 0, 6, 0.1, 0, 0, 0, 0), + nrow = 4L, + ncol = 4L + ) + ) + + upper_adj_matrix <- as_adjacency_matrix( + g, + type = "upper", + sparse = FALSE, + attr = "attribute" + ) + + expect_equal( + upper_adj_matrix, + matrix( + c(0, 0, 0, 0, 3.4, 2.7, 0, 0, 0, 0, 6, 0, 0, 4.3, 0.1, 0), + nrow = 4L, + ncol = 4L + ) + ) +})