test_that("assigning and querying attributes work", {
  ring <- graph_from_literal(A - B - C - D - E - F - G - A)
  E(ring)$weight <- seq_len(ecount(ring))

  expect_equal(V(ring)$name, LETTERS[seq_len(vcount(ring))])
  expect_equal(E(ring)$weight, seq_len(ecount(ring)))
})

test_that("bracketing works (not changing attribute of similar graphs)", {
  # https://github.com/igraph/igraph/issues/533
  g <- make_graph(c(1, 2, 1, 3, 3, 4))

  g <- set_vertex_attr(g, name = "weight", value = 1:vcount(g))
  graph2 <- set_vertex_attr(g, name = "weight", value = rep(1, vcount(g)))
  expect_equal(vertex_attr(g, name = "weight"), 1:4)

  g <- set_edge_attr(g, name = "weight", value = 1:ecount(g))
  graph2 <- set_edge_attr(g, name = "weight", value = rep(1, ecount(g)))
  expect_equal(edge_attr(g, name = "weight"), 1:3)

  g <- set_graph_attr(g, name = "name", "foo")
  graph2 <- set_graph_attr(g, name = "name", "foobar")
  expect_equal(graph_attr(g, name = "name"), "foo")
})

test_that("bracketing works with a function (not changing attribute of similar graphs)", {
  # https://github.com/igraph/igraph/issues/533
  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")

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

test_that("bracketing works with shortcuts (not changing attribute of similar graphs)", {
  # https://github.com/igraph/igraph/issues/533
  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")

  copy_test <- function(graph) {
    V(graph)$weight <- rep(1, vcount(graph))
    E(graph)$weight <- rep(1, ecount(graph))
    graph$name <- "foobar"
  }

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

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)
  expect_equal(graph_attr(g), list(name = "toy", layout = cbind(1:4, 1:4)))

  V(g)$name <- letters[1:4]
  V(g)$color <- rainbow(4)
  expect_equal(vertex_attr(g), list(name = letters[1:4], color = rainbow(4)))

  E(g)$weight <- 1:3
  E(g)$label <- LETTERS[1:3]
  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"
  expect_equal(graph_attr(g, "name"), "toy")

  g$layout <- cbind(1:4, 1:4)
  expect_equal(graph_attr(g, "layout"), cbind(1:4, 1:4))

  V(g)$name <- letters[1:4]
  expect_equal(vertex_attr(g, "name"), letters[1:4])

  V(g)$color <- rainbow(4)
  expect_equal(vertex_attr(g, "color"), rainbow(4))

  E(g)$weight <- 1:3
  expect_equal(edge_attr(g, "weight"), 1:3)

  E(g)$label <- LETTERS[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]
  expect_equal(vertex_attr(g, "name", c(1, 3)), letters[c(1, 3)])

  V(g)$color <- as.list(rainbow(4))
  expect_equal(
    vertex_attr(g, "color", c("a", "c")),
    as.list(rainbow(4))[c(1, 3)]
  )

  E(g)$weight <- 1:3
  expect_equal(edge_attr(g, "weight", 2:3), 2:3)

  E(g)$label <- as.list(LETTERS[1: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 on 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", {
  # 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", {
  # https://github.com/igraph/rigraph/issues/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", {
  # https://github.com/igraph/rigraph/issues/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("assert_named_list() works", {
  not_list <- 1:10
  expect_error(assert_named_list(not_list), "named list")

  expect_silent(assert_named_list(list()))

  unnamed_list <- as.list(1:10)
  expect_error(assert_named_list(unnamed_list), "named list")

  empty_name <- rlang::set_names(unnamed_list, c(as.character(1:9), ""))
  expect_error(assert_named_list(empty_name), "named list")

  dups <- rlang::set_names(unnamed_list, rep("bla", 10))
  expect_error(assert_named_list(dups), "named list")
})

test_that("is_bipartite works", {
  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)
  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(g2),
    list(res = TRUE, type = c(rep(FALSE, 7), rep(TRUE, 5)))
  )
})

test_that("without_attr", {
  withr::local_seed(42)
  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)
  g_no_attr <- sample_(gnp(10, 2 / 10), without_attr())

  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", {
  g1 <- 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(g1, g2)
  expect_true(all(!which_loop(g2)))
})


