tests/testthat/test-disparity.R

In cograph: Analysis and Visualization of Complex Networks

# Tests for disparity_filter()

skip_on_cran()

test_that("disparity_filter.matrix works", {
  # Create a simple weighted network
  mat <- matrix(c(
    0.0, 0.5, 0.1, 0.0,
    0.3, 0.0, 0.4, 0.1,
    0.1, 0.2, 0.0, 0.5,
    0.0, 0.1, 0.3, 0.0
  ), nrow = 4, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  result <- disparity_filter(mat, level = 0.05)

  # Check output is binary matrix
  expect_true(is.matrix(result))
  expect_true(all(result %in% c(0, 1)))
  expect_equal(dim(result), c(4, 4))

  # Diagonal should be 0
  expect_true(all(diag(result) == 0))
})

test_that("disparity_filter preserves dimnames", {
  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
  diag(mat) <- 0

  result <- disparity_filter(mat, level = 0.5)

  expect_equal(rownames(result), rownames(mat))
  expect_equal(colnames(result), colnames(mat))
})

test_that("disparity_filter with different significance levels", {
  mat <- matrix(c(
    0.0, 0.8, 0.1, 0.1,
    0.1, 0.0, 0.7, 0.2,
    0.2, 0.1, 0.0, 0.7,
    0.1, 0.2, 0.1, 0.0
  ), nrow = 4, byrow = TRUE)

  # More stringent level should keep fewer edges
  result_05 <- disparity_filter(mat, level = 0.5)
  result_01 <- disparity_filter(mat, level = 0.01)

  n_edges_05 <- sum(result_05)
  n_edges_01 <- sum(result_01)

  expect_true(n_edges_01 <= n_edges_05)
})

test_that("disparity_filter.tna works", {
  # Create mock TNA model
  weights <- matrix(c(
    0.0, 0.5, 0.1,
    0.3, 0.0, 0.4,
    0.1, 0.2, 0.0
  ), nrow = 3, byrow = TRUE)
  rownames(weights) <- colnames(weights) <- c("A", "B", "C")

  model <- list(
    weights = weights,
    labels = c("A", "B", "C"),
    inits = c(0.33, 0.33, 0.34)
  )
  class(model) <- "tna"

  result <- disparity_filter(model, level = 0.5)

  # Check structure
  expect_s3_class(result, "tna_disparity")
  expect_true("significant" %in% names(result))
  expect_true("weights_orig" %in% names(result))
  expect_true("weights_filtered" %in% names(result))
  expect_equal(result$level, 0.5)
})

test_that("disparity_filter.cograph_network works", {
  mat <- matrix(c(
    0.0, 0.5, 0.1,
    0.3, 0.0, 0.4,
    0.1, 0.2, 0.0
  ), nrow = 3, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- as_cograph(mat)
  result <- disparity_filter(net, level = 0.5)

  expect_s3_class(result, "tna_disparity")
  expect_equal(dim(result$significant), c(3, 3))
})

test_that("tna_disparity print method works", {
  mat <- matrix(c(
    0.0, 0.5, 0.1, 0.0,
    0.3, 0.0, 0.4, 0.1,
    0.1, 0.2, 0.0, 0.5,
    0.0, 0.1, 0.3, 0.0
  ), nrow = 4, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- as_cograph(mat)
  result <- disparity_filter(net, level = 0.5)

  expect_output(print(result), "Disparity Filter Result")
  expect_output(print(result), "Significance level")
})

test_that("disparity_filter handles zero matrices", {
  mat <- matrix(0, 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  result <- disparity_filter(mat, level = 0.05)

  expect_true(all(result == 0))
})

test_that("disparity_filter handles single strong edge", {
  # Network where one edge dominates
  mat <- matrix(0, 4, 4)
  mat[1, 2] <- 0.99  # Very strong edge
  mat[1, 3] <- 0.005
  mat[1, 4] <- 0.005
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  result <- disparity_filter(mat, level = 0.05)

  # The dominant edge should be significant
  expect_equal(result[1, 2], 1)
})

test_that("disparity_filter tna_disparity contains filtered weights", {
  mat <- matrix(c(
    0.0, 0.5, 0.1,
    0.3, 0.0, 0.4,
    0.1, 0.2, 0.0
  ), nrow = 3, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- as_cograph(mat)
  result <- disparity_filter(net, level = 0.5)

  # Filtered weights should be original * significant
  expected_filtered <- mat * result$significant
  expect_equal(result$weights_filtered, expected_filtered)
})

test_that("disparity_filter edge counts are correct", {
  mat <- matrix(c(
    0.0, 0.5, 0.1,
    0.3, 0.0, 0.4,
    0.1, 0.2, 0.0
  ), nrow = 3, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- as_cograph(mat)
  result <- disparity_filter(net, level = 0.5)

  expect_equal(result$n_edges_orig, sum(mat != 0))
  expect_equal(result$n_edges_filtered, sum(result$significant != 0))
})

test_that("disparity_filter.igraph works on simple graph", {
  g <- igraph::make_ring(5)
  igraph::E(g)$weight <- c(10, 1, 1, 1, 1)
  igraph::V(g)$name <- LETTERS[1:5]

  result <- disparity_filter(g, level = 0.5)

  expect_s3_class(result, "tna_disparity")
  expect_equal(nrow(result$weights_orig), 5)
  # The strong edge (weight=10) should be significant
  expect_true(result$n_edges_filtered > 0)
  expect_true(result$n_edges_filtered <= result$n_edges_orig)
})

test_that("disparity_filter.igraph handles multigraph", {
  # Build multigraph with parallel edges
  el <- data.frame(
    from = c("A", "A", "A", "A", "A", "B", "C"),
    to   = c("B", "B", "B", "B", "C", "C", "D"),
    stringsAsFactors = FALSE
  )
  g <- igraph::graph_from_data_frame(el, directed = FALSE)

  result <- disparity_filter(g, level = 0.5)

  expect_s3_class(result, "tna_disparity")
  # A-B has 4 edges, should dominate A's weight
  expect_true(result$significant["A", "B"] == 1 || result$significant["B", "A"] == 1)
})

test_that("disparity_filter.igraph with no weight attr assigns weight=1", {
  g <- igraph::make_ring(4)
  igraph::V(g)$name <- LETTERS[1:4]
  # No weight attribute

  result <- disparity_filter(g, level = 0.5)

  expect_s3_class(result, "tna_disparity")
  expect_equal(nrow(result$weights_orig), 4)
})