tests/testthat/test-honem.R

In Nestimate: Network Estimation, Bootstrap, and Higher-Order Analysis

# ===========================================================================
# Section 1: Internal — .honem_transition_matrix
# ===========================================================================

test_that(".honem_transition_matrix row-normalizes", {
  mat <- matrix(c(0, 3, 1, 2, 0, 2, 0, 0, 0), 3, 3, byrow = TRUE,
                dimnames = list(c("A", "B", "C"), c("A", "B", "C")))
  D <- .honem_transition_matrix(mat)

  expect_equal(D["A", "B"], 3 / 4)
  expect_equal(D["A", "C"], 1 / 4)
  expect_equal(D["B", "A"], 2 / 4)
  expect_equal(D["B", "C"], 2 / 4)
  # Row C: all zeros, stays zero

  expect_equal(sum(D["C", ]), 0)
})

# ===========================================================================
# Section 2: Internal — .honem_neighborhood_matrix
# ===========================================================================

test_that(".honem_neighborhood_matrix produces correct shape", {
  D <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), 3, 3, byrow = TRUE)
  S <- .honem_neighborhood_matrix(D, max_power = 5L)

  expect_equal(dim(S), c(3L, 3L))
  expect_true(all(is.finite(S)))
})

test_that(".honem_neighborhood_matrix respects max_power", {
  D <- diag(3) * 0.5
  S1 <- .honem_neighborhood_matrix(D, max_power = 1L)
  S5 <- .honem_neighborhood_matrix(D, max_power = 5L)

  # With different max_power, results should differ
  expect_false(all(abs(S1 - S5) < 1e-10))
})

# ===========================================================================
# Section 3: Internal — .honem_svd
# ===========================================================================

test_that(".honem_svd returns correct dimensions", {
  S <- matrix(runif(25), 5, 5, dimnames = list(LETTERS[1:5], LETTERS[1:5]))
  result <- .honem_svd(S, dim = 3L)

  expect_equal(nrow(result$embeddings), 5L)
  expect_equal(ncol(result$embeddings), 3L)
  expect_equal(length(result$singular_values), 3L)
  expect_true(result$explained_variance >= 0 && result$explained_variance <= 1)
})

test_that(".honem_svd caps dim at n-1", {
  S <- matrix(runif(9), 3, 3, dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  result <- .honem_svd(S, dim = 100L)

  expect_equal(ncol(result$embeddings), 2L)  # capped at n-1 = 2
})

# ===========================================================================
# Section 4: build_honem end-to-end
# ===========================================================================

test_that("build_honem returns net_honem class from matrix", {
  mat <- matrix(c(0, 2, 0, 0,
                  0, 0, 3, 0,
                  1, 0, 0, 2,
                  0, 1, 0, 0), 4, 4, byrow = TRUE,
                dimnames = list(LETTERS[1:4], LETTERS[1:4]))
  emb <- build_honem(mat, dim = 2L, max_power = 3L)

  expect_s3_class(emb, "net_honem")
  expect_equal(emb$n_nodes, 4L)
  expect_equal(emb$dim, 2L)
  expect_equal(nrow(emb$embeddings), 4L)
  expect_equal(ncol(emb$embeddings), 2L)
})

test_that("build_honem works with net_hon object", {
  trajs <- list(c("A", "B", "C", "D"), c("A", "B", "D", "C"),
                c("B", "C", "D", "A"), c("C", "D", "A", "B"))
  hon <- build_hon(trajs, max_order = 2L, method = "hon")
  emb <- build_honem(hon, dim = 3L)

  expect_s3_class(emb, "net_honem")
  expect_equal(emb$n_nodes, hon$n_nodes)
})

test_that("build_honem preserves node names", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2, byrow = TRUE,
                dimnames = list(c("X", "Y"), c("X", "Y")))
  emb <- build_honem(mat, dim = 1L)

  expect_equal(emb$nodes, c("X", "Y"))
  expect_equal(rownames(emb$embeddings), c("X", "Y"))
})

