tests/testthat/test_ArchiveBest.R

test_that("ArchiveBest", {
  a = ArchiveBest$new(PS_2D, FUN_2D_CODOMAIN)
  expect_output(print(a), "ArchiveBest")
  expect_equal(a$n_evals, 0)
  expect_equal(a$cols_x, c("x1", "x2"))
  expect_equal(a$cols_y, "y")
  xdt = data.table(x1 = 0, x2 = 1)
  xss_trafoed = list(list(x1 = 0, x2 = 1))
  ydt = data.table(y = 1)
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$n_evals, 1)
  expect_data_table(a$data, nrows = 0)
  a$clear()
  expect_data_table(a$data, nrows = 0)
})

test_that("Archive best works", {
  a = ArchiveBest$new(PS_2D, FUN_2D_CODOMAIN)
  expect_error(a$best(), "No results stored in archive")
  xdt = data.table(x1 = c(0, 0.5), x2 = c(1, 1))
  xss_trafoed = list(list(x1 = c(0, 0.5), x2 = c(1, 1)))
  ydt = data.table(y = c(1, 0.25))
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$best(), data.table(x1 = 0.5, x2 = 1, y = 0.25))

  xdt = data.table(x1 = 1, x2 = 1)
  xss_trafoed = list(list(x1 = 1, x2 = 1))
  ydt = data.table(y = 0)
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$best(), data.table(x1 = 1, x2 = 1, y = 0))

  codomain = ps(y = p_dbl(tags = "maximize"))

  a = ArchiveBest$new(PS_2D, codomain)
  expect_error(a$best(), "No results stored in archive")
  xdt = data.table(x1 = c(0, 0.5), x2 = c(1, 1))
  xss_trafoed = list(list(x1 = c(0, 0.5), x2 = c(1, 1)))
  ydt = data.table(y = c(1, 0.25))
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$best(), data.table(x1 = 0, x2 = 1, y = 1))

  xdt = data.table(x1 = 1, x2 = 1)
  xss_trafoed = list(list(x1 = 1, x2 = 1))
  ydt = data.table(y = 2)
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$best(), data.table(x1 = 1, x2 = 1, y = 2))
})

test_that("ArchiveBest multi-crit works", {
  a = ArchiveBest$new(PS_2D, FUN_2D_2D_CODOMAIN)
  expect_output(print(a), "ArchiveBest")
  expect_equal(a$n_evals, 0)
  expect_equal(a$cols_x, c("x1", "x2"))
  expect_equal(a$cols_y, c("y1", "y2"))
  xdt = data.table(x1 = c(0, 1), x2 = c(1, 0))
  xss_trafoed = list(list(x1 = c(0, 1), x2 = c(1, 0)))
  ydt = data.table(y1 = c(0, 1), y2 = c(1, 0))
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$n_evals, 2)
  expect_data_table(a$data, nrows = 0)

  expect_equal(a$best(), data.table(x1 = 0, x2 = 1, y1 = 0, y2 = 1))

  xdt = data.table(x1 = 10, x2 = 10)
  xss_trafoed = list(list(x1 = 10, x2 = 10))
  ydt = data.table(y1 = -20, y2 = 20)
  a$add_evals(xdt, xss_trafoed, ydt)
  expect_equal(a$best(), data.table(x1 = 10, x2 = 10, y1 = -20, y2 = 20))
})

Try the bbotk package in your browser

Any scripts or data that you put into this service are public.

bbotk documentation built on Nov. 13, 2023, 5:06 p.m.