tests/test-backcompat.R

In bootnet: Bootstrap Methods for Various Network Estimation Routines

# Backward-compatibility reference values captured from bootnet 1.8
# (commit 580f1fe) on R 4.6.1 — these results must not change unless a
# NEWS-documented, intentional break is made.
#
# All data are generated with fixed seeds; every reference value below was
# produced twice from the installed bootnet 1.8 and verified to be bitwise
# identical across runs (including mgm, which is seeded immediately before
# the call).

library(bootnet)

## ---------------------------------------------------------------------------
## Data generation (fixed seeds — do not change)
## ---------------------------------------------------------------------------

# Gaussian data: 6 variables, 200 rows, Toeplitz correlation matrix 0.6^|i-j|
genGauss <- function(){
  Sigma <- 0.6 ^ abs(outer(1:6, 1:6, "-"))
  set.seed(20260716)
  d <- as.data.frame(mvtnorm::rmvnorm(200, sigma = Sigma))
  colnames(d) <- paste0("V", 1:6)
  d
}

# Binary data: 5 nodes, chain Ising graph (weight 0.7), thresholds -0.7, n = 500
genBinary <- function(){
  ig <- matrix(0, 5, 5)
  ig[cbind(1:4, 2:5)] <- 0.7
  ig <- ig + t(ig)
  set.seed(31415)
  d <- as.data.frame(IsingSampler::IsingSampler(500, ig, rep(-0.7, 5)))
  colnames(d) <- paste0("I", 1:5)
  d
}

gaussData <- genGauss()
binData   <- genBinary()

## ---------------------------------------------------------------------------
## a. EBICglasso
## ---------------------------------------------------------------------------

net_ebic <- estimateNetwork(gaussData, default = "EBICglasso", verbose = FALSE)

ref_ebic_graph <- structure(c(0, 0.5013921896, 0, 0.0458909248, 0, 0, 0.5013921896,
0, 0.3989122116, 0.0509131063, 0.03146761, 0, 0, 0.3989122116,
0, 0.3440014768, 0, 0.0105654823, 0.0458909248, 0.0509131063,
0.3440014768, 0, 0.3829775915, 0.0133346708, 0, 0.03146761, 0,
0.3829775915, 0, 0.4493225882, 0, 0, 0.0105654823, 0.0133346708,
0.4493225882, 0), dim = c(6L, 6L))

stopifnot(isTRUE(all.equal(round(unname(net_ebic$graph), 10),
                           ref_ebic_graph, tolerance = 1e-8)))
cat("OK: EBICglasso graph\n")

## ---------------------------------------------------------------------------
## b. ggmModSelect
## ---------------------------------------------------------------------------

net_gms <- estimateNetwork(gaussData, default = "ggmModSelect", verbose = FALSE)

ref_gms_graph <- structure(c(0, 0.5588904338, 0, 0, 0, 0, 0.5588904338, 0, 0.4519451477,
0, 0, 0, 0, 0.4519451477, 0, 0.4105052623, 0, 0, 0, 0, 0.4105052623,
0, 0.4294993889, 0, 0, 0, 0, 0.4294993889, 0, 0.5029608362, 0,
0, 0, 0, 0.5029608362, 0), dim = c(6L, 6L))

stopifnot(isTRUE(all.equal(round(unname(net_gms$graph), 10),
                           ref_gms_graph, tolerance = 1e-8)))
cat("OK: ggmModSelect graph\n")

## ---------------------------------------------------------------------------
## c. IsingFit
## ---------------------------------------------------------------------------

net_ising <- suppressWarnings(
  estimateNetwork(binData, default = "IsingFit", verbose = FALSE))

ref_ising_graph <- structure(c(0, 0.8472137518, 0, 0, 0, 0.8472137518, 0, 0.3789165163,
0, 0, 0, 0.3789165163, 0, 0.6413969983, 0, 0, 0, 0.6413969983,
0, 0.4259031921, 0, 0, 0, 0.4259031921, 0), dim = c(5L, 5L))

ref_ising_intercepts <- c(-0.7827314985, -0.7543547939, -0.4739905321,
                          -0.7296237443, -0.5371955831)

stopifnot(isTRUE(all.equal(round(unname(net_ising$graph), 10),
                           ref_ising_graph, tolerance = 1e-8)))
