tests/testthat/test-backbone.R

In bibnets: Importing, Constructing, and Exporting Bibliometric Networks

## Tests for backbone() — Serrano disparity filter

## Hub graph: A is a hub with 3 weak edges and 1 strong one
## A-B(10), A-C(1), A-D(1), B-C(8), C-D(1)
make_backbone_edges <- function() {
  data.frame(
    from   = c("A", "A", "A", "B", "C"),
    to     = c("B", "C", "D", "C", "D"),
    weight = c(10,   1,   1,   8,   1),
    stringsAsFactors = FALSE
  )
}

test_that("backbone returns correct edges for hub graph at alpha 0.05", {
  edges <- make_backbone_edges()
  b <- backbone(edges, alpha = 0.05)

  ## Expected: A-B (alpha from A ≈ 0.028 < 0.05) and B-C (alpha from C = 0.04 < 0.05)
  ## All other edges have min-alpha above 0.05
  expect_equal(nrow(b), 2)
  expect_true(all(c("from", "to", "weight", "alpha") %in% names(b)))

  ## A-B must be present
  ab <- b[(b$from == "A" & b$to == "B") | (b$from == "B" & b$to == "A"), ]
  expect_equal(nrow(ab), 1)
  expect_equal(ab$weight, 10)

  ## B-C must be present
  bc <- b[(b$from == "B" & b$to == "C") | (b$from == "C" & b$to == "B"), ]
  expect_equal(nrow(bc), 1)
  expect_equal(bc$weight, 8)
})

test_that("backbone alpha values are correct", {
  edges <- make_backbone_edges()
  b <- backbone(edges, alpha = 0.9999)   # keep everything

  expect_equal(nrow(b), nrow(edges))

  ## For A-B edge: from A: s=12, k=3, alpha=(1-10/12)^2 = (1/6)^2 ≈ 0.0278
  ##               from B: s=18, k=2, alpha=(1-10/18)^1 = 8/18 ≈ 0.444
  ##               min = 0.0278
  ab <- b[(b$from == "A" & b$to == "B") | (b$from == "B" & b$to == "A"), ]
  expect_equal(ab$alpha, (1 - 10/12)^2, tolerance = 1e-10)
})

test_that("backbone returns empty data frame when no edges pass filter", {
  ## All weak, tiny graph — nothing passes strict alpha
  edges <- data.frame(
    from   = c("A", "B"),
    to     = c("B", "C"),
    weight = c(1,   1),
    stringsAsFactors = FALSE
  )
  ## Nodes with degree 1 always get alpha=0, so both edges are kept
  b <- backbone(edges, alpha = 0.01)
  expect_equal(nrow(b), 2)
})

test_that("backbone always keeps edges from degree-1 nodes", {
  ## A is a leaf (degree 1): its alpha = 0, so A-B is always kept
  edges <- data.frame(
    from   = c("A", "B", "B"),
    to     = c("B", "C", "D"),
    weight = c(1,   100,  100),
    stringsAsFactors = FALSE
  )
  b <- backbone(edges, alpha = 0.001)
  ## A-B should be kept (A has degree 1 → alpha=0 from A's side)
  ab <- b[(b$from == "A" & b$to == "B") | (b$from == "B" & b$to == "A"), ]
  expect_equal(nrow(ab), 1)
})

test_that("backbone returns input columns unchanged plus alpha", {
  edges <- make_backbone_edges()
  edges$count <- 1L
  b <- backbone(edges, alpha = 0.9999)  # keep all
  expect_true("count" %in% names(b))
  expect_true("alpha" %in% names(b))
})

test_that("backbone handles empty edge list", {
  empty <- data.frame(from = character(0), to = character(0),
                       weight = numeric(0), stringsAsFactors = FALSE)
  b <- backbone(empty, alpha = 0.05)
  expect_equal(nrow(b), 0)
  expect_true("alpha" %in% names(b))
})

test_that("backbone result is sorted by weight descending", {
  edges <- make_backbone_edges()
  b <- backbone(edges, alpha = 0.9999)
  expect_true(all(diff(b$weight) <= 0))
})

test_that("backbone rejects bad alpha values", {
  edges <- make_backbone_edges()
  expect_error(backbone(edges, alpha = 0))
  expect_error(backbone(edges, alpha = 1))
  expect_error(backbone(edges, alpha = -0.1))
  expect_error(backbone(edges, alpha = 1.1))
})