test_that("without_multiple", {
  g1 <- 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(g1, g2)
  expect_true(all(!which_multiple(g2)))
})


test_that("simplified", {
  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(g1, g2)
  expect_true(all(!which_multiple(g2)))
  expect_true(all(!which_loop(g2)))
})


test_that("with_vertex_", {
  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))

  g2 <- make_(
    from_literal(A - A:B:C, B - A:B:C),
    with_vertex_(
      color = "red",
      foo = paste0("xx", 1:3)
    )
  )

  expect_identical_graphs(g1, g2)
  expect_equal(V(g2)$color, rep("red", gorder(g2)))
  expect_equal(V(g2)$foo, paste0("xx", 1:3))

  expect_snapshot(
    make_(from_literal(A - A:B:C, B - A:B:C), with_vertex_(color = 1:2)),
    error = TRUE
  )
})


test_that("with_edge_", {
  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))

  g2 <- make_(
    from_literal(A - A:B:C, B - A:B:C),
    with_edge_(
      color = "red",
      foo = seq_len(3)
    )
  )

  expect_identical_graphs(g1, g2)
  expect_equal(E(g1)$color, E(g2)$color)
  expect_equal(E(g1)$foo, E(g2)$foo)

  expect_snapshot(
    make_(from_literal(A - A:B:C, B - A:B:C), with_edge_(color = 1:2)),
    error = TRUE
  )
})


test_that("with_graph_", {
  g1 <- 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(g1, g2)
  expect_equal(g1$color, g2$color)
  expect_equal(g1$foo, g2$foo)
})


test_that("adding and removing attributes", {
  g1 <- make_empty_graph()
  g2 <- make_empty_graph()

  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(g1, g2)
})

test_that("error messages work", {
  g <- make_full_graph(5)
  expect_snapshot_igraph_error(set_vertex_attr(g, "test", value = c(1, 2)))
  expect_snapshot_igraph_error(set_edge_attr(g, "test", value = c(1, 2)))
  expect_snapshot_igraph_error(delete_graph_attr(g, "a"))
  expect_snapshot_igraph_error(delete_vertex_attr(g, "a"))
  expect_snapshot_igraph_error(delete_edge_attr(g, "a"))
  expect_snapshot_igraph_error(assert_named_list("a"))
  expect_snapshot_igraph_error(assert_named_list(list("a", "b")))
})

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

test_that("assign data.frame attributes works", {
  # https://github.com/igraph/rigraph/issues/1669
  g1 <- make_tree(10, 3)
  edge.attributes(g1) <- head(mtcars, ecount(g1))
  expect_no_error(E(g1)[c(1, 2)])

  g2 <- make_tree(10, 3)
  edge.attributes(g2, E(g2)[1:5]) <- head(mtcars, 5)
  expect_equal(E(g2)$wt, c(mtcars$wt[1:5], rep(NA, ecount(g2) - 5)))
})

test_that("good error message when not using character", {
  ring <- graph_from_literal(A - B - C - D - E - F - G - A)
  expect_snapshot_igraph_error({
    set_graph_attr(ring, 1, 1)
  })
})

test_that("set_vertex_attrs() works", {
  g <- make_ring(10)
  g <- set_vertex_attrs(g, color = "blue", size = 10, name = LETTERS[1:10])
  expect_equal(V(g)$color, rep("blue", vcount(g)))
  expect_equal(V(g)$size, rep(10, vcount(g)))
  expect_equal(V(g)$name, LETTERS[1:10])
  expect_snapshot_igraph_error({
    set_vertex_attrs(g)
  })

  attr_list <- list(age = 42, gender = "F")
  g <- set_vertex_attrs(g, !!!attr_list)
  expect_equal(V(g)$age, rep(42, vcount(g)))
  expect_equal(V(g)$gender, rep("F", vcount(g)))
})
