# Deterministic tests of the frozen Part II coarse -> fine -> validation logic.
# These fixtures stub the AH evaluation/audit outputs ONLY within a local
# copy of find_n_req(); no public package functions are modified.
# This avoids relying on random Monte Carlo crossings near the 0.80 target.

part2_boundary_fixture <- function(coarse, fine = numeric(0),
                                   validation = numeric(0),
                                   validation_stage1 = NULL,
                                   N_upper = 160) {
  # The search must still invoke the trial generator and the evaluation loop.
  trial_generator <- function(N, F) {
    data.frame(arm = c(0, 1), X = c(1, 1), status = c(1, 1))
  }
  fake_evaluate_tau_grid <- function(trial, tau_grid, alpha = 0.05) {
    data.frame(tau = tau_grid)
  }
  fake_stage1_audit <- function(raw_results, thresholds) {
    N <- as.integer(sub("^N_", "", raw_results$scenario_id[1]))
    n_attempts <- length(unique(raw_results$sim_id))
    layer <- switch(as.character(n_attempts),
                    "1" = "coarse", "2" = "fine", "3" = "validation")
    powers <- switch(layer, coarse = coarse, fine = fine,
                     validation = validation)
    power <- unname(powers[as.character(N)])
    if (length(power) != 1L || is.na(power)) {
      stop("Fixture lacks ", layer, " power at N=", N)
    }
    support_pass <- TRUE
    if (layer == "validation" && !is.null(validation_stage1)) {
      support_pass <- unname(validation_stage1[as.character(N)])
      if (length(support_pass) != 1L || is.na(support_pass)) {
        stop("Fixture lacks validation Stage 1 result at N=", N)
      }
    }
    list(scenario_summary = data.frame(
      n_sim = n_attempts,
      min_mean_p_risk = 0.5,
      min_mean_n_risk = N / 2,
      p_support = 1,
      Stage1_pass = support_pass,
      power_overall = power
    ))
  }

  # Clone the public function with a *local* evaluation environment.
  # Never edit the locked package namespace or change actual Part II code.
  local_environment <- new.env(parent = environment(find_n_req))
  local_environment$evaluate_tau_grid <- fake_evaluate_tau_grid
  local_environment$stage1_audit <- fake_stage1_audit
  search_for_test <- eval(
    call("function", formals(find_n_req), body(find_n_req)),
    envir = local_environment
  )

  search_for_test(
    F_followup = 6, tau = 12,
    thresholds = list(p_risk_min = 0.1, n_risk_min = 10,
                      p_support_min = 0.95),
    trial_generator = trial_generator,
    N_lower = 100, N_upper = N_upper,
    coarse_step = 20, fine_step = 10,
    n_coarse = 1, n_fine = 2, n_validate = 3,
    power_target = 0.80,
    search_seed = 202614, validation_seed = 202615
  )
}

has_trace_action <- function(result, action) {
  any(vapply(result$trace, function(event) {
    identical(event$action, action)
  }, logical(1)))
}

test_that("Part II confirms a normal boundary with an independently validated predecessor", {
  result <- part2_boundary_fixture(
    coarse = c("100" = 0.60, "120" = 0.70, "140" = 0.82),
    fine = c("120" = 0.70, "130" = 0.75, "140" = 0.82),
    validation = c("130" = 0.79, "140" = 0.81)
  )
  expect_identical(result$status, "validated_boundary")
  expect_equal(result$N_req, 140)
  expect_equal(result$validation_results$N, c(130, 140))
  expect_identical(result$validation_results$final_feasible,
                   c(FALSE, TRUE))
  expect_true(all(is.na(result$fine_results$power_overall_iso)))
})

test_that("Part II accepts a validated feasible lower bound", {
  result <- part2_boundary_fixture(
    coarse = c("100" = 0.90),
    fine = c("100" = 0.90),
    validation = c("100" = 0.90)
  )
  expect_identical(result$status, "validated_lower_bound")
  expect_equal(result$N_req, 100)
  expect_equal(result$validation_results$N, 100)
  expect_true(result$validation_results$final_feasible)
})

test_that("Part II independently validates the upper bound when coarse search fails", {
  result <- part2_boundary_fixture(
    coarse = c("100" = 0.50, "120" = 0.60,
               "140" = 0.70, "160" = 0.75),
    validation = c("160" = 0.78)
  )
  expect_identical(result$status, "no_feasible_within_range")
  expect_true(is.na(result$N_req))
  expect_equal(result$validation_results$N, 160)
  expect_true(has_trace_action(result, "upper_bound_safeguard"))
})

test_that("nonmonotone fine results are validated and only validation power is isotonic", {
  result <- part2_boundary_fixture(
    coarse = c("100" = 0.60, "120" = 0.70, "140" = 0.82),
    fine = c("120" = 0.82, "130" = 0.70, "140" = 0.83),
    validation = c("120" = 0.75, "130" = 0.83, "140" = 0.80)
  )
  expect_true(has_trace_action(result, "promote_nonmonotone_fine"))
  expect_equal(result$validation_results$N, c(120, 130, 140))
  expect_equal(result$validation_results$power_overall,
               c(0.75, 0.83, 0.80))
  expect_equal(result$validation_results$power_overall_iso,
               c(0.75, 0.815, 0.815))
  expect_true(all(result$validation_results$Stage1_pass))
  expect_true(all(is.na(result$fine_results$power_overall_iso)))
  expect_identical(result$status, "validated_boundary")
  expect_equal(result$N_req, 130)
})

test_that("Part II returns to fine localization to validate a missing predecessor", {
  result <- part2_boundary_fixture(
    coarse = c("100" = 0.60, "120" = 0.70, "140" = 0.84),
    fine = c("120" = 0.65, "130" = 0.70, "140" = 0.84),
    validation = c("120" = 0.79, "130" = 0.81, "140" = 0.84)
  )
  expect_true(has_trace_action(result, "return_to_fine"))
  expect_identical(result$status, "validated_boundary")
  expect_equal(result$N_req, 130)
  expect_equal(result$validation_results$N, c(120, 130, 140))
  expect_equal(sum(result$search_results$search_stage == "validation" &
                   result$search_results$N == 130), 1)
})

test_that("Part II never replaces an unsupported validation point with smoothed power", {
  result <- part2_boundary_fixture(
    coarse = c("100" = 0.50, "120" = 0.70, "140" = 0.85),
    fine = c("120" = 0.70, "130" = 0.70, "140" = 0.85),
    validation = c("130" = 0.79, "140" = 0.95),
    validation_stage1 = c("130" = TRUE, "140" = FALSE),
    N_upper = 140
  )
  expect_identical(result$status, "no_feasible_within_range")
  expect_true(is.na(result$N_req))
  expect_equal(result$validation_results$power_overall[2], 0.95)
  expect_false(result$validation_results$Stage1_pass[2])
  expect_false(result$validation_results$final_feasible[2])
})