tests/testthat/test-operators.R
In igraph/rigraph: Network Analysis and Visualization
test_that("union() works", {
order_by_two_first_columns <- function(x) x[order(x[, 1], x[, 2]), ]
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gu <- union(g1, g2)
expect_vcount(gu, 11)
expect_ecount(gu, 20)
expect_equal(
order_by_two_first_columns(rbind(as_edgelist(g1), as_edgelist(g2))),
order_by_two_first_columns(as_edgelist(gu))
)
expect_isomorphic(difference(gu, g1), g2)
expect_isomorphic(intersection(gu, g2), g2)
})
test_that("disjoint_union() works", {
order_by_two_first_columns <- function(x) x[order(x[, 1], x[, 2]), ]
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gdu <- disjoint_union(g1, g2)
expect_equal(
order_by_two_first_columns(as_edgelist(gdu)),
order_by_two_first_columns(rbind(
as_edgelist(g1),
as_edgelist(g2) + vcount(g1)
))
)
})
test_that("disjoint_union() does not convert types", {
# https://github.com/igraph/rigraph/issues/761
g1 <- make_graph(~ A - -B)
g2 <- make_graph(~ D - -E)
g1 <- set_edge_attr(g1, "date", value = as.POSIXct(c("2021-01-01 01:01:01")))
g2 <- set_edge_attr(g2, "date", value = as.POSIXct(c("2021-03-03 03:03:03")))
u <- disjoint_union(g1, g2)
expect_s3_class(E(u)$date, c("POSIXct", "POSIXt"))
})
test_that("intersection() works", {
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gu <- union(g1, g2)
expect_isomorphic(intersection(gu, g1, keep.all.vertices = FALSE), g1)
})
test_that("complementer() works", {
g2 <- make_star(11, center = 11, mode = "undirected")
x <- complementer(complementer(g2))
expect_identical_graphs(x, g2)
gnp <- sample_gnp(50, 3 / 50)
gnp_comp <- complementer(gnp)
gnp_comp_comp <- complementer(gnp_comp)
expect_isomorphic(gnp, gnp_comp_comp)
})
test_that("compose() works", {
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gu <- union(g1, g2)
gc <- compose(gu, g1)
expect_vcount(gc, 11)
expect_ecount(gc, 60)
expect_equal(diameter(gc), 2)
gnp <- sample_gnp(50, 3 / 50, directed = TRUE)
gnp_i <- make_graph(rep(1:vcount(gnp), each = 2), directed = TRUE)
gnp_comp1 <- compose(gnp, gnp_i)
gnp_comp2 <- compose(gnp_i, gnp)
expect_isomorphic(gnp, gnp_comp1)
expect_isomorphic(gnp, gnp_comp2)
})
test_that("compose works for named graphs", {
g1 <- graph_from_literal(A - B:D:E, B - C:D, C - D, D - E)
g2 <- graph_from_literal(A - B - E - A)
V(g1)$bar1 <- seq_len(vcount(g1))
V(g2)$bar2 <- seq_len(vcount(g2))
V(g1)$foo <- letters[seq_len(vcount(g1))]
V(g2)$foo <- letters[seq_len(vcount(g2))]
E(g1)$bar1 <- seq_len(ecount(g1))
E(g2)$bar2 <- seq_len(ecount(g2))
E(g1)$foo <- letters[seq_len(ecount(g1))]
E(g2)$foo <- letters[seq_len(ecount(g2))]
g <- compose(g1, g2)
df <- as_data_frame(g, what = "both")
df.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
bar1 foo_1 foo_2 bar2 name
A 1 a a 1 A
B 2 b b 2 B
D 3 c NA NA D
E 4 d c 3 E
C 5 e NA NA C
"
)
)
expect_equal(df$vertices, df.v)
df.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to bar1 foo_1 foo_2 bar2
1 A B 3 c c 3
2 A A 3 c b 2
3 A E 1 a c 3
4 A A 1 a a 1
5 B E 1 a b 2
6 B B 1 a a 1
7 B D 6 f c 3
8 A D 6 f b 2
9 D E 4 d c 3
10 A D 4 d a 1
11 D E 2 b b 2
12 B D 2 b a 1
13 E E 3 c b 2
14 B E 3 c a 1
15 E C 5 e c 3
16 A C 5 e a 1
"
)
)
rownames(df$edges) <- rownames(df$edges)
expect_equal(df$edges, df.e)
})
test_that("Union of directed named graphs", {
graphs <- list(
make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 3, 2 -+ 3, 2 -+ 4, 3 -+ 4, 1 -+ 5, 3 -+ 5),
make_graph(~ 1:2:3:4:5, 2 -+ 3, 1 -+ 4, 2 -+ 4, 3 -+ 4, 2 -+ 5, 3 -+ 5),
make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 3, 2 -+ 4, 3 -+ 4, 1 -+ 5, 4 -+ 5)
)
gg <- union.igraph(graphs)
expect_vcount(gg, 5)
expect_ecount(gg, 10)
})
test_that("edge reversal works", {
directed_graph <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4)
reverse_directed_graph <- reverse_edges(directed_graph, 1:3)
expected <- make_graph(~ 1 +- 2, 1 +- 3, 1 +- 4, 2 -+ 3, 3 -+ 4)
expect_isomorphic(reverse_directed_graph, expected)
reverse_all_directed_graph <- reverse_edges(directed_graph)
expect_vcount(reverse_all_directed_graph, vcount(directed_graph))
expect_equal(
as_edgelist(reverse_all_directed_graph),
as_edgelist(directed_graph)[, c(2, 1)]
)
undirected_graph <- make_graph(~ 1 - -2, 1 - -3, 1 - -4, 2 - -3, 3 - -4)
reverse_undirected_graph <- reverse_edges(undirected_graph, 1:3)
expect_identical_graphs(undirected_graph, reverse_undirected_graph)
isolated_vertices_g <- make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 4)
reverse_isolated_vertices_g <- reverse_edges(isolated_vertices_g)
expect_vcount(reverse_isolated_vertices_g, vcount(isolated_vertices_g))
expect_equal(
as_edgelist(reverse_isolated_vertices_g),
as_edgelist(isolated_vertices_g)[, c(2, 1)]
)
})
test_that("t() is aliased to edge reversal for graphs", {
g <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4)
expect_vcount(t(g), vcount(g))
expect_equal(as_edgelist(t(g)), as_edgelist(g)[, c(2, 1)])
})
test_that("vertices() works", {
g_all_unnamed <- make_empty_graph(1) + vertices("a", "b")
expect_s3_class(V(g_all_unnamed), "igraph.vs")
expect_identical(V(g_all_unnamed)$name, c(NA, "a", "b"))
g_mix_named_unnamed <- make_empty_graph(1) + vertices("a", "b", foo = 5)
expect_s3_class(V(g_mix_named_unnamed), "igraph.vs")
expect_true(is.na(V(g_mix_named_unnamed)$name[1]))
expect_identical(V(g_mix_named_unnamed)$name[-1], c("a", "b"))
expect_equal(V(g_mix_named_unnamed)$foo, c(NA, 5, 5))
g_mix_bigger_attribute <- make_empty_graph(1) +
vertices("a", "b", "c", foo = 5:7, bar = 8)
expect_s3_class(V(g_mix_bigger_attribute), "igraph.vs")
expect_identical(V(g_mix_bigger_attribute)$name, c(NA, "a", "b", "c"))
expect_equal(V(g_mix_bigger_attribute)$foo, c(NA, 5, 6, 7))
expect_equal(V(g_mix_bigger_attribute)$bar, c(NA, 8, 8, 8))
g_one_unnamed <- make_empty_graph(1) + vertices(letters)
expect_s3_class(V(g_one_unnamed), "igraph.vs")
expect_identical(V(g_one_unnamed)$name, c(NA, letters))
g_all_named <- make_empty_graph(1) + vertices(foo = 5:7)
expect_s3_class(V(g_all_named), "igraph.vs")
expect_null(V(g_all_named)$name)
expect_identical(V(g_all_named)$foo, c(NA, 5:7))
g_all_named_empty <- make_empty_graph(1) + vertices(foo = numeric())
expect_s3_class(V(g_all_named_empty), "igraph.vs")
expect_null(V(g_all_named_empty)$name)
expect_identical(V(g_all_named_empty)$foo, NA_real_)
g_none <- make_empty_graph(1) + vertices()
expect_s3_class(V(g_none), "igraph.vs")
expect_null(V(g_none)$name)
expect_snapshot_error(make_empty_graph(1) + vertices("a", "b", foo = 5:7))
})
test_that("infix operators work", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
E(g)$name <- LETTERS[1:10]
g <- g - c("a", "b")
expect_vcount(g, 8)
expect_ecount(g, 7)
expect_isomorphic(g, make_lattice(8))
g <- g - edge("e|f")
expect_isomorphic(g, make_lattice(5) + make_lattice(3))
g <- g - edge("H")
expect_isomorphic(g, graph_from_literal(a - b - c, d - e - f, g - h))
g <- make_ring(10)
V(g)$name <- letters[1:10]
g <- g - path("a", "b")
expect_isomorphic(
g,
graph_from_literal(a, b - c - d - e - f - g - h - i - j - a)
)
g <- g + path("a", "b")
expect_isomorphic(g, make_ring(10))
g <- make_ring(10)
V(g)$name <- letters[1:10]
g <- g - path("a", "b", "c", "d")
expect_isomorphic(g, make_lattice(8) + 2)
expect_isomorphic(
g - V(g)[c("d", "g")],
make_lattice(4) + make_lattice(2) + 2
)
expect_isomorphic(
g - E(g)["f" %--% "g"],
make_lattice(5) + make_lattice(3) + 2
)
})
test_that("disjoint union works for named graphs", {
g1 <- g2 <- make_ring(10)
g1$foo <- "bar"
V(g1)$name <- letters[1:10]
V(g2)$name <- letters[11:20]
E(g1)$weight <- 1:10
E(g2)$weight <- 10:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:20
E(g1)$b1 <- 1:10
E(g2)$b2 <- 11:20
g <- disjoint_union(g1, g2)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2", "name")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight")
)
expect_equal(V(g)$name, letters[1:20])
expect_equal(V(g)$a1, c(1:10, rep(NA, 10)))
expect_equal(V(g)$a2, c(rep(NA, 10), 11:20))
expect_equal(E(g)$weight, c(1:10, 10:1))
expect_equal(E(g)$b1, c(1:10, rep(NA, 10)))
expect_equal(E(g)$b2, c(rep(NA, 10), 11:20))
})
test_that("disjoint union gives warning for non-unique vertex names", {
g1 <- make_ring(5)
V(g1)$name <- letters[1:5]
g2 <- make_ring(5)
V(g2)$name <- letters[5:9]
expect_warning(
disjoint_union(g1, g2),
"Duplicate vertex names in disjoint union"
)
})
test_that("union of unnamed graphs works", {
g1 <- make_ring(10)
g2 <- make_ring(13)
g1$foo <- "bar"
E(g1)$weight <- 1:10
E(g2)$weight <- 13:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:23
E(g1)$b1 <- letters[1:10]
E(g2)$b2 <- letters[11:23]
g <- union.igraph(g1, g2)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight_1", "weight_2")
)
df1 <- as_data_frame(g)
df1 <- df1[order(df1$from, df1$to), c(1, 2, 3, 5, 4, 6)]
df2 <- merge(
as_data_frame(g1),
as_data_frame(g2),
by = c("from", "to"),
all = TRUE
)
rownames(df1) <- seq_len(nrow(df1))
colnames(df2) <- c("from", "to", "weight_1", "b1", "weight_2", "b2")
expect_equal(df1, df2)
})
test_that("union of named graphs works", {
g1 <- make_ring(10)
g2 <- make_ring(13)
V(g1)$name <- letters[seq_len(vcount(g1))]
V(g2)$name <- letters[seq_len(vcount(g2))]
g1$foo <- "bar"
E(g1)$weight <- 1:10
E(g2)$weight <- 13:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:23
E(g1)$b1 <- letters[1:10]
E(g2)$b2 <- letters[11:23]
g <- union.igraph(g1, g2)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2", "name")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight_1", "weight_2")
)
df1 <- as_data_frame(g, what = "both")
g.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
a1 a2 name
a 1 11 a
b 2 12 b
c 3 13 c
d 4 14 d
e 5 15 e
f 6 16 f
g 7 17 g
h 8 18 h
i 9 19 i
j 10 20 j
k NA 21 k
l NA 22 l
m NA 23 m
"
)
)
expect_equal(df1$vertices, g.v)
g.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to weight_1 weight_2 b1 b2
1 l m NA 2 NA v
2 k l NA 3 NA u
3 j k NA 4 NA t
4 i j 9 5 i s
5 h i 8 6 h r
6 g h 7 7 g q
7 f g 6 8 f p
8 e f 5 9 e o
9 d e 4 10 d n
10 c d 3 11 c m
11 b c 2 12 b l
12 a m NA 1 NA w
13 a j 10 NA j NA
14 a b 1 13 a k
"
)
)
rownames(df1$edges) <- rownames(df1$edges)
expect_equal(df1$edges, g.e)
})
test_that("intersection of named graphs works", {
g1 <- make_ring(10)
g2 <- make_ring(13)
V(g1)$name <- letters[V(g1)]
V(g2)$name <- letters[V(g2)]
g1$foo <- "bar"
E(g1)$weight <- 1:10
E(g2)$weight <- 13:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:23
E(g1)$b1 <- letters[1:10]
E(g2)$b2 <- letters[11:23]
g <- intersection(g1, g2, keep.all.vertices = FALSE)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2", "name")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight_1", "weight_2")
)
df1 <- as_data_frame(g, what = "both")
g.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to weight_1 weight_2 b1 b2
1 i j 9 5 i s
2 h i 8 6 h r
3 g h 7 7 g q
4 f g 6 8 f p
5 e f 5 9 e o
6 d e 4 10 d n
7 c d 3 11 c m
8 b c 2 12 b l
9 a b 1 13 a k
"
)
)
rownames(df1$edges) <- rownames(df1$edges)
expect_equal(df1$edges, g.e)
g.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
a1 a2 name
a 1 11 a
b 2 12 b
c 3 13 c
d 4 14 d
e 5 15 e
f 6 16 f
g 7 17 g
h 8 18 h
i 9 19 i
j 10 20 j
"
)
)
expect_equal(df1$vertices, g.v)
gg <- intersection(g1, g2, keep.all.vertices = TRUE)
df2 <- as_data_frame(gg, what = "both")
rownames(df2$edges) <- rownames(df2$edges)
expect_equal(df2$edges, g.e)
gg.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
a1 a2 name
a 1 11 a
b 2 12 b
c 3 13 c
d 4 14 d
e 5 15 e
f 6 16 f
g 7 17 g
h 8 18 h
i 9 19 i
j 10 20 j
k NA 21 k
l NA 22 l
m NA 23 m
"
)
)
expect_equal(df2$vertices, gg.v)
})
test_that("difference of named graphs works", {
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
V(g1)$name <- letters[1:10]
V(g2)$name <- letters[1:11]
g <- g1 %u% g2
sg <- make_ring(4)
V(sg)$name <- letters[c(1, 2, 3, 11)]
df1 <- as_data_frame(g - sg, what = "both")
t1.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to
1 a j
2 b k
3 c d
4 j k
5 i k
6 h k
7 g k
8 f k
9 e k
10 d k
11 d e
12 e f
13 f g
14 g h
15 h i
16 i j
"
)
)
rownames(df1$edges) <- rownames(df1$edges)
expect_equal(df1$edges, t1.e)
expect_equal(
df1$vertices,
data.frame(
row.names = letters[1:11],
name = letters[1:11],
stringsAsFactors = FALSE
)
)
gg <- sg - g
expect_ecount(gg, 0)
expect_equal(V(gg)$name, letters[c(1:3, 11)])
})
test_that("intersection of non-named graphs keeps attributes properly", {
withr::local_seed(42)
g <- sample_gnp(10, 1 / 2)
g2 <- sample_gnp(10, 1 / 2)
E(g)$weight <- sample(ecount(g))
E(g2)$weight <- sample(ecount(g2))
gi <- intersection(g, g2)
rn <- function(D) {
rownames(D) <- paste(D[, 1], D[, 2], sep = "-")
D
}
df <- rn(as_data_frame(g))
df2 <- rn(as_data_frame(g2))
dfi <- rn(as_data_frame(gi))
expect_equal(df[rownames(dfi), ], dfi[, 1:3], ignore_attr = TRUE)
expect_equal(df2[rownames(dfi), ], dfi[, c(1, 2, 4)], ignore_attr = TRUE)
})
test_that("union of non-named graphs keeps attributes properly", {
withr::local_seed(42)
g <- sample_gnp(10, 1 / 2)
g2 <- sample_gnp(10, 1 / 2)
E(g)$weight <- sample(ecount(g))
E(g2)$weight <- sample(ecount(g2))
gu <- union.igraph(g, g2)
rn <- function(D) {
rownames(D) <- paste(D[, 1], D[, 2], sep = "-")
D
}
df <- rn(as_data_frame(g))
df2 <- rn(as_data_frame(g2))
dfu <- rn(as_data_frame(gu))
expect_equal(dfu[rownames(df), 1:3], df, ignore_attr = TRUE)
expect_equal(dfu[rownames(df2), c(1, 2, 4)], df2, ignore_attr = TRUE)
expect_equal(
dfu[!rownames(dfu) %in% rownames(df), 3],
rep(NA_real_, ecount(gu) - ecount(g))
)
expect_equal(
dfu[!rownames(dfu) %in% rownames(df2), 4],
rep(NA_real_, ecount(gu) - ecount(g2))
)
})
test_that("c on attached vs", {
g <- make_ring(10)
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(get_vs_graph_id(c(vg, vg2)), get_graph_id(g))
vg <- V(g)
vg2 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(ignore_attr = TRUE, c(vg2, vg), V(g))
vg <- V(g)[c(2, 5, 6, 8)]
expect_equal(ignore_attr = TRUE, c(vg, vg), V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)])
})
test_that("c on detached vs", {
g <- make_ring(10)
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
vg3 <- V(g)
vg4 <- V(g)[FALSE]
vg5 <- V(g)[c(2, 5, 6, 8)]
vg6 <- V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]
rm(g)
gc()
expect_equal(ignore_attr = TRUE, c(vg, vg2), vg3)
expect_equal(ignore_attr = TRUE, c(vg3, vg4), vg3)
expect_equal(ignore_attr = TRUE, c(vg4, vg3), vg3)
expect_equal(ignore_attr = TRUE, c(vg5, vg5), vg6)
})
test_that("c on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(names(c(vg, vg2)), names(V(g)))
vg <- V(g)
vg2 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(names(c(vg, vg2)), names(V(g)))
expect_equal(ignore_attr = TRUE, c(vg2, vg), V(g))
expect_equal(names(c(vg2, vg)), names(V(g)))
vg <- V(g)[c(2, 5, 6, 8)]
expect_equal(ignore_attr = TRUE, c(vg, vg), V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)])
expect_equal(names(c(vg, vg)), names(V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]))
})
test_that("c on detached vs, names", {
g <- make_ring(10)
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
vg3 <- V(g)
vg4 <- V(g)[FALSE]
vg5 <- V(g)[c(2, 5, 6, 8)]
vg6 <- V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]
rm(g)
gc()
expect_equal(ignore_attr = TRUE, c(vg, vg2), vg3)
expect_equal(names(c(vg, vg2)), names(vg3))
expect_equal(ignore_attr = TRUE, c(vg3, vg4), vg3)
expect_equal(names(c(vg3, vg4)), names(vg3))
expect_equal(ignore_attr = TRUE, c(vg4, vg3), vg3)
expect_equal(names(c(vg3, vg4)), names(vg3))
expect_equal(ignore_attr = TRUE, c(vg5, vg5), vg6)
expect_equal(names(c(vg5, vg5)), names(vg6))
})
test_that("union on attached vs", {
g <- make_ring(10)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
vu <- union(v1, v2)
expect_equal(ignore_attr = TRUE, vu, V(g))
expect_equal(ignore_attr = TRUE, union(V(g)), V(g))
v3 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, union(V(g), v3), V(g))
expect_equal(ignore_attr = TRUE, union(v3, V(g), v3), V(g))
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
})
test_that("union on detached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
vu <- union(v1, v2)
v3 <- V(g)[FALSE]
rm(g)
gc()
expect_equal(ignore_attr = TRUE, vu, vg)
expect_equal(ignore_attr = TRUE, union(vg), vg)
expect_equal(ignore_attr = TRUE, union(vg, v3), vg)
expect_equal(ignore_attr = TRUE, union(v3, vg, v3), vg)
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
})
test_that("union on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
vu <- union(v1, v2)
expect_equal(ignore_attr = TRUE, vu, V(g))
expect_equal(names(vu), names(V(g)))
expect_equal(ignore_attr = TRUE, union(V(g)), V(g))
expect_equal(names(union(V(g))), names(V(g)))
v3 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, union(V(g), v3), V(g))
expect_equal(names(union(V(g), v3)), names(V(g)))
expect_equal(ignore_attr = TRUE, union(v3, V(g), v3), V(g))
expect_equal(names(union(v3, V(g), v3)), names(V(g)))
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(names(union(v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(names(union(v3, v3, v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
expect_equal(names(union(v3, v3)), names(v3))
})
test_that("union on detached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
rm(g)
gc()
vu <- union(v1, v2)
expect_equal(ignore_attr = TRUE, vu, vg)
expect_equal(names(vu), names(vg))
expect_equal(ignore_attr = TRUE, union(vg), vg)
expect_equal(names(union(vg)), names(vg))
expect_equal(ignore_attr = TRUE, union(vg, v3), vg)
expect_equal(names(union(vg, v3)), names(vg))
expect_equal(ignore_attr = TRUE, union(v3, vg, v3), vg)
expect_equal(names(union(v3, vg, v3)), names(vg))
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(names(union(v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(names(union(v3, v3, v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
expect_equal(names(union(v3, v3)), names(v3))
})
test_that("intersection on attached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
})
test_that("intersection on detached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
rm(g)
gc()
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
})
test_that("intersection on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
expect_equal(names(vi1), names(v12))
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
expect_equal(names(vi2), names(v13))
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
expect_equal(names(vi3), names(v14))
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
expect_equal(names(vi4), names(v1))
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
expect_equal(names(vi5), names(v24))
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
expect_equal(names(vi6), names(v3))
})
test_that("intersection on detached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
rm(g)
gc()
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
expect_equal(names(vi1), names(v12))
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
expect_equal(names(vi2), names(v13))
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
expect_equal(names(vi3), names(v14))
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
expect_equal(names(vi4), names(v1))
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
expect_equal(names(vi5), names(v24))
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
expect_equal(names(vi6), names(v3))
})
test_that("difference on attached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(ignore_attr = TRUE, vd6, vr6)
})
test_that("difference on detached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
rm(g)
gc()
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(ignore_attr = TRUE, vd6, vr6)
})
test_that("difference on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(names(vd1), names(vr1))
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(names(vd2), names(vr2))
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(names(vd3), names(vr3))
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(names(vd4), names(vr4))
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(names(vd5), names(vr5))
expect_equal(ignore_attr = TRUE, vd6, vr6)
expect_equal(names(vd6), names(vr6))
})
test_that("difference on detached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
rm(g)
gc()
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(names(vd1), names(vr1))
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(names(vd2), names(vr2))
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(names(vd3), names(vr3))
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(names(vd4), names(vr4))
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(names(vd5), names(vr5))
expect_equal(ignore_attr = TRUE, vd6, vr6)
expect_equal(names(vd6), names(vr6))
})
test_that("rev on attached vs", {
for (i in 1:10) {
g <- make_ring(10)
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
}
})
test_that("rev on detached vs", {
for (i in 1:10) {
g <- make_ring(10)
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
rm(g)
gc()
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
}
})
test_that("rev on attached vs, names", {
for (i in 1:10) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
expect_equal(names(vg2), names(vgr))
}
})
test_that("rev on detached vs, names", {
for (i in 1:10) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
rm(g)
gc()
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
expect_equal(names(vg2), names(vgr))
}
})
unique_tests <- list(
list(1:5, 1:5),
list(c(1, 1, 2:5), 1:5),
list(c(1, 1, 1, 1), 1),
list(c(1, 2, 2, 2), 1:2),
list(c(2, 2, 1, 1), 2:1),
list(c(1, 2, 1, 2), 1:2),
list(c(), c())
)
test_that("unique on attached vs", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
vg <- unique(V(g)[d[[1]]])
vr <- V(g)[d[[2]]]
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
test_that("unique on detached vs", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
vg <- V(g)[d[[1]]]
vr <- V(g)[d[[2]]]
rm(g)
gc()
vg <- unique(vg)
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
test_that("unique on attached vs, names", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- unique(V(g)[d[[1]]])
vr <- V(g)[d[[2]]]
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
test_that("unique on detached vs, names", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)[d[[1]]]
vr <- V(g)[d[[2]]]
rm(g)
gc()
vg <- unique(vg)
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
igraph/rigraph documentation built on June 13, 2025, 1:44 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("union() works", {
order_by_two_first_columns <- function(x) x[order(x[, 1], x[, 2]), ]
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gu <- union(g1, g2)
expect_vcount(gu, 11)
expect_ecount(gu, 20)
expect_equal(
order_by_two_first_columns(rbind(as_edgelist(g1), as_edgelist(g2))),
order_by_two_first_columns(as_edgelist(gu))
)
expect_isomorphic(difference(gu, g1), g2)
expect_isomorphic(intersection(gu, g2), g2)
})
test_that("disjoint_union() works", {
order_by_two_first_columns <- function(x) x[order(x[, 1], x[, 2]), ]
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gdu <- disjoint_union(g1, g2)
expect_equal(
order_by_two_first_columns(as_edgelist(gdu)),
order_by_two_first_columns(rbind(
as_edgelist(g1),
as_edgelist(g2) + vcount(g1)
))
)
})
test_that("disjoint_union() does not convert types", {
# https://github.com/igraph/rigraph/issues/761
g1 <- make_graph(~ A - -B)
g2 <- make_graph(~ D - -E)
g1 <- set_edge_attr(g1, "date", value = as.POSIXct(c("2021-01-01 01:01:01")))
g2 <- set_edge_attr(g2, "date", value = as.POSIXct(c("2021-03-03 03:03:03")))
u <- disjoint_union(g1, g2)
expect_s3_class(E(u)$date, c("POSIXct", "POSIXt"))
})
test_that("intersection() works", {
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gu <- union(g1, g2)
expect_isomorphic(intersection(gu, g1, keep.all.vertices = FALSE), g1)
})
test_that("complementer() works", {
g2 <- make_star(11, center = 11, mode = "undirected")
x <- complementer(complementer(g2))
expect_identical_graphs(x, g2)
gnp <- sample_gnp(50, 3 / 50)
gnp_comp <- complementer(gnp)
gnp_comp_comp <- complementer(gnp_comp)
expect_isomorphic(gnp, gnp_comp_comp)
})
test_that("compose() works", {
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
gu <- union(g1, g2)
gc <- compose(gu, g1)
expect_vcount(gc, 11)
expect_ecount(gc, 60)
expect_equal(diameter(gc), 2)
gnp <- sample_gnp(50, 3 / 50, directed = TRUE)
gnp_i <- make_graph(rep(1:vcount(gnp), each = 2), directed = TRUE)
gnp_comp1 <- compose(gnp, gnp_i)
gnp_comp2 <- compose(gnp_i, gnp)
expect_isomorphic(gnp, gnp_comp1)
expect_isomorphic(gnp, gnp_comp2)
})
test_that("compose works for named graphs", {
g1 <- graph_from_literal(A - B:D:E, B - C:D, C - D, D - E)
g2 <- graph_from_literal(A - B - E - A)
V(g1)$bar1 <- seq_len(vcount(g1))
V(g2)$bar2 <- seq_len(vcount(g2))
V(g1)$foo <- letters[seq_len(vcount(g1))]
V(g2)$foo <- letters[seq_len(vcount(g2))]
E(g1)$bar1 <- seq_len(ecount(g1))
E(g2)$bar2 <- seq_len(ecount(g2))
E(g1)$foo <- letters[seq_len(ecount(g1))]
E(g2)$foo <- letters[seq_len(ecount(g2))]
g <- compose(g1, g2)
df <- as_data_frame(g, what = "both")
df.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
bar1 foo_1 foo_2 bar2 name
A 1 a a 1 A
B 2 b b 2 B
D 3 c NA NA D
E 4 d c 3 E
C 5 e NA NA C
"
)
)
expect_equal(df$vertices, df.v)
df.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to bar1 foo_1 foo_2 bar2
1 A B 3 c c 3
2 A A 3 c b 2
3 A E 1 a c 3
4 A A 1 a a 1
5 B E 1 a b 2
6 B B 1 a a 1
7 B D 6 f c 3
8 A D 6 f b 2
9 D E 4 d c 3
10 A D 4 d a 1
11 D E 2 b b 2
12 B D 2 b a 1
13 E E 3 c b 2
14 B E 3 c a 1
15 E C 5 e c 3
16 A C 5 e a 1
"
)
)
rownames(df$edges) <- rownames(df$edges)
expect_equal(df$edges, df.e)
})
test_that("Union of directed named graphs", {
graphs <- list(
make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 3, 2 -+ 3, 2 -+ 4, 3 -+ 4, 1 -+ 5, 3 -+ 5),
make_graph(~ 1:2:3:4:5, 2 -+ 3, 1 -+ 4, 2 -+ 4, 3 -+ 4, 2 -+ 5, 3 -+ 5),
make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 3, 2 -+ 4, 3 -+ 4, 1 -+ 5, 4 -+ 5)
)
gg <- union.igraph(graphs)
expect_vcount(gg, 5)
expect_ecount(gg, 10)
})
test_that("edge reversal works", {
directed_graph <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4)
reverse_directed_graph <- reverse_edges(directed_graph, 1:3)
expected <- make_graph(~ 1 +- 2, 1 +- 3, 1 +- 4, 2 -+ 3, 3 -+ 4)
expect_isomorphic(reverse_directed_graph, expected)
reverse_all_directed_graph <- reverse_edges(directed_graph)
expect_vcount(reverse_all_directed_graph, vcount(directed_graph))
expect_equal(
as_edgelist(reverse_all_directed_graph),
as_edgelist(directed_graph)[, c(2, 1)]
)
undirected_graph <- make_graph(~ 1 - -2, 1 - -3, 1 - -4, 2 - -3, 3 - -4)
reverse_undirected_graph <- reverse_edges(undirected_graph, 1:3)
expect_identical_graphs(undirected_graph, reverse_undirected_graph)
isolated_vertices_g <- make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 4)
reverse_isolated_vertices_g <- reverse_edges(isolated_vertices_g)
expect_vcount(reverse_isolated_vertices_g, vcount(isolated_vertices_g))
expect_equal(
as_edgelist(reverse_isolated_vertices_g),
as_edgelist(isolated_vertices_g)[, c(2, 1)]
)
})
test_that("t() is aliased to edge reversal for graphs", {
g <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4)
expect_vcount(t(g), vcount(g))
expect_equal(as_edgelist(t(g)), as_edgelist(g)[, c(2, 1)])
})
test_that("vertices() works", {
g_all_unnamed <- make_empty_graph(1) + vertices("a", "b")
expect_s3_class(V(g_all_unnamed), "igraph.vs")
expect_identical(V(g_all_unnamed)$name, c(NA, "a", "b"))
g_mix_named_unnamed <- make_empty_graph(1) + vertices("a", "b", foo = 5)
expect_s3_class(V(g_mix_named_unnamed), "igraph.vs")
expect_true(is.na(V(g_mix_named_unnamed)$name[1]))
expect_identical(V(g_mix_named_unnamed)$name[-1], c("a", "b"))
expect_equal(V(g_mix_named_unnamed)$foo, c(NA, 5, 5))
g_mix_bigger_attribute <- make_empty_graph(1) +
vertices("a", "b", "c", foo = 5:7, bar = 8)
expect_s3_class(V(g_mix_bigger_attribute), "igraph.vs")
expect_identical(V(g_mix_bigger_attribute)$name, c(NA, "a", "b", "c"))
expect_equal(V(g_mix_bigger_attribute)$foo, c(NA, 5, 6, 7))
expect_equal(V(g_mix_bigger_attribute)$bar, c(NA, 8, 8, 8))
g_one_unnamed <- make_empty_graph(1) + vertices(letters)
expect_s3_class(V(g_one_unnamed), "igraph.vs")
expect_identical(V(g_one_unnamed)$name, c(NA, letters))
g_all_named <- make_empty_graph(1) + vertices(foo = 5:7)
expect_s3_class(V(g_all_named), "igraph.vs")
expect_null(V(g_all_named)$name)
expect_identical(V(g_all_named)$foo, c(NA, 5:7))
g_all_named_empty <- make_empty_graph(1) + vertices(foo = numeric())
expect_s3_class(V(g_all_named_empty), "igraph.vs")
expect_null(V(g_all_named_empty)$name)
expect_identical(V(g_all_named_empty)$foo, NA_real_)
g_none <- make_empty_graph(1) + vertices()
expect_s3_class(V(g_none), "igraph.vs")
expect_null(V(g_none)$name)
expect_snapshot_error(make_empty_graph(1) + vertices("a", "b", foo = 5:7))
})
test_that("infix operators work", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
E(g)$name <- LETTERS[1:10]
g <- g - c("a", "b")
expect_vcount(g, 8)
expect_ecount(g, 7)
expect_isomorphic(g, make_lattice(8))
g <- g - edge("e|f")
expect_isomorphic(g, make_lattice(5) + make_lattice(3))
g <- g - edge("H")
expect_isomorphic(g, graph_from_literal(a - b - c, d - e - f, g - h))
g <- make_ring(10)
V(g)$name <- letters[1:10]
g <- g - path("a", "b")
expect_isomorphic(
g,
graph_from_literal(a, b - c - d - e - f - g - h - i - j - a)
)
g <- g + path("a", "b")
expect_isomorphic(g, make_ring(10))
g <- make_ring(10)
V(g)$name <- letters[1:10]
g <- g - path("a", "b", "c", "d")
expect_isomorphic(g, make_lattice(8) + 2)
expect_isomorphic(
g - V(g)[c("d", "g")],
make_lattice(4) + make_lattice(2) + 2
)
expect_isomorphic(
g - E(g)["f" %--% "g"],
make_lattice(5) + make_lattice(3) + 2
)
})
test_that("disjoint union works for named graphs", {
g1 <- g2 <- make_ring(10)
g1$foo <- "bar"
V(g1)$name <- letters[1:10]
V(g2)$name <- letters[11:20]
E(g1)$weight <- 1:10
E(g2)$weight <- 10:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:20
E(g1)$b1 <- 1:10
E(g2)$b2 <- 11:20
g <- disjoint_union(g1, g2)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2", "name")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight")
)
expect_equal(V(g)$name, letters[1:20])
expect_equal(V(g)$a1, c(1:10, rep(NA, 10)))
expect_equal(V(g)$a2, c(rep(NA, 10), 11:20))
expect_equal(E(g)$weight, c(1:10, 10:1))
expect_equal(E(g)$b1, c(1:10, rep(NA, 10)))
expect_equal(E(g)$b2, c(rep(NA, 10), 11:20))
})
test_that("disjoint union gives warning for non-unique vertex names", {
g1 <- make_ring(5)
V(g1)$name <- letters[1:5]
g2 <- make_ring(5)
V(g2)$name <- letters[5:9]
expect_warning(
disjoint_union(g1, g2),
"Duplicate vertex names in disjoint union"
)
})
test_that("union of unnamed graphs works", {
g1 <- make_ring(10)
g2 <- make_ring(13)
g1$foo <- "bar"
E(g1)$weight <- 1:10
E(g2)$weight <- 13:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:23
E(g1)$b1 <- letters[1:10]
E(g2)$b2 <- letters[11:23]
g <- union.igraph(g1, g2)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight_1", "weight_2")
)
df1 <- as_data_frame(g)
df1 <- df1[order(df1$from, df1$to), c(1, 2, 3, 5, 4, 6)]
df2 <- merge(
as_data_frame(g1),
as_data_frame(g2),
by = c("from", "to"),
all = TRUE
)
rownames(df1) <- seq_len(nrow(df1))
colnames(df2) <- c("from", "to", "weight_1", "b1", "weight_2", "b2")
expect_equal(df1, df2)
})
test_that("union of named graphs works", {
g1 <- make_ring(10)
g2 <- make_ring(13)
V(g1)$name <- letters[seq_len(vcount(g1))]
V(g2)$name <- letters[seq_len(vcount(g2))]
g1$foo <- "bar"
E(g1)$weight <- 1:10
E(g2)$weight <- 13:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:23
E(g1)$b1 <- letters[1:10]
E(g2)$b2 <- letters[11:23]
g <- union.igraph(g1, g2)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2", "name")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight_1", "weight_2")
)
df1 <- as_data_frame(g, what = "both")
g.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
a1 a2 name
a 1 11 a
b 2 12 b
c 3 13 c
d 4 14 d
e 5 15 e
f 6 16 f
g 7 17 g
h 8 18 h
i 9 19 i
j 10 20 j
k NA 21 k
l NA 22 l
m NA 23 m
"
)
)
expect_equal(df1$vertices, g.v)
g.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to weight_1 weight_2 b1 b2
1 l m NA 2 NA v
2 k l NA 3 NA u
3 j k NA 4 NA t
4 i j 9 5 i s
5 h i 8 6 h r
6 g h 7 7 g q
7 f g 6 8 f p
8 e f 5 9 e o
9 d e 4 10 d n
10 c d 3 11 c m
11 b c 2 12 b l
12 a m NA 1 NA w
13 a j 10 NA j NA
14 a b 1 13 a k
"
)
)
rownames(df1$edges) <- rownames(df1$edges)
expect_equal(df1$edges, g.e)
})
test_that("intersection of named graphs works", {
g1 <- make_ring(10)
g2 <- make_ring(13)
V(g1)$name <- letters[V(g1)]
V(g2)$name <- letters[V(g2)]
g1$foo <- "bar"
E(g1)$weight <- 1:10
E(g2)$weight <- 13:1
V(g1)$a1 <- 1:10
V(g2)$a2 <- 11:23
E(g1)$b1 <- letters[1:10]
E(g2)$b2 <- letters[11:23]
g <- intersection(g1, g2, keep.all.vertices = FALSE)
expect_equal(
sort(graph_attr_names(g)),
c("circular_1", "circular_2", "foo", "mutual_1", "mutual_2", "name_1", "name_2")
)
expect_equal(
sort(vertex_attr_names(g)),
c("a1", "a2", "name")
)
expect_equal(
sort(edge_attr_names(g)),
c("b1", "b2", "weight_1", "weight_2")
)
df1 <- as_data_frame(g, what = "both")
g.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to weight_1 weight_2 b1 b2
1 i j 9 5 i s
2 h i 8 6 h r
3 g h 7 7 g q
4 f g 6 8 f p
5 e f 5 9 e o
6 d e 4 10 d n
7 c d 3 11 c m
8 b c 2 12 b l
9 a b 1 13 a k
"
)
)
rownames(df1$edges) <- rownames(df1$edges)
expect_equal(df1$edges, g.e)
g.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
a1 a2 name
a 1 11 a
b 2 12 b
c 3 13 c
d 4 14 d
e 5 15 e
f 6 16 f
g 7 17 g
h 8 18 h
i 9 19 i
j 10 20 j
"
)
)
expect_equal(df1$vertices, g.v)
gg <- intersection(g1, g2, keep.all.vertices = TRUE)
df2 <- as_data_frame(gg, what = "both")
rownames(df2$edges) <- rownames(df2$edges)
expect_equal(df2$edges, g.e)
gg.v <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
a1 a2 name
a 1 11 a
b 2 12 b
c 3 13 c
d 4 14 d
e 5 15 e
f 6 16 f
g 7 17 g
h 8 18 h
i 9 19 i
j 10 20 j
k NA 21 k
l NA 22 l
m NA 23 m
"
)
)
expect_equal(df2$vertices, gg.v)
})
test_that("difference of named graphs works", {
g1 <- make_ring(10)
g2 <- make_star(11, center = 11, mode = "undirected")
V(g1)$name <- letters[1:10]
V(g2)$name <- letters[1:11]
g <- g1 %u% g2
sg <- make_ring(4)
V(sg)$name <- letters[c(1, 2, 3, 11)]
df1 <- as_data_frame(g - sg, what = "both")
t1.e <- read.table(
stringsAsFactors = FALSE,
textConnection(
"
from to
1 a j
2 b k
3 c d
4 j k
5 i k
6 h k
7 g k
8 f k
9 e k
10 d k
11 d e
12 e f
13 f g
14 g h
15 h i
16 i j
"
)
)
rownames(df1$edges) <- rownames(df1$edges)
expect_equal(df1$edges, t1.e)
expect_equal(
df1$vertices,
data.frame(
row.names = letters[1:11],
name = letters[1:11],
stringsAsFactors = FALSE
)
)
gg <- sg - g
expect_ecount(gg, 0)
expect_equal(V(gg)$name, letters[c(1:3, 11)])
})
test_that("intersection of non-named graphs keeps attributes properly", {
withr::local_seed(42)
g <- sample_gnp(10, 1 / 2)
g2 <- sample_gnp(10, 1 / 2)
E(g)$weight <- sample(ecount(g))
E(g2)$weight <- sample(ecount(g2))
gi <- intersection(g, g2)
rn <- function(D) {
rownames(D) <- paste(D[, 1], D[, 2], sep = "-")
D
}
df <- rn(as_data_frame(g))
df2 <- rn(as_data_frame(g2))
dfi <- rn(as_data_frame(gi))
expect_equal(df[rownames(dfi), ], dfi[, 1:3], ignore_attr = TRUE)
expect_equal(df2[rownames(dfi), ], dfi[, c(1, 2, 4)], ignore_attr = TRUE)
})
test_that("union of non-named graphs keeps attributes properly", {
withr::local_seed(42)
g <- sample_gnp(10, 1 / 2)
g2 <- sample_gnp(10, 1 / 2)
E(g)$weight <- sample(ecount(g))
E(g2)$weight <- sample(ecount(g2))
gu <- union.igraph(g, g2)
rn <- function(D) {
rownames(D) <- paste(D[, 1], D[, 2], sep = "-")
D
}
df <- rn(as_data_frame(g))
df2 <- rn(as_data_frame(g2))
dfu <- rn(as_data_frame(gu))
expect_equal(dfu[rownames(df), 1:3], df, ignore_attr = TRUE)
expect_equal(dfu[rownames(df2), c(1, 2, 4)], df2, ignore_attr = TRUE)
expect_equal(
dfu[!rownames(dfu) %in% rownames(df), 3],
rep(NA_real_, ecount(gu) - ecount(g))
)
expect_equal(
dfu[!rownames(dfu) %in% rownames(df2), 4],
rep(NA_real_, ecount(gu) - ecount(g2))
)
})
test_that("c on attached vs", {
g <- make_ring(10)
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(get_vs_graph_id(c(vg, vg2)), get_graph_id(g))
vg <- V(g)
vg2 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(ignore_attr = TRUE, c(vg2, vg), V(g))
vg <- V(g)[c(2, 5, 6, 8)]
expect_equal(ignore_attr = TRUE, c(vg, vg), V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)])
})
test_that("c on detached vs", {
g <- make_ring(10)
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
vg3 <- V(g)
vg4 <- V(g)[FALSE]
vg5 <- V(g)[c(2, 5, 6, 8)]
vg6 <- V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]
rm(g)
gc()
expect_equal(ignore_attr = TRUE, c(vg, vg2), vg3)
expect_equal(ignore_attr = TRUE, c(vg3, vg4), vg3)
expect_equal(ignore_attr = TRUE, c(vg4, vg3), vg3)
expect_equal(ignore_attr = TRUE, c(vg5, vg5), vg6)
})
test_that("c on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(names(c(vg, vg2)), names(V(g)))
vg <- V(g)
vg2 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, c(vg, vg2), V(g))
expect_equal(names(c(vg, vg2)), names(V(g)))
expect_equal(ignore_attr = TRUE, c(vg2, vg), V(g))
expect_equal(names(c(vg2, vg)), names(V(g)))
vg <- V(g)[c(2, 5, 6, 8)]
expect_equal(ignore_attr = TRUE, c(vg, vg), V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)])
expect_equal(names(c(vg, vg)), names(V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]))
})
test_that("c on detached vs, names", {
g <- make_ring(10)
vg <- V(g)[1:5]
vg2 <- V(g)[6:10]
vg3 <- V(g)
vg4 <- V(g)[FALSE]
vg5 <- V(g)[c(2, 5, 6, 8)]
vg6 <- V(g)[c(2, 5, 6, 8, 2, 5, 6, 8)]
rm(g)
gc()
expect_equal(ignore_attr = TRUE, c(vg, vg2), vg3)
expect_equal(names(c(vg, vg2)), names(vg3))
expect_equal(ignore_attr = TRUE, c(vg3, vg4), vg3)
expect_equal(names(c(vg3, vg4)), names(vg3))
expect_equal(ignore_attr = TRUE, c(vg4, vg3), vg3)
expect_equal(names(c(vg3, vg4)), names(vg3))
expect_equal(ignore_attr = TRUE, c(vg5, vg5), vg6)
expect_equal(names(c(vg5, vg5)), names(vg6))
})
test_that("union on attached vs", {
g <- make_ring(10)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
vu <- union(v1, v2)
expect_equal(ignore_attr = TRUE, vu, V(g))
expect_equal(ignore_attr = TRUE, union(V(g)), V(g))
v3 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, union(V(g), v3), V(g))
expect_equal(ignore_attr = TRUE, union(v3, V(g), v3), V(g))
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
})
test_that("union on detached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
vu <- union(v1, v2)
v3 <- V(g)[FALSE]
rm(g)
gc()
expect_equal(ignore_attr = TRUE, vu, vg)
expect_equal(ignore_attr = TRUE, union(vg), vg)
expect_equal(ignore_attr = TRUE, union(vg, v3), vg)
expect_equal(ignore_attr = TRUE, union(v3, vg, v3), vg)
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
})
test_that("union on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
vu <- union(v1, v2)
expect_equal(ignore_attr = TRUE, vu, V(g))
expect_equal(names(vu), names(V(g)))
expect_equal(ignore_attr = TRUE, union(V(g)), V(g))
expect_equal(names(union(V(g))), names(V(g)))
v3 <- V(g)[FALSE]
expect_equal(ignore_attr = TRUE, union(V(g), v3), V(g))
expect_equal(names(union(V(g), v3)), names(V(g)))
expect_equal(ignore_attr = TRUE, union(v3, V(g), v3), V(g))
expect_equal(names(union(v3, V(g), v3)), names(V(g)))
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(names(union(v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(names(union(v3, v3, v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
expect_equal(names(union(v3, v3)), names(v3))
})
test_that("union on detached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
rm(g)
gc()
vu <- union(v1, v2)
expect_equal(ignore_attr = TRUE, vu, vg)
expect_equal(names(vu), names(vg))
expect_equal(ignore_attr = TRUE, union(vg), vg)
expect_equal(names(union(vg)), names(vg))
expect_equal(ignore_attr = TRUE, union(vg, v3), vg)
expect_equal(names(union(vg, v3)), names(vg))
expect_equal(ignore_attr = TRUE, union(v3, vg, v3), vg)
expect_equal(names(union(v3, vg, v3)), names(vg))
expect_equal(ignore_attr = TRUE, union(v3), v3)
expect_equal(names(union(v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3, v3), v3)
expect_equal(names(union(v3, v3, v3)), names(v3))
expect_equal(ignore_attr = TRUE, union(v3, v3), v3)
expect_equal(names(union(v3, v3)), names(v3))
})
test_that("intersection on attached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
})
test_that("intersection on detached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
rm(g)
gc()
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
})
test_that("intersection on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
expect_equal(names(vi1), names(v12))
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
expect_equal(names(vi2), names(v13))
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
expect_equal(names(vi3), names(v14))
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
expect_equal(names(vi4), names(v1))
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
expect_equal(names(vi5), names(v24))
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
expect_equal(names(vi6), names(v3))
})
test_that("intersection on detached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
v12 <- V(g)[6:7]
v13 <- V(g)[FALSE]
v14 <- V(g)[1:3]
v24 <- V(g)[FALSE]
rm(g)
gc()
vi1 <- intersection(v1, v2)
expect_equal(ignore_attr = TRUE, vi1, v12)
expect_equal(names(vi1), names(v12))
vi2 <- intersection(v1, v3)
expect_equal(ignore_attr = TRUE, vi2, v13)
expect_equal(names(vi2), names(v13))
vi3 <- intersection(v1, v4)
expect_equal(ignore_attr = TRUE, vi3, v14)
expect_equal(names(vi3), names(v14))
vi4 <- intersection(v1, vg)
expect_equal(ignore_attr = TRUE, vi4, v1)
expect_equal(names(vi4), names(v1))
vi5 <- intersection(v2, v4)
expect_equal(ignore_attr = TRUE, vi5, v24)
expect_equal(names(vi5), names(v24))
vi6 <- intersection(v3, vg)
expect_equal(ignore_attr = TRUE, vi6, v3)
expect_equal(names(vi6), names(v3))
})
test_that("difference on attached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(ignore_attr = TRUE, vd6, vr6)
})
test_that("difference on detached vs", {
g <- make_ring(10)
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
rm(g)
gc()
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(ignore_attr = TRUE, vd6, vr6)
})
test_that("difference on attached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(names(vd1), names(vr1))
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(names(vd2), names(vr2))
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(names(vd3), names(vr3))
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(names(vd4), names(vr4))
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(names(vd5), names(vr5))
expect_equal(ignore_attr = TRUE, vd6, vr6)
expect_equal(names(vd6), names(vr6))
})
test_that("difference on detached vs, names", {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)
v1 <- V(g)[1:7]
v2 <- V(g)[6:10]
v3 <- V(g)[FALSE]
v4 <- V(g)[1:3]
vr1 <- V(g)[8:10]
vr2 <- V(g)
vr3 <- V(g)[1:5]
vr4 <- V(g)[4:7]
vr5 <- V(g)[FALSE]
vr6 <- V(g)[FALSE]
rm(g)
gc()
vd1 <- difference(vg, v1)
vd2 <- difference(vg, v3)
vd3 <- difference(v1, v2)
vd4 <- difference(v1, v4)
vd5 <- difference(v3, v3)
vd6 <- difference(v3, v4)
expect_equal(ignore_attr = TRUE, vd1, vr1)
expect_equal(names(vd1), names(vr1))
expect_equal(ignore_attr = TRUE, vd2, vr2)
expect_equal(names(vd2), names(vr2))
expect_equal(ignore_attr = TRUE, vd3, vr3)
expect_equal(names(vd3), names(vr3))
expect_equal(ignore_attr = TRUE, vd4, vr4)
expect_equal(names(vd4), names(vr4))
expect_equal(ignore_attr = TRUE, vd5, vr5)
expect_equal(names(vd5), names(vr5))
expect_equal(ignore_attr = TRUE, vd6, vr6)
expect_equal(names(vd6), names(vr6))
})
test_that("rev on attached vs", {
for (i in 1:10) {
g <- make_ring(10)
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
}
})
test_that("rev on detached vs", {
for (i in 1:10) {
g <- make_ring(10)
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
rm(g)
gc()
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
}
})
test_that("rev on attached vs, names", {
for (i in 1:10) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
expect_equal(names(vg2), names(vgr))
}
})
test_that("rev on detached vs, names", {
for (i in 1:10) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
idx <- seq_len(i)
vg <- V(g)[idx]
vgr <- V(g)[rev(idx)]
rm(g)
gc()
vg2 <- rev(vg)
expect_equal(ignore_attr = TRUE, vg2, vgr)
expect_equal(names(vg2), names(vgr))
}
})
unique_tests <- list(
list(1:5, 1:5),
list(c(1, 1, 2:5), 1:5),
list(c(1, 1, 1, 1), 1),
list(c(1, 2, 2, 2), 1:2),
list(c(2, 2, 1, 1), 2:1),
list(c(1, 2, 1, 2), 1:2),
list(c(), c())
)
test_that("unique on attached vs", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
vg <- unique(V(g)[d[[1]]])
vr <- V(g)[d[[2]]]
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
test_that("unique on detached vs", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
vg <- V(g)[d[[1]]]
vr <- V(g)[d[[2]]]
rm(g)
gc()
vg <- unique(vg)
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
test_that("unique on attached vs, names", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- unique(V(g)[d[[1]]])
vr <- V(g)[d[[2]]]
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
test_that("unique on detached vs, names", {
sapply(unique_tests, function(d) {
g <- make_ring(10)
V(g)$name <- letters[1:10]
vg <- V(g)[d[[1]]]
vr <- V(g)[d[[2]]]
rm(g)
gc()
vg <- unique(vg)
expect_equal(ignore_attr = TRUE, vg, vr)
})
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.