tests/testthat/test-runSearchTuningGrid.R

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

skip_if_tuning_grid_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("RRphylo")
  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))
}

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

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

make_tuning_template <- function() {
  get_cached_tuning_template("tuning_template", function() {
    set.seed(60)
    tr <- ape::rtree(20)
    X <- matrix(rnorm(20 * 2), ncol = 2)
    rownames(X) <- tr$tip.label
    createSimulationTemplate(
      baseline_tree = tr,
      trait_data = X,
      formula = "trait_data ~ 1",
      method = "LL"
    )
  })
}

make_formula_tuning_template <- function() {
  get_cached_tuning_template("formula_tuning_template", function() {
    set.seed(61)
    tr <- ape::rtree(20)
    grp <- factor(rep(c("a", "b"), length.out = 20))
    size <- rnorm(20)
    X <- data.frame(
      y1 = 0.3 * size + ifelse(grp == "b", 0.7, 0) + rnorm(20),
      y2 = -0.25 * size + ifelse(grp == "b", -0.4, 0) + rnorm(20),
      size = size,
      grp = grp,
      row.names = tr$tip.label
    )
    createSimulationTemplate(
      baseline_tree = tr,
      trait_data = X,
      formula = cbind(y1, y2) ~ size + grp,
      method = "LL"
    )
  })
}

test_that("bifrost_search_tuning_grid has print and data-frame methods", {
  summary_table <- data.frame(
    setting_id = 1L,
    IC = "GIC",
    shift_acceptance_threshold = 5,
    min_descendant_tips = 3L,
    null_mean_false_positive_rate = 0.01,
    proportional_fuzzy_f1 = 0.8,
    correlation_fuzzy_f1 = 0.7,
    stringsAsFactors = FALSE
  )
  grid <- structure(
    list(
      IC = "GIC",
      grid = summary_table[, c("setting_id", "shift_acceptance_threshold", "min_descendant_tips")],
      summary_table = summary_table,
      studies = NULL,
      null_replicates = 2L,
      recovery_replicates = 3L,
      weighted = FALSE,
      store_studies = FALSE
    ),
    class = c("bifrost_search_tuning_grid", "list")
  )

  testthat::expect_output(print(grid), "Bifrost Search Tuning Grid")
  testthat::expect_identical(as.data.frame(grid), summary_table)
})

test_that("runSearchTuningGrid returns a fixed-IC tuning grid on a small real run", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()
  grid <- suppressWarnings(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      tree_tip_count = 16,
      null_replicates = 1,
      recovery_replicates = 1,
      null_simulation_options = list(),
      proportional_simulation_options = list(
        num_shifts = 1,
        min_shift_tips = 2,
        max_shift_tips = 5
      ),
      correlation_simulation_options = list(),
      base_search_options = list(
        formula = "trait_data ~ 1",
        method = "LL",
        num_cores = 1
      ),
      weighted = FALSE,
      num_cores = 1,
      seed = 61,
      store_studies = TRUE
    )
  )

  testthat::expect_s3_class(grid, "bifrost_search_tuning_grid")
  testthat::expect_identical(grid$IC, "GIC")
  testthat::expect_equal(nrow(grid$summary_table), 1)
  testthat::expect_length(grid$studies, 1)
  testthat::expect_true(all(c(
    "null_mean_false_positive_rate",
    "proportional_fuzzy_f1",
    "correlation_fuzzy_f1",
    "proportional_evaluable_fraction",
    "correlation_evaluable_fraction"
  ) %in% names(grid$summary_table)))
  testthat::expect_identical(grid$studies[[1]]$null$generating_scenario, "null")
  testthat::expect_identical(grid$studies[[1]]$proportional$generating_scenario, "proportional")
  testthat::expect_identical(grid$studies[[1]]$correlation$generating_scenario, "correlation")
  testthat::expect_identical(
    grid$simulation_generators,
    c(
      null = "original",
      proportional = "original",
      correlation = "original"
    )
  )
  testthat::expect_false("simulation_designs" %in% names(grid))
  testthat::expect_identical(
    grid$studies[[1]]$correlation$simulation_generator,
    "original"
  )
})

