test-methods.R
In caugi: Causal Graph Interface

test_that("print method works for empty graph", {
  cg <- caugi(class = "DAG")
  output <- capture.output(print(cg))

  expect_true(any(grepl("0 nodes, 0 edges", output, fixed = TRUE)))
  expect_true(any(grepl("nodes: (none)", output, fixed = TRUE)))
  expect_true(any(grepl("edges: (none)", output, fixed = TRUE)))
})

test_that("print method works for simple graph", {
  cg <- caugi(A %-->% B, class = "DAG")
  output <- capture.output(print(cg))

  expect_true(any(grepl("2 nodes, 1 edges", output, fixed = TRUE)))
  expect_true(any(grepl("graph_class: DAG", output, fixed = TRUE)))
  expect_true(any(grepl("A", output, fixed = TRUE)))
  expect_true(any(grepl("B", output, fixed = TRUE)))
  expect_true(any(grepl("A-->B", output, fixed = TRUE)))
})

test_that("print method works for larger graph", {
  cg <- caugi(
    A %-->% B + C,
    B %-->% D,
    C %-->% D + E,
    class = "DAG"
  )
  output <- capture.output(print(cg))

  expect_true(any(grepl("5 nodes, 5 edges", output, fixed = TRUE)))
  expect_true(any(grepl("A", output, fixed = TRUE)))
  expect_true(any(grepl("D", output, fixed = TRUE)))
})

test_that("print method respects max_nodes", {
  cg <- caugi(
    A %-->% B + C + D + E + G,
    class = "DAG"
  )
  output <- capture.output(print(cg, max_nodes = 2))

  expect_true(any(grepl("nodes more", output, fixed = TRUE)))
})

test_that("print method with many edges shows truncation", {
  withr::local_options(width = 40) # mock small console width
  # Create a graph with enough edges to trigger automatic truncation
  cg <- caugi(
    A %-->% B + C + D + E + G + H + I + J + K + L + M + N + O + P + Q,
    B %-->% C + D + E + G + H + I + J + K + L + M + N + O + P + Q,
    C %-->% D + E + G + H + I + J + K + L + M + N + O + P + Q,
    class = "DAG"
  )
  output <- capture.output(print(cg))

  # Should show truncation message when there are many edges
  expect_true(any(grepl("edges more", output, fixed = TRUE)))
})

test_that("print method shows simple status", {
  cg <- caugi(A %-->% B, class = "DAG")
  output <- capture.output(print(cg))
  expect_true(any(grepl("simple: TRUE", output, fixed = TRUE)))
})

test_that("print method returns object invisibly", {
  cg <- caugi(A %-->% B, class = "DAG")
  result <- withVisible(print(cg))

  expect_false(result$visible)
  expect_s7_class(result$value, caugi)
})

test_that("length method works", {
  cg <- caugi(A %-->% B + C, class = "DAG")
  expect_equal(length(cg), 3)

  cg_empty <- caugi(class = "DAG")
  expect_equal(length(cg_empty), 0)

  cg_nodes <- caugi(nodes = LETTERS[1:10], class = "DAG")
  expect_equal(length(cg_nodes), 10)
})

test_that("print defensive and helper branches are covered", {
  cg <- caugi(A %-->% B %-->% C, class = "DAG")

  # Exercise print() fallback for malformed objects without a session.
  bad <- cg
  attr(bad, "session") <- NULL
  out_bad <- capture.output(print(bad))
  expect_true(any(grepl("session=NULL", out_bad, fixed = TRUE)))
  expect_true(any(grepl("graph_class: NA", out_bad, fixed = TRUE)))

  # Exercise session formatting fallback branch (no hex pointer pattern).
  out_fmt <- testthat::with_mocked_bindings(
    capture.output(print(cg)),
    format = function(x, ...) "session_text",
    .package = "base"
  )
  expect_true(any(grepl("session=session_text", out_fmt, fixed = TRUE)))

  # Exercise n_fit < 1 guards in both node and edge printing.
  out_fit <- testthat::with_mocked_bindings(
    capture.output(print(cg)),
    .caugi_fit_on_line = function(...) 0L,
    .package = "caugi"
  )
  expect_true(length(out_fit) > 0L)

  # Exercise max_edges branch where edge_labels becomes empty.
  out_edges <- capture.output(print(cg, max_edges = 0))
  expect_true(any(grepl("edges: (none)", out_edges, fixed = TRUE)))

  expect_identical(
    caugi:::.caugi_fit_on_line(character(), width = 80, indent = 2),
    0L
  )
})

