tests/testthat/test-repair.R

In irace: Iterated Racing for Automatic Algorithm Configuration

withr::with_output_sink("test-repair.Rout", {

repair_irace <- function(targetRunner, repair)
{
  weights <- rnorm(200, mean = 0.9, sd = 0.02)
  parameters <- readParameters(text = '
   p1 "" r (0,1)
   p2 "" r (0,1)
   p3 "" r (0,1)
   dummy "" c ("d1", "d2")
   ')
  scenario <- list(targetRunner = targetRunner,
                   repairConfiguration = repair,
                   instances = weights,
                   maxExperiments=180,
                   seed = 1234567,
                   parameters = parameters)
  scenario <- checkScenario (scenario)
  expect_true(irace:::checkTargetFiles(scenario = scenario))
  confs <- irace(scenario = scenario)
  expect_gt(nrow(confs), 0L)
  confs
}

target_sum2one <- function(experiment, scenario)
{
  configuration <- experiment$configuration
  p1 <-  configuration[["p1"]]
  p2 <-  configuration[["p2"]]
  p3 <-  configuration[["p3"]]
  stopifnot(isTRUE(all.equal(p1+p2+p3, 1.0)))
  list(cost = -p1, call = toString(experiment))
}

repair_sum2one <- function(configuration, parameters)
{
  isreal <- parameters$names[parameters$types == "r"]
  digits <- sapply(isreal, function(x) parameters$get(x)[["digits"]])
  c_real <- unlist(configuration[isreal])
  c_real <- c_real / sum(c_real)
  c_real[-1] <- round(c_real[-1], digits[-1])
  c_real[1L] <- 1 - sum(c_real[-1])
  configuration[isreal] <- c_real
  configuration
}

target_order <- function(experiment, scenario)
{
  configuration <- experiment$configuration
  p1 <- configuration[["p1"]]
  p2 <- configuration[["p2"]]
  p3 <- configuration[["p3"]]
  stopifnot(p1 <= p2 && p2 <= p3)
  list(cost = -p1, call = toString(experiment))
}

repair_order <- function(configuration, parameters)
{
 columns <- c("p1","p2","p3")
 #cat("Before"); print(configuration)
 configuration[columns] <- sort(unlist(configuration[columns], use.names=FALSE))
 #cat("After"); print(configuration)
 configuration
}

test_that("repair: sum to one", {
  generate_set_seed()
  confs <- repair_irace(target_sum2one, repair_sum2one)
  expect_equal(unique(apply(confs[, c("p1", "p2", "p3")], 1L, sum)), 1)
})

test_that("repair: increasing order", {
  generate_set_seed()
  confs <- repair_irace(target_order, repair_order)
  expect_true(all(apply(confs[, c("p1", "p2", "p3")], 1L, diff) >= 0))
})

}) # withr::with_output_sink()