tests/testthat/test-coverage-input-parse-40.R

In cograph: Analysis and Visualization of Complex Networks

# Tests for input-parse.R and related input parsing functions
# Coverage target: 40% improvement for input-parse.R

# =============================================================================
# parse_input() tests - Main dispatch function
# =============================================================================

skip_on_cran()

test_that("parse_input dispatches to parse_matrix for matrix input", {
  m <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), nrow = 3)
  result <- parse_input(m)

  expect_type(result, "list")
  expect_true("nodes" %in% names(result))
  expect_true("edges" %in% names(result))
  expect_true("directed" %in% names(result))
})

test_that("parse_input dispatches to parse_edgelist for data.frame input", {
  df <- data.frame(from = c("A", "B"), to = c("B", "C"), weight = c(0.5, 0.8))
  result <- parse_input(df)

  expect_type(result, "list")
  expect_true("nodes" %in% names(result))
  expect_true("edges" %in% names(result))
})

test_that("parse_input returns already parsed format unchanged", {
  already_parsed <- list(
    nodes = data.frame(id = 1:3, label = c("A", "B", "C"), stringsAsFactors = FALSE),
    edges = data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.8), stringsAsFactors = FALSE),
    directed = FALSE

  )
  result <- parse_input(already_parsed)

  expect_identical(result, already_parsed)
})

test_that("parse_input errors on unsupported input type", {
  expect_error(
    parse_input("not a valid input"),
    "Unsupported input type"
  )
  expect_error(
    parse_input(123),
    "Unsupported input type"
  )
  expect_error(
    parse_input(list(foo = 1, bar = 2)),
    "Unsupported input type"
  )
})

test_that("parse_input passes directed parameter correctly", {
  # Symmetric matrix but force directed = TRUE
  m <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), nrow = 3)
  result <- parse_input(m, directed = TRUE)
  expect_true(result$directed)

  # Same matrix with directed = FALSE
  result2 <- parse_input(m, directed = FALSE)
  expect_false(result2$directed)
})

# =============================================================================
# is_symmetric_matrix() tests
# =============================================================================

test_that("is_symmetric_matrix returns TRUE for symmetric matrix", {
  m <- matrix(c(0, 1, 2, 1, 0, 3, 2, 3, 0), nrow = 3)
  expect_true(is_symmetric_matrix(m))
})
test_that("is_symmetric_matrix returns FALSE for asymmetric matrix", {
  m <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), nrow = 3)
  expect_false(is_symmetric_matrix(m))
})

test_that("is_symmetric_matrix returns FALSE for non-square matrix", {
  m <- matrix(1:6, nrow = 2, ncol = 3)
  expect_false(is_symmetric_matrix(m))
})

test_that("is_symmetric_matrix returns FALSE for non-matrix input", {
  expect_false(is_symmetric_matrix(c(1, 2, 3)))
  expect_false(is_symmetric_matrix(data.frame(a = 1:3)))
  expect_false(is_symmetric_matrix(NULL))
})

test_that("is_symmetric_matrix handles numeric tolerance", {
  m <- matrix(c(0, 1, 1 + 1e-10, 1, 0, 1, 1, 1, 0), nrow = 3)
  # With default tolerance, should be symmetric

expect_true(is_symmetric_matrix(m))

  # With very strict tolerance, should be asymmetric
  expect_false(is_symmetric_matrix(m, tol = 1e-15))
})

# =============================================================================
# create_nodes_df() tests
# =============================================================================

test_that("create_nodes_df creates correct structure", {
  result <- create_nodes_df(5)

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 5)
  expect_true(all(c("id", "label", "name", "x", "y") %in% names(result)))
  expect_equal(result$id, 1:5)
  expect_equal(result$label, as.character(1:5))
})

test_that("create_nodes_df uses provided labels", {
  result <- create_nodes_df(3, labels = c("A", "B", "C"))

  expect_equal(result$label, c("A", "B", "C"))
  expect_equal(result$name, c("A", "B", "C"))
})

test_that("create_nodes_df uses provided names", {
  result <- create_nodes_df(3, labels = c("A", "B", "C"), names = c("Alpha", "Beta", "Gamma"))

  expect_equal(result$label, c("A", "B", "C"))
  expect_equal(result$name, c("Alpha", "Beta", "Gamma"))
})

