diff --git a/R/incidence.R b/R/incidence.R index 0cc7716b932..49120ba4dd1 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -45,12 +45,6 @@ graph.incidence.sparse <- function(incidence, directed, mode, multiple, el[, 2] <- el[, 2] + n1 if (!is.null(weighted)) { - if (is.logical(weighted) && weighted) { - weighted <- "weight" - } - if (!is.character(weighted)) { - stop("invalid value supplied for `weighted' argument, please see docs.") - } if (!directed || mode == 1) { ## nothing do to @@ -92,12 +86,6 @@ graph.incidence.sparse <- function(incidence, directed, mode, multiple, graph.incidence.dense <- function(incidence, directed, mode, multiple, weighted) { if (!is.null(weighted)) { - if (is.logical(weighted) && weighted) { - weighted <- "weight" - } - if (!is.character(weighted)) { - stop("invalid value supplied for `weighted' argument, please see docs.") - } n1 <- nrow(incidence) n2 <- ncol(incidence) @@ -228,6 +216,31 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE, ) multiple <- as.logical(multiple) + if (!is.null(weighted)) { + if (is.logical(weighted) && weighted) { + + if (multiple) { + cli::cli_abort(c( + "{.arg multiple} and {.arg weighted} cannot be both {.code TRUE}.", + "igraph either interprets numbers larger than 1 as weights or as multiplicities, but it cannot be both." + )) + } + weighted <- "weight" + } + if (is.logical(weighted) && !weighted) { + cli::cli_abort(c( + "{.arg weighted} can't be {.code FALSE}.", + i = "See {.help graph_from_biadjacency_matrix}'s manual page." + )) + } + if (!is.character(weighted)) { + cli::cli_abort(c( + "{.arg weighted} can't be {.obj_type_friendly {weighted}}.", + i = "See {.help graph_from_biadjacency_matrix}'s manual page." + )) + } + } + if (inherits(incidence, "Matrix")) { res <- graph.incidence.sparse(incidence, directed = directed, diff --git a/tests/testthat/_snaps/incidence.md b/tests/testthat/_snaps/incidence.md new file mode 100644 index 00000000000..b15badd95f6 --- /dev/null +++ b/tests/testthat/_snaps/incidence.md @@ -0,0 +1,87 @@ +# graph_from_biadjacency_matrix() works -- dense + + Code + (g <- graph_from_biadjacency_matrix(inc)) + Output + IGRAPH UN-B 8 7 -- + + attr: type (v/l), name (v/c) + + edges (vertex names): + [1] A--c A--d B--b B--c B--e C--b C--d + +--- + + Code + (weighted_g <- graph_from_biadjacency_matrix(inc, weighted = TRUE)) + Output + IGRAPH UNWB 8 7 -- + + attr: type (v/l), name (v/c), weight (e/n) + + edges (vertex names): + [1] A--c A--d B--b B--c B--e C--b C--d + +# graph_from_biadjacency_matrix() works -- dense + multiple + + Code + (g <- graph_from_biadjacency_matrix(inc, multiple = TRUE)) + Output + IGRAPH UN-B 8 10 -- + + attr: type (v/l), name (v/c) + + edges (vertex names): + [1] A--c A--d A--d A--e B--b B--e C--b C--c C--c C--e + +# graph_from_biadjacency_matrix() works -- sparse + + Code + (g <- graph_from_biadjacency_matrix(inc)) + Output + IGRAPH UN-B 8 7 -- + + attr: type (v/l), name (v/c) + + edges (vertex names): + [1] B--b C--b A--c B--c A--d C--d B--e + +--- + + Code + (weighted_g <- graph_from_biadjacency_matrix(inc, weighted = TRUE)) + Output + IGRAPH UNWB 8 7 -- + + attr: type (v/l), name (v/c), weight (e/n) + + edges (vertex names): + [1] B--b C--b A--c B--c A--d C--d B--e + +# graph_from_biadjacency_matrix() works -- sparse + multiple + + Code + (g <- graph_from_biadjacency_matrix(inc, multiple = TRUE)) + Output + IGRAPH UN-B 8 10 -- + + attr: type (v/l), name (v/c) + + edges (vertex names): + [1] B--b C--b A--c C--c C--c A--d A--d A--e B--e C--e + +# graph_from_biadjacency_matrix() errors well + + Code + (g <- graph_from_biadjacency_matrix(inc, weight = FALSE)) + Condition + Error in `graph_from_biadjacency_matrix()`: + ! `weighted` can't be `FALSE`. + i See `?graph_from_biadjacency_matrix()`'s manual page. + +--- + + Code + (g <- graph_from_biadjacency_matrix(inc, weight = 42)) + Condition + Error in `graph_from_biadjacency_matrix()`: + ! `weighted` can't be a number. + i See `?graph_from_biadjacency_matrix()`'s manual page. + +--- + + Code + (g <- graph_from_biadjacency_matrix(inc, multiple = TRUE, weighted = TRUE)) + Condition + Error in `graph_from_biadjacency_matrix()`: + ! `multiple` and `weighted` cannot be both `TRUE`. + igraph either interprets numbers larger than 1 as weights or as multiplicities, but it cannot be both. + diff --git a/tests/testthat/test-incidence.R b/tests/testthat/test-incidence.R new file mode 100644 index 00000000000..7b871739e16 --- /dev/null +++ b/tests/testthat/test-incidence.R @@ -0,0 +1,171 @@ +test_that("graph_from_biadjacency_matrix() works -- dense", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + expect_snapshot((g <- graph_from_biadjacency_matrix(inc))) + expect_false(is_weighted(g)) + + expect_snapshot((weighted_g <- graph_from_biadjacency_matrix(inc, weighted = TRUE))) + expect_true(is_weighted(weighted_g)) +}) + + +test_that("graph_from_biadjacency_matrix() works -- dense + multiple", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:2, 15, repl = TRUE), 3, 5) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + expect_snapshot((g <- graph_from_biadjacency_matrix(inc, multiple = TRUE))) + expect_false(is_weighted(g)) +}) + + +test_that("graph_from_biadjacency_matrix() works - dense, modes", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + out_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "out") + expect_true(is_directed(out_g)) + expect_length(E(out_g), 7) + expect_equal(as_adj_list(out_g, mode = "out")$A %>% as.numeric(), c(6, 7)) + + in_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "in") + expect_true(is_directed(in_g)) + expect_length(E(in_g), 7) + expect_equal(as_adj_list(in_g, mode = "in")$A %>% as.numeric(), c(6, 7)) + + mutual_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "all") + expect_true(is_directed(mutual_g)) + expect_length(E(mutual_g), 14) + expect_equal(as_adj_list(mutual_g, mode = "all")$A %>% as.numeric(), c(6, 6, 7, 7)) +}) + +test_that("graph_from_biadjacency_matrix() works - dense, modes, weighted", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:2, 15, repl = TRUE), 3, 5) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + out_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "out", weighted = TRUE) + expect_true(is_directed(out_g)) + expect_length(E(out_g), 8) + expect_equal(as_adj_list(out_g, mode = "out")$A %>% as.numeric(), c(6, 7, 8)) + + in_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "in", weighted = TRUE) + expect_true(is_directed(in_g)) + expect_length(E(in_g), 8) + expect_equal(as_adj_list(in_g, mode = "in")$A %>% as.numeric(), c(6, 7, 8)) + + mutual_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "all", weighted = TRUE) + expect_true(is_directed(mutual_g)) + expect_length(E(mutual_g), 16) + expect_equal(as_adj_list(mutual_g, mode = "all")$A %>% as.numeric(), c(6, 6, 7, 7, 8, 8)) +}) + +test_that("graph_from_biadjacency_matrix() works -- sparse", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) + inc <- Matrix::Matrix(inc, sparse = TRUE) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + expect_snapshot((g <- graph_from_biadjacency_matrix(inc))) + expect_false(is_weighted(g)) + + expect_snapshot((weighted_g <- graph_from_biadjacency_matrix(inc, weighted = TRUE))) + expect_true(is_weighted(weighted_g)) +}) + +test_that("graph_from_biadjacency_matrix() works -- sparse + multiple", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:2, 15, repl = TRUE), 3, 5) + inc <- Matrix::Matrix(inc, sparse = TRUE) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + expect_snapshot((g <- graph_from_biadjacency_matrix(inc, multiple = TRUE))) + expect_false(is_weighted(g)) +}) + +test_that("graph_from_biadjacency_matrix() works - sparse, modes", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) + inc <- Matrix::Matrix(inc, sparse = TRUE) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + out_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "out") + expect_true(is_directed(out_g)) + expect_length(E(out_g), 7) + expect_equal(as_adj_list(out_g, mode = "out")$A %>% as.numeric(), c(6, 7)) + + in_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "in") + expect_true(is_directed(in_g)) + expect_length(E(in_g), 7) + expect_equal(as_adj_list(in_g, mode = "in")$A %>% as.numeric(), c(6, 7)) + + mutual_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "all") + expect_true(is_directed(mutual_g)) + expect_length(E(mutual_g), 14) + expect_equal(as_adj_list(mutual_g, mode = "all")$A %>% as.numeric(), c(6, 6, 7, 7)) +}) + +test_that("graph_from_biadjacency_matrix() works - sparse, modes, weighted", { + local_igraph_options(print.id = FALSE) + withr::local_seed(42) + + inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) + inc <- Matrix::Matrix(inc, sparse = TRUE) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + out_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "out", weighted= TRUE) + expect_true(is_directed(out_g)) + expect_length(E(out_g), 7) + expect_equal(as_adj_list(out_g, mode = "out")$A %>% as.numeric(), c(6, 7)) + + in_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "in", weighted= TRUE) + expect_true(is_directed(in_g)) + expect_length(E(in_g), 7) + expect_equal(as_adj_list(in_g, mode = "in")$A %>% as.numeric(), c(6, 7)) + + mutual_g <- graph_from_biadjacency_matrix(inc, directed = TRUE, mode = "all", weighted= TRUE) + expect_true(is_directed(mutual_g)) + expect_length(E(mutual_g), 14) + expect_equal(as_adj_list(mutual_g, mode = "all")$A %>% as.numeric(), c(6, 6, 7, 7)) +}) + +test_that("graph_from_biadjacency_matrix() errors well", { + inc <- matrix(sample(0:1, 15, repl = TRUE), 3, 5) + colnames(inc) <- letters[1:5] + rownames(inc) <- LETTERS[1:3] + + expect_snapshot(error= TRUE, { + (g <- graph_from_biadjacency_matrix(inc, weight = FALSE)) + }) + expect_snapshot(error = TRUE, { + (g <- graph_from_biadjacency_matrix(inc, weight = 42)) + }) + expect_snapshot(error = TRUE, { + (g <- graph_from_biadjacency_matrix(inc, multiple = TRUE, weighted = TRUE)) + }) +})