test_that("build_honem rejects invalid input", {
  expect_error(build_honem(42), "net_hon object or a square matrix")
  expect_error(build_honem(matrix(1, 1, 1)), "at least 2 nodes")
})

# ===========================================================================
# Section 5: Embedding quality
# ===========================================================================

test_that("build_honem embeddings reflect network structure", {
  # Create a network with two clusters
  mat <- matrix(0, 6, 6, dimnames = list(LETTERS[1:6], LETTERS[1:6]))
  # Cluster 1: A, B, C (strong connections)
  mat["A", "B"] <- 5; mat["B", "C"] <- 5; mat["C", "A"] <- 5
  # Cluster 2: D, E, F (strong connections)
  mat["D", "E"] <- 5; mat["E", "F"] <- 5; mat["F", "D"] <- 5
  # Weak cross-cluster link
  mat["C", "D"] <- 1

  emb <- build_honem(mat, dim = 2L, max_power = 5L)

  # Nodes within same cluster should be closer than across clusters
  d_within1 <- sqrt(sum((emb$embeddings["A", ] - emb$embeddings["B", ])^2))
  d_across <- sqrt(sum((emb$embeddings["A", ] - emb$embeddings["E", ])^2))

  expect_true(d_within1 < d_across)
})

# ===========================================================================
# Section 6: S3 methods
# ===========================================================================

test_that("print.net_honem works", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  emb <- build_honem(mat, dim = 1L)
  out <- capture.output(print(emb))
  expect_true(any(grepl("HONEM", out)))
})

test_that("summary.net_honem works", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  emb <- build_honem(mat, dim = 1L)
  out <- capture.output(summary(emb))
  expect_true(any(grepl("Variance", out)))
})

test_that("plot.net_honem works", {
  mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3,
                dimnames = list(c("A", "B", "C"), c("A", "B", "C")))
  emb <- build_honem(mat, dim = 2L)
  expect_no_error(plot(emb))
})

# ===========================================================================
# Section 7: Coverage for plot.net_honem with dim < 2
# ===========================================================================

test_that("plot.net_honem issues message and returns invisibly when dim < 2", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  emb <- build_honem(mat, dim = 1L)
  expect_equal(emb$dim, 1L)
  expect_message(result <- plot(emb), "at least 2 dimensions")
  expect_identical(result, emb)
})


# ===========================================================================
# Section 8: Input validation — additional edge cases
# ===========================================================================

test_that("build_honem rejects non-square matrix", {
  mat <- matrix(1:6, 2, 3)
  expect_error(build_honem(mat), "net_hon object or a square matrix")
})

test_that("build_honem rejects dim < 1", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  expect_error(build_honem(mat, dim = 0L), "'dim' must be >= 1")
})

test_that("build_honem rejects max_power < 1", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  expect_error(build_honem(mat, max_power = 0L), "'max_power' must be >= 1")
})

test_that("build_honem handles all-zero matrix (degenerate embeddings)", {
  mat <- matrix(0, 3, 3, dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L)
  # Should not error — produces zero embeddings

  expect_s3_class(emb, "net_honem")
  expect_equal(nrow(emb$embeddings), 3L)
  expect_equal(ncol(emb$embeddings), 2L)
  # All embeddings should be zero (no information in a zero matrix)
  expect_true(all(emb$embeddings == 0))
})

test_that("build_honem rejects non-matrix non-hon input types", {
  expect_error(build_honem(data.frame(a = 1, b = 2)), "net_hon object or a square matrix")
  expect_error(build_honem("not a matrix"), "net_hon object or a square matrix")
  expect_error(build_honem(list(a = 1)), "net_hon object or a square matrix")
})


# ===========================================================================
# Section 9: .honem_neighborhood_matrix — detailed tests
# ===========================================================================