test_that("create_nodes_df initializes x and y as NA", {
  result <- create_nodes_df(3)

  expect_true(all(is.na(result$x)))
  expect_true(all(is.na(result$y)))
})

test_that("create_nodes_df handles single node", {
  result <- create_nodes_df(1)

  expect_equal(nrow(result), 1)
  expect_equal(result$id, 1)
  expect_equal(result$label, "1")
})

# =============================================================================
# create_edges_df() tests
# =============================================================================

test_that("create_edges_df creates correct structure", {
  result <- create_edges_df(from = c(1, 2, 3), to = c(2, 3, 1))

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 3)
  expect_true(all(c("from", "to", "weight") %in% names(result)))
})

test_that("create_edges_df uses default weight of 1", {
  result <- create_edges_df(from = c(1, 2), to = c(2, 3))

  expect_equal(result$weight, c(1, 1))
})

test_that("create_edges_df uses provided weights", {
  result <- create_edges_df(from = c(1, 2), to = c(2, 3), weight = c(0.5, 1.5))

  expect_equal(result$weight, c(0.5, 1.5))
})

test_that("create_edges_df handles empty edges", {
  result <- create_edges_df(from = integer(0), to = integer(0))

  expect_equal(nrow(result), 0)
  expect_true(all(c("from", "to", "weight") %in% names(result)))
})

# =============================================================================
# detect_duplicate_edges() tests
# =============================================================================

test_that("detect_duplicate_edges returns FALSE for no duplicates", {
  edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 4), weight = c(0.5, 0.6, 0.7))
  result <- detect_duplicate_edges(edges)

  expect_false(result$has_duplicates)
  expect_null(result$info)
})

test_that("detect_duplicate_edges detects simple duplicates", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(0.5, 0.3, 0.7))
  result <- detect_duplicate_edges(edges)

  expect_true(result$has_duplicates)
  expect_length(result$info, 1)
  expect_equal(result$info[[1]]$count, 2)
  expect_equal(result$info[[1]]$weights, c(0.5, 0.3))
})

test_that("detect_duplicate_edges detects reversed duplicates in undirected mode", {
  edges <- data.frame(from = c(1, 2, 2), to = c(2, 1, 3), weight = c(0.5, 0.3, 0.7))
  result <- detect_duplicate_edges(edges)

  expect_true(result$has_duplicates)
  expect_length(result$info, 1)
  expect_equal(result$info[[1]]$nodes, c(1, 2))
  expect_equal(result$info[[1]]$count, 2)
})

test_that("detect_duplicate_edges handles NULL edges", {
  result <- detect_duplicate_edges(NULL)

  expect_false(result$has_duplicates)
  expect_null(result$info)
})

test_that("detect_duplicate_edges handles empty data frame", {
  edges <- data.frame(from = integer(0), to = integer(0))
  result <- detect_duplicate_edges(edges)

  expect_false(result$has_duplicates)
  expect_null(result$info)
})

test_that("detect_duplicate_edges handles edges without weight column", {
  edges <- data.frame(from = c(1, 1), to = c(2, 2))
  result <- detect_duplicate_edges(edges)

  expect_true(result$has_duplicates)
  expect_equal(result$info[[1]]$weights, c(1, 1))
})

test_that("detect_duplicate_edges handles multiple duplicate groups", {
  edges <- data.frame(
    from = c(1, 1, 2, 2, 3),
    to = c(2, 2, 3, 3, 4),
    weight = c(0.1, 0.2, 0.3, 0.4, 0.5)
  )
  result <- detect_duplicate_edges(edges)

  expect_true(result$has_duplicates)
  expect_length(result$info, 2)
})

# =============================================================================
# aggregate_duplicate_edges() tests
# =============================================================================

test_that("aggregate_duplicate_edges with method='sum'", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(0.5, 0.3, 0.7))
  result <- aggregate_duplicate_edges(edges, method = "sum")

  expect_equal(nrow(result), 2)
  expect_equal(result$weight[result$from == 1 & result$to == 2], 0.8)
})

