tests/testthat/test-transitive_reduction.R

In ISMtools: Interpretive Structural Modelling Analysis Tools

# Tests for transitive reduction functions

test_that("extract_direct_edges removes transitive edges", {
  # A -> B -> C, and A -> C (transitive)
  adj <- matrix(c(
    0, 1, 1,
    0, 0, 1,
    0, 0, 0
  ), nrow = 3, byrow = TRUE)

  reach <- compute_reachability(adj)
  direct <- extract_direct_edges(reach)

  # A -> C should be removed (transitive through B)
  expect_equal(direct[1, 3], 0)

  # A -> B and B -> C should remain
  expect_equal(direct[1, 2], 1)
  expect_equal(direct[2, 3], 1)
})

test_that("extract_direct_edges removes self-loops", {
  reach <- matrix(c(
    1, 1, 0,
    0, 1, 1,
    0, 0, 1
  ), nrow = 3, byrow = TRUE)

  direct <- extract_direct_edges(reach)

  # Diagonal should be 0
  expect_equal(diag(direct), c(0, 0, 0))
})

test_that("extract_direct_edges handles no transitive edges", {
  # Simple chain with no shortcuts
  adj <- matrix(c(
    0, 1, 0,
    0, 0, 1,
    0, 0, 0
  ), nrow = 3, byrow = TRUE)

  reach <- compute_reachability(adj)
  direct <- extract_direct_edges(reach)

  # A -> B and B -> C should remain
  expect_equal(direct[1, 2], 1)
  expect_equal(direct[2, 3], 1)

  # No other edges
  expect_equal(sum(direct), 2)
})

test_that("extract_direct_edges preserves dimnames", {
  adj <- matrix(c(0, 1, 0, 0), nrow = 2, byrow = TRUE)
  rownames(adj) <- colnames(adj) <- c("A", "B")

  reach <- compute_reachability(adj)
  direct <- extract_direct_edges(reach)

  expect_equal(rownames(direct), c("A", "B"))
  expect_equal(colnames(direct), c("A", "B"))
})

test_that("identify_transitive_edges classifies correctly", {
  # A -> B -> C, and A -> C (transitive)
  adj <- matrix(c(
    0, 1, 1,
    0, 0, 1,
    0, 0, 0
  ), nrow = 3, byrow = TRUE)
  rownames(adj) <- colnames(adj) <- c("A", "B", "C")

  reach <- compute_reachability(adj)
  edges <- identify_transitive_edges(reach)

  # Check structure
  expect_true(all(c("from", "to", "from_label", "to_label", "type") %in% names(edges)))

  # A -> C should be transitive
  ac_edge <- edges[edges$from_label == "A" & edges$to_label == "C", ]
  expect_equal(ac_edge$type, "transitive")

  # A -> B should be direct
  ab_edge <- edges[edges$from_label == "A" & edges$to_label == "B", ]
  expect_equal(ab_edge$type, "direct")
})

test_that("identify_transitive_edges handles empty graph", {
  reach <- matrix(c(
    1, 0,
    0, 1
  ), nrow = 2, byrow = TRUE)

  edges <- identify_transitive_edges(reach)

  expect_equal(nrow(edges), 0)
})