test_that(".honem_neighborhood_matrix with max_power=1 gives exp(0)*D + exp(-1)*D^2", {
  # 3x3 identity-like transition matrix for easy verification
  D <- matrix(c(0, 1, 0,
                0, 0, 1,
                1, 0, 0), 3, 3, byrow = TRUE)

  S <- .honem_neighborhood_matrix(D, max_power = 1L)

  # weights: exp(0) = 1, exp(-1)
  w0 <- exp(0)
  w1 <- exp(-1)
  Z <- w0 + w1
  D2 <- D %*% D
  expected <- (w0 * D + w1 * D2) / Z
  expect_equal(S, expected, tolerance = 1e-12)
})

test_that(".honem_neighborhood_matrix with larger max_power changes result", {
  D <- matrix(c(0, 0.5, 0.5,
                0.5, 0, 0.5,
                0.5, 0.5, 0), 3, 3, byrow = TRUE)
  S1 <- .honem_neighborhood_matrix(D, max_power = 1L)
  S3 <- .honem_neighborhood_matrix(D, max_power = 3L)
  S10 <- .honem_neighborhood_matrix(D, max_power = 10L)

  # All should differ
  expect_false(all(abs(S1 - S3) < 1e-10))
  expect_false(all(abs(S3 - S10) < 1e-10))
  # All should be finite
  expect_true(all(is.finite(S1)))
  expect_true(all(is.finite(S3)))
  expect_true(all(is.finite(S10)))
})

test_that(".honem_neighborhood_matrix produces no NaN/Inf values", {
  # Sparse matrix with a sink node (row of zeros)
  D <- matrix(c(0, 1, 0, 0,
                0, 0, 1, 0,
                0, 0, 0, 1,
                0, 0, 0, 0), 4, 4, byrow = TRUE)
  S <- .honem_neighborhood_matrix(D, max_power = 20L)
  expect_true(all(is.finite(S)))
  expect_false(any(is.nan(S)))
})

test_that(".honem_neighborhood_matrix with identity-like D converges", {
  # D close to identity => higher powers similar to D
  n <- 5
  D <- diag(n) * 0.8 + matrix(0.2 / (n - 1), n, n)
  diag(D) <- 0.8
  S5 <- .honem_neighborhood_matrix(D, max_power = 5L)
  S50 <- .honem_neighborhood_matrix(D, max_power = 50L)
  # Should converge — difference between S5 and S50 small
  # (exponential decay of weights means higher powers contribute little)
  expect_true(max(abs(S5 - S50)) < 0.1)
})


# ===========================================================================
# Section 10: .honem_svd — edge cases
# ===========================================================================

test_that(".honem_svd handles degenerate matrix (identical rows)", {
  # Matrix with identical rows => rank 1
  S <- matrix(rep(c(1, 2, 3, 4), 4), 4, 4, byrow = TRUE,
              dimnames = list(LETTERS[1:4], LETTERS[1:4]))
  result <- .honem_svd(S, dim = 3L)

  # Should not crash
  expect_equal(nrow(result$embeddings), 4L)
  expect_equal(ncol(result$embeddings), 3L)
  expect_true(all(is.finite(result$embeddings)))
  expect_true(result$explained_variance >= 0 && result$explained_variance <= 1)
})

test_that(".honem_svd dim is capped at n-1 for small matrices", {
  S <- matrix(runif(4), 2, 2, dimnames = list(c("A", "B"), c("A", "B")))
  result <- .honem_svd(S, dim = 50L)
  # n=2, so dim capped at 1
  expect_equal(ncol(result$embeddings), 1L)
  expect_equal(length(result$singular_values), 1L)
})