test_that("aggregate_duplicate_edges with method='mean'", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(0.5, 0.3, 0.7))
  result <- aggregate_duplicate_edges(edges, method = "mean")

  expect_equal(result$weight[result$from == 1 & result$to == 2], 0.4)
})

test_that("aggregate_duplicate_edges with method='max'", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(0.5, 0.3, 0.7))
  result <- aggregate_duplicate_edges(edges, method = "max")

  expect_equal(result$weight[result$from == 1 & result$to == 2], 0.5)
})

test_that("aggregate_duplicate_edges with method='min'", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(0.5, 0.3, 0.7))
  result <- aggregate_duplicate_edges(edges, method = "min")

  expect_equal(result$weight[result$from == 1 & result$to == 2], 0.3)
})

test_that("aggregate_duplicate_edges with method='first'", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(0.5, 0.3, 0.7))
  result <- aggregate_duplicate_edges(edges, method = "first")

  expect_equal(result$weight[result$from == 1 & result$to == 2], 0.5)
})

test_that("aggregate_duplicate_edges with custom function", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3), weight = c(3, 4, 5))
  result <- aggregate_duplicate_edges(edges, method = function(x) sqrt(sum(x^2)))

  expect_equal(result$weight[result$from == 1 & result$to == 2], 5)  # sqrt(9+16) = 5
})

test_that("aggregate_duplicate_edges errors on unknown method", {
  edges <- data.frame(from = c(1, 1), to = c(2, 2), weight = c(0.5, 0.3))

  expect_error(
    aggregate_duplicate_edges(edges, method = "unknown"),
    "Unknown aggregation method"
  )
})

test_that("aggregate_duplicate_edges handles NULL edges", {
  result <- aggregate_duplicate_edges(NULL)
  expect_null(result)
})

test_that("aggregate_duplicate_edges handles empty data frame", {
  edges <- data.frame(from = integer(0), to = integer(0), weight = numeric(0))
  result <- aggregate_duplicate_edges(edges)

  expect_equal(nrow(result), 0)
})

test_that("aggregate_duplicate_edges handles reversed duplicates", {
  edges <- data.frame(from = c(1, 2), to = c(2, 1), weight = c(0.5, 0.3))
  result <- aggregate_duplicate_edges(edges, method = "sum")

  expect_equal(nrow(result), 1)
  expect_equal(result$weight, 0.8)
  # Should use canonical order (1 -> 2)
  expect_equal(result$from, 1)
  expect_equal(result$to, 2)
})

# =============================================================================
# parse_matrix() tests - Extended coverage
# =============================================================================

test_that("parse_matrix errors on non-matrix input", {
  expect_error(parse_matrix(data.frame(a = 1:3)), "must be a matrix")
})

test_that("parse_matrix errors on non-numeric matrix", {
  m <- matrix(c("a", "b", "c", "d"), nrow = 2)
  expect_error(parse_matrix(m), "must be numeric")
})

test_that("parse_matrix uses colnames when rownames are NULL", {
  m <- matrix(c(0, 1, 1, 0), nrow = 2)
  colnames(m) <- c("X", "Y")
  result <- parse_matrix(m)

  expect_equal(result$nodes$label, c("X", "Y"))
})

test_that("parse_matrix generates labels when no dimnames", {
  m <- matrix(c(0, 1, 1, 0), nrow = 2)
  result <- parse_matrix(m)

  expect_equal(result$nodes$label, c("1", "2"))
})

test_that("parse_matrix correctly extracts directed edges", {
  m <- matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), nrow = 3, byrow = TRUE)
  result <- parse_matrix(m, directed = TRUE)

  expect_true(result$directed)
  # All non-zero entries should be edges
  expect_equal(nrow(result$edges), 2)
})

test_that("parse_matrix correctly extracts undirected edges from upper triangle", {
  m <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), nrow = 3)
  result <- parse_matrix(m, directed = FALSE)

  expect_false(result$directed)
  # Only upper triangle
  expect_equal(nrow(result$edges), 3)
})

test_that("parse_matrix handles weighted matrix", {
  m <- matrix(c(0, 0.5, 0.3, 0.5, 0, 0.8, 0.3, 0.8, 0), nrow = 3)
  result <- parse_matrix(m)

  expect_true(all(result$edges$weight %in% c(0.3, 0.5, 0.8)))
})

