From 00a114b07470f272bd7e3e0c37fa4b1c79f2c58a Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 20 Feb 2025 13:04:42 +0100 Subject: [PATCH 1/2] added snapshot tests --- R/attributes.R | 40 ++---- tests/testthat/_snaps/attributes.md | 56 ++++++++ tests/testthat/test-attributes.R | 149 ++++++++++++++++++++ tests/testthat/test-constructor-modifiers.R | 130 ----------------- 4 files changed, 220 insertions(+), 155 deletions(-) create mode 100644 tests/testthat/_snaps/attributes.md delete mode 100644 tests/testthat/test-constructor-modifiers.R diff --git a/R/attributes.R b/R/attributes.R index 90535597f69..f76f7e011f0 100644 --- a/R/attributes.R +++ b/R/attributes.R @@ -487,12 +487,8 @@ i_set_vertex_attr <- function(graph, name, index = V(graph), value, check = TRUE } else if (length(value) == length(index)) { value_in <- unname(value) } else { - stop( - "Length of new attribute value must be ", - if (length(index) != 1) "1 or ", - length(index), - ", the number of target vertices, not ", - length(value) + cli::cli_abort( + "Length of new attribute value must be {if (length(index) != 1) '1 or '}{length(index)}, the number of target vertices, not {length(value)}." ) } @@ -543,14 +539,14 @@ set_value_at <- function(value, idx, length_out) { assert_named_list(value) if (!all(lengths(value) == length(index))) { - stop("Invalid attribute value length, must match number of vertices") + cli::cli_abort("Invalid attribute value length, must match number of vertices.") } if (!missing(index)) { index <- as_igraph_vs(graph, index) if (anyDuplicated(index) || anyNA(index)) { - stop("Invalid vertices in index") + cli::cli_abort("{.arg index} contains duplicated vertices or NAs.") } } @@ -698,12 +694,8 @@ i_set_edge_attr <- function(graph, name, index = E(graph), value, check = TRUE) } else if (length(value) == length(index)) { value_in <- unname(value) } else { - stop( - "Length of new attribute value must be ", - if (length(index) != 1) "1 or ", - length(index), - ", the number of target edges, not ", - length(value) + cli::cli_abort( + "Length of new attribute value must be {if (length(index) != 1) '1 or '}{length(index)}, the number of target edges, not {length(value)}." ) } @@ -743,13 +735,13 @@ edge.attributes <- function(graph, index = E(graph)) { assert_named_list(value) if (any(sapply(value, length) != length(index))) { - stop("Invalid attribute value length, must match number of edges") + cli::cli_abort("Invalid attribute value length, must match number of edges") } if (!missing(index)) { index <- as_igraph_es(graph, index) if (any(duplicated(index)) || any(is.na(index))) { - stop("Invalid edges in index") + cli::cli_abort("{.arg index} contains duplicated edges or NAs.") } } @@ -855,7 +847,7 @@ delete_graph_attr <- function(graph, name) { name <- as.character(name) if (!name %in% graph_attr_names(graph)) { - stop("No such graph attribute: ", name) + cli::cli_abort("No graph attribute {.arg {name}} found.") } gattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_graph) @@ -884,7 +876,7 @@ delete_vertex_attr <- function(graph, name) { name <- as.character(name) if (!name %in% vertex_attr_names(graph)) { - stop("No such vertex attribute: ", name) + cli::cli_abort("No vertex attribute {.arg {name}} found.") } vattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_vertex) @@ -913,7 +905,7 @@ delete_edge_attr <- function(graph, name) { name <- as.character(name) if (!name %in% edge_attr_names(graph)) { - stop("No such edge attribute: ", name) + cli::cli_abort("No edge attribute {.arg {name}} found.") } eattr <- .Call(R_igraph_mybracket2, graph, igraph_t_idx_attr, igraph_attr_idx_edge) @@ -1020,7 +1012,7 @@ igraph.i.attribute.combination <- function(comb) { if (any(!sapply(comb, function(x) { is.function(x) || (is.character(x) && length(x) == 1) }))) { - stop("Attribute combination element must be a function or character scalar") + cli::cli_abort("Attribute combination element must be a function or character scalar.") } if (is.null(names(comb))) { names(comb) <- rep("", length(comb)) @@ -1041,7 +1033,7 @@ igraph.i.attribute.combination <- function(comb) { ) x <- pmatch(tolower(x), known[, 1]) if (is.na(x)) { - stop("Unknown/unambigous attribute combination specification") + cli::cli_abort("Unknown/unambigous attribute combination specification.") } known[, 2][x] } @@ -1185,10 +1177,8 @@ NULL } assert_named_list <- function(value) { - error_msg <- "{.arg value} must be a named list with unique names" - if (!is.list(value)) { - rlang::abort(error_msg) + cli::cli_abort("{.arg value} must be a named list with unique names") } if (length(value) == 0) { @@ -1196,6 +1186,6 @@ assert_named_list <- function(value) { } if (!rlang::is_named(value) || anyDuplicated(names(value)) > 0) { - rlang::abort(error_msg) + cli::cli_abort("{.arg value} must be a named list with unique names") } } diff --git a/tests/testthat/_snaps/attributes.md b/tests/testthat/_snaps/attributes.md new file mode 100644 index 00000000000..c2650441779 --- /dev/null +++ b/tests/testthat/_snaps/attributes.md @@ -0,0 +1,56 @@ +# error messages work + + Code + set_vertex_attr(g, "test", value = c(1, 2)) + Condition + Error in `i_set_vertex_attr()`: + ! Length of new attribute value must be 1 or 5, the number of target vertices, not 2. + +--- + + Code + set_edge_attr(g, "test", value = c(1, 2)) + Condition + Error in `i_set_edge_attr()`: + ! Length of new attribute value must be 1 or 10, the number of target edges, not 2. + +--- + + Code + delete_graph_attr(g, "a") + Condition + Error in `delete_graph_attr()`: + ! No graph attribute `a` found. + +--- + + Code + delete_vertex_attr(g, "a") + Condition + Error in `delete_vertex_attr()`: + ! No vertex attribute `a` found. + +--- + + Code + delete_edge_attr(g, "a") + Condition + Error in `delete_edge_attr()`: + ! No edge attribute `a` found. + +--- + + Code + assert_named_list("a") + Condition + Error in `assert_named_list()`: + ! `value` must be a named list with unique names + +--- + + Code + assert_named_list(list("a", "b")) + Condition + Error in `assert_named_list()`: + ! `value` must be a named list with unique names + diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index 480c2738b3a..29cd492b137 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -350,3 +350,152 @@ test_that("is_bipartite works", { list(res = TRUE, type = c(rep(FALSE, 7), rep(TRUE, 5))) ) }) + +test_that("without_attr", { + withr::local_seed(42) + g <- sample_gnp(10, 2 / 10) %>% + delete_graph_attr("name") %>% + delete_graph_attr("type") %>% + delete_graph_attr("loops") %>% + delete_graph_attr("p") + + withr::local_seed(42) + g2 <- sample_(gnp(10, 2 / 10), without_attr()) + + expect_identical_graphs(g, g2) + expect_equal(graph_attr_names(g2), character()) + expect_equal(vertex_attr_names(g2), character()) + expect_equal(edge_attr_names(g2), character()) +}) + + +test_that("without_loops", { + g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% + simplify(remove.multiple = FALSE) + + g2 <- make_( + from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), + without_loops() + ) + + expect_identical_graphs(g, g2) + expect_true(all(!which_loop(g2))) +}) + + +test_that("without_multiple", { + g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% + simplify(remove.loops = FALSE) + + g2 <- make_( + from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), + without_multiples() + ) + + expect_identical_graphs(g, g2) + expect_true(all(!which_multiple(g2))) +}) + + +test_that("simplified", { + g <- make_graph(~ A - A:B:C, B - A:B:C) + + g2 <- make_( + from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), + simplified() + ) + + expect_identical_graphs(g, g2) + expect_true(all(!which_multiple(g2))) + expect_true(all(!which_loop(g2))) +}) + + +test_that("with_vertex_", { + g <- make_graph(~ A - A:B:C, B - A:B:C) %>% + set_vertex_attr("color", value = "red") %>% + set_vertex_attr("foo", value = paste0("xx", 1:3)) + + g2 <- make_( + from_literal(A - A:B:C, B - A:B:C), + with_vertex_( + color = "red", + foo = paste0("xx", 1:3) + ) + ) + + expect_identical_graphs(g, g2) + expect_equal(V(g2)$color, rep("red", gorder(g2))) + expect_equal(V(g2)$foo, paste0("xx", 1:3)) +}) + + +test_that("with_edge_", { + g <- make_graph(~ A - A:B:C, B - A:B:C) %>% + set_edge_attr("color", value = "red") %>% + set_edge_attr("foo", value = seq_len(3)) + + g2 <- make_( + from_literal(A - A:B:C, B - A:B:C), + with_edge_( + color = "red", + foo = seq_len(3) + ) + ) + + expect_identical_graphs(g, g2) + expect_equal(E(g)$color, E(g2)$color) + expect_equal(E(g)$foo, E(g2)$foo) +}) + + +test_that("with_graph_", { + g <- make_graph(~ A - A:B:C, B - A:B:C) %>% + set_graph_attr("color", value = "red") %>% + set_graph_attr("foo", value = 1:5) + + g2 <- make_( + from_literal(A - A:B:C, B - A:B:C), + with_graph_( + color = "red", + foo = 1:5 + ) + ) + + expect_identical_graphs(g, g2) + expect_equal(g$color, g2$color) + expect_equal(g$foo, g2$foo) +}) + + +test_that("adding and removing attributes", { + g <- make_empty_graph() + g2 <- make_empty_graph() + + g$foo <- "bar" + g <- delete_graph_attr(g, "foo") + E(g)$foo <- "bar" + g <- delete_edge_attr(g, "foo") + V(g)$foo <- "bar" + g <- delete_vertex_attr(g, "foo") + + expect_identical_graphs(g, g2) +}) + +test_that("error messages work", { + g <- make_full_graph(5) + expect_snapshot(set_vertex_attr(g, "test", value = c(1, 2)), error = TRUE) + expect_snapshot(set_edge_attr(g, "test", value = c(1, 2)), error = TRUE) + expect_snapshot(delete_graph_attr(g, "a"), error = TRUE) + expect_snapshot(delete_vertex_attr(g, "a"), error = TRUE) + expect_snapshot(delete_edge_attr(g, "a"), error = TRUE) + expect_snapshot(assert_named_list("a"), error = TRUE) + expect_snapshot(assert_named_list(list("a", "b")), error = TRUE) +}) + +test_that("empty returns work", { + g <- make_full_graph(5) + expect_length(vertex_attr_names(g), 0) + expect_length(vertex_attr_names(g), 0) + expect_length(edge_attr_names(g), 0) +}) diff --git a/tests/testthat/test-constructor-modifiers.R b/tests/testthat/test-constructor-modifiers.R deleted file mode 100644 index 5d3fa715e3e..00000000000 --- a/tests/testthat/test-constructor-modifiers.R +++ /dev/null @@ -1,130 +0,0 @@ -test_that("without_attr", { - withr::local_seed(42) - g <- sample_gnp(10, 2 / 10) %>% - delete_graph_attr("name") %>% - delete_graph_attr("type") %>% - delete_graph_attr("loops") %>% - delete_graph_attr("p") - - withr::local_seed(42) - g2 <- sample_(gnp(10, 2 / 10), without_attr()) - - expect_identical_graphs(g, g2) - expect_equal(graph_attr_names(g2), character()) - expect_equal(vertex_attr_names(g2), character()) - expect_equal(edge_attr_names(g2), character()) -}) - - -test_that("without_loops", { - g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% - simplify(remove.multiple = FALSE) - - g2 <- make_( - from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), - without_loops() - ) - - expect_identical_graphs(g, g2) - expect_true(all(!which_loop(g2))) -}) - - -test_that("without_multiple", { - g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% - simplify(remove.loops = FALSE) - - g2 <- make_( - from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), - without_multiples() - ) - - expect_identical_graphs(g, g2) - expect_true(all(!which_multiple(g2))) -}) - - -test_that("simplified", { - g <- make_graph(~ A - A:B:C, B - A:B:C) - - g2 <- make_( - from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), - simplified() - ) - - expect_identical_graphs(g, g2) - expect_true(all(!which_multiple(g2))) - expect_true(all(!which_loop(g2))) -}) - - -test_that("with_vertex_", { - g <- make_graph(~ A - A:B:C, B - A:B:C) %>% - set_vertex_attr("color", value = "red") %>% - set_vertex_attr("foo", value = paste0("xx", 1:3)) - - g2 <- make_( - from_literal(A - A:B:C, B - A:B:C), - with_vertex_( - color = "red", - foo = paste0("xx", 1:3) - ) - ) - - expect_identical_graphs(g, g2) - expect_equal(V(g2)$color, rep("red", gorder(g2))) - expect_equal(V(g2)$foo, paste0("xx", 1:3)) -}) - - -test_that("with_edge_", { - g <- make_graph(~ A - A:B:C, B - A:B:C) %>% - set_edge_attr("color", value = "red") %>% - set_edge_attr("foo", value = seq_len(3)) - - g2 <- make_( - from_literal(A - A:B:C, B - A:B:C), - with_edge_( - color = "red", - foo = seq_len(3) - ) - ) - - expect_identical_graphs(g, g2) - expect_equal(E(g)$color, E(g2)$color) - expect_equal(E(g)$foo, E(g2)$foo) -}) - - -test_that("with_graph_", { - g <- make_graph(~ A - A:B:C, B - A:B:C) %>% - set_graph_attr("color", value = "red") %>% - set_graph_attr("foo", value = 1:5) - - g2 <- make_( - from_literal(A - A:B:C, B - A:B:C), - with_graph_( - color = "red", - foo = 1:5 - ) - ) - - expect_identical_graphs(g, g2) - expect_equal(g$color, g2$color) - expect_equal(g$foo, g2$foo) -}) - - -test_that("adding and removing attributes", { - g <- make_empty_graph() - g2 <- make_empty_graph() - - g$foo <- "bar" - g <- delete_graph_attr(g, "foo") - E(g)$foo <- "bar" - g <- delete_edge_attr(g, "foo") - V(g)$foo <- "bar" - g <- delete_vertex_attr(g, "foo") - - expect_identical_graphs(g, g2) -}) From 653c18b36501db464f283fafc143216084fd54a8 Mon Sep 17 00:00:00 2001 From: schochastics Date: Mon, 24 Feb 2025 17:21:21 +0100 Subject: [PATCH 2/2] added proper support for data.frame attributes --- R/attributes.R | 9 ++ tests/testthat/test-attributes.R | 190 ++++++++++--------------------- 2 files changed, 66 insertions(+), 133 deletions(-) diff --git a/R/attributes.R b/R/attributes.R index f76f7e011f0..89fa53e2eed 100644 --- a/R/attributes.R +++ b/R/attributes.R @@ -349,6 +349,9 @@ graph.attributes <- function(graph) { "graph.attributes<-" <- function(graph, value) { ensure_igraph(graph) assert_named_list(value) + if (inherits(value, "data.frame")) { + value <- as.list(value) + } .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_graph, value) } @@ -537,6 +540,9 @@ set_value_at <- function(value, idx, length_out) { ensure_igraph(graph) assert_named_list(value) + if (inherits(value, "data.frame")) { + value <- as.list(value) + } if (!all(lengths(value) == length(index))) { cli::cli_abort("Invalid attribute value length, must match number of vertices.") @@ -733,6 +739,9 @@ edge.attributes <- function(graph, index = E(graph)) { ensure_igraph(graph) assert_named_list(value) + if (inherits(value, "data.frame")) { + value <- as.list(value) + } if (any(sapply(value, length) != length(index))) { cli::cli_abort("Invalid attribute value length, must match number of edges") diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index 29cd492b137..26183618166 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -31,13 +31,13 @@ test_that("bracketing works with a function (not changing attribute of similar g g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") - run.test <- function(g) { + copy_test <- function(g) { graph2 <- set_vertex_attr(g, name = "weight", value = rep(1, vcount(g))) graph2 <- set_edge_attr(g, name = "weight", value = rep(1, ecount(g))) graph2 <- set_graph_attr(g, name = "name", "foobar") } - g2 <- run.test(g) + g2 <- copy_test(g) expect_equal(vertex_attr(g, name = "weight"), 1:4) expect_equal(edge_attr(g, name = "weight"), 1:3) expect_equal(graph_attr(g, name = "name"), "foo") @@ -50,13 +50,13 @@ test_that("bracketing works with shortcuts (not changing attribute of similar gr g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") - run.test <- function(graph) { + copy_test <- function(graph) { V(graph)$weight <- rep(1, vcount(graph)) E(graph)$weight <- rep(1, ecount(graph)) graph$name <- "foobar" } - g2 <- run.test(g) + g_copy <- copy_test(g) expect_equal(vertex_attr(g, name = "weight"), 1:4) expect_equal(edge_attr(g, name = "weight"), 1:3) expect_equal(graph_attr(g, name = "name"), "foo") @@ -188,25 +188,31 @@ test_that("attribute combinations handle errors correctly", { expect_error(as_undirected(g, edge.attr.comb = list(weight = sum)), "invalid 'type'") }) -test_that("can change type of attributes (#466)", { +test_that("can change type of attributes", { + # https://github.com/igraph/rigraph/issues/466 g <- make_ring(10) V(g)$foo <- 1 expect_equal(V(g)$foo, rep(1, 10)) + V(g)$foo <- "a" expect_equal(V(g)$foo, rep("a", 10)) + V(g)$foo <- 2 expect_equal(V(g)$foo, rep(2, 10)) E(g)$foo <- 1 expect_equal(E(g)$foo, rep(1, 10)) + E(g)$foo <- "a" expect_equal(E(g)$foo, rep("a", 10)) + E(g)$foo <- 2 expect_equal(E(g)$foo, rep(2, 10)) }) -test_that("setting attributes strips names (#466)", { +test_that("setting attributes strips names", { + # https://github.com/igraph/rigraph/issues/466 g <- make_ring(10) V(g)$foo <- stats::setNames(1:10, letters[1:10]) @@ -222,7 +228,8 @@ test_that("setting attributes strips names (#466)", { expect_identical(E(g)$bar, rep(1, 10)) }) -test_that("setting NULL attributes works and doesn't change the input (#466)", { +test_that("setting NULL attributes works and doesn't change the input", { + # https://github.com/igraph/rigraph/issues/466 g <- make_ring(10) expect_identical(set_vertex_attr(g, "foo", value = NULL), g) @@ -231,96 +238,6 @@ test_that("setting NULL attributes works and doesn't change the input (#466)", { expect_identical(set_edge_attr(g, "foo", 1:3, value = NULL), g) }) -test_that("GRAPH attributes are destroyed when the graph is destroyed", { - finalized <- FALSE - finalizer <- function(e) { - finalized <<- TRUE - } - - env <- new.env(parent = emptyenv()) - reg.finalizer(env, finalizer) - - g <- make_ring(1) - g$a <- list(env) - rm(env) - gc() - expect_false(finalized) - - rm(g) - gc() - expect_true(finalized) -}) - -test_that("vertex attributes are destroyed when the graph is destroyed", { - finalized <- FALSE - finalizer <- function(e) { - finalized <<- TRUE - } - - env <- new.env(parent = emptyenv()) - reg.finalizer(env, finalizer) - - g <- make_ring(1) - V(g)$a <- list(env) - rm(env) - gc() - expect_false(finalized) - - g <- add_vertices(g, 1) - gc() - expect_false(finalized) - - g <- delete_vertices(g, 2) - gc() - expect_false(finalized) - - # Called for the side effect of clearing the protect list - make_empty_graph() - expect_false(finalized) - - rm(g) - - gc() - expect_true(finalized) -}) - -test_that("edge attributes are destroyed when the graph is destroyed", { - finalized <- FALSE - finalizer <- function(e) { - finalized <<- TRUE - } - - env <- new.env(parent = emptyenv()) - reg.finalizer(env, finalizer) - - g <- make_ring(2) - E(g)$a <- list(env) - rm(env) - gc() - expect_false(finalized) - - g <- add_vertices(g, 1) - gc() - expect_false(finalized) - - g <- add_edges(g, c(2, 3)) - gc() - expect_false(finalized) - - g <- delete_edges(g, 2) - gc() - expect_false(finalized) - - # Called for the side effect of clearing the protect list - make_empty_graph() - expect_false(finalized) - - rm(g) - - gc() - expect_true(finalized) -}) - test_that("assert_named_list() works", { not_list <- 1:10 expect_error(assert_named_list(not_list), "named list") @@ -338,39 +255,39 @@ test_that("assert_named_list() works", { }) test_that("is_bipartite works", { - I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) - g <- graph_from_biadjacency_matrix(I) - expect_true(bipartite_mapping(g)$res) + biadj_mat1 <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) + g1 <- graph_from_biadjacency_matrix(biadj_mat1) + expect_true(bipartite_mapping(g1)$res) withr::local_seed(42) - I <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) - g <- graph_from_biadjacency_matrix(I) + biadj_mat2 <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) + g2 <- graph_from_biadjacency_matrix(biadj_mat2) expect_equal( - bipartite_mapping(g), + bipartite_mapping(g2), list(res = TRUE, type = c(rep(FALSE, 7), rep(TRUE, 5))) ) }) test_that("without_attr", { withr::local_seed(42) - g <- sample_gnp(10, 2 / 10) %>% + g_stripped <- sample_gnp(10, 2 / 10) %>% delete_graph_attr("name") %>% delete_graph_attr("type") %>% delete_graph_attr("loops") %>% delete_graph_attr("p") withr::local_seed(42) - g2 <- sample_(gnp(10, 2 / 10), without_attr()) + g_no_attr <- sample_(gnp(10, 2 / 10), without_attr()) - expect_identical_graphs(g, g2) - expect_equal(graph_attr_names(g2), character()) - expect_equal(vertex_attr_names(g2), character()) - expect_equal(edge_attr_names(g2), character()) + expect_identical_graphs(g_stripped, g_no_attr) + expect_equal(graph_attr_names(g_no_attr), character()) + expect_equal(vertex_attr_names(g_no_attr), character()) + expect_equal(edge_attr_names(g_no_attr), character()) }) test_that("without_loops", { - g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% + g1 <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% simplify(remove.multiple = FALSE) g2 <- make_( @@ -378,13 +295,13 @@ test_that("without_loops", { without_loops() ) - expect_identical_graphs(g, g2) + expect_identical_graphs(g1, g2) expect_true(all(!which_loop(g2))) }) test_that("without_multiple", { - g <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% + g1 <- make_graph(~ A - A:B:C, B - A:B:C, simplify = FALSE) %>% simplify(remove.loops = FALSE) g2 <- make_( @@ -392,27 +309,27 @@ test_that("without_multiple", { without_multiples() ) - expect_identical_graphs(g, g2) + expect_identical_graphs(g1, g2) expect_true(all(!which_multiple(g2))) }) test_that("simplified", { - g <- make_graph(~ A - A:B:C, B - A:B:C) + g1 <- make_graph(~ A - A:B:C, B - A:B:C) g2 <- make_( from_literal(A - A:B:C, B - A:B:C, simplify = FALSE), simplified() ) - expect_identical_graphs(g, g2) + expect_identical_graphs(g1, g2) expect_true(all(!which_multiple(g2))) expect_true(all(!which_loop(g2))) }) test_that("with_vertex_", { - g <- make_graph(~ A - A:B:C, B - A:B:C) %>% + g1 <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_vertex_attr("color", value = "red") %>% set_vertex_attr("foo", value = paste0("xx", 1:3)) @@ -424,14 +341,14 @@ test_that("with_vertex_", { ) ) - expect_identical_graphs(g, g2) + expect_identical_graphs(g1, g2) expect_equal(V(g2)$color, rep("red", gorder(g2))) expect_equal(V(g2)$foo, paste0("xx", 1:3)) }) test_that("with_edge_", { - g <- make_graph(~ A - A:B:C, B - A:B:C) %>% + g1 <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_edge_attr("color", value = "red") %>% set_edge_attr("foo", value = seq_len(3)) @@ -443,14 +360,14 @@ test_that("with_edge_", { ) ) - expect_identical_graphs(g, g2) - expect_equal(E(g)$color, E(g2)$color) - expect_equal(E(g)$foo, E(g2)$foo) + expect_identical_graphs(g1, g2) + expect_equal(E(g1)$color, E(g2)$color) + expect_equal(E(g1)$foo, E(g2)$foo) }) test_that("with_graph_", { - g <- make_graph(~ A - A:B:C, B - A:B:C) %>% + g1 <- make_graph(~ A - A:B:C, B - A:B:C) %>% set_graph_attr("color", value = "red") %>% set_graph_attr("foo", value = 1:5) @@ -462,24 +379,24 @@ test_that("with_graph_", { ) ) - expect_identical_graphs(g, g2) - expect_equal(g$color, g2$color) - expect_equal(g$foo, g2$foo) + expect_identical_graphs(g1, g2) + expect_equal(g1$color, g2$color) + expect_equal(g1$foo, g2$foo) }) test_that("adding and removing attributes", { - g <- make_empty_graph() + g1 <- make_empty_graph() g2 <- make_empty_graph() - g$foo <- "bar" - g <- delete_graph_attr(g, "foo") - E(g)$foo <- "bar" - g <- delete_edge_attr(g, "foo") - V(g)$foo <- "bar" - g <- delete_vertex_attr(g, "foo") + g1$foo <- "bar" + g1 <- delete_graph_attr(g1, "foo") + E(g1)$foo <- "bar" + g1 <- delete_edge_attr(g1, "foo") + V(g1)$foo <- "bar" + g1 <- delete_vertex_attr(g1, "foo") - expect_identical_graphs(g, g2) + expect_identical_graphs(g1, g2) }) test_that("error messages work", { @@ -499,3 +416,10 @@ test_that("empty returns work", { expect_length(vertex_attr_names(g), 0) expect_length(edge_attr_names(g), 0) }) + +test_that("assign data.frame attributes works", { + # https://github.com/igraph/rigraph/issues/1669 + g <- make_tree(10, 3) + edge.attributes(g) <- head(mtcars, ecount(g)) + expect_no_error(E(g)[c(1, 2)]) +})