test_that(".honem_svd returns valid explained_variance for zero matrix", {
  S <- matrix(0, 3, 3, dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  result <- .honem_svd(S, dim = 2L)
  # Zero matrix => all singular values are 0 => 0/0 = NaN
  # Check it doesn't crash (NaN is a known edge case for degenerate input)
  expect_equal(nrow(result$embeddings), 3L)
  expect_equal(ncol(result$embeddings), 2L)
})

test_that(".honem_svd singular_values are non-negative", {
  set.seed(7)
  S <- matrix(runif(25), 5, 5, dimnames = list(LETTERS[1:5], LETTERS[1:5]))
  result <- .honem_svd(S, dim = 4L)
  expect_true(all(result$singular_values >= 0))
})


# ===========================================================================
# Section 11: End-to-end — field verification
# ===========================================================================

test_that("build_honem result has all expected fields", {
  mat <- matrix(c(0, 2, 1, 3, 0, 2, 1, 3, 0), 3, 3, byrow = TRUE,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L, max_power = 5L)

  # All required fields present
  expect_true("embeddings" %in% names(emb))
  expect_true("nodes" %in% names(emb))
  expect_true("singular_values" %in% names(emb))
  expect_true("explained_variance" %in% names(emb))
  expect_true("dim" %in% names(emb))
  expect_true("max_power" %in% names(emb))
  expect_true("n_nodes" %in% names(emb))
})

test_that("build_honem embeddings dimensions match n_nodes x dim", {
  mat <- matrix(c(0, 3, 0, 1,
                  2, 0, 1, 0,
                  0, 2, 0, 3,
                  1, 0, 2, 0), 4, 4, byrow = TRUE,
                dimnames = list(LETTERS[1:4], LETTERS[1:4]))
  emb <- build_honem(mat, dim = 3L)

  expect_equal(nrow(emb$embeddings), emb$n_nodes)
  expect_equal(ncol(emb$embeddings), emb$dim)
  expect_equal(emb$n_nodes, 4L)
  expect_equal(emb$dim, 3L)
})

test_that("build_honem singular_values are non-negative and sorted descending", {
  set.seed(12)
  mat <- matrix(sample(0:5, 25, replace = TRUE), 5, 5,
                dimnames = list(LETTERS[1:5], LETTERS[1:5]))
  diag(mat) <- 0
  emb <- build_honem(mat, dim = 4L)

  expect_true(all(emb$singular_values >= 0))
  # Check sorted descending (or equal)
  diffs <- diff(emb$singular_values)
  expect_true(all(diffs <= 1e-10))
})

test_that("build_honem explained_variance is in [0, 1]", {
  mat <- matrix(c(0, 5, 1, 3, 0, 2, 1, 4, 0), 3, 3, byrow = TRUE,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L)

  expect_gte(emb$explained_variance, 0)
  expect_lte(emb$explained_variance, 1)
})

test_that("build_honem max_power stored correctly", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  emb <- build_honem(mat, dim = 1L, max_power = 7L)
  expect_equal(emb$max_power, 7L)
})


# ===========================================================================
# Section 12: S3 methods — detailed output checks
# ===========================================================================

test_that("print.net_honem output contains key info", {
  mat <- matrix(c(0, 2, 1, 3, 0, 2, 1, 3, 0), 3, 3, byrow = TRUE,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L, max_power = 5L)
  out <- capture.output(print(emb))

  expect_true(any(grepl("HONEM", out)))
  expect_true(any(grepl("Nodes:", out)))
  expect_true(any(grepl("Dimensions:", out)))
  expect_true(any(grepl("Max power:", out)))
  expect_true(any(grepl("Variance explained:", out)))
  # Check actual numbers appear
  expect_true(any(grepl("3", out)))  # 3 nodes
  expect_true(any(grepl("2", out)))  # 2 dimensions
})

test_that("print.net_honem returns invisibly", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  emb <- build_honem(mat, dim = 1L)
  out <- capture.output(result <- print(emb))
  expect_identical(result, emb)
})

