tests/testthat/test-runFalsePositiveSimulationStudy.R

In bifrost: Branch-Level Inference Framework for Recognizing Optimal Shifts in Traits

skip_if_fp_study_deps <- function() {
  testthat::skip_if_not_installed("ape")
  testthat::skip_if_not_installed("phytools")
  testthat::skip_if_not_installed("mvMORPH")
  testthat::skip_if_not_installed("future")
  testthat::skip_if_not_installed("future.apply")
  testthat::skip_if_not_installed("progressr")
  withr::local_options(list(progressr.enable = FALSE))
}

.fp_template_cache <- new.env(parent = emptyenv())

get_cached_fp_template <- function(key, builder) {
  if (!exists(key, envir = .fp_template_cache, inherits = FALSE)) {
    assign(key, builder(), envir = .fp_template_cache)
  }
  unserialize(serialize(get(key, envir = .fp_template_cache, inherits = FALSE), NULL))
}

make_fp_template <- function() {
  get_cached_fp_template("fp_template", function() {
    set.seed(30)
    tr <- ape::rtree(22)
    X <- matrix(rnorm(22 * 2), ncol = 2)
    rownames(X) <- tr$tip.label
    createSimulationTemplate(
      baseline_tree = tr,
      trait_data = X,
      formula = "trait_data ~ 1",
      method = "LL"
    )
  })
}

make_formula_fp_template <- function() {
  get_cached_fp_template("formula_fp_template", function() {
    set.seed(31)
    tr <- ape::rtree(22)
    grp <- factor(rep(c("a", "b"), length.out = 22))
    size <- rnorm(22)
    X <- data.frame(
      y1 = 0.4 * size + ifelse(grp == "b", 0.8, 0) + rnorm(22),
      y2 = -0.2 * size + ifelse(grp == "b", -0.5, 0) + rnorm(22),
      size = size,
      grp = grp,
      row.names = tr$tip.label
    )
    createSimulationTemplate(
      baseline_tree = tr,
      trait_data = X,
      formula = cbind(y1, y2) ~ size + grp,
      method = "LL"
    )
  })
}

make_fp_template_with_error <- function() {
  get_cached_fp_template("fp_template_with_error", function() {
    set.seed(32)
    tr <- ape::rtree(18)
    X <- matrix(rnorm(18 * 2), ncol = 2)
    rownames(X) <- tr$tip.label
    createSimulationTemplate(
      baseline_tree = tr,
      trait_data = X,
      formula = "trait_data ~ 1",
      method = "LL",
      error = TRUE
    )
  })
}

test_that("simulation searches muffle only the repeated settings advisory", {
  skip_if_fp_study_deps()

  tree <- ape::rtree(12)
  trait_data <- matrix(
    rnorm(24),
    nrow = 12,
    dimnames = list(tree$tip.label, c("trait_1", "trait_2"))
  )
  settings_warning <- simpleWarning("repeated settings advisory", call = NULL)
  class(settings_warning) <- c(
    "bifrost_search_settings_warning",
    class(settings_warning)
  )
  search <- function(...) {
    warning(settings_warning)
    warning("genuine fitting warning", call. = FALSE)
    list(
      shift_nodes_no_uncertainty = integer(0),
      num_candidates = 1L,
      candidate_nodes = ape::Ntip(tree) + 2L
    )
  }
  replicate <- list(
    sim = list(tree = tree, data = trait_data),
    seed = NULL
  )
  warning_classes <- list()
  warning_messages <- character()

  results <- withCallingHandlers(
    lapply(seq_len(3L), function(i) {
      bifrost:::.simulation_study_search(
        replicate = replicate,
        search_options = list(min_descendant_tips = 2L),
        tree_component = "tree",
        data_components = "data",
        search_optimal_configuration = search,
        generate_painted_trees = generatePaintedTrees,
        with_replicate_seed = function(seed, code) force(code)
      )
    }),
    warning = function(w) {
      warning_classes[[length(warning_classes) + 1L]] <<- class(w)
      warning_messages[[length(warning_messages) + 1L]] <<- conditionMessage(w)
      invokeRestart("muffleWarning")
    }
  )

  testthat::expect_length(results, 3L)
  testthat::expect_false(any(vapply(
    warning_classes,
    function(classes) "bifrost_search_settings_warning" %in% classes,
    logical(1)
  )))
  testthat::expect_identical(
    warning_messages,
    rep("genuine fitting warning", 3L)
  )
})

