tests/testthat/test-irt_simulate_parallel.R

In irtsim: Monte Carlo Simulation-Based Sample-Size Planning for Item Response Theory

# test-irt_simulate_parallel.R
# TDD tests for parallel parameter in irt_simulate() — Objective 25
# Tests the future.apply parallelization feature with reproducibility invariant.

# Helper functions (copied from test-irt_simulate.R for isolation)
make_1pl_study <- function(n_items = 10,
                           sample_sizes = c(100, 250),
                           missing = "none") {
  design <- irt_design(
    model = "1PL",
    n_items = n_items,
    item_params = list(b = seq(-2, 2, length.out = n_items))
  )
  irt_study(design, sample_sizes = sample_sizes, missing = missing)
}

make_2pl_study <- function(n_items = 10,
                           sample_sizes = c(100, 250),
                           missing = "none") {
  design <- irt_design(
    model = "2PL",
    n_items = n_items,
    item_params = list(
      a = rep(1.2, n_items),
      b = seq(-2, 2, length.out = n_items)
    )
  )
  irt_study(design, sample_sizes = sample_sizes, missing = missing)
}


# =============================================================================
# 1. Reproducibility Invariant (CRITICAL TEST)
#
# Contract: reproducibility is guaranteed *within* a dispatch mode, not across.
#
#   - Serial path: deterministic per-cell set.seed() under Mersenne-Twister.
#   - Parallel path: future.apply assigns each iteration a formally independent
#     L'Ecuyer-CMRG substream via future.seed = TRUE.
#
# Numeric results differ across modes by design. Both are statistically valid;
# the parallel path has the stronger formal guarantee (non-overlapping,
# uncorrelated substreams). See @details in ?irt_simulate.
# =============================================================================

test_that("serial dispatch is bit-identical across re-runs with the same seed", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100, 150))

  res_serial_1 <- irt_simulate(study, iterations = 5, seed = 42,
                               parallel = FALSE, progress = FALSE)
  res_serial_2 <- irt_simulate(study, iterations = 5, seed = 42,
                               parallel = FALSE, progress = FALSE)

  expect_identical(res_serial_1$item_results,  res_serial_2$item_results)
  expect_identical(res_serial_1$theta_results, res_serial_2$theta_results)
  expect_identical(res_serial_1$seed,          res_serial_2$seed)
  expect_identical(res_serial_1$iterations,    res_serial_2$iterations)
})

test_that("parallel dispatch is bit-identical across re-runs with the same seed", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100, 150))

  res_parallel_1 <- irt_simulate(study, iterations = 5, seed = 42,
                                 parallel = TRUE, progress = FALSE)
  res_parallel_2 <- irt_simulate(study, iterations = 5, seed = 42,
                                 parallel = TRUE, progress = FALSE)

  expect_identical(res_parallel_1$item_results,  res_parallel_2$item_results)
  expect_identical(res_parallel_1$theta_results, res_parallel_2$theta_results)
  expect_identical(res_parallel_1$seed,          res_parallel_2$seed)
  expect_identical(res_parallel_1$iterations,    res_parallel_2$iterations)
})

test_that("serial and parallel dispatch yield statistically valid results (schema-level agreement)", {
  # Across-mode numeric identity is NOT guaranteed (different RNG algorithms).
  # What must hold: same shape, same columns, same column types, same
  # converged count (modulo MC noise allowed by the design).
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100, 150))

  res_serial   <- irt_simulate(study, iterations = 5, seed = 42,
                               parallel = FALSE, progress = FALSE)
  res_parallel <- irt_simulate(study, iterations = 5, seed = 42,
                               parallel = TRUE,  progress = FALSE)

  # Structural invariants
  expect_identical(dim(res_serial$item_results),  dim(res_parallel$item_results))
  expect_identical(dim(res_serial$theta_results), dim(res_parallel$theta_results))
  expect_identical(names(res_serial$item_results),  names(res_parallel$item_results))
  expect_identical(names(res_serial$theta_results), names(res_parallel$theta_results))
  expect_identical(
    vapply(res_serial$item_results,  typeof, character(1)),
    vapply(res_parallel$item_results, typeof, character(1))
  )

  # Metadata fields must match exactly
  expect_identical(res_serial$seed,       res_parallel$seed)
  expect_identical(res_serial$iterations, res_parallel$iterations)
})


# =============================================================================
# 2. Default Behavior: parallel = FALSE by default
# =============================================================================

test_that("parallel defaults to FALSE", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  # Call without parallel argument
  res_default <- irt_simulate(study, iterations = 3, seed = 42)

  # Call with explicit parallel = FALSE
  res_explicit <- irt_simulate(study, iterations = 3, seed = 42, parallel = FALSE)

  # Should be identical
  expect_identical(res_default$item_results, res_explicit$item_results)
  expect_identical(res_default$theta_results, res_explicit$theta_results)
})


# =============================================================================
# 3. Type Checking: parallel must be a single logical
# =============================================================================

test_that("parallel = 'yes' raises an error", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  expect_error(
    irt_simulate(study, iterations = 3, seed = 42, parallel = "yes"),
    "parallel"
  )
})

test_that("parallel = 1 raises an error", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  expect_error(
    irt_simulate(study, iterations = 3, seed = 42, parallel = 1),
    "parallel"
  )
})

test_that("parallel = c(TRUE, FALSE) raises an error", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  expect_error(
    irt_simulate(study, iterations = 3, seed = 42, parallel = c(TRUE, FALSE)),
    "parallel"
  )
})

test_that("parallel = NA raises an error", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  expect_error(
    irt_simulate(study, iterations = 3, seed = 42, parallel = NA),
    "parallel"
  )
})


# =============================================================================
# 4. Parallel Mode: Works with Multiple Sample Sizes
# =============================================================================

test_that("parallel = TRUE works with multiple sample sizes", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100, 200))

  res <- irt_simulate(study, iterations = 3, seed = 42, parallel = TRUE)

  expect_s3_class(res, "irt_results")

  # Check correct number of rows
  # 1PL: 3 iterations × 2 sample_sizes × 5 items × 1 param per item = 30
  expected_rows <- 3 * 2 * 5 * 1
  expect_equal(nrow(res$item_results), expected_rows)

  # theta_results: 3 iterations × 2 sample_sizes = 6
  expected_theta_rows <- 3 * 2
  expect_equal(nrow(res$theta_results), expected_theta_rows)
})


# =============================================================================
# 5. Parallel Mode: Works with 2PL
# =============================================================================

test_that("parallel = TRUE works with 2PL", {
  # Note: sample_size bumped from 100 → 500 because 2PL with only 5 items
  # and n=100 is borderline under any RNG. Under Option B the parallel path
  # draws data from L'Ecuyer-CMRG substreams (not the per-cell MT seeds that
  # happened to work serially), so we need conditions where convergence is
  # robust to the specific random stream. n=500 is what you'd actually use
  # for a 2PL sample-size study anyway.
  study <- make_2pl_study(n_items = 5, sample_sizes = c(500))

  res <- irt_simulate(study, iterations = 3, seed = 42, parallel = TRUE)

  expect_s3_class(res, "irt_results")

  # 2PL: 3 iterations × 1 sample_size × 5 items × 2 params per item = 30
  expected_rows <- 3 * 1 * 5 * 2
  expect_equal(nrow(res$item_results), expected_rows)

  # Verify both a and b parameters are present
  expect_true(setequal(unique(res$item_results$param), c("a", "b")))

  # Check that some rows converged
  expect_true(sum(res$item_results$converged) > 0)
})


# =============================================================================
# 6. Progress Messages: Suppressed in Parallel Mode
# =============================================================================

test_that("progress messages are suppressed when parallel = TRUE", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  # Even with progress = TRUE, parallel mode should suppress messages
  expect_silent(
    irt_simulate(study, iterations = 5, seed = 42, parallel = TRUE,
                 progress = TRUE)
  )
})


# =============================================================================
# 7. Progress Messages: Preserved in Serial Mode
# =============================================================================

test_that("progress = TRUE runs without error in serial mode", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  # cli::cli_progress_bar uses its own connection handler that is not
  # reliably captured by capture.output(type = "message") across R
  # versions and cli backends. We test the functional contract: progress
  # = TRUE completes without error and returns valid results.
  res <- irt_simulate(
    study,
    iterations = 10,
    seed = 42,
    parallel = FALSE,
    progress = TRUE
  )

  expect_s3_class(res, "irt_results")
  expect_equal(res$iterations, 10L)
})


# =============================================================================
# 8. Large Iteration Test: Parallel Mode
# =============================================================================

test_that("parallel = TRUE works with large iteration count", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100, 200))

  # Moderate iteration count to keep test fast
  res <- irt_simulate(study, iterations = 20, seed = 42, parallel = TRUE)

  expect_s3_class(res, "irt_results")
  expect_equal(res$iterations, 20L)

  # Row count check: 20 × 2 × 5 × 1 = 200
  expect_equal(nrow(res$item_results), 200)
})


# =============================================================================
# 9. Seed Variation: Different Seeds Produce Different Results in Parallel
# =============================================================================

test_that("parallel mode respects different seeds", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100))

  res1 <- irt_simulate(study, iterations = 3, seed = 1, parallel = TRUE)
  res2 <- irt_simulate(study, iterations = 3, seed = 2, parallel = TRUE)

  # Different seeds should produce different estimates
  expect_false(identical(res1$item_results, res2$item_results))
})


# =============================================================================
# 10. Output Structure Consistency
# =============================================================================

test_that("parallel = TRUE produces same structure as parallel = FALSE", {
  study <- make_1pl_study(n_items = 5, sample_sizes = c(100, 200))

  res_serial <- irt_simulate(study, iterations = 3, seed = 42, parallel = FALSE)
  res_parallel <- irt_simulate(study, iterations = 3, seed = 42, parallel = TRUE)

  # Same column names and types
  expect_identical(names(res_serial$item_results),
                   names(res_parallel$item_results))
  expect_identical(names(res_serial$theta_results),
                   names(res_parallel$theta_results))

  # Same column classes
  expect_identical(sapply(res_serial$item_results, class),
                   sapply(res_parallel$item_results, class))
  expect_identical(sapply(res_serial$theta_results, class),
                   sapply(res_parallel$theta_results, class))
})