test_that("runSearchTuningGrid works in parallel for formula-calibrated templates", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()
  testthat::skip_on_covr()

  tmpl <- make_formula_tuning_template()
  grid <- suppressWarnings(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = c(5, 7),
      min_descendant_tips_values = 3,
      tree_tip_count = 16,
      null_replicates = 1,
      recovery_replicates = 1,
      proportional_simulation_options = list(
        num_shifts = 1,
        min_shift_tips = 2,
        max_shift_tips = 5
      ),
      base_search_options = list(
        formula = "trait_data ~ 1",
        method = "LL",
        num_cores = 1
      ),
      weighted = FALSE,
      num_cores = 2,
      seed = 62,
      store_studies = TRUE
    )
  )

  testthat::expect_true(all(vapply(grid$studies, function(x) {
    all(x$proportional$per_replicate$status == "ok")
  }, logical(1))))
  testthat::expect_true(all(vapply(grid$studies, function(x) {
    identical(colnames(x$null$simdata[[1]]$data), c("y1", "y2"))
  }, logical(1))))
})

test_that("runSearchTuningGrid propagates fixed IC and scenario-specific options", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()
  mock_env <- new.env(parent = emptyenv())
  mock_env$null_calls <- list()
  mock_env$shift_calls <- list()

  local_rebind(
    "runFalsePositiveSimulationStudy",
    function(template, search_options, seed, num_cores, ...) {
      mock_env$null_calls[[length(mock_env$null_calls) + 1L]] <- list(
        IC = search_options$IC,
        threshold = search_options$shift_acceptance_threshold,
        min_tips = search_options$min_descendant_tips,
        search_num_cores = search_options$num_cores,
        search_progress = search_options$progress,
        num_cores = num_cores,
        seed = seed
      )
      list(
        generating_scenario = "null",
        per_replicate = data.frame(
          n_inferred_shifts = c(1, NA_real_),
          false_positive_rate = c(0.05, NA_real_),
          n_candidates = c(5, 5),
          status = c("ok", "error")
        ),
        study_summary = list(mean_false_positive_rate = 0.05)
      )
    },
    environment(runSearchTuningGrid)
  )
  local_rebind(
    "runShiftRecoverySimulationStudy",
    function(template, simulation_options, search_options, weighted, seed, num_cores, ...) {
      mock_env$shift_calls[[length(mock_env$shift_calls) + 1L]] <- list(
        IC = search_options$IC,
        threshold = search_options$shift_acceptance_threshold,
        min_tips = search_options$min_descendant_tips,
        search_num_cores = search_options$num_cores,
        search_progress = search_options$progress,
        num_cores = num_cores,
        scale_mode = simulation_options$scale_mode,
        weighted = weighted,
        seed = seed
      )
      scenario <- simulation_options$scale_mode
      list(
        generating_scenario = scenario,
        per_replicate = data.frame(
          n_candidates = c(4, 4),
          n_inferred_shifts = c(1, NA_real_),
          status = c("ok", "error")
        ),
        evaluation = list(
          strict = if (scenario == "proportional") {
            list(
              precision = 0.11,
              recall = 0.12,
              f1 = 0.13,
              specificity = 0.14,
              fpr = 0.15,
              balanced_accuracy = 0.16
            )
          } else {
            list(
              precision = 0.21,
              recall = 0.22,
              f1 = 0.23,
              specificity = 0.24,
              fpr = 0.25,
              balanced_accuracy = 0.26
            )
          },
          fuzzy = if (scenario == "proportional") {
            list(
              precision = 0.31,
              recall = 0.32,
              f1 = 0.33,
              specificity = 0.34,
              fpr = 0.35,
              balanced_accuracy = 0.36
            )
          } else {
            list(
              precision = 0.41,
              recall = 0.42,
              f1 = 0.43,
              specificity = 0.44,
              fpr = 0.45,
              balanced_accuracy = 0.46
            )
          },
          weighted = if (weighted) {
            list(fuzzy = list(f1 = if (scenario == "proportional") 0.75 else 0.55))
          } else {
            NULL
          }
        )
      )
    },
    environment(runSearchTuningGrid)
  )

  grid <- runSearchTuningGrid(
    template = tmpl,
    IC = "BIC",
    shift_acceptance_thresholds = c(2, 10),
    min_descendant_tips_values = 5,
    null_replicates = 2,
    recovery_replicates = 3,
    proportional_simulation_options = list(
      num_shifts = 1,
      min_shift_tips = 2,
      max_shift_tips = 5
    ),
    base_search_options = list(
      formula = "trait_data ~ 1",
      method = "LL",
      num_cores = 7,
      progress = TRUE
    ),
    weighted = TRUE,
    num_cores = 1,
    seed = 62,
    store_studies = FALSE
  )

  testthat::expect_null(grid$studies)
  testthat::expect_true(all(grid$summary_table$IC == "BIC"))
  testthat::expect_equal(nrow(grid$summary_table), 2)
  testthat::expect_true(all(vapply(mock_env$null_calls, `[[`, character(1), "IC") == "BIC"))
  testthat::expect_true(all(vapply(mock_env$shift_calls, `[[`, character(1), "IC") == "BIC"))
  testthat::expect_true(all(vapply(mock_env$null_calls, `[[`, numeric(1), "num_cores") == 1))
  testthat::expect_true(all(vapply(mock_env$shift_calls, `[[`, numeric(1), "num_cores") == 1))
  testthat::expect_true(all(vapply(mock_env$null_calls, `[[`, numeric(1), "search_num_cores") == 1))
  testthat::expect_true(all(vapply(mock_env$shift_calls, `[[`, numeric(1), "search_num_cores") == 1))
  testthat::expect_false(any(vapply(mock_env$null_calls, `[[`, logical(1), "search_progress")))
  testthat::expect_false(any(vapply(mock_env$shift_calls, `[[`, logical(1), "search_progress")))
  testthat::expect_true(all(c("null_seed", "proportional_seed", "correlation_seed") %in% names(grid$summary_table)))
  testthat::expect_equal(
    grid$summary_table$null_seed,
    vapply(mock_env$null_calls, `[[`, numeric(1), "seed")
  )
  testthat::expect_equal(
    grid$summary_table$proportional_seed,
    vapply(mock_env$shift_calls[c(TRUE, FALSE, TRUE, FALSE)], `[[`, numeric(1), "seed")
  )
  testthat::expect_equal(
    grid$summary_table$correlation_seed,
    vapply(mock_env$shift_calls[c(FALSE, TRUE, FALSE, TRUE)], `[[`, numeric(1), "seed")
  )
  testthat::expect_equal(length(unique(unlist(grid$summary_table[
    , c("null_seed", "proportional_seed", "correlation_seed")
  ]))), 3L)
  testthat::expect_equal(
    vapply(mock_env$shift_calls[c(FALSE, TRUE, FALSE, TRUE)], `[[`, character(1), "scale_mode"),
    c("correlation", "correlation")
  )
  testthat::expect_true(all(c(
    "proportional_weighted_fuzzy_f1",
    "correlation_weighted_fuzzy_f1"
  ) %in% names(grid$summary_table)))
  recovery_metric_columns <- unlist(lapply(
    c("proportional", "correlation"),
    function(scenario) {
      paste(
        scenario,
        rep(c("strict", "fuzzy"), each = 6L),
        rep(c("precision", "recall", "f1", "specificity", "fpr", "balanced_accuracy"), 2L),
        sep = "_"
      )
    }
  ))
  testthat::expect_true(all(recovery_metric_columns %in% names(grid$summary_table)))
  testthat::expect_equal(
    unname(unlist(grid$summary_table[1L, paste("proportional", c(
      "strict_precision", "strict_recall", "strict_f1", "strict_specificity", "strict_fpr", "strict_balanced_accuracy",
      "fuzzy_precision", "fuzzy_recall", "fuzzy_f1", "fuzzy_specificity", "fuzzy_fpr", "fuzzy_balanced_accuracy"
    ), sep = "_")])),
    c(0.11, 0.12, 0.13, 0.14, 0.15, 0.16, 0.31, 0.32, 0.33, 0.34, 0.35, 0.36)
  )
  testthat::expect_equal(
    unname(unlist(grid$summary_table[1L, paste("correlation", c(
      "strict_precision", "strict_recall", "strict_f1", "strict_specificity", "strict_fpr", "strict_balanced_accuracy",
      "fuzzy_precision", "fuzzy_recall", "fuzzy_f1", "fuzzy_specificity", "fuzzy_fpr", "fuzzy_balanced_accuracy"
    ), sep = "_")])),
    c(0.21, 0.22, 0.23, 0.24, 0.25, 0.26, 0.41, 0.42, 0.43, 0.44, 0.45, 0.46)
  )
  testthat::expect_equal(grid$summary_table$null_evaluable_fraction, rep(1, 2))
  testthat::expect_equal(grid$summary_table$proportional_evaluable_fraction, rep(1, 2))
  testthat::expect_equal(grid$summary_table$correlation_evaluable_fraction, rep(1, 2))
  testthat::expect_equal(grid$summary_table$null_completion_rate, rep(0.5, 2))
  testthat::expect_equal(grid$summary_table$proportional_completion_rate, rep(0.5, 2))
  testthat::expect_equal(grid$summary_table$correlation_completion_rate, rep(0.5, 2))
  testthat::expect_equal(grid$summary_table$null_failure_rate, rep(0.5, 2))
  testthat::expect_equal(grid$summary_table$proportional_failure_rate, rep(0.5, 2))
  testthat::expect_equal(grid$summary_table$correlation_failure_rate, rep(0.5, 2))
})