test_that("runFalsePositiveSimulationStudy returns study summaries", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()
  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    tree_tip_count = 18,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 6
  )

  testthat::expect_s3_class(study, "bifrost_simulation_study")
  testthat::expect_identical(study$study_type, "false_positive")
  testthat::expect_identical(study$generating_scenario, "null")
  testthat::expect_identical(study$simulation_generator, "original")
  testthat::expect_identical(
    unique(study$per_replicate$simulation_generator),
    "original"
  )
  testthat::expect_false("simulation_design" %in% names(study))
  testthat::expect_false("simulation_design" %in% names(study$per_replicate))
  testthat::expect_false(study$search_options$progress)
  testthat::expect_length(study$simdata, 1)
  testthat::expect_length(study$results, 1)
  testthat::expect_true(all(c(
    "replicate", "n_candidates", "n_inferred_shifts", "false_positive_rate",
    "status", "error"
  ) %in% names(study$per_replicate)))
  testthat::expect_equal(
    study$per_replicate$false_positive_rate,
    study$per_replicate$n_inferred_shifts / study$per_replicate$n_candidates
  )
  testthat::expect_identical(as.data.frame(study), study$per_replicate)
})

test_that("runFalsePositiveSimulationStudy forwards the empirical generator", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  study <- runFalsePositiveSimulationStudy(
    make_fp_template(),
    n_replicates = 1,
    tree_tip_count = 18,
    simulation_options = list(simulation_generator = "empirical"),
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 6
  )

  testthat::expect_identical(study$simulation_generator, "empirical")
  testthat::expect_identical(
    study$simdata[[1L]]$simulation_generator,
    "empirical"
  )
})

test_that("runFalsePositiveSimulationStudy stores compact replicate calls", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  study <- runFalsePositiveSimulationStudy(
    make_fp_template(),
    n_replicates = 1,
    tree_tip_count = 18,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "BAD",
      method = "LL"
    ),
    num_cores = 1,
    seed = 56
  )

  replicate_call <- study$simdata[[1L]]$user_input
  testthat::expect_identical(replicate_call[[1L]], quote(simulateNullDataset))
  testthat::expect_identical(
    replicate_call$template,
    "<bifrost_simulation_template>"
  )
  testthat::expect_false(is.symbol(replicate_call$template))
  testthat::expect_lt(as.numeric(object.size(replicate_call)), 10000)
})

test_that("the false-positive study rejects generator vectors before RNG setup", {
  skip_if_fp_study_deps()
  tmpl <- make_fp_template()
  rng_setup_called <- FALSE
  local_rebind(
    ".simulation_set_seed",
    function(...) {
      rng_setup_called <<- TRUE
      stats::runif(1)
      stop("RNG setup reached", call. = FALSE)
    },
    environment(runFalsePositiveSimulationStudy)
  )
  set.seed(20260709)
  before <- .Random.seed
  testthat::expect_error(
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 1,
      simulation_options = list(
        simulation_generator = c("original", "empirical")
      ),
      seed = 6
    ),
    "simulation_generator.*original.*empirical"
  )
  testthat::expect_false(rng_setup_called)
  testthat::expect_identical(.Random.seed, before)
})

test_that("runFalsePositiveSimulationStudy rejects per-replicate seeds", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()

  testthat::expect_error(
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 2,
      simulation_options = list(seed = 99),
      search_options = list(
        formula = "trait_data ~ 1",
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 1,
        IC = "GIC",
        method = "LL"
      ),
      num_cores = 1,
      seed = 6
    ),
    "simulation_options\\$seed"
  )
})

test_that("runFalsePositiveSimulationStudy uses intercept-only searches for formula-calibrated templates", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_formula_fp_template()
  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    tree_tip_count = 20,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 123
  )

  testthat::expect_identical(
    study$search_options$formula,
    simulationStudyFormulaCases$string
  )
  testthat::expect_identical(study$per_replicate$status, "ok")
  testthat::expect_equal(colnames(study$simdata[[1]]$data), c("y1", "y2"))
  testthat::expect_false("mass" %in% colnames(study$simdata[[1]]$data))
})

test_that("runFalsePositiveSimulationStudy inherits the default intercept-only search for data.frame templates", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_formula_fp_template()
  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    tree_tip_count = 20,
    search_options = list(
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 124
  )

  testthat::expect_identical(study$search_options$formula, "trait_data ~ 1")
  testthat::expect_identical(study$per_replicate$status, "ok")
  testthat::expect_true(all(is.na(study$per_replicate$error)))
})

