tests/testthat/test-coverage-plot-hon-40.R

In cograph: Analysis and Visualization of Complex Networks

# Tests for plot_simplicial() with net_hon and net_hypa objects

skip_on_cran()

# ============================================
# Mock factories (no nestimate dependency)
# ============================================

create_mock_net_hon <- function(higher_order = TRUE, use_labels = FALSE) {
  states <- if (use_labels) {
    c("adapt", "cohesion", "consensus", "discuss")
  } else {
    c("1", "2", "3", "4")
  }
  if (higher_order) {
    edges <- data.frame(
      path = if (use_labels) {
        c("adapt -> cohesion", "cohesion -> consensus",
          "adapt -> cohesion -> consensus",
          "cohesion -> consensus -> discuss")
      } else {
        c("1 -> 2", "2 -> 3", "1 -> 2 -> 3", "2 -> 3 -> 4")
      },
      from = if (use_labels) {
        c("adapt", "cohesion", "adapt -> cohesion",
          "cohesion -> consensus")
      } else {
        c("1", "2", "1 -> 2", "2 -> 3")
      },
      to = if (use_labels) {
        c("cohesion", "consensus", "consensus", "discuss")
      } else {
        c("2", "3", "3", "4")
      },
      count = c(10L, 8L, 5L, 3L),
      probability = c(0.5, 0.4, 0.25, 0.15),
      from_order = c(1L, 1L, 2L, 2L),
      to_order = c(2L, 2L, 3L, 3L),
      stringsAsFactors = FALSE
    )
  } else {
    edges <- data.frame(
      path = if (use_labels) {
        c("adapt -> cohesion", "cohesion -> consensus",
          "consensus -> discuss")
      } else {
        c("1 -> 2", "2 -> 3", "3 -> 4")
      },
      from = states[1:3],
      to = states[2:4],
      count = c(10L, 8L, 6L),
      probability = c(0.5, 0.4, 0.3),
      from_order = c(1L, 1L, 1L),
      to_order = c(2L, 2L, 2L),
      stringsAsFactors = FALSE
    )
  }
  structure(list(
    edges = edges,
    first_order_states = states,
    matrix = matrix(0, 4, 4, dimnames = list(states, states))
  ), class = "net_hon")
}

create_mock_net_hypa <- function(has_anomalies = TRUE, use_labels = FALSE) {
  if (has_anomalies) {
    scores <- data.frame(
      path = if (use_labels) {
        c("adapt -> cohesion -> consensus",
          "cohesion -> consensus -> discuss",
          "adapt -> consensus -> discuss",
          "consensus -> adapt -> cohesion")
      } else {
        c("1 -> 2 -> 3", "2 -> 3 -> 4", "1 -> 3 -> 4", "3 -> 1 -> 2")
      },
      anomaly = c("over", "under", "normal", "over"),
      ratio = c(5.0, 3.2, 1.0, 4.1),
      stringsAsFactors = FALSE
    )
  } else {
    scores <- data.frame(
      path = if (use_labels) {
        c("adapt -> cohesion -> consensus",
          "cohesion -> consensus -> discuss")
      } else {
        c("1 -> 2 -> 3", "2 -> 3 -> 4")
      },
      anomaly = c("normal", "normal"),
      ratio = c(1.0, 0.9),
      stringsAsFactors = FALSE
    )
  }
  nodes <- if (use_labels) {
    c("adapt\x01cohesion", "cohesion\x01consensus",
      "consensus\x01discuss", "adapt\x01consensus")
  } else {
    c("1\x012", "2\x013", "3\x014", "1\x013")
  }
  structure(list(
    scores = scores,
    nodes = nodes,
    adjacency = matrix(0, 4, 4)
  ), class = "net_hypa")
}

# Mock tna object with labels for numeric ID translation
create_mock_tna <- function() {
  labels <- c("adapt", "cohesion", "consensus", "discuss")
  mat <- matrix(0.25, 4, 4, dimnames = list(labels, labels))
  diag(mat) <- 0
  structure(list(
    weights = mat,
    labels = labels,
    inits = rep(0.25, 4),
    data = NULL
  ), class = "tna")
}

# ============================================
# .extract_hon_pathways tests
# ============================================