test_that("runSearchTuningGrid reports missing means when every replicate fails", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()
  local_rebind(
    "runFalsePositiveSimulationStudy",
    function(...) {
      list(
        generating_scenario = "null",
        per_replicate = data.frame(
          n_inferred_shifts = NA_real_,
          false_positive_rate = NA_real_,
          n_candidates = NA_real_,
          status = "error"
        ),
        study_summary = list(mean_false_positive_rate = NA_real_)
      )
    },
    environment(runSearchTuningGrid)
  )
  local_rebind(
    "runShiftRecoverySimulationStudy",
    function(template, simulation_options, ...) {
      list(
        generating_scenario = simulation_options$scale_mode,
        per_replicate = data.frame(
          n_candidates = NA_real_,
          n_inferred_shifts = NA_real_,
          status = "error"
        ),
        evaluation = list(
          strict = list(f1 = NA_real_),
          fuzzy = list(f1 = NA_real_, recall = NA_real_),
          weighted = NULL
        )
      )
    },
    environment(runSearchTuningGrid)
  )

  grid <- runSearchTuningGrid(
    template = tmpl,
    IC = "GIC",
    shift_acceptance_thresholds = 5,
    min_descendant_tips_values = 3,
    null_replicates = 1,
    recovery_replicates = 1,
    proportional_simulation_options = list(
      num_shifts = 1,
      min_shift_tips = 2,
      max_shift_tips = 5
    ),
    base_search_options = list(formula = "trait_data ~ 1", method = "LL"),
    weighted = FALSE,
    num_cores = 1,
    seed = 63,
    store_studies = FALSE
  )

  testthat::expect_true(is.na(grid$summary_table$null_fraction_any_false_positive))
  testthat::expect_true(is.na(grid$summary_table$null_mean_inferred_shifts))
  testthat::expect_true(is.na(grid$summary_table$proportional_mean_inferred_shifts))
  testthat::expect_true(is.na(grid$summary_table$correlation_mean_inferred_shifts))
  testthat::expect_equal(grid$summary_table$null_failure_rate, 1)
  testthat::expect_equal(grid$summary_table$proportional_failure_rate, 1)
  testthat::expect_equal(grid$summary_table$correlation_failure_rate, 1)
})