test_that("compare_proxy and all.equal branches are covered", {
  proxy_fun <- caugi:::`compare_proxy.caugi::caugi`
  eq_fun <- caugi:::`all.equal.caugi::caugi`

  cg <- caugi(
    from = c("B", "A"),
    edge = c("-->", "-->"),
    to = c("C", "B"),
    nodes = c("A", "B", "C"),
    class = "DAG"
  )
  proxy <- proxy_fun(cg, path = "cg")
  expect_true(is.list(proxy$object))
  expect_identical(proxy$path, "cg")

  expect_match(eq_fun(cg, list()), "current is not a caugi object")

  cg_simple <- caugi(A %-->% B, class = "DAG")
  cg_non_simple <- caugi(A %-->% B, class = "UNKNOWN", simple = FALSE)
  diff_simple <- eq_fun(cg_simple, cg_non_simple)
  expect_true(any(grepl("^simple:", diff_simple)))
  expect_true(any(grepl("^graph_class:", diff_simple)))

  cg_nodes2 <- caugi(A %-->% B, C, class = "DAG")
  diff_nodes <- eq_fun(cg_simple, cg_nodes2)
  expect_true(any(grepl("^nodes differ:", diff_nodes)))

  cg_edges_more <- caugi(A %-->% B, B %-->% C, class = "DAG")
  diff_n_edges <- eq_fun(cg_simple, cg_edges_more)
  expect_true(any(grepl("^edges differ:", diff_n_edges)))

  target <- caugi(
    from = c("A", "B"),
    edge = c("-->", "-->"),
    to = c("B", "C"),
    nodes = c("A", "B", "C"),
    class = "DAG"
  )
  current <- caugi(
    from = c("A", "C"),
    edge = c("-->", "-->"),
    to = c("B", "A"),
    nodes = c("A", "B", "C"),
    class = "DAG"
  )
  diff_content <- eq_fun(target, current)
  expect_true(any(grepl(
    "edges have different content",
    diff_content,
    fixed = TRUE
  )))
  expect_type(diff_content, "character")
})

test_that("== and != compare caugi objects by graph content", {
  cg <- caugi(A %-->% B, class = "DAG")
  cg_same <- caugi(A %-->% B, class = "DAG")

  # Reflexive and identical content.
  expect_true(cg == cg)
  expect_true(cg == cg_same)
  expect_false(cg != cg_same)

  # Both operators return a single logical, not a vector.
  expect_length(cg == cg_same, 1L)
  expect_type(cg == cg_same, "logical")
  expect_length(cg != cg_same, 1L)
  expect_type(cg != cg_same, "logical")

  # Different edge content.
  expect_false(cg == caugi(A %-->% C, class = "DAG"))
  expect_true(cg != caugi(A %-->% C, class = "DAG"))

  # Different number of edges.
  expect_false(cg == caugi(A %-->% B, B %-->% C, class = "DAG"))

  # Different node set (extra isolated node).
  expect_false(cg == caugi(A %-->% B, C, class = "DAG"))

  # Different graph class.
  expect_false(cg == caugi(A %-->% B, class = "UNKNOWN"))

  # Different `simple` flag.
  expect_false(
    caugi(A %-->% B, class = "DAG") ==
      caugi(A %-->% B, class = "UNKNOWN", simple = FALSE)
  )

  # Non-caugi other operand falls back to FALSE / TRUE.
  expect_false(cg == 5)
  expect_false(cg == "DAG")
  expect_false(cg == list())
  expect_true(cg != 5)
  expect_true(5 != cg)

  # Edge insertion order does not affect equality.
  cg_a <- caugi(A %-->% B, B %-->% C, class = "DAG")
  cg_b <- caugi(B %-->% C, A %-->% B, class = "DAG")
  expect_true(cg_a == cg_b)

  # Nor does it when symmetric and asymmetric edges are mixed.
  expect_true(
    caugi(A %-->% B, B %<->% C, class = "ADMG") ==
      caugi(C %<->% B, A %-->% B, class = "ADMG")
  )

  # Different endpoints of a symmetric edge are still a different graph.
  expect_false(caugi(A %---% B, class = "UG") == caugi(A %---% C, class = "UG"))
  expect_false(
    caugi(A %---% B, class = "UG") == caugi(A %-->% B, class = "DAG")
  )
})

# `==` compares graph content, so a symmetric edge must be an unordered pair.
#
# Regression test. `==` previously compared the `from`/`to` columns literally,
# so `A --- B` and `B --- A` -- the same edge -- came out unequal. Any
# comparison of a graph against one a transformation produced was therefore
# sensitive to the declared node order alone.
test_that("symmetric edges compare as unordered pairs", {
  expect_true(caugi(A %---% B, class = "UG") == caugi(B %---% A, class = "UG"))
  expect_true(
    caugi(A %<->% B, class = "ADMG") == caugi(B %<->% A, class = "ADMG")
  )
  expect_true(
    caugi(A %o-o% B, class = "UNKNOWN") == caugi(B %o-o% A, class = "UNKNOWN")
  )
})

test_that("asymmetric edges stay direction-sensitive", {
  expect_false(
    caugi(A %-->% B, class = "DAG") == caugi(B %-->% A, class = "DAG")
  )
  # `o->` is asymmetric: the circle and the arrowhead sit on named ends.
  expect_false(
    caugi(A %o->% B, class = "UNKNOWN") == caugi(B %o->% A, class = "UNKNOWN")
  )
})