test_that(".extract_hon_pathways extracts higher-order edges", {
  hon <- create_mock_net_hon()
  paths <- cograph:::.extract_hon_pathways(hon)
  expect_length(paths, 2)
  expect_equal(paths[1], "1 2 -> 3")
  expect_equal(paths[2], "2 3 -> 4")
})

test_that(".extract_hon_pathways returns empty for first-order only", {
  hon <- create_mock_net_hon(higher_order = FALSE)
  paths <- cograph:::.extract_hon_pathways(hon)
  expect_length(paths, 0)
  expect_identical(paths, character(0))
})

test_that(".extract_hon_pathways translates numeric IDs with label_map", {
  hon <- create_mock_net_hon()
  label_map <- c("1" = "adapt", "2" = "cohesion",
                 "3" = "consensus", "4" = "discuss")
  paths <- cograph:::.extract_hon_pathways(hon, label_map = label_map)
  expect_length(paths, 2)
  expect_equal(paths[1], "adapt cohesion -> consensus")
  expect_equal(paths[2], "cohesion consensus -> discuss")
})

test_that(".extract_hon_pathways sorts by count descending", {
  hon <- create_mock_net_hon()
  # count: 5, 3 — first HO edge has count=5
  paths <- cograph:::.extract_hon_pathways(hon)
  expect_equal(paths[1], "1 2 -> 3")  # count=5
  expect_equal(paths[2], "2 3 -> 4")  # count=3
})

# ============================================
# .extract_hypa_pathways tests
# ============================================

test_that(".extract_hypa_pathways extracts anomalous paths", {
  hypa <- create_mock_net_hypa()
  paths <- cograph:::.extract_hypa_pathways(hypa)
  expect_length(paths, 3)
  # Sorted by ratio descending: 5.0, 4.1, 3.2
  expect_equal(paths[1], "1 2 -> 3")   # ratio=5.0
  expect_equal(paths[2], "3 1 -> 2")   # ratio=4.1
  expect_equal(paths[3], "2 3 -> 4")   # ratio=3.2
})

test_that(".extract_hypa_pathways filters by type", {
  hypa <- create_mock_net_hypa()
  over <- cograph:::.extract_hypa_pathways(hypa, type = "over")
  expect_length(over, 2)

  under <- cograph:::.extract_hypa_pathways(hypa, type = "under")
  expect_length(under, 1)
  expect_equal(under, "2 3 -> 4")
})

test_that(".extract_hypa_pathways returns empty for no anomalies", {
  hypa <- create_mock_net_hypa(has_anomalies = FALSE)
  paths <- cograph:::.extract_hypa_pathways(hypa)
  expect_length(paths, 0)
  expect_identical(paths, character(0))
})

test_that(".extract_hypa_pathways translates with label_map", {
  hypa <- create_mock_net_hypa()
  label_map <- c("1" = "adapt", "2" = "cohesion",
                 "3" = "consensus", "4" = "discuss")
  paths <- cograph:::.extract_hypa_pathways(hypa, label_map = label_map)
  expect_true("adapt cohesion -> consensus" %in% paths)
  expect_true("cohesion consensus -> discuss" %in% paths)
})

# ============================================
# .build_hon_label_map tests
# ============================================

test_that(".build_hon_label_map returns named vector from tna", {
  model <- create_mock_tna()
  lm <- cograph:::.build_hon_label_map(model)
  expect_equal(lm, c("1" = "adapt", "2" = "cohesion",
                      "3" = "consensus", "4" = "discuss"))
})

test_that(".build_hon_label_map returns NULL for non-tna", {
  expect_null(cograph:::.build_hon_label_map(NULL))
  mat <- matrix(0, 3, 3)
  expect_null(cograph:::.build_hon_label_map(mat))
})

# ============================================
# .extract_blob_states for HON/HYPA
# ============================================

test_that(".extract_blob_states returns first_order_states for net_hon", {
  hon <- create_mock_net_hon()
  states <- cograph:::.extract_blob_states(hon)
  expect_equal(states, c("1", "2", "3", "4"))
})

test_that(".extract_blob_states extracts unique states from net_hypa nodes", {
  hypa <- create_mock_net_hypa()
  states <- cograph:::.extract_blob_states(hypa)
  expect_true(is.character(states))
  expect_true(all(c("1", "2", "3", "4") %in% states))
  expect_equal(states, sort(unique(states)))
})

# ============================================
# plot_simplicial(x, hon) — tna + HON
# ============================================