test_that("runSearchTuningGrid inherits template defaults and can choose multisession plans", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()
  tmpl$search_formula <- NULL
  mock_env <- new.env(parent = emptyenv())
  mock_env$null_calls <- list()
  mock_env$shift_calls <- list()
  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(
    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"
  )
  testthat::local_mocked_bindings(
    future_lapply = function(X, FUN, ...) lapply(X, FUN),
    .package = "future.apply"
  )

  local_rebind(
    "runFalsePositiveSimulationStudy",
    function(template, search_options, seed, ...) {
      mock_env$null_calls[[length(mock_env$null_calls) + 1L]] <- list(
        formula = search_options$formula,
        seed = seed
      )
      list(
        generating_scenario = "null",
        per_replicate = data.frame(
          n_inferred_shifts = 0,
          false_positive_rate = 0,
          n_candidates = 5,
          status = "ok"
        ),
        study_summary = list(mean_false_positive_rate = 0)
      )
    },
    environment(runSearchTuningGrid)
  )
  local_rebind(
    "runShiftRecoverySimulationStudy",
    function(template, simulation_options, search_options, seed, ...) {
      mock_env$shift_calls[[length(mock_env$shift_calls) + 1L]] <- list(
        formula = search_options$formula,
        scale_mode = simulation_options$scale_mode,
        max_shift_tips = simulation_options$max_shift_tips,
        seed = seed
      )
      scenario <- simulation_options$scale_mode
      list(
        generating_scenario = scenario,
        per_replicate = data.frame(
          n_candidates = 4,
          n_inferred_shifts = 1,
          status = "ok"
        ),
        evaluation = list(
          strict = list(f1 = 0.4),
          fuzzy = list(f1 = 0.6, recall = 0.7),
          weighted = NULL
        )
      )
    },
    environment(runSearchTuningGrid)
  )

  grid <- runSearchTuningGrid(
    template = tmpl,
    IC = "GIC",
    shift_acceptance_thresholds = 5,
    min_descendant_tips_values = 3,
    null_replicates = 1,
    recovery_replicates = 1,
    proportional_simulation_options = list(
      num_shifts = 1,
      min_shift_tips = 2,
      max_shift_tips = 5
    ),
    correlation_simulation_options = list(max_shift_tips = 9),
    base_search_options = list(method = "LL", num_cores = 1),
    weighted = FALSE,
    num_cores = 2,
    seed = NULL,
    store_studies = FALSE
  )

  testthat::expect_identical(mock_env$null_calls[[1]]$formula, "trait_data ~ 1")
  testthat::expect_identical(mock_env$shift_calls[[1]]$formula, "trait_data ~ 1")
  testthat::expect_identical(mock_env$shift_calls[[2]]$scale_mode, "correlation")
  testthat::expect_identical(mock_env$shift_calls[[2]]$max_shift_tips, 9)
  testthat::expect_true(is.finite(mock_env$null_calls[[1]]$seed))
  testthat::expect_true(any(vapply(plans, function(x) identical(x$strategy, future::multisession), logical(1))))
  testthat::expect_equal(nrow(grid$summary_table), 1)

  plans <- list()
  Sys.unsetenv(c("RSTUDIO", "RSTUDIO_SESSION_INITIALIZED"))
  grid <- runSearchTuningGrid(
    template = tmpl,
    IC = "GIC",
    shift_acceptance_thresholds = 5,
    min_descendant_tips_values = 3,
    null_replicates = 1,
    recovery_replicates = 1,
    proportional_simulation_options = list(
      num_shifts = 1,
      min_shift_tips = 2,
      max_shift_tips = 5
    ),
    correlation_simulation_options = list(max_shift_tips = 9),
    base_search_options = list(method = "LL", num_cores = 1),
    weighted = FALSE,
    num_cores = 2,
    seed = NULL,
    store_studies = FALSE
  )

  expected_strategy <- if (.Platform$OS.type == "windows") {
    future::multisession
  } else {
    future::multicore
  }
  testthat::expect_true(any(vapply(plans, function(x) identical(x$strategy, expected_strategy), logical(1))))
  testthat::expect_equal(nrow(grid$summary_table), 1)
})