test_that("runFalsePositiveSimulationStudy rejects non-intercept search formulas", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_formula_fp_template()

  testthat::expect_error(
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 1,
      tree_tip_count = 20,
      search_options = list(
        formula = "trait_data[, 1:2] ~ trait_data[, 3]",
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 1,
        IC = "GIC",
        method = "LL"
      ),
      num_cores = 1,
      seed = 123
    ),
    simulationStudyFormulaErrors$non_intercept
  )
})

test_that("runFalsePositiveSimulationStudy validates inputs and inherits template error settings", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template_with_error()

  testthat::expect_error(
    runFalsePositiveSimulationStudy(list(), n_replicates = 1),
    "bifrost_simulation_template"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 0),
    "n_replicates"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1.5),
    "n_replicates"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1, tree_tip_count = 3.5),
    "tree_tip_count"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1, tree_tip_count = tmpl$n_tips + 1L),
    "tree_tip_count cannot exceed"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1, num_cores = 0),
    "num_cores"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1, num_cores = 1.5),
    "num_cores"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1, seed = 1.5),
    "seed"
  )
  testthat::expect_error(
    runFalsePositiveSimulationStudy(tmpl, n_replicates = 1, simulation_options = 1),
    "must both be lists"
  )

  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 33
  )

  testthat::expect_true(isTRUE(study$search_options$error))
})

test_that("runFalsePositiveSimulationStudy restores the caller RNG state when seeded", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()
  local_rebind(
    "simulateNullDataset",
    function(template, tree_tip_count = NULL, ...) {
      stats::rnorm(1)
      list(
        tree = template$baseline_tree,
        data = template$trait_data
      )
    },
    environment(runFalsePositiveSimulationStudy)
  )
  local_rebind(
    "searchOptimalConfiguration",
    function(...) {
      stats::rnorm(1)
      list(
        shift_nodes_no_uncertainty = integer(0),
        num_candidates = 3L,
        ic_weights = data.frame()
      )
    },
    environment(runFalsePositiveSimulationStudy)
  )

  expect_global_rng_restored(
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 2,
      tree_tip_count = 18,
      search_options = list(
        formula = "trait_data ~ 1",
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 1,
        IC = "GIC",
        method = "LL"
      ),
      num_cores = 1,
      seed = 6
    )
  )
})

test_that("runFalsePositiveSimulationStudy inherits evaluated template settings", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  set.seed(36)
  tr <- ape::rtree(18)
  X <- matrix(rnorm(18 * 2), ncol = 2)
  rownames(X) <- tr$tip.label
  method_value <- "LL"
  error_value <- TRUE

  tmpl <- createSimulationTemplate(
    baseline_tree = tr,
    trait_data = X,
    formula = "trait_data ~ 1",
    method = method_value,
    error = error_value
  )

  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC"
    ),
    num_cores = 1,
    seed = 37
  )

  testthat::expect_identical(study$search_options$method, "LL")
  testthat::expect_true(isTRUE(study$search_options$error))
  testthat::expect_identical(study$per_replicate$status, "ok")
})

test_that("runFalsePositiveSimulationStudy falls back to template call settings when stored values are missing", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  method_value <- "LL"
  tmpl <- make_fp_template_with_error()
  tmpl$fit_method <- NULL
  tmpl$fit_error <- NULL
  tmpl$global_model$call$method <- method_value
  tmpl$global_model$call$error <- quote(TRUE)
  tmpl$search_formula <- NULL

  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC"
    ),
    num_cores = 1,
    seed = 39
  )

  testthat::expect_identical(study$search_options$formula, "trait_data ~ 1")
  testthat::expect_identical(study$search_options$method, "LL")
  testthat::expect_true(isTRUE(study$search_options$error))
})

test_that("runFalsePositiveSimulationStudy tolerates unevaluable template error calls", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()
  tmpl$fit_method <- NULL
  tmpl$fit_error <- NULL
  tmpl$global_model$call$method <- "LL"
  tmpl$global_model$call$error <- quote(missing_error_flag)
  tmpl$search_formula <- NULL

  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC"
    ),
    num_cores = 1,
    seed = 40
  )

  testthat::expect_false("error" %in% names(study$search_options))
  testthat::expect_identical(study$per_replicate$status, "ok")
})