test_that("plot_simplicial(tna, hon) translates labels and renders", {
  model <- create_mock_tna()
  hon <- create_mock_net_hon()
  expect_no_error(p <- with_temp_png(
    plot_simplicial(model, hon, dismantled = TRUE)
  ))
  expect_true(inherits(p, "grob") || is.list(p))
})

test_that("plot_simplicial(tna, hypa) translates labels and renders", {
  model <- create_mock_tna()
  hypa <- create_mock_net_hypa()
  expect_no_error(p <- with_temp_png(
    plot_simplicial(model, hypa, dismantled = TRUE)
  ))
  expect_true(inherits(p, "grob") || is.list(p))
})

# ============================================
# plot_simplicial(hon) — HON as x
# ============================================

test_that("plot_simplicial(hon) auto-extracts with numeric labels", {
  hon <- create_mock_net_hon()
  expect_no_error(p <- with_temp_png(plot_simplicial(hon)))
  expect_s3_class(p, "ggplot")
})

test_that("plot_simplicial(hon) with label states works directly", {
  hon <- create_mock_net_hon(use_labels = TRUE)
  expect_no_error(p <- with_temp_png(plot_simplicial(hon)))
  expect_s3_class(p, "ggplot")
})

test_that("plot_simplicial returns NULL for HON without HO edges", {
  hon <- create_mock_net_hon(higher_order = FALSE)
  expect_message(
    result <- plot_simplicial(hon),
    "No higher-order pathways"
  )
  expect_null(result)
})

# ============================================
# plot_simplicial(hypa) — HYPA as x
# ============================================

test_that("plot_simplicial(hypa) auto-extracts anomalous paths", {
  hypa <- create_mock_net_hypa()
  expect_no_error(p <- with_temp_png(plot_simplicial(hypa)))
  expect_s3_class(p, "ggplot")
})

test_that("plot_simplicial returns NULL for HYPA without anomalies", {
  hypa <- create_mock_net_hypa(has_anomalies = FALSE)
  expect_message(
    result <- plot_simplicial(hypa),
    "No anomalous pathways"
  )
  expect_null(result)
})

# ============================================
# plot_simplicial(tna, hon) returns NULL for no HO edges
# ============================================

test_that("plot_simplicial(tna, hon) with no HO edges returns NULL", {
  model <- create_mock_tna()
  hon <- create_mock_net_hon(higher_order = FALSE)
  expect_message(
    result <- plot_simplicial(model, hon),
    "No higher-order pathways"
  )
  expect_null(result)
})

test_that("plot_simplicial(tna, hypa) with no anomalies returns NULL", {
  model <- create_mock_tna()
  hypa <- create_mock_net_hypa(has_anomalies = FALSE)
  expect_message(
    result <- plot_simplicial(model, hypa),
    "No anomalous pathways"
  )
  expect_null(result)
})

# ============================================
# max_pathways limiting
# ============================================

test_that("max_pathways limits number of pathways displayed", {
  model <- create_mock_tna()
  hon <- create_mock_net_hon()
  # HON has 2 HO pathways; limit to 1
  expect_no_error(p <- with_temp_png(
    plot_simplicial(model, hon, max_pathways = 1)
  ))
  expect_s3_class(p, "ggplot")
})

test_that("max_pathways = NULL shows all pathways", {
  hon <- create_mock_net_hon()
  expect_no_error(p <- with_temp_png(
    plot_simplicial(hon, max_pathways = NULL)
  ))
  expect_s3_class(p, "ggplot")
})

# ============================================
# User pathways override auto-extraction
# ============================================

test_that("plot_simplicial uses user pathways over auto-extraction for HON", {
  hon <- create_mock_net_hon(use_labels = TRUE)
  custom <- c("adapt cohesion -> discuss", "consensus discuss -> adapt")
  expect_no_error(p <- with_temp_png(
    plot_simplicial(hon, pathways = custom)
  ))
  expect_s3_class(p, "ggplot")
})

# ============================================
# Error when pathways missing and x is not HON/HYPA
# ============================================

