tests/testthat/test-ms-stability.R

In fmriAR: Fast AR and ARMA Noise Whitening for Functional MRI (fMRI) Design and Data

test_that("Multiscale pooling stabilizes AR coefficients across train folds", {
  skip_if_no_fmriAR()
  skip_if_not_installed("abind")

  h <- make_hierarchy(n_coarse = 4L, medium_per_coarse = 3L, fine_per_medium = 3L, vox_per_fine = 4L)
  sim_all <- simulate_hier_ar2(h, n_train_per_run = 140L, n_test = 140L, runs_train = 3L, seed = 789)
  parcels <- sim_all$parcels_fine

  # Build 3 folds: leave-one-run-out across the 3 training runs
  n_per_run <- 140L
  total_train <- 3L * n_per_run
  run_idx <- rep(1:3, each = n_per_run)

  get_plan <- function(keep_runs, multiscale) {
    idx <- run_idx %in% keep_runs
    Y_tr <- sim_all$Y_train[idx, , drop = FALSE]
    X_tr <- sim_all$X_train[idx, , drop = FALSE]
    fmriAR::fit_noise(Y = Y_tr, X = X_tr, parcels = parcels,
                      pooling = "parcel", multiscale = multiscale, ms_mode = "acvf_pooled", p_target = 2L)
  }

  # Collect phi_by_parcel across folds
  phi_fine_list <- list()
  phi_ms_list   <- list()
  folds <- list(c(2,3), c(1,3), c(1,2))
  for (f in seq_along(folds)) {
    plan_f <- get_plan(folds[[f]], multiscale = FALSE)
    plan_m <- get_plan(folds[[f]], multiscale = TRUE)
    phi_fine_list[[f]] <- plan_phi_by_parcel(plan_f)
    phi_ms_list[[f]]   <- plan_phi_by_parcel(plan_m)
  }

  # Stack and compute SD across folds per parcel and lag
  phi_fine_arr <- abind::abind(phi_fine_list, along = 3L)  # p x K x F
  phi_ms_arr   <- abind::abind(phi_ms_list,   along = 3L)

  sd_fine <- apply(phi_fine_arr, c(1,2), stats::sd, na.rm = TRUE)
  sd_ms   <- apply(phi_ms_arr,   c(1,2), stats::sd, na.rm = TRUE)

  # Compare median SD across parcels and lags
  med_fine <- median(sd_fine)
  med_ms   <- median(sd_ms)

  # Expect at least ~10% reduction in dispersion
  expect_lte(med_ms, 0.9 * med_fine)
})