test-calibrate_trial.R
In adaptr: Adaptive Trial Simulator

test_that("calibrate_trial works", {
  # Store seed - check that the entire process
  # from trial spec to running to calibration does not change it
  set.seed(12345)
  oldseed <- get(".Random.seed", envir = globalenv())

  spec <- setup_trial_binom(arms = 1:2, true_ys = rep(0.35, 2), data_looks = 500 * 1:5)

  # Run and save
  tmp_file <- tempfile()
  on.exit(try(file.remove(tmp_file)), add = TRUE, after = FALSE)
  res <- suppressMessages(calibrate_trial(spec, n_rep = 100, cores = 1, base_seed = 24,
                                          # Save plots and run verbose to check those and facilitate
                                          # checking plots later
                                          plot = TRUE, verbose = TRUE,
                                          # starting with prev x and prev y just to check
                                          prev_x = 1, prev_y = 0,
                                          path = tmp_file))
  res$elapsed_time <- NULL
  expect_snapshot(res)

  # Check plots
  vdiffr::expect_doppelganger("Gaussian process-based calibration plot", res$plots[[1]])

  # Check that a new calibration immediately succeeds when using previous x/y
  res2 <- suppressMessages(calibrate_trial(spec, n_rep = 100, cores = 2, base_seed = 24,
                                           prev_x = res$evaluations$x, prev_y = res$evaluations$y))
  expect_equal(res$evaluations, res2$evaluations)

  # Check that reloading works
  res_load <- suppressMessages(calibrate_trial(spec, n_rep = 100, cores = 2, base_seed = 24,
                                               # Save plots and run verbose to check those and facilitate
                                               # checking plots later
                                               plot = TRUE, verbose = TRUE,
                                               # starting with prev x and prev y just to check
                                               prev_x = 1, prev_y = 0,
                                               path = tmp_file))
  expect_equal(res$evaluations, res_load$evaluations)

  # Check that seed is unchanged
  expect_identical(oldseed, get(".Random.seed", envir = globalenv()))
})

test_that("calibrate_trial errors/warns correctly", {
  spec <- setup_trial_binom(arms = 1:2, true_ys = rep(0.35, 2), data_looks = 500 * 1:5)

  err_spec <- spec
  class(err_spec) <- "fake trial"
  expect_error(calibrate_trial(err_spec))
  expect_error(calibrate_trial(spec, n_rep = 50))
  expect_error(calibrate_trial(spec, narrow = c(TRUE, FALSE)))
  expect_error(calibrate_trial(spec, narrow = TRUE, noisy = TRUE))
  expect_error(calibrate_trial(spec, noisy = FALSE, base_seed = NULL))
  expect_error(calibrate_trial(spec, noisy = 27))
  expect_error(calibrate_trial(spec, base_seed = "Hello"))
  expect_error(calibrate_trial(spec, base_seed = 1, target = Inf))
  expect_error(calibrate_trial(spec, base_seed = 1, target = c(0.05, 0.1) ))
  expect_error(calibrate_trial(spec, base_seed = 1, search_range = 1))
  expect_error(calibrate_trial(spec, base_seed = 1, search_range = c(1, Inf)))
  expect_error(calibrate_trial(spec, base_seed = 1, search_range = c(1, 1)))
  expect_error(calibrate_trial(spec, base_seed = 1, tol = -1))
  expect_error(calibrate_trial(spec, base_seed = 1, tol = 1:2))
  expect_error(calibrate_trial(spec, base_seed = 1, tol = NULL))
  expect_error(calibrate_trial(spec, base_seed = 1, tol = NA))
  expect_error(calibrate_trial(spec, base_seed = 1, init_n = 1))
  expect_error(calibrate_trial(spec, base_seed = 1, iter_max = 24.3))
  expect_error(calibrate_trial(spec, base_seed = 1, resolution = 99))
  expect_error(calibrate_trial(spec, base_seed = 1, kappa = NA))
  expect_error(calibrate_trial(spec, base_seed = 1, pow = 3))
  expect_error(calibrate_trial(spec, base_seed = 1, lengthscale = - 99))
  expect_error(calibrate_trial(spec, base_seed = 1, lengthscale = c(10, 0.1)))
  expect_error(calibrate_trial(spec, base_seed = 1, scale_x = NULL))
  expect_error(calibrate_trial(spec, base_seed = 1, prev_x = "x"))
  expect_error(calibrate_trial(spec, base_seed = 1, prev_x = 1:3, prev_y = 4:5))
  expect_error(calibrate_trial(spec, base_seed = 1, overwrite = NULL))
  expect_error(calibrate_trial(spec, base_seed = 1, verbose = "Yes, please."))
  expect_error(calibrate_trial(spec, base_seed = 1, plot = NULL))
  expect_error(calibrate_trial(spec, base_seed = 1, fun = "mean"))

  # Check that reloading errors correctly
  # Run and save
  tmp_file <- tempfile()
  on.exit(try(file.remove(tmp_file)), add = TRUE, after = FALSE)
  res <- suppressMessages(calibrate_trial(spec, n_rep = 100, cores = 2, base_seed = 24,
                                          # Save plots and run verbose to check those and facilitate
                                          # checking plots later
                                          plot = TRUE, verbose = TRUE,
                                          # starting with prev x and prev y just to check
                                          prev_x = 1, prev_y = 0,
                                          path = tmp_file))
  # Modify spec and error
  err_spec <- spec
  err_spec$description <- "this will now cause an error"
  expect_error(suppressMessages(
    calibrate_trial(err_spec, n_rep = 100, cores = 2, base_seed = 24,
                    # Save plots and run verbose to check those and facilitate
                    # checking plots later
                    plot = TRUE, verbose = TRUE,
                    # starting with prev x and prev y just to check
                    prev_x = 1, prev_y = 0,
                    path = tmp_file)))
  # Error with invalid controls
  expect_error(suppressMessages(
    calibrate_trial(spec, n_rep = 100, cores = 2, base_seed = 25,
                    # Save plots and run verbose to check those and facilitate
                    # checking plots later
                    plot = TRUE, verbose = TRUE,
                    # starting with prev x and prev y just to check
                    prev_x = 1, prev_y = 0,
                    path = tmp_file)))
  # Error with different functions
  err_res <- res
  err_res$fun <- mean
  saveRDS(err_res, tmp_file)
  expect_error(suppressMessages(
    calibrate_trial(spec, n_rep = 100, cores = 2, base_seed = 24,
                    # Save plots and run verbose to check those and facilitate
                    # checking plots later
                    plot = TRUE, verbose = TRUE,
                    # starting with prev x and prev y just to check
                    prev_x = 1, prev_y = 0,
                    path = tmp_file)))
  # Error with previous version
  err_res <- res
  err_res$adaptr_version <- -99
  saveRDS(err_res, tmp_file)
  expect_error(suppressMessages(
    calibrate_trial(spec, n_rep = 100, cores = 2, base_seed = 25,
                    # Save plots and run verbose to check those and facilitate
                    # checking plots later
                    plot = TRUE, verbose = TRUE,
                    # starting with prev x and prev y just to check
                    prev_x = 1, prev_y = 0,
                    path = tmp_file)))
})


test_that("calibrate_trial messages correctly", {
  spec <- suppressWarnings(setup_trial_binom(arms = 1:2, true_ys = rep(0.35, 2), data_looks = 100, n_draws = 100))
  expect_message(calibrate_trial(spec, target = 1, tol = 1))
  expect_message(calibrate_trial(spec, target = 1, tol = 1, base_seed = 123, n_rep = 100))
})