test_that("summary.net_honem output contains variance and singular values info", {
  mat <- matrix(c(0, 2, 1, 3, 0, 2, 1, 3, 0), 3, 3, byrow = TRUE,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L, max_power = 5L)
  out <- capture.output(summary(emb))

  expect_true(any(grepl("HONEM Summary", out)))
  expect_true(any(grepl("Variance explained:", out)))
  expect_true(any(grepl("Top singular values:", out)))
  expect_true(any(grepl("Embedding range:", out)))
})

test_that("summary.net_honem returns invisibly", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  emb <- build_honem(mat, dim = 1L)
  out <- capture.output(result <- summary(emb))
  expect_identical(result, emb)
})

test_that("plot.net_honem works with dim >= 2 and labels <= 50 nodes", {
  mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L)
  expect_no_error(result <- plot(emb))
  expect_identical(result, emb)
})

test_that("plot.net_honem suppresses labels for > 50 nodes", {
  # Create a larger matrix — plot should skip text labels
  n <- 55
  mat <- matrix(sample(0:3, n * n, replace = TRUE), n, n)
  diag(mat) <- 0
  nms <- paste0("N", seq_len(n))
  dimnames(mat) <- list(nms, nms)
  emb <- build_honem(mat, dim = 2L)
  # Just verify it doesn't error with >50 nodes
  expect_no_error(plot(emb))
})

test_that("plot.net_honem respects custom dims argument", {
  mat <- matrix(c(0, 3, 1, 2,
                  1, 0, 2, 0,
                  0, 1, 0, 3,
                  2, 0, 1, 0), 4, 4, byrow = TRUE,
                dimnames = list(LETTERS[1:4], LETTERS[1:4]))
  emb <- build_honem(mat, dim = 3L)
  # Plot dims 1 and 3
  expect_no_error(plot(emb, dims = c(1L, 3L)))
})


# ===========================================================================
# Section 13: .honem_transition_matrix — additional tests
# ===========================================================================

test_that(".honem_transition_matrix preserves zero rows", {
  mat <- matrix(c(0, 0, 0, 1, 0, 2, 0, 3, 0), 3, 3, byrow = TRUE,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  D <- .honem_transition_matrix(mat)
  expect_equal(sum(D["A", ]), 0)  # Row A all zeros stays zero
  expect_equal(sum(D["B", ]), 1, tolerance = 1e-12)  # Row B normalizes to 1
  expect_equal(sum(D["C", ]), 1, tolerance = 1e-12)  # Row C normalizes to 1
})

test_that(".honem_transition_matrix produces row-stochastic matrix", {
  set.seed(42)
  mat <- matrix(sample(0:10, 16, replace = TRUE), 4, 4)
  diag(mat) <- 0
  dimnames(mat) <- list(LETTERS[1:4], LETTERS[1:4])
  D <- .honem_transition_matrix(mat)

  row_sums <- rowSums(D)
  nonzero_rows <- row_sums > 0
  # Non-zero rows should sum to 1
  expect_true(all(abs(row_sums[nonzero_rows] - 1) < 1e-12))
  # Zero rows should remain zero
  expect_true(all(row_sums[!nonzero_rows] == 0))
})


# ===========================================================================
# Section 14: Dim capping in build_honem
# ===========================================================================

test_that("build_honem caps dim at n-1 for small matrices", {
  mat <- matrix(c(0, 1, 1, 0), 2, 2,
                dimnames = list(c("A", "B"), c("A", "B")))
  # Request dim=100 but only 2 nodes => capped at 1
  emb <- build_honem(mat, dim = 100L)
  expect_equal(emb$dim, 1L)
  expect_equal(ncol(emb$embeddings), 1L)
})

test_that("build_honem with dim equal to n-1 works", {
  mat <- matrix(c(0, 2, 1, 3, 0, 2, 1, 3, 0), 3, 3, byrow = TRUE,
                dimnames = list(LETTERS[1:3], LETTERS[1:3]))
  emb <- build_honem(mat, dim = 2L)  # n-1 = 2
  expect_equal(emb$dim, 2L)
  expect_equal(ncol(emb$embeddings), 2L)
})