tests/testthat/test-level_partitioning.R

In ISMtools: Interpretive Structural Modelling Analysis Tools

# Tests for level_partitioning()

test_that("level_partitioning returns correct structure", {
  adj <- matrix(c(
    0, 1, 0, 0,
    0, 0, 1, 1,
    0, 0, 0, 0,
    0, 0, 0, 0
  ), nrow = 4, byrow = TRUE)

  reach <- compute_reachability(adj)
  levels <- level_partitioning(reach)

  expect_s3_class(levels, "ism_levels")
  expect_true(is.list(levels))
  expect_true(length(levels) > 0)
})

test_that("level_partitioning identifies correct levels for chain", {
  # Chain: 1 -> 2 -> 3 -> 4
  adj <- matrix(c(
    0, 1, 0, 0,
    0, 0, 1, 0,
    0, 0, 0, 1,
    0, 0, 0, 0
  ), nrow = 4, byrow = TRUE)

  reach <- compute_reachability(adj)
  levels <- level_partitioning(reach)

  # Should have 4 levels for a chain
  expect_equal(length(levels), 4)

  # Node 4 should be at top (Level 1) - it's the outcome
  expect_true(4 %in% levels[[1]])

  # Node 1 should be at bottom - it's the root cause
  expect_true(1 %in% levels[[length(levels)]])
})

test_that("level_partitioning handles parallel elements", {
  # 1 -> 3, 2 -> 3 (1 and 2 are parallel root causes)
  adj <- matrix(c(
    0, 0, 1,
    0, 0, 1,
    0, 0, 0
  ), nrow = 3, byrow = TRUE)

  reach <- compute_reachability(adj)
  levels <- level_partitioning(reach)

  # Node 3 should be at top (Level 1)
  expect_true(3 %in% levels[[1]])

  # Nodes 1 and 2 should be at same level (bottom)
  bottom_level <- levels[[length(levels)]]
  expect_true(all(c(1, 2) %in% bottom_level))
})

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

  reach <- compute_reachability(adj)
  levels <- level_partitioning(reach)

  # Check labels attribute
  expect_equal(attr(levels, "labels"), c("A", "B"))
})

test_that("level_partitioning validates input", {
  expect_error(level_partitioning(c(1, 2, 3)), "must be a matrix")
  expect_error(level_partitioning(matrix(1:6, nrow = 2)), "must be square")
  expect_error(level_partitioning(matrix(c(0, 0.5, 0, 0), nrow = 2)),
               "must contain only 0s and 1s")
})

test_that("level_partitioning warns about missing self-reachability", {
  adj <- matrix(c(0, 1, 0, 0), nrow = 2, byrow = TRUE)
  # Create reach matrix without self-reachability
  reach <- compute_reachability(adj, include_self = FALSE)

  expect_warning(level_partitioning(reach), "Diagonal elements should be 1")
})

test_that("level_partitioning handles single element", {
  reach <- matrix(1, nrow = 1, ncol = 1)
  levels <- level_partitioning(reach)

  expect_equal(length(levels), 1)
  expect_equal(levels[[1]], 1)
})

test_that("print.ism_levels works correctly", {
  adj <- matrix(c(0, 1, 0, 0), nrow = 2, byrow = TRUE)
  rownames(adj) <- colnames(adj) <- c("X", "Y")
  reach <- compute_reachability(adj)
  levels <- level_partitioning(reach)

  # Should print without error and include labels
  expect_output(print(levels), "ISM Hierarchical Levels")
  expect_output(print(levels), "X|Y")
})

test_that("summary.ism_levels returns data frame", {
  adj <- matrix(c(0, 1, 0, 0), nrow = 2, byrow = TRUE)
  reach <- compute_reachability(adj)
  levels <- level_partitioning(reach)

  summ <- summary(levels)
  expect_s3_class(summ, "data.frame")
  expect_true("level" %in% names(summ))
  expect_true("index" %in% names(summ))
})