test: add tests for graph_from_biadjacency_matrix()

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,

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.
+

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))
+  })
+})