test_that("parse_matrix handles sparse matrix", {
  m <- matrix(0, nrow = 5, ncol = 5)
  m[1, 2] <- 1
  m[2, 1] <- 1
  result <- parse_matrix(m)

  expect_equal(nrow(result$nodes), 5)
  expect_equal(nrow(result$edges), 1)  # Only upper triangle for symmetric
})

test_that("parse_matrix handles single node network", {
  m <- matrix(0, nrow = 1, ncol = 1)
  result <- parse_matrix(m)

  expect_equal(nrow(result$nodes), 1)
  expect_equal(nrow(result$edges), 0)
})

test_that("parse_matrix handles self-loops in directed network", {
  m <- matrix(c(0.5, 1, 0, 0.5), nrow = 2)
  result <- parse_matrix(m, directed = TRUE)

  # Self-loops on diagonal
  self_loops <- result$edges[result$edges$from == result$edges$to, ]
  expect_true(nrow(self_loops) > 0)
})

# =============================================================================
# parse_edgelist() tests - Extended coverage
# =============================================================================

test_that("parse_edgelist errors on non-data.frame input", {
  expect_error(parse_edgelist(matrix(1:4, 2)), "must be a data frame")
})

test_that("parse_edgelist auto-detects column names: source/target", {
  df <- data.frame(source = c("A", "B"), target = c("B", "C"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 2)
})

test_that("parse_edgelist auto-detects column names: src/tgt", {
  df <- data.frame(src = c("A", "B"), tgt = c("B", "C"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 2)
})

test_that("parse_edgelist auto-detects column names: v1/v2", {
  df <- data.frame(v1 = c("A", "B"), v2 = c("B", "C"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 2)
})

test_that("parse_edgelist auto-detects column names: node1/node2", {
  df <- data.frame(node1 = c("A", "B"), node2 = c("B", "C"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 2)
})

test_that("parse_edgelist auto-detects column names: i/j", {
  df <- data.frame(i = c("A", "B"), j = c("B", "C"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 2)
})

test_that("parse_edgelist falls back to columns 1 and 2", {
  df <- data.frame(col1 = c("A", "B"), col2 = c("B", "C"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 2)
})

test_that("parse_edgelist auto-detects weight column: w", {
  df <- data.frame(from = c("A", "B"), to = c("B", "C"), w = c(0.5, 0.8))
  result <- parse_edgelist(df)

  expect_equal(result$weights, c(0.5, 0.8))
})

test_that("parse_edgelist auto-detects weight column: value", {
  df <- data.frame(from = c("A", "B"), to = c("B", "C"), value = c(0.5, 0.8))
  result <- parse_edgelist(df)

  expect_equal(result$weights, c(0.5, 0.8))
})

test_that("parse_edgelist auto-detects weight column: strength", {
  df <- data.frame(from = c("A", "B"), to = c("B", "C"), strength = c(0.5, 0.8))
  result <- parse_edgelist(df)

  expect_equal(result$weights, c(0.5, 0.8))
})

test_that("parse_edgelist handles numeric node IDs", {
  df <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$nodes), 3)
})

test_that("parse_edgelist auto-detects directed for bidirectional edges", {
  # Edges 1->2 and 2->1 should indicate directed
  df <- data.frame(from = c(1, 2), to = c(2, 1))
  result <- parse_edgelist(df)

  expect_true(result$directed)
})

test_that("parse_edgelist auto-detects undirected for simple edges", {
  # No bidirectional edges
  df <- data.frame(from = c(1, 2, 3), to = c(2, 3, 4))
  result <- parse_edgelist(df)

  expect_false(result$directed)
})

test_that("parse_edgelist respects explicit directed parameter", {
  df <- data.frame(from = c(1, 2), to = c(2, 3))

  result_directed <- parse_edgelist(df, directed = TRUE)
  expect_true(result_directed$directed)

  result_undirected <- parse_edgelist(df, directed = FALSE)
  expect_false(result_undirected$directed)
})

test_that("parse_edgelist handles mixed character and numeric nodes", {
  df <- data.frame(from = c("A", "B", "1"), to = c("B", "1", "A"))
  result <- parse_edgelist(df)

  expect_equal(nrow(result$nodes), 3)
  expect_true(all(c("A", "B", "1") %in% result$nodes$label))
})

# =============================================================================
# Integration tests - parse_input with different formats
# =============================================================================

test_that("parse_input correctly identifies igraph objects", {
  skip_if_not_installed("igraph")

  g <- igraph::make_ring(5)
  result <- parse_input(g)

  expect_equal(nrow(result$nodes), 5)
  expect_false(result$directed)
})

test_that("parse_input correctly identifies tna objects", {
  # Create mock tna object
  mock_tna <- list(
    weights = matrix(c(0, 0.5, 0.1, 0.3, 0, 0.8, 0.7, 0.2, 0), nrow = 3),
    labels = c("A", "B", "C"),
    inits = c(0.3, 0.4, 0.3)
  )
  class(mock_tna) <- "tna"

  result <- parse_input(mock_tna)

  expect_equal(nrow(result$nodes), 3)
  expect_true(result$directed)
})

# =============================================================================
# Edge cases and error handling
# =============================================================================

test_that("parse_matrix handles negative weights", {
  m <- matrix(c(0, -0.5, 0.3, -0.5, 0, -0.8, 0.3, -0.8, 0), nrow = 3)
  result <- parse_matrix(m)

  expect_true(any(result$edges$weight < 0))
})

test_that("parse_matrix handles very small weights", {
  m <- matrix(c(0, 1e-10, 1e-10, 0), nrow = 2)
  result <- parse_matrix(m)

  expect_equal(nrow(result$edges), 1)
})

test_that("parse_edgelist handles duplicate edges gracefully", {
  df <- data.frame(
    from = c("A", "A", "B"),
    to = c("B", "B", "C"),
    weight = c(0.5, 0.3, 0.8)
  )
  result <- parse_edgelist(df)

  expect_equal(nrow(result$edges), 3)  # Keeps all edges
})

test_that("create_nodes_df handles large number of nodes", {
  result <- create_nodes_df(1000)

  expect_equal(nrow(result), 1000)
  expect_equal(result$id, 1:1000)
})

test_that("aggregate_duplicate_edges preserves row attributes", {
  edges <- data.frame(
    from = c(1, 1, 2),
    to = c(2, 2, 3),
    weight = c(0.5, 0.3, 0.7)
  )
  result <- aggregate_duplicate_edges(edges, method = "sum")

  expect_equal(ncol(result), 3)  # from, to, weight preserved
})

test_that("detect_duplicate_edges info contains correct node pairs", {
  edges <- data.frame(
    from = c(5, 10, 5),
    to = c(10, 5, 10),
    weight = c(0.1, 0.2, 0.3)
  )
  result <- detect_duplicate_edges(edges)

  expect_true(result$has_duplicates)
  # All three should map to 5-10
  expect_equal(result$info[[1]]$nodes, c(5, 10))
  expect_equal(result$info[[1]]$count, 3)
})

# =============================================================================
# Complex scenarios
# =============================================================================

test_that("parse_matrix handles fully connected network", {
  n <- 4
  m <- matrix(1, nrow = n, ncol = n)
  diag(m) <- 0  # No self-loops
  result <- parse_matrix(m)

  expect_equal(nrow(result$nodes), 4)
  # For undirected, upper triangle has n*(n-1)/2 edges
  expect_equal(nrow(result$edges), 6)
})

test_that("parse_edgelist handles single edge network", {
  df <- data.frame(from = "A", to = "B")
  result <- parse_edgelist(df)

  expect_equal(nrow(result$nodes), 2)
  expect_equal(nrow(result$edges), 1)
})

test_that("parse_matrix with all zero weights returns empty edges", {
  m <- matrix(0, nrow = 3, ncol = 3)
  result <- parse_matrix(m)

  expect_equal(nrow(result$nodes), 3)
  expect_equal(nrow(result$edges), 0)
})

test_that("aggregate_duplicate_edges handles edges without weight column", {
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 2, 3))
  result <- aggregate_duplicate_edges(edges, method = "sum")

  # Should work even without weight column
  expect_equal(nrow(result), 2)
})