test_that("assigning and querying attributes work", { ## Create a small ring graph, assign attributes ring <- graph_from_literal(A - B - C - D - E - F - G - A) E(ring)$weight <- seq_len(ecount(ring)) ## Query attributes expect_that(V(ring)$name, equals(LETTERS[seq_len(vcount(ring))])) expect_that(E(ring)$weight, equals(seq_len(ecount(ring)))) }) test_that("brackering works", { g <- make_graph(c(1, 2, 1, 3, 3, 4)) g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g)) g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") 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") expect_that( vertex_attr(g, name = "weight"), equals(1:4) ) expect_that( edge_attr(g, name = "weight"), equals(1:3) ) expect_that(graph_attr(g, name = "name"), equals("foo")) }) test_that("brackering works with a function", { g <- make_graph(c(1, 2, 1, 3, 3, 4)) g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g)) g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") run.test <- function(graph) { graph2 <- set_vertex_attr(graph, name = "weight", value = rep(1, vcount(graph)) ) graph2 <- set_edge_attr(graph, name = "weight", value = rep(1, ecount(graph)) ) graph2 <- set_graph_attr(graph, name = "name", "foobar") } g2 <- run.test(g) expect_that( vertex_attr(g, name = "weight"), equals(1:4) ) expect_that( edge_attr(g, name = "weight"), equals(1:3) ) expect_that(graph_attr(g, name = "name"), equals("foo")) }) test_that("brackering works with shortcuts", { g <- make_graph(c(1, 2, 1, 3, 3, 4)) g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g)) g <- set_edge_attr(g, name = "weight", value = 1:ecount(g)) g <- set_graph_attr(g, name = "name", "foo") run.test <- function(graph) { V(graph)$weight <- rep(1, vcount(graph)) E(graph)$weight <- rep(1, ecount(graph)) graph$name <- "foobar" } g2 <- run.test(g) expect_that( vertex_attr(g, name = "weight"), equals(1:4) ) expect_that( edge_attr(g, name = "weight"), equals(1:3) ) expect_that(graph_attr(g, name = "name"), equals("foo")) }) ## TODO: subsetting test_that("we can query all attributes at once", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) expect_equal(graph_attr(g), structure(list(), .Names = character(0))) expect_equal(unname(vertex_attr(g)), list()) expect_equal(unname(edge_attr(g)), list()) g$name <- "toy" g$layout <- cbind(1:4, 1:4) V(g)$name <- letters[1:4] V(g)$color <- rainbow(4) E(g)$weight <- 1:3 E(g)$label <- LETTERS[1:3] expect_equal(graph_attr(g), list(name = "toy", layout = cbind(1:4, 1:4))) expect_equal(vertex_attr(g), list(name = letters[1:4], color = rainbow(4))) expect_equal(edge_attr(g), list(weight = 1:3, label = LETTERS[1:3])) }) test_that("we can query single attributes with the generic functions", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) g$name <- "toy" g$layout <- cbind(1:4, 1:4) V(g)$name <- letters[1:4] V(g)$color <- rainbow(4) E(g)$weight <- 1:3 E(g)$label <- LETTERS[1:3] expect_equal(graph_attr(g, "name"), "toy") expect_equal(graph_attr(g, "layout"), cbind(1:4, 1:4)) expect_equal(vertex_attr(g, "name"), letters[1:4]) expect_equal(vertex_attr(g, "color"), rainbow(4)) expect_equal(edge_attr(g, "weight"), 1:3) expect_equal(edge_attr(g, "label"), LETTERS[1:3]) }) test_that("we can query a subset of vertices", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) V(g)$name <- letters[1:4] V(g)$color <- as.list(rainbow(4)) E(g)$weight <- 1:3 E(g)$label <- as.list(LETTERS[1:3]) expect_equal(vertex_attr(g, "name", c(1, 3)), letters[c(1, 3)]) expect_equal( vertex_attr(g, "color", c("a", "c")), as.list(rainbow(4))[c(1, 3)] ) expect_equal(edge_attr(g, "weight", 2:3), 2:3) expect_equal(edge_attr(g, "label", 2:3), as.list(LETTERS[1:3])[2:3]) }) test_that("we can set all attributes at once", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) g$name <- "toy" g$layout <- cbind(1:4, 1:4) V(g)$name <- letters[1:4] V(g)$color <- as.list(rainbow(4)) E(g)$weight <- 1:3 E(g)$label <- as.list(LETTERS[1:3]) g2 <- make_graph(c(2, 1, 3, 1, 4, 1)) graph_attr(g2) <- graph_attr(g) expect_equal(graph_attr(g2), graph_attr(g)) vertex_attr(g2) <- vertex_attr(g) expect_equal(vertex_attr(g2), vertex_attr(g)) edge_attr(g2) <- edge_attr(g) expect_equal(edge_attr(g2), edge_attr(g)) }) test_that("we can set all attributes some vertices/edges", { g <- make_graph(c(1, 2, 1, 3, 2, 4)) V(g)$name <- letters[1:4] V(g)$color <- as.list(rainbow(4)) E(g)$weight <- 1:3 E(g)$label <- as.list(LETTERS[1:3]) g2 <- make_graph(c(2, 1, 3, 1, 4, 1, 2, 5, 3, 6)) vertex_attr(g2, index = c(1, 2, 4, 5)) <- vertex_attr(g) expect_equal(vertex_attr(g2), list(name = c( "a", "b", NA_character_, "c", "d", NA_character_ ), color = list( rainbow(4)[1], rainbow(4)[2], NULL, rainbow(4)[3], rainbow(4)[4], NULL ))) edge_attr(g2, index = c(1, 3, 5)) <- edge_attr(g) expect_equal(edge_attr(g2), list(weight = c( 1L, NA_integer_, 2L, NA_integer_, 3L ), label = list("A", NULL, "B", NULL, "C"))) }) test_that("cannot use vs/es from another graph", { g <- make_ring(10) g2 <- g + 1 v <- V(g)[1:4] expect_error(g2 - v, "Cannot use a vertex sequence from another graph") e <- E(g)[1:2] expect_error(g2 - e, "Cannot use an edge sequence from another graph") }) test_that("attribute combinations handle errors correctly", { g <- make_graph(c(1, 2, 2, 1)) E(g)$weight <- c("a", "b") expect_error(as.undirected(g, edge.attr.comb = list(weight = "sum")), "invalid 'type'") expect_error(as.undirected(g, edge.attr.comb = list(weight = sum)), "invalid 'type'") }) test_that("can change type of attributes (#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)", { g <- make_ring(10) V(g)$foo <- stats::setNames(1:10, letters[1:10]) expect_identical(V(g)$foo, 1:10) E(g)$foo <- stats::setNames(1:10, letters[1:10]) expect_identical(E(g)$foo, 1:10) V(g)$bar <- c(a = 1) expect_identical(V(g)$bar, rep(1, 10)) E(g)$bar <- c(a = 1) expect_identical(E(g)$bar, rep(1, 10)) }) test_that("setting NULL attributes works and doesn't change the input (#466)", { g <- make_ring(10) expect_identical(set_vertex_attr(g, "foo", value = NULL), g) expect_identical(set_vertex_attr(g, "foo", 1:3, value = NULL), g) expect_identical(set_edge_attr(g, "foo", value = NULL), g) 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) })