test_that("runSearchTuningGrid inherits template search formulas when base options omit one", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()
  mock_env <- new.env(parent = emptyenv())
  mock_env$null_formula <- NULL

  local_rebind(
    "runFalsePositiveSimulationStudy",
    function(template, search_options, ...) {
      mock_env$null_formula <- search_options$formula
      list(
        generating_scenario = "null",
        per_replicate = data.frame(
          n_inferred_shifts = 0,
          false_positive_rate = 0,
          n_candidates = 5,
          status = "ok"
        ),
        study_summary = list(mean_false_positive_rate = 0)
      )
    },
    environment(runSearchTuningGrid)
  )
  local_rebind(
    "runShiftRecoverySimulationStudy",
    function(template, simulation_options, ...) {
      list(
        generating_scenario = simulation_options$scale_mode,
        per_replicate = data.frame(
          n_candidates = 4,
          n_inferred_shifts = 1,
          status = "ok"
        ),
        evaluation = list(
          strict = list(f1 = 0.4),
          fuzzy = list(f1 = 0.6, recall = 0.7),
          weighted = NULL
        )
      )
    },
    environment(runSearchTuningGrid)
  )

  runSearchTuningGrid(
    template = tmpl,
    IC = "GIC",
    shift_acceptance_thresholds = 5,
    min_descendant_tips_values = 3,
    null_replicates = 1,
    recovery_replicates = 1,
    proportional_simulation_options = list(
      num_shifts = 1,
      min_shift_tips = 2,
      max_shift_tips = 5
    ),
    base_search_options = list(method = "LL", num_cores = 1),
    weighted = FALSE,
    num_cores = 1,
    seed = 64,
    store_studies = FALSE
  )

  testthat::expect_identical(mock_env$null_formula, "trait_data ~ 1")
})