test_that("runFalsePositiveSimulationStudy is reproducible with the same seed and workers", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()
  testthat::skip_on_covr()

  tmpl <- make_fp_template()
  run_once <- function() {
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 2,
      tree_tip_count = 18,
      search_options = list(
        formula = "trait_data ~ 1",
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 1,
        IC = "GIC",
        method = "LL"
      ),
      num_cores = 2,
      seed = 6
    )
  }

  study_a <- run_once()
  study_b <- run_once()

  testthat::expect_identical(study_a$per_replicate, study_b$per_replicate)
  testthat::expect_true(all(vapply(seq_along(study_a$simdata), function(i) {
    isTRUE(all.equal(study_a$simdata[[i]]$data, study_b$simdata[[i]]$data))
  }, logical(1))))
  testthat::expect_identical(
    lapply(study_a$results, `[[`, "shift_nodes_no_uncertainty"),
    lapply(study_b$results, `[[`, "shift_nodes_no_uncertainty")
  )
})

test_that("runFalsePositiveSimulationStudy gives seeded draws independent of worker count", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()
  testthat::skip_on_covr()

  tmpl <- make_fp_template()
  local_rebind(
    "simulateNullDataset",
    function(template, tree_tip_count = NULL, ...) {
      draw <- stats::rnorm(1)
      list(
        tree = template$baseline_tree,
        data = template$trait_data,
        random_draw = draw
      )
    },
    environment(runFalsePositiveSimulationStudy)
  )
  local_rebind(
    "searchOptimalConfiguration",
    function(...) {
      list(
        shift_nodes_no_uncertainty = integer(0),
        num_candidates = 3L,
        ic_weights = data.frame(),
        random_draw = stats::rnorm(1)
      )
    },
    environment(runFalsePositiveSimulationStudy)
  )
  withr::local_envvar(c(
    RSTUDIO = "1",
    RSTUDIO_SESSION_INITIALIZED = "1"
  ))

  run_once <- function(num_cores) {
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 2,
      tree_tip_count = 18,
      search_options = list(
        formula = "trait_data ~ 1",
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 1,
        IC = "GIC",
        method = "LL"
      ),
      num_cores = num_cores,
      seed = 606
    )
  }

  serial <- run_once(1L)
  multisession <- run_once(2L)

  testthat::expect_identical(
    vapply(serial$simdata, `[[`, numeric(1), "random_draw"),
    vapply(multisession$simdata, `[[`, numeric(1), "random_draw")
  )
  testthat::expect_identical(
    vapply(serial$results, `[[`, numeric(1), "random_draw"),
    vapply(multisession$results, `[[`, numeric(1), "random_draw")
  )
})

test_that("runFalsePositiveSimulationStudy makes outer parallelism override inner cores", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()

  testthat::local_mocked_bindings(
    future_lapply = serial_future_lapply,
    .package = "future.apply"
  )
  testthat::local_mocked_bindings(
    plan = function(...) list(),
    .package = "future"
  )

  testthat::expect_warning(
    study <- runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 1,
      search_options = list(
        formula = "trait_data ~ 1",
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 2,
        IC = "GIC",
        method = "LL"
      ),
      num_cores = 2,
      seed = 34
    ),
    "forcing each search to use one core"
  )
  testthat::expect_identical(study$search_options$num_cores, 1L)
})

test_that("runFalsePositiveSimulationStudy does not capture simdata in future workers", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  worker_environments <- list()
  testthat::local_mocked_bindings(
    future_lapply = function(X, FUN, ...) {
      worker_environments[[length(worker_environments) + 1L]] <<- environment(FUN)
      serial_future_lapply(X, FUN, ...)
    },
    .package = "future.apply"
  )
  testthat::local_mocked_bindings(
    plan = function(...) list(),
    .package = "future"
  )
  local_rebind(
    "searchOptimalConfiguration",
    function(...) {
      list(
        shift_nodes_no_uncertainty = integer(0),
        num_candidates = 3L,
        ic_weights = data.frame()
      )
    },
    environment(runFalsePositiveSimulationStudy)
  )

  runFalsePositiveSimulationStudy(
    make_fp_template(),
    n_replicates = 1,
    tree_tip_count = 18,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 2,
    seed = 54
  )

  testthat::expect_length(worker_environments, 1L)
  testthat::expect_false(any(vapply(worker_environments, function(worker_env) {
    exists("simdata", envir = worker_env, inherits = FALSE)
  }, logical(1L))))
})