stopifnot(isTRUE(all.equal(round(unname(unlist(net_ising$intercepts)), 10),
                           ref_ising_intercepts, tolerance = 1e-8)))
cat("OK: IsingFit graph + intercepts\n")

## ---------------------------------------------------------------------------
## d. mgm (seed set immediately before the call; criterion = EBIC default)
## ---------------------------------------------------------------------------

set.seed(42)
net_mgm <- suppressWarnings(suppressMessages(
  estimateNetwork(binData, default = "mgm", verbose = FALSE)))

ref_mgm_graph <- structure(c(0, 0.423607139, 0, 0, 0, 0.423607139, 0, 0.1894588907,
0, 0, 0, 0.1894588907, 0, 0.3206992763, 0, 0, 0, 0.3206992763,
0, 0.2129518263, 0, 0, 0, 0.2129518263, 0), dim = c(5L, 5L))

stopifnot(isTRUE(all.equal(round(unname(net_mgm$graph), 10),
                           ref_mgm_graph, tolerance = 1e-8)))
cat("OK: mgm graph\n")

## ---------------------------------------------------------------------------
## e. Bootstrap results (nonparametric + person/case-drop) on EBICglasso net
## ---------------------------------------------------------------------------

set.seed(1234)
boot_np <- suppressMessages(
  bootnet(net_ebic, nBoots = 6, type = "nonparametric",
          statistics = c("edge", "strength"), verbose = FALSE))

# Sorted bootTable values (sorting makes this robust to row ordering)
ref_np_values <- c(-0.13939805, -0.10966104, -0.06282389, -0.03739441, -0.03564222,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0.00301201, 0.0088298, 0.00883062,
0.01299946, 0.01586979, 0.01590527, 0.01954646, 0.03346298, 0.03604092,
0.03668636, 0.03819781, 0.03957764, 0.03986875, 0.04030457, 0.04731852,
0.05130405, 0.0623849, 0.06917367, 0.09438307, 0.10960173, 0.1112265,
0.11175038, 0.11859931, 0.11885293, 0.1198825, 0.24607124, 0.28089999,
0.30633193, 0.33044699, 0.34043903, 0.34078203, 0.35364731, 0.37190248,
0.37300506, 0.37776775, 0.38969664, 0.40522278, 0.4107018, 0.41833464,
0.41899725, 0.42136412, 0.42919942, 0.43874591, 0.46995338, 0.48533852,
0.48840078, 0.4921327, 0.49328085, 0.49478216, 0.49496943, 0.51431166,
0.51918522, 0.52293325, 0.52983258, 0.54763095, 0.54901693, 0.56858632,
0.58465914, 0.5883564, 0.59526182, 0.59548093, 0.59597349, 0.6803367,
0.69123116, 0.69573331, 0.69853425, 0.72050956, 0.75085337, 0.75088232,
0.76085628, 0.76180316, 0.77848275, 0.79152637, 0.86249941, 0.8680938,
0.86872975, 0.87372246, 0.87974868, 0.90398624, 0.90438782, 0.92202198,
0.93543972, 0.93566801, 0.94559053, 0.97514951, 0.9868398, 1.0023142,
1.01596065, 1.06289669, 1.08311673, 1.14571073)

ref_np_dim  <- c(126L, 12L)
ref_np_cols <- c("name", "type", "node1", "node2", "value", "id", "nNode",
                 "nPerson", "rank_avg", "rank_min", "rank_max", "graph")

stopifnot(isTRUE(all.equal(round(sort(boot_np$bootTable$value), 8),
                           ref_np_values, tolerance = 1e-8)))
stopifnot(identical(dim(boot_np$bootTable), ref_np_dim))
stopifnot(identical(colnames(boot_np$bootTable), ref_np_cols))
cat("OK: nonparametric bootstrap values + bootTable structure\n")

set.seed(5678)
boot_cd <- suppressMessages(
  bootnet(net_ebic, nBoots = 6, type = "person", caseN = 3,
          verbose = FALSE))

ref_cs <- c(edge = 0.75, strength = 0.75)

cs <- round(suppressWarnings(corStability(boot_cd, verbose = FALSE)), 8)
stopifnot(isTRUE(all.equal(cs[names(ref_cs)], ref_cs, tolerance = 1e-8)))
cat("OK: person-drop bootstrap CS-coefficients\n")

cat("All backward-compatibility reference checks passed.\n")