test_that("the tuning grid rejects generator vectors before RNG setup", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()
  tmpl <- make_tuning_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(runSearchTuningGrid)
  )
  set.seed(20260709)
  before <- .Random.seed
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      null_replicates = 1,
      recovery_replicates = 1,
      null_simulation_options = list(
        simulation_generator = c("original", "empirical")
      ),
      proportional_simulation_options = list(
        num_shifts = 1,
        min_shift_tips = 2,
        max_shift_tips = 5
      ),
      base_search_options = list(formula = "trait_data ~ 1", method = "LL"),
      weighted = FALSE,
      num_cores = 1,
      seed = 64,
      store_studies = FALSE
    ),
    "simulation_generator.*original.*empirical"
  )
  testthat::expect_false(rng_setup_called)
  testthat::expect_identical(.Random.seed, before)
})

test_that("runSearchTuningGrid validates integer controls and restores the caller RNG", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()
  local_rebind(
    "runFalsePositiveSimulationStudy",
    function(...) {
      stats::rnorm(1)
      list(
        generating_scenario = "null",
        per_replicate = data.frame(
          n_inferred_shifts = 0,
          false_positive_rate = 0,
          n_candidates = 5,
          status = "ok"
        ),
        study_summary = list(mean_false_positive_rate = 0)
      )
    },
    environment(runSearchTuningGrid)
  )
  local_rebind(
    "runShiftRecoverySimulationStudy",
    function(template, simulation_options, weighted, ...) {
      stats::rnorm(1)
      list(
        generating_scenario = simulation_options$scale_mode,
        per_replicate = data.frame(
          n_candidates = 4,
          n_inferred_shifts = 1,
          status = "ok"
        ),
        evaluation = list(
          strict = list(f1 = 0.4),
          fuzzy = list(f1 = 0.6, recall = 0.7),
          weighted = if (weighted) list(fuzzy = list(f1 = 0.5)) else NULL
        )
      )
    },
    environment(runSearchTuningGrid)
  )

  run_grid <- function(...) {
    args <- utils::modifyList(list(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      null_replicates = 1,
      recovery_replicates = 1,
      proportional_simulation_options = list(
        num_shifts = 1,
        min_shift_tips = 2,
        max_shift_tips = 5
      ),
      base_search_options = list(formula = "trait_data ~ 1", method = "LL"),
      weighted = FALSE,
      num_cores = 1,
      seed = 64,
      store_studies = FALSE
    ), list(...))
    do.call(runSearchTuningGrid, args)
  }

  testthat::expect_error(run_grid(min_descendant_tips_values = 3.5), "min_descendant_tips_values")
  testthat::expect_error(run_grid(null_replicates = 1.5), "null_replicates")
  testthat::expect_error(run_grid(recovery_replicates = 1.5), "recovery_replicates")
  testthat::expect_error(run_grid(tree_tip_count = 3.5), "tree_tip_count")
  testthat::expect_error(run_grid(fuzzy_distance = 1.5), "fuzzy_distance")
  testthat::expect_error(run_grid(num_cores = 1.5), "num_cores")
  testthat::expect_error(run_grid(seed = 1.5), "seed")
  expect_global_rng_restored(run_grid(seed = 65))
})

