tests/testthat/test-plot-mlvar.R

In cograph: Analysis and Visualization of Complex Networks

skip_coverage_tests()

# --- Helper: build a synthetic net_mlvar object ---
make_test_mlvar <- function(d = 5) {
  vars <- paste0("V", seq_len(d))

  make_netobj <- function(mat, dir, method) {
    nodes_df <- data.frame(id = seq_len(d), label = vars, name = vars,
                           stringsAsFactors = FALSE)
    obj <- list(
      weights    = mat,
      nodes      = nodes_df,
      edges      = data.frame(from = character(0), to = character(0)),
      directed   = dir,
      n_nodes    = d,
      n_edges    = 0L,
      method     = method,
      meta       = list(tna = list(method = method)),
      node_groups = NULL
    )
    class(obj) <- c("netobject", "cograph_network")
    obj
  }

  set.seed(99)
  temporal_mat <- matrix(rnorm(d * d, 0, 0.3), d, d, dimnames = list(vars, vars))

  contemp_mat <- matrix(rnorm(d * d, 0, 0.2), d, d)
  contemp_mat <- (contemp_mat + t(contemp_mat)) / 2
  diag(contemp_mat) <- 0
  dimnames(contemp_mat) <- list(vars, vars)

  between_mat <- matrix(rnorm(d * d, 0, 0.15), d, d)
  between_mat <- (between_mat + t(between_mat)) / 2
  diag(between_mat) <- 0
  dimnames(between_mat) <- list(vars, vars)

  fit <- list(
    temporal        = make_netobj(temporal_mat, TRUE,  "mlvar_temporal"),
    contemporaneous = make_netobj(contemp_mat,  FALSE, "mlvar_contemporaneous"),
    between         = make_netobj(between_mat,  FALSE, "mlvar_between")
  )
  class(fit) <- c("net_mlvar", "netobject_group")
  fit
}

# --- Type alias resolution ---
test_that(".resolve_mlvar_type resolves aliases", {
  resolve <- cograph:::.resolve_mlvar_type
  expect_equal(resolve("temporal"),        "temporal")
  expect_equal(resolve("t"),               "temporal")
  expect_equal(resolve("contemporaneous"), "contemporaneous")
  expect_equal(resolve("c"),               "contemporaneous")
  expect_equal(resolve("between"),         "between")
  expect_equal(resolve("b"),               "between")
  expect_equal(resolve("all"),             "all")
  expect_equal(resolve("a"),              "all")
  expect_equal(resolve("T"),               "temporal")
  expect_equal(resolve("C"),               "contemporaneous")
  expect_error(resolve("xyz"), "type must be one of")
})

# --- Plotting individual types ---
test_that("splot.net_mlvar plots temporal (default)", {
  fit <- make_test_mlvar()
  expect_no_error(splot(fit, filetype = "png",
                        filename = file.path(tempdir(), "mlvar_t")))
  expect_true(file.exists(paste0(tempdir(), "/mlvar_t.png")))
})

test_that("splot.net_mlvar plots contemporaneous via alias", {
  fit <- make_test_mlvar()
  expect_no_error(splot(fit, type = "c", filetype = "png",
                        filename = file.path(tempdir(), "mlvar_c")))
  expect_true(file.exists(paste0(tempdir(), "/mlvar_c.png")))
})

test_that("splot.net_mlvar plots between via alias", {
  fit <- make_test_mlvar()
  expect_no_error(splot(fit, type = "b", filetype = "png",
                        filename = file.path(tempdir(), "mlvar_b")))
  expect_true(file.exists(paste0(tempdir(), "/mlvar_b.png")))
})

# --- Panel mode ---
test_that("splot.net_mlvar type='all' renders 1x3 panel", {
  fit <- make_test_mlvar()
  expect_no_error(splot(fit, type = "all", filetype = "png",
                        filename = file.path(tempdir(), "mlvar_all"),
                        width = 21))
  expect_true(file.exists(paste0(tempdir(), "/mlvar_all.png")))
})

# --- User args override styling ---
test_that("user args override default styling", {
  fit <- make_test_mlvar()
  expect_no_error(splot(fit, type = "t",
                        layout = "circle", node_size = 15,
                        title = "Custom Title",
                        filetype = "png",
                        filename = file.path(tempdir(), "mlvar_override")))
  expect_true(file.exists(paste0(tempdir(), "/mlvar_override.png")))
})

# --- Missing network errors ---
test_that("splot.net_mlvar errors on missing network", {
  fit <- make_test_mlvar()
  fit$between <- NULL
  expect_error(splot(fit, type = "b"), "not found")
})

# --- Dispatch from splot() works ---
test_that("splot() dispatches net_mlvar before netobject_group", {
  fit <- make_test_mlvar()
  # If dispatch is wrong, this would hit plot_netobject_group and likely error
  # or produce a different plot. The key check is no error.
  expect_no_error(splot(fit, type = "t", filetype = "png",
                        filename = file.path(tempdir(), "mlvar_dispatch")))
})