test_that("plot_simplicial errors when pathways NULL and x is plain matrix", {
  mat <- matrix(0, 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C")))
  expect_error(
    plot_simplicial(mat),
    "pathways.*must be provided"
  )
})

test_that("plot_simplicial errors when pathways NULL and x is NULL", {
  expect_error(
    plot_simplicial(x = NULL),
    "pathways.*must be provided"
  )
})

# ============================================
# Regression: existing functionality unchanged
# ============================================

test_that("plot_simplicial still works with explicit pathways (regression)", {
  mat <- matrix(runif(16), 4, 4,
                dimnames = list(LETTERS[1:4], LETTERS[1:4]))
  diag(mat) <- 0
  expect_no_error(p <- with_temp_png(
    plot_simplicial(mat, c("A B -> C", "B C -> D"))
  ))
  expect_s3_class(p, "ggplot")
})

test_that("plot_simplicial with NULL x and explicit pathways still works", {
  expect_no_error(p <- with_temp_png(
    plot_simplicial(pathways = c("A B -> C", "X Y -> Z"))
  ))
  expect_s3_class(p, "ggplot")
})

# ============================================
# Direct tna/netobject support (requires Nestimate)
# ============================================

test_that("plot_simplicial(tna) auto-builds HON from sequence data", {
  skip_if_not_installed("Nestimate")
  skip_if_no_tna()
  model <- tna::tna(tna::group_regulation)
  expect_no_error(p <- with_temp_png(
    plot_simplicial(model, max_pathways = 5)
  ))
  expect_s3_class(p, "ggplot")
})

test_that("plot_simplicial(tna, method='hypa') auto-builds HYPA", {
  skip_if_not_installed("Nestimate")
  skip_if_no_tna()
  model <- tna::tna(tna::group_regulation)
  expect_no_error(p <- with_temp_png(
    plot_simplicial(model, method = "hypa", max_pathways = 5)
  ))
  expect_s3_class(p, "ggplot")
})

test_that("plot_simplicial(tna) dismantled uses grid layout", {
  skip_if_not_installed("Nestimate")
  skip_if_no_tna()
  model <- tna::tna(tna::group_regulation)
  expect_no_error(p <- with_temp_png(
    plot_simplicial(model, max_pathways = 4, dismantled = TRUE, ncol = 2)
  ))
  expect_true(inherits(p, "grob") || is.list(p))
})

test_that("plot_simplicial(netobject) auto-builds HON", {
  skip_if_not_installed("Nestimate")
  skip_if_no_tna()
  df <- as.data.frame(tna::tna(tna::group_regulation)$data)
  net <- Nestimate::build_network(df, method = "tna")
  expect_no_error(p <- with_temp_png(
    plot_simplicial(net, max_pathways = 5)
  ))
  expect_s3_class(p, "ggplot")
})

# ============================================
# .extract_sequence_data tests
# ============================================

test_that(".extract_sequence_data converts tna data to labeled df", {
  skip_if_no_tna()
  model <- tna::tna(tna::group_regulation)
  df <- cograph:::.extract_sequence_data(model)
  expect_s3_class(df, "data.frame")
  # Should have character values (state labels), not numeric
  expect_true(is.character(df[[1]]))
})

test_that(".extract_sequence_data returns NULL for unsupported types", {
  expect_null(cograph:::.extract_sequence_data(NULL))
  expect_null(cograph:::.extract_sequence_data(matrix(0, 3, 3)))
})

# ============================================
# .build_higher_order tests
# ============================================

test_that(".build_higher_order errors without Nestimate", {
  # Can't really test this if Nestimate is installed, so just test bad method
  skip_if_not_installed("Nestimate")
  skip_if_no_tna()
  model <- tna::tna(tna::group_regulation)
  expect_error(
    cograph:::.build_higher_order(model, method = "bad"),
    "method must be"
  )
})

test_that(".build_higher_order errors for objects without data", {
  skip_if_not_installed("Nestimate")
  tna_no_data <- structure(list(
    weights = matrix(0, 3, 3), labels = c("A", "B", "C"),
    inits = c(1/3, 1/3, 1/3), data = NULL
  ), class = "tna")
  expect_error(
    cograph:::.build_higher_order(tna_no_data),
    "Cannot extract sequence data"
  )
})

# ============================================
# ncol parameter for grid layout
# ============================================

test_that("ncol controls grid columns in dismantled mode", {
  hon <- create_mock_net_hon()
  expect_no_error(p <- with_temp_png(
    plot_simplicial(hon, dismantled = TRUE, ncol = 1)
  ))
  expect_true(inherits(p, "grob") || is.list(p))
})