test_that("runSearchTuningGrid validates inputs", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()

  tmpl <- make_tuning_template()

  testthat::expect_error(
    runSearchTuningGrid(
      template = list(),
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "bifrost_simulation_template"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = numeric(0),
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "shift_acceptance_thresholds"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = c(5, -1),
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "finite non-negative"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = Inf,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "finite non-negative"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5),
      base_search_options = list(formula = "trait_data[, 1] ~ x")
    ),
    "intercept-only search formulas only"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = NULL,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "min_descendant_tips_values"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 0,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "min_descendant_tips_values"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      tree_tip_count = tmpl$n_tips + 1,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "tree_tip_count cannot exceed"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3
    ),
    "must be lists"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1)
    ),
    "must include num_shifts, min_shift_tips, and max_shift_tips"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      null_replicates = 0,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "null_replicates"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      recovery_replicates = 0,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5)
    ),
    "recovery_replicates"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5),
      fuzzy_distance = -1
    ),
    "fuzzy_distance"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5),
      weighted = NA
    ),
    "weighted"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5),
      num_cores = 0
    ),
    "num_cores"
  )
  testthat::expect_error(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = 5,
      min_descendant_tips_values = 3,
      proportional_simulation_options = list(num_shifts = 1, min_shift_tips = 2, max_shift_tips = 5),
      store_studies = NA
    ),
    "store_studies"
  )
})

test_that("runSearchTuningGrid can parallelize over settings in a small real run", {
  testthat::skip_on_cran()
  skip_if_tuning_grid_deps()
  testthat::skip_on_covr()

  tmpl <- make_tuning_template()
  grid <- suppressWarnings(
    runSearchTuningGrid(
      template = tmpl,
      IC = "GIC",
      shift_acceptance_thresholds = c(2, 5),
      min_descendant_tips_values = 3,
      tree_tip_count = 16,
      null_replicates = 1,
      recovery_replicates = 1,
      proportional_simulation_options = list(
        num_shifts = 1,
        min_shift_tips = 2,
        max_shift_tips = 5
      ),
      base_search_options = list(
        formula = "trait_data ~ 1",
        method = "LL",
        num_cores = 4
      ),
      weighted = FALSE,
      num_cores = 2,
      seed = 63,
      store_studies = FALSE
    )
  )

  testthat::expect_s3_class(grid, "bifrost_search_tuning_grid")
  testthat::expect_equal(nrow(grid$summary_table), 2)
  testthat::expect_true(all(grid$summary_table$IC == "GIC"))
})