tests/testthat/test-from-converters.R

In cograph: Analysis and Visualization of Complex Networks

# test-from-converters.R - Converter Function Tests
# Tests for from_qgraph() and from_tna()

# ============================================
# FROM_QGRAPH() BASIC FUNCTIONALITY
# ============================================

skip_on_cran()

test_that("from_qgraph() validates input is qgraph object", {
  # Non-qgraph input should error
  expect_error(from_qgraph(matrix(1:4, 2, 2)))
  expect_error(from_qgraph(list(a = 1)), "qgraph")
  expect_error(from_qgraph(data.frame(from = 1, to = 2)))
})

test_that("from_qgraph() works with actual qgraph object", {
  skip_if_no_qgraph()

  # Create a simple qgraph object
  adj <- matrix(c(0, 0.5, -0.3, 0.5, 0, 0.4, -0.3, 0.4, 0), 3, 3)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  # Should return params without plotting when plot=FALSE
  params <- from_qgraph(q, plot = FALSE)

  expect_true(is.list(params))
  expect_true("x" %in% names(params))
})

test_that("from_qgraph() extracts layout from qgraph", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE, layout = "circle")

  params <- from_qgraph(q, plot = FALSE)

  expect_true("layout" %in% names(params))
  expect_true(is.matrix(params$layout))
  expect_equal(nrow(params$layout), 3)
})

test_that("from_qgraph() extracts node labels", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3)
  rownames(adj) <- colnames(adj) <- c("A", "B", "C")
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  params <- from_qgraph(q, plot = FALSE)

  expect_true("labels" %in% names(params))
  expect_equal(unname(params$labels), c("A", "B", "C"))
})

test_that("from_qgraph() handles engine selection", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 1, 0), 2, 2)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  # Both engines should work
  params_splot <- from_qgraph(q, engine = "splot", plot = FALSE)
  params_soplot <- from_qgraph(q, engine = "soplot", plot = FALSE)

  expect_true(is.list(params_splot))
  expect_true(is.list(params_soplot))
})

test_that("from_qgraph() respects weight_digits parameter", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 0.12345, 0.12345, 0), 2, 2)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  params <- from_qgraph(q, weight_digits = 2, plot = FALSE)

  expect_equal(params$weight_digits, 2)
})

test_that("from_qgraph() handles override parameters", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 1, 0), 2, 2)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  params <- from_qgraph(q, plot = FALSE, theme = "dark", node_size = 5)

  expect_equal(params$theme, "dark")
  expect_equal(params$node_size, 5)
})

test_that("from_qgraph() extracts directed setting", {
  skip_if_no_qgraph()

  # Asymmetric matrix -> directed
  adj <- matrix(c(0, 1, 0, 0), 2, 2)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE, directed = TRUE)

  params <- from_qgraph(q, plot = FALSE)

  expect_true("directed" %in% names(params))
})

test_that("from_qgraph() can plot with splot engine", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  result <- safe_plot({
    from_qgraph(q, engine = "splot", plot = TRUE)
  })

  expect_true(result$success, info = result$error)
})

test_that("from_qgraph() handles pie/donut conversion", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 1, 0), 2, 2)
  # qgraph pie values get mapped to donut_fill
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE, pie = c(0.3, 0.7))

  params <- from_qgraph(q, plot = FALSE)

  # Should have donut-related parameters if pie was specified
  # (depends on qgraph version and how it stores pie data)
  expect_true(is.list(params))
})

# ============================================
# FROM_QGRAPH() SHAPE MAPPING
# ============================================

test_that("map_qgraph_shape() converts shapes correctly", {
  map_qgraph_shape <- cograph:::map_qgraph_shape

  # Test known mappings
  expect_equal(map_qgraph_shape("rectangle"), "square")
  expect_equal(map_qgraph_shape("square"), "square")
  expect_equal(map_qgraph_shape("circle"), "circle")
  expect_equal(map_qgraph_shape("ellipse"), "circle")
  expect_equal(map_qgraph_shape("triangle"), "triangle")
  expect_equal(map_qgraph_shape("diamond"), "diamond")
})

test_that("map_qgraph_shape() preserves unknown shapes", {
  map_qgraph_shape <- cograph:::map_qgraph_shape

  expect_equal(map_qgraph_shape("unknown"), "unknown")
  expect_equal(map_qgraph_shape("custom_shape"), "custom_shape")
})

test_that("map_qgraph_shape() handles vectors", {
  map_qgraph_shape <- cograph:::map_qgraph_shape

  shapes <- c("rectangle", "circle", "triangle")
  result <- map_qgraph_shape(shapes)

  expect_equal(result, c("square", "circle", "triangle"))
})

# ============================================
# FROM_QGRAPH() LINE TYPE MAPPING
# ============================================

test_that("map_qgraph_lty() converts line types correctly", {
  map_qgraph_lty <- cograph:::map_qgraph_lty

  # Numeric codes
  expect_equal(map_qgraph_lty(1), "solid")
  expect_equal(map_qgraph_lty(2), "dashed")
  expect_equal(map_qgraph_lty(3), "dotted")

  # String names
  expect_equal(map_qgraph_lty("solid"), "solid")
  expect_equal(map_qgraph_lty("dashed"), "dashed")
  expect_equal(map_qgraph_lty("dotted"), "dotted")
})

test_that("map_qgraph_lty() handles unknown values", {
  map_qgraph_lty <- cograph:::map_qgraph_lty

  expect_equal(map_qgraph_lty(99), "solid")  # Falls back to solid
})

test_that("map_qgraph_lty() handles vectors", {
  map_qgraph_lty <- cograph:::map_qgraph_lty

  ltys <- c(1, 2, 3)
  result <- map_qgraph_lty(ltys)

  expect_equal(result, c("solid", "dashed", "dotted"))
})

# ============================================
# FROM_TNA() BASIC FUNCTIONALITY
# ============================================

test_that("from_tna() validates input is tna object", {
  # Non-tna input should error
  expect_error(from_tna(matrix(1:4, 2, 2)), "tna")
  expect_error(from_tna(list(a = 1)), "tna")
  expect_error(from_tna(data.frame(from = 1, to = 2)), "tna")
})

test_that("from_tna() works with tna object", {
  skip_if_no_tna()

  # Create a transition matrix for tna
  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")

  tna_obj <- tna::tna(trans_mat)
  params <- from_tna(tna_obj, plot = FALSE)

  expect_true(is.list(params))
  expect_true("x" %in% names(params))
})

test_that("from_tna() extracts transition matrix", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  params <- from_tna(tna_obj, plot = FALSE)

  expect_true("x" %in% names(params))
  expect_true(is.matrix(params$x))
})

test_that("from_tna() extracts labels", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  params <- from_tna(tna_obj, plot = FALSE)

  expect_true("labels" %in% names(params))
})

test_that("from_tna() maps initial probabilities to donut_fill", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  params <- from_tna(tna_obj, plot = FALSE)

  expect_true("donut_fill" %in% names(params))
})

test_that("from_tna() sets directed=TRUE", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  params <- from_tna(tna_obj, plot = FALSE)

  expect_true(params$directed)
})

test_that("from_tna() handles engine selection", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 1, 1, 0), 2, 2)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B")
  tna_obj <- tna::tna(trans_mat)

  params_splot <- from_tna(tna_obj, engine = "splot", plot = FALSE)
  params_soplot <- from_tna(tna_obj, engine = "soplot", plot = FALSE)

  expect_true(is.list(params_splot))
  expect_true(is.list(params_soplot))
})

test_that("from_tna() respects weight_digits parameter", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  params <- from_tna(tna_obj, weight_digits = 3, plot = FALSE)

  expect_equal(params$weight_digits, 3)
})

test_that("from_tna() handles override parameters", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  params <- from_tna(tna_obj, plot = FALSE, node_size = 8, theme = "dark")

  expect_equal(params$node_size, 8)
  expect_equal(params$theme, "dark")
})

test_that("from_tna() can plot with splot engine", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  result <- safe_plot({
    from_tna(tna_obj, engine = "splot", plot = TRUE)
  })

  expect_true(result$success, info = result$error)
})

# ============================================
# SPLOT() DIRECT TNA SUPPORT
# ============================================

test_that("splot() accepts tna object directly", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  result <- safe_plot(splot(tna_obj))
  expect_true(result$success, info = result$error)
})

test_that("splot() with tna applies user overrides", {
  skip_if_no_tna()

  trans_mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(trans_mat) <- colnames(trans_mat) <- c("A", "B", "C")
  tna_obj <- tna::tna(trans_mat)

  result <- safe_plot(splot(tna_obj, theme = "dark", node_size = 6))
  expect_true(result$success, info = result$error)
})

# ============================================
# EDGE VECTOR REORDERING
# ============================================

test_that("from_qgraph() correctly reorders edge vectors", {
  skip_if_no_qgraph()

  # Create a network where qgraph and cograph might have different edge orders
  adj <- matrix(c(0, 1, 0.5, 1, 0, 0.8, 0.5, 0.8, 0), 3, 3)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  params <- from_qgraph(q, plot = FALSE)

  # The matrix should be preserved correctly
  expect_true(is.matrix(params$x))
  expect_equal(dim(params$x), c(3, 3))
})

# ============================================
# ERROR HANDLING
# ============================================

test_that("from_qgraph() handles missing Arguments field gracefully", {
  # Create a malformed "qgraph-like" object
  fake_qgraph <- list(
    graphAttributes = list(Nodes = list(), Edges = list()),
    Edgelist = list(from = 1, to = 2)
  )
  class(fake_qgraph) <- "qgraph"

  # Should error because Arguments field is missing
  expect_error(from_qgraph(fake_qgraph))
})

test_that("from_tna() handles empty tna object",
 {
  skip_if_no_tna()

  # Creating an empty tna object might not be possible

  # but we should handle edge cases gracefully
  skip("Depends on tna package behavior with empty input")
})

# ============================================
# INTEGRATION
# ============================================

test_that("from_qgraph() output can be customized with sn_* functions", {
  skip_if_no_qgraph()

  adj <- matrix(c(0, 1, 1, 0), 2, 2)
  q <- qgraph::qgraph(adj, DoNotPlot = TRUE)

  # Plot with from_qgraph, then the result can be further customized
  result <- with_temp_png({
    from_qgraph(q, engine = "splot", plot = TRUE)
  })

  # Just verify it completes without error
  expect_true(TRUE)
})

# ============================================
# TNA_STYLING PARAMETER
# ============================================

test_that("splot() tna_styling = TRUE works on plain matrix", {
  mat <- create_test_matrix(4, symmetric = FALSE)
  result <- safe_plot(splot(mat, tna_styling = TRUE))
  expect_true(result$success, info = result$error)
})

test_that("splot() tna_styling = TRUE with user overrides", {
  mat <- create_test_matrix(4, symmetric = FALSE)
  result <- safe_plot(splot(mat, tna_styling = TRUE,
                            edge_color = "red", layout = "circle"))
  expect_true(result$success, info = result$error)
})

test_that("splot() tna_styling = FALSE on tna object strips visual defaults", {
  mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")
  mock_tna <- structure(
    list(weights = mat, labels = c("A", "B", "C"),
         inits = c(0.4, 0.3, 0.3), data = NULL),
    class = c("tna", "list")
  )
  result <- safe_plot(splot(mock_tna, tna_styling = FALSE))
  expect_true(result$success, info = result$error)
})

test_that(".tna_style_defaults() returns expected structure", {
  defs <- cograph:::.tna_style_defaults(5, TRUE)
  expect_true(is.list(defs))
  expect_equal(defs$layout, "oval")
  expect_equal(defs$edge_color, "#003355")
  expect_equal(defs$node_size, 7)
  expect_equal(defs$arrow_size, 0.61)
  expect_equal(defs$edge_start_style, "dotted")
  expect_equal(length(defs$node_fill), 5)

  # Undirected — no arrow defaults

  defs_undir <- cograph:::.tna_style_defaults(3, FALSE)
  expect_null(defs_undir$arrow_size)
  expect_null(defs_undir$edge_start_style)
})

test_that("group_tna forwards all user args", {
  mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")
  mock_tna <- structure(
    list(weights = mat, labels = c("A", "B", "C"),
         inits = c(0.4, 0.3, 0.3), data = NULL),
    class = c("tna", "list")
  )
  mock_group <- structure(
    list(G1 = mock_tna, G2 = mock_tna),
    class = c("group_tna", "list")
  )

  # All user args (node_size, edge_color) should be forwarded
  result <- safe_plot(splot(mock_group, edge_color = "darkred", node_size = 10))
  expect_true(result$success, info = result$error)

  # i selection with user args forwarded via ...
  result2 <- safe_plot(splot(mock_group, i = 1, edge_color = "purple",
                             background = "gray95"))
  expect_true(result2$success, info = result2$error)

  # Custom title with grid (covers paste(title, "-", group_name) branch)
  result3 <- safe_plot(splot(mock_group, title = "My Network"))
  expect_true(result3$success, info = result3$error)
})

test_that("splot() tna object with ... args", {
  mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.4, 0.6, 0), 3, 3, byrow = TRUE)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")
  mock_tna <- structure(
    list(weights = mat, labels = c("A", "B", "C"),
         inits = c(0.4, 0.3, 0.3), data = NULL),
    class = c("tna", "list")
  )
  # Pass background via ... to hit the .dots loop in tna path
  result <- safe_plot(splot(mock_tna, background = "gray95"))
  expect_true(result$success, info = result$error)
})

test_that("splot() tna_styling = TRUE on non-matrix input (igraph)", {
  skip_if_not_installed("igraph")
  g <- igraph::make_ring(4)
  # Covers the non-matrix default directed = TRUE branch

  result <- safe_plot(splot(g, tna_styling = TRUE))
  expect_true(result$success, info = result$error)
})