test_that("runFalsePositiveSimulationStudy validates formula types and can choose multisession plans", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()

  testthat::expect_error(
    runFalsePositiveSimulationStudy(
      tmpl,
      n_replicates = 1,
      search_options = list(
        formula = 1,
        min_descendant_tips = 3,
        shift_acceptance_threshold = 5,
        num_cores = 1,
        IC = "GIC"
      ),
      num_cores = 1,
      seed = 41
    ),
    simulationStudyFormulaErrors$invalid_type
  )

  plans <- list()
  old_rstudio <- Sys.getenv("RSTUDIO", unset = NA_character_)
  old_rstudio_init <- Sys.getenv("RSTUDIO_SESSION_INITIALIZED", unset = NA_character_)
  Sys.setenv(RSTUDIO = "1", RSTUDIO_SESSION_INITIALIZED = "1")
  on.exit({
    if (is.na(old_rstudio)) Sys.unsetenv("RSTUDIO") else Sys.setenv(RSTUDIO = old_rstudio)
    if (is.na(old_rstudio_init)) Sys.unsetenv("RSTUDIO_SESSION_INITIALIZED") else Sys.setenv(RSTUDIO_SESSION_INITIALIZED = old_rstudio_init)
  }, add = TRUE)

  testthat::local_mocked_bindings(
    future_lapply = serial_future_lapply,
    .package = "future.apply"
  )
  testthat::local_mocked_bindings(
    plan = function(strategy, workers = NULL, ...) {
      if (missing(strategy)) {
        return("old_plan")
      }
      plans[[length(plans) + 1L]] <<- list(strategy = strategy, workers = workers)
      invisible("mock_plan")
    },
    .package = "future"
  )

  runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 2,
    seed = 42
  )

  testthat::expect_true(any(vapply(plans, function(x) identical(x$strategy, future::multisession), logical(1))))
})

test_that("runFalsePositiveSimulationStudy accepts formula objects in search options", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()
  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      formula = simulationStudyFormulaCases$formula,
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 43
  )

  testthat::expect_s3_class(study$search_options$formula, "formula")
  testthat::expect_identical(
    study$search_options$formula,
    simulationStudyFormulaCases$formula
  )
  testthat::expect_identical(study$per_replicate$status, "ok")
})

test_that("runFalsePositiveSimulationStudy records search fallback errors", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()

  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 3,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "BAD",
      method = "LL"
    ),
    num_cores = 1,
    seed = 35
  )

  testthat::expect_identical(study$per_replicate$status, "error")
  testthat::expect_match(study$per_replicate$error, "IC must be GIC or BIC")
  testthat::expect_true(is.na(study$per_replicate$n_inferred_shifts))
  testthat::expect_true(is.na(study$per_replicate$false_positive_rate))
  testthat::expect_identical(study$study_summary$n_completed, 0L)
  testthat::expect_identical(study$study_summary$n_failed, 1L)
  testthat::expect_identical(study$study_summary$n_evaluable_replicates, 0L)
  testthat::expect_equal(study$study_summary$completion_rate, 0)
  testthat::expect_equal(study$study_summary$failure_rate, 1)
  testthat::expect_true(is.na(study$study_summary$mean_false_positive_rate))
  testthat::expect_true(is.na(study$study_summary$median_false_positive_rate))
  testthat::expect_equal(
    study$results[[1]]$num_candidates,
    max(length(generatePaintedTrees(ape::as.phylo(study$simdata[[1]]$tree), min_tips = 3)) - 1L, 0L)
  )
})

test_that("runFalsePositiveSimulationStudy reports NA summaries when no replicate is evaluable", {
  testthat::skip_on_cran()
  skip_if_fp_study_deps()

  tmpl <- make_fp_template()

  study <- runFalsePositiveSimulationStudy(
    tmpl,
    n_replicates = 1,
    search_options = list(
      formula = "trait_data ~ 1",
      min_descendant_tips = 100,
      shift_acceptance_threshold = 5,
      num_cores = 1,
      IC = "GIC",
      method = "LL"
    ),
    num_cores = 1,
    seed = 38
  )

  testthat::expect_equal(study$per_replicate$n_candidates, 0)
  testthat::expect_true(is.na(study$per_replicate$false_positive_rate))
  testthat::expect_identical(study$study_summary$n_evaluable_replicates, 0L)
  testthat::expect_true(is.na(study$study_summary$mean_false_positive_rate))
  testthat::expect_true(is.na(study$study_summary$median_false_positive_rate))
})