R/irace.R

Defines functions irace_run irace_common irace extractElites allConfigurationsInit do_experiments generateInstances checkMinimumBudget computeMinimumBudget computeTerminationOfRace computeNbConfigurations computeComputationalBudget computeNbIterations similarConfigurations numeric.configurations.equal recoverFromFile

Documented in irace

# FIXME: Restoring occurs after reading the command-line/scenario file. At
# least for the irace command-line parameters (scenario), it should occur
# before. We would need to:
#
# 1) Read recovery file settings from command-line/scenario file
#
# 2) if set, then recover irace scenario

# 3) then read other settings from command-line/scenario file being
# careful to not override with defaults whatever the recovery has set.
#
# 4) checkScenario()
#
# A work-around is to modify the recovery file (you can load it in R,
# modify scenario then save it again).
recoverFromFile <- function(filename, scenario = list())
{
  iraceResults <- read_logfile(filename)
  if (iraceResults$irace_version != irace::irace_version)
    irace_error("Recovery file '", filename, "' was generated by a version of irace (",
      iraceResults$irace_version, ") different from this version of irace (",
      irace::irace_version, ").")

  # Restore part of scenario but not all.
  for (name in .irace.params.recover)
    scenario[[name]] <- iraceResults$scenario[[name]]
  # We call checkScenario() again to fix any inconsistencies in the recovered data.
  # FIXME: Do not call checkScenario earlier and instead do the minimum to check recoveryFile.
  scenario <- checkScenario(scenario)
  race_state <- iraceResults$state$clone()
  race_state$initialize(scenario, recover = TRUE)
  race_state
}

##
## Numerical configurations similarity function
##
# FIXME: This function is too slow and it shows up in profiles.
numeric.configurations.equal <- function(x, configurations, parameters, threshold, param.names)
{
  d <- numeric(nrow(configurations))
  isSimilar <- matrix(TRUE, nrow = nrow(configurations), ncol = length(param.names))
  selected <- seq_nrow(configurations)
  for (i in seq_along(param.names)) {
    pname <- param.names[i]
    param <- parameters$get(pname)

    is_dep <- param[["is_dependent"]]
    x_domain <- if (is_dep) getDependentBound(param, x) else param[["domain"]]
    x_range <- x_domain[[2L]] - x_domain[[1L]]

    X <- x[[pname]]
    # FIXME: Since at the end we select a subset of configurations, we could use selected here.
    y <- configurations[[pname]]
    ## FIXME: This can probably done much faster by doing a matrix operation that updates
    ## isSimilar[, i] in one step instead of the for-loop.
    ## We would need to handle the NAs first.
    for (j in seq_len(nrow(isSimilar))) { # Configurations loop
      Y <- y[selected[j]]
      if (is.na (X) && is.na(Y)) { # Both NA, just ignore this pname
        next
      } else if (xor(is.na (X), is.na(Y))) { # Distance is 1.0, so not equal
        isSimilar[j,i] <- FALSE
      } else {
        # FIXME: Why is this updating d[j]? It seems that if the difference is
        # large for one configuration, then it will be assumed to be large for
        # the rest.
        if (is_dep) {
          # Compare dependent domains by normalising their values to their own ranges first
          # and calculating the difference. (When possible)
          y_domain <- getDependentBound(param, configurations[selected[j],])
          y_range <- y_domain[[2L]] - y_domain[[1L]]
          dx <- if (x_range == 0) 0 else (as.numeric(X) - x_domain[[1L]]) / x_range
          dy <- if (y_range == 0) 0 else (as.numeric(Y) - y_domain[[1L]]) / y_range
          d[j] <- max(d[j], abs(dx - dy))
        } else {
          # FIXME: We should calculate (X - x.domain[1]) / x.range once for all configurations
          # and all parameters, then calculate the differences using vectorization.
          d[j] <- max(d[j], abs((as.numeric(X) - as.numeric(Y)) / x_range))
        }
        if (d[j] > threshold) isSimilar[j,i] <- FALSE
      }
    }
    index <- which(rowAlls(isSimilar))
    isSimilar <- isSimilar[index, , drop=FALSE]
    d <- d[index]
    selected  <- selected[index]
    if (nrow(isSimilar) == 0L) break
  }

  if (length(selected) == 0L)
    return(NULL)
  c(x[[".ID."]], configurations[selected,".ID."])
}

##
## Identify which configurations are similar.
##
# FIXME: It would be nice to print the minimum similarity found to the user.
similarConfigurations <- function(configurations, parameters, threshold)
{
  # FIXME: Use data.table
  debug.level <- getOption(".irace.debug.level", 0)
  if (debug.level >= 1) irace_note ("Computing similarity of configurations .")

  # Create vectors of categorical and numerical
  p <- parameters$types %in% c("c","o")
  vecCat <- parameters$names[p & !parameters$isFixed]
  vecNum <- parameters$names[!p & !parameters$isFixed]

  irace_assert(all(parameters$types[vecCat] %in% c("c","o")))
  irace_assert(all(parameters$types[vecNum] %not_in% c("c","o")))
  irace_assert(length(intersect(vecCat, vecNum)) == 0)

  nbCater <- length(vecCat)
  nbNumer <- length(vecNum)

  ### Categorical/Ordinal filtering ####
  if (nbCater > 0) {
    ## Build a vector with the categorical appended together in a string
    strings <- do.call(paste, c(configurations[, vecCat, drop=FALSE], sep = " ; "))

    if (nbNumer != 0) configurations <- configurations[, c(".ID.", vecNum)]
    ord.strings <- order(strings)
    configurations <- configurations[ord.strings, ]
    strings <- strings[ord.strings]

    ## keep similar (index i == true means is the same as i + 1)
    similarIdx <- strings[-length(strings)] == strings[-1]

    ## Now let's get just a FALSE if we remove it, TRUE otherwise:
    keepIdx <- c(similarIdx[1],
                 (similarIdx[-1] | similarIdx[-length(similarIdx)]),
                 similarIdx[length(similarIdx)])

    ## filtering them out:
    configurations <- configurations [keepIdx, , drop=FALSE]
    ## filtering their strings out (to use them to define blocks):
    strings <- strings[keepIdx]

    ## if everything is already filtered out, return
    if (nrow(configurations) == 0) {
      if (debug.level >= 1) cat(" DONE\n")
      return(NULL)
    }
  }

  ### Numerical parameters within blocks of the same string ###
  if (nbNumer > 0) {
    similar <- c()
    if (nbCater > 0) {
      ## In this case the object "string" is available to define blocks
      ## Loop over blocks:
      beginBlock <- 1L
      while (beginBlock < nrow(configurations)) {
        ## The current block is made of all configurations that have the same
        ## categorical string as the one of configuration[beginBlock, ]
        blockIds <- which(strings == strings[beginBlock])
        endBlock <- blockIds[length(blockIds)]

        irace_assert (endBlock > beginBlock)
        ## Loop inside blocks:
        for (i in seq(beginBlock, endBlock - 1L)) {
          ## Compare configuration i with all the ones that are after in the block
          similar <- c(similar,
                       numeric.configurations.equal(configurations[i, ], configurations[(i+1L):endBlock,],
                                                parameters, threshold = threshold, param.names = vecNum))
          if (debug.level >= 1) cat(".")
        }
        beginBlock <- endBlock + 1L # Next block starts after the end of the current one
      }
    } else {
      ## No categorical, so no blocks, just do the basic check without blocks
      for (i in seq_len(nrow(configurations) - 1L)) {
        similar <- c(similar,
                     numeric.configurations.equal(configurations[i, ], configurations[(i+1L):nrow(configurations),],
                                              parameters, threshold = threshold, param.names = vecNum))
        if (debug.level >= 1) cat(".")
      }
    }
    # FIXME: We have to use unique because we return the same configuration
    # more than once in different calls to numeric.configurations.equal.
    # Currently, we compare each configuration k=1...n with every configuration
    # k+1...n. Instead, we should compare k=1...n with ((k+1...n) notin
    # similar).  It may happen that A ~ B and A ~ C and B /= C, but this is OK
    # because we still return A, B and C. It may also happen that A ~ B, B ~ C
    # and A /= C, but this is also OK because we will compare A with B,C then B
    # with C.
    similar <- unique(similar)
    configurations <- configurations[configurations[[".ID."]] %in% similar, ]
  }

  if (debug.level >= 1) cat(" DONE\n")
  if (nrow(configurations) == 0L) return(NULL)
  configurations[[".ID."]]
}


## Number of iterations.
computeNbIterations <- function(nbParameters) (2 + log2(nbParameters))

## Computational budget at each iteration.
computeComputationalBudget <- function(remainingBudget, indexIteration,
                                       nbIterations)
  floor (remainingBudget / (nbIterations - indexIteration + 1L))

## The number of configurations
computeNbConfigurations <- function(currentBudget, indexIteration,
                                    mu, eachTest, blockSize,
                                    nElites = 0L, nOldInstances = 0L, newInstances = 0L,
                                    maxConfigurations = 1024L)
{
  # FIXME: This is slightly incorrect, because we may have elites that have not
  # been executed on all nOldInstances. Thus, we need to pass explicitly the
  # budget that we save (that is, number of entries that are not NA).
  savedBudget <- nElites *  nOldInstances
  eachTest <- eachTest * blockSize
  n <- max (mu + eachTest  * min(5L, indexIteration),
            round_to_next_multiple(nOldInstances + newInstances, eachTest))
  min (floor ((currentBudget + savedBudget) / n), maxConfigurations)
}

## Termination of a race at each iteration. The race will stop if the
## number of surviving configurations is equal or less than this number.
computeTerminationOfRace <- function(nbParameters) (2 + log2(nbParameters))

## Compute the minimum budget required, and exit early in case the
## budget given by the user is insufficient.
computeMinimumBudget <- function(scenario, minSurvival, nbIterations, elitist_new_instances)
{
  blockSize <- scenario$blockSize
  eachTest <- blockSize * scenario$eachTest
  Tnew <- elitist_new_instances # This is already multiplied by blockSize.
  mu <- scenario$mu

  # This is computed from the default formulas as follows:
  #  B_1 = B / I
  #  B_2 = B -  (B/I) / (I - 1) = B / I
  #  B_3 = B - 2(B/I) / (I - 2) = B / I
  # thus
  #  B_i = B / I
  # and
  #  C_i = B_i / T_i = B / (I * T_i).
  #
  # We want to enforce that C_i >= min_surv + 1, thus
  #  B / (I * T_i) >= min_surv + 1                             (1)
  # becomes
  #  B >= (min_surv + 1) * I * T_i
  #
  # This is an over-estimation, since actually B_1 = floor(B/I) and if
  # floor(B/I) < B/I, then B_i < B/I, and we could still satisfy Eq. (1)
  # with a smaller budget. However, the exact formula requires computing B_i
  # taking into account the floor() function, which is not obvious.

  minimumBudget <- (minSurvival + 1L) * nbIterations

  # We need to compute T_i:
  if (scenario$elitist) {
    # T_i = max(mu + Teach * min (5, i),
    #           ceiling((T_{i-1} + Tnew) / Teach) * Teach)
    # T_1 = mu + Teach
    # T_2 ~ mu + Teach + max (Teach, Tnew)
    # T_3 ~ max(mu + 3 * Teach,
    #           mu + Teach + max(Teach, Tnew) + T_new)

    #     = mu + Teach + max(Teach + max(Teach, Tnew), 2 * Tnew)

    # if Teach > Tnew then 2*Teach > 2*Tnew then max = 2*Teach
    # if Teach < Tnew then Teach + Tnew < 2*Tnew then max = 2*Tnew
    # hence: T_3 = mu + Teach + 2 * max(Teach, Tnew)

    # T_4 = max(mu + 4 * Teach,
    #           ceiling((mu + Teach + 2 * max(Teach, Tnew)) + Tnew) / Teach) * Teach)
    #     ~ mu + Teach + max(2 * Teach + max(Teach, Tnew), 3 * Tnew)
    #     = mu + Teach + 3 * max(Teach, Tnew)

    # T_i = mu + Teach + (i - 1) * max(Teach, Tnew)

    # T_6 = max (mu + 5*Teach,
    #            mu + Teach + 5 * max(Teach, Tnew) + Tnew)
    #      = mu + Teach + Tnew + 5 * max (Teach, Tnew)

    # T_i = mu + Teach + max(I-5, 0) * Tnew + 5 * max (Teach, Tnew)
    if (nbIterations > 5L) {
      minimumBudget <- minimumBudget *
        (mu + eachTest + (nbIterations - 5L) * Tnew +  5L * max(eachTest, Tnew))
    } else {
      minimumBudget <- minimumBudget *
        (mu + eachTest + (nbIterations - 1L) * max(eachTest, Tnew))
    }
  } else {
    #   T_i = mu + T_each * min (5, i)
    # and the most strict value is for i >= 5, thus
    #   B >= (min_surv + 1) * I * (mu + 5 * T_each)
    minimumBudget <- minimumBudget * (mu + 5L * eachTest)
  }
  minimumBudget
}

checkMinimumBudget <- function(scenario, remainingBudget, minSurvival, nbIterations,
                               boundEstimate, timeUsed, elitist_new_instances)
{
  minimumBudget <- computeMinimumBudget(scenario, minSurvival, nbIterations, elitist_new_instances)

  if (remainingBudget >= minimumBudget)
    return(TRUE)
  if (scenario$maxTime == 0) {
    irace_error("Insufficient budget: ",
                "With the current settings, irace will require a value of ",
                "'maxExperiments' of at least '",  minimumBudget, "'.")
  } else if (nbIterations == 1L) {
    irace_error("Insufficient budget: ",
                "With the current settings and estimated time per run (",
                boundEstimate, ") irace will require a value of 'maxTime' of at least '",
                ceiling((minimumBudget * boundEstimate) + timeUsed), "'.")
  }
  FALSE
}

## Generate instances + seed.
generateInstances <- function(race_state, scenario, n, update = FALSE)
{
  if (!update)
    race_state$instances_log <- NULL
  # If we are adding and the scenario is deterministic, we have already added all instances.
  else if (scenario$deterministic)
    return(race_state$instances_log)

  instances <- scenario$instances
  # Number of times that we need to repeat the set of instances given by the user.
  ntimes <- if (scenario$deterministic) 1L else
            # "Upper bound"" of instances needed
            # FIXME: We could bound it even further if maxExperiments >> nInstances
            ceiling(n / length(instances))

  # Get instances order
  if (scenario$sampleInstances) {
    blockSize <- scenario$blockSize
    n_blocks <- length(instances) / blockSize
    # Sample instances index in groups (ntimes)
    selected_blocks <- unlist(lapply(rep.int(n_blocks, ntimes), sample.int, replace = FALSE))
    sindex <- c(outer(seq_len(blockSize), (selected_blocks - 1L) * blockSize, "+"))
  } else {
    sindex <- rep.int(seq_along(instances), ntimes)
  }
  # Sample seeds.
  race_state$instances_log <- rbindlist(use.names = TRUE, list(
    race_state$instances_log,
    data.table(instanceID = sindex, seed = runif_integer(length(sindex)))))
  race_state$instances_log
}

do_experiments <- function(race_state, configurations, ninstances, scenario, iteration)
{
  instances <- seq_len(ninstances)
  output <- race_wrapper_helper(race_state = race_state,
    configurations = configurations,
    instance_idx = instances,
    bounds = rep(scenario$boundMax, nrow(configurations)),
    is_exe = rep_len(TRUE, nrow(configurations) * ninstances), scenario = scenario)

  set(output, j = "iteration", value = iteration)
  Results <- race_state$update_experiment_log(output, instances = instances,
    scenario = scenario)

  rejected_ids <- configurations[[".ID."]][colAnys(is.infinite(Results))]
  scenario$parameters$forbid_configurations(
    race_state$update_rejected(rejected_ids, configurations)
  )
  Results
}

## Initialize allConfigurations with any initial configurations provided.
allConfigurationsInit <- function(scenario)
{
  initConfigurations <- scenario$initConfigurations

  confs_from_file <- NULL
  if (!is.null.or.empty(scenario$configurationsFile)) {
    confs_from_file <- readConfigurationsFile(scenario$configurationsFile,
                                              scenario$parameters, scenario$debugLevel)
  }
  if (is.null.or.empty(initConfigurations)) {
    initConfigurations <- confs_from_file
  } else {
    if (!is.null.or.empty(scenario$configurationsFile) && !identical(initConfigurations, confs_from_file))
      irace_warning("'initConfigurations' provided in 'scenario',",
                    " thus ignoring configurations from file '",
                    scenario$configurationsFile, "'.")
    cat("# Adding", nrow(initConfigurations), "initial configuration(s)\n")
    initConfigurations <- fix_configurations(initConfigurations, scenario$parameters, debugLevel = scenario$debugLevel)
  }

  if (is.null.or.empty(initConfigurations)) {
    allConfigurations <- configurations_alloc(c(".ID.", scenario$parameters$names, ".PARENT."),
      nrow = 0L, parameters = scenario$parameters)
    setDF(allConfigurations)
  } else {
    allConfigurations <- cbind(.ID. = seq_nrow(initConfigurations),
                               initConfigurations, .PARENT. = NA_integer_)
    rownames(allConfigurations) <- allConfigurations[[".ID."]]
    num <- nrow(allConfigurations)
    allConfigurations <- checkForbidden(allConfigurations, scenario$parameters$forbidden)
    if (nrow(allConfigurations) < num) {
      irace_warning(num - nrow(allConfigurations), " of the ", num,
                    " initial configurations were forbidden",
                    " and, thus, discarded.")
    }
  }
  allConfigurations
}

## extractElites
# Input: the configurations with the .RANK. field filled.
#        the number of elites wished
# Output: nbElites elites, sorted by ranks, with the weights assigned.
extractElites <- function(configurations, nbElites, debugLevel)
{
  irace_assert(nbElites > 0L)
  # Keep only alive configurations.
  elites <- as.data.table(configurations)
  before <- nrow(elites)
  # Remove duplicated. Duplicated configurations may be generated, however, it
  # is too slow to check at generation time. Nevertheless, we can check now
  # since we typically have very few elites.
  elites <- unique(elites, by=which(!startsWith(colnames(elites), ".")))
  after <- nrow(elites)
  if (debugLevel >= 2L && after < before)
    irace_note("Dropped ", before - after, " duplicated elites.\n")

  after <- min(after, nbElites)
  setorderv(elites, cols=".RANK.")
  selected <- seq_len(after)
  elites <- elites[selected, ]
  set(elites, j = ".WEIGHT.", value = ((after + 1L) - selected) / (after * (after + 1L) / 2))
  setDF(elites)
  rownames(elites) <- elites[[".ID."]]
  elites
}

#' Execute one run of the Iterated Racing algorithm.
#'
#' The function `irace` implements the Iterated Racing procedure for parameter
#' tuning. It receives a configuration scenario and a parameter space to be
#' tuned, and returns the best configurations found, namely, the elite
#' configurations obtained from the last iterations. As a first step, it checks
#' the correctness of `scenario` using [checkScenario()] and recovers a
#' previous execution if `scenario$recoveryFile` is set. A R data file log of
#' the execution is created in `scenario$logFile`.
#'
#' The execution of this function is reproducible under some conditions. See
#' the FAQ section in the [User
#' Guide](https://cran.r-project.org/package=irace/vignettes/irace-package.pdf).
#'
#' @inheritParams defaultScenario
#'
#' @template return_irace
#'
#' @examples
#' \dontrun{
#' # In general, there are three steps:
#' scenario <- readScenario(filename = "scenario.txt")
#' irace(scenario = scenario)
#' }
#' #######################################################################
#' # This example illustrates how to tune the parameters of the simulated
#' # annealing algorithm (SANN) provided by the optim() function in the
#' # R base package.  The goal in this example is to optimize instances of
#' # the following family:
#' #      f(x) = lambda * f_rastrigin(x) + (1 - lambda) * f_rosenbrock(x)
#' # where lambda follows a normal distribution whose mean is 0.9 and
#' # standard deviation is 0.02. f_rastrigin and f_rosenbrock are the
#' # well-known Rastrigin and Rosenbrock benchmark functions (taken from
#' # the cmaes package). In this scenario, different instances are given
#' # by different values of lambda.
#' #######################################################################
#' ## First we provide an implementation of the functions to be optimized:
#' f_rosenbrock <- function (x) {
#'   d <- length(x)
#'   z <- x + 1
#'   hz <- z[1L:(d - 1L)]
#'   tz <- z[2L:d]
#'   sum(100 * (hz^2 - tz)^2 + (hz - 1)^2)
#' }
#' f_rastrigin <- function (x) {
#'   sum(x * x - 10 * cos(2 * pi * x) + 10)
#' }
#'
#' ## We generate 20 instances (in this case, weights):
#' weights <- rnorm(20, mean = 0.9, sd = 0.02)
#'
#' ## On this set of instances, we are interested in optimizing two
#' ## parameters of the SANN algorithm: tmax and temp. We setup the
#' ## parameter space as follows:
#' parameters_table <- '
#'   tmax "" i,log (1, 5000)
#'   temp "" r (0, 100)
#'   '
#' ## We use the irace function readParameters to read this table:
#' parameters <- readParameters(text = parameters_table)
#'
#' ## Next, we define the function that will evaluate each candidate
#' ## configuration on a single instance. For simplicity, we restrict to
#' ## three-dimensional functions and we set the maximum number of
#' ## iterations of SANN to 1000.
#' target_runner <- function(experiment, scenario)
#' {
#'     instance <- experiment$instance
#'     configuration <- experiment$configuration
#'
#'     D <- 3
#'     par <- runif(D, min=-1, max=1)
#'     fn <- function(x) {
#'       weight <- instance
#'       return(weight * f_rastrigin(x) + (1 - weight) * f_rosenbrock(x))
#'     }
#'     # For reproducible results, we should use the random seed given by
#'     # experiment$seed to set the random seed of the target algorithm.
#'     res <- withr::with_seed(experiment$seed,
#'                      stats::optim(par,fn, method="SANN",
#'                                   control=list(maxit=1000
#'                                              , tmax = as.numeric(configuration[["tmax"]])
#'                                              , temp = as.numeric(configuration[["temp"]])
#'                                                )))
#'     ## This list may also contain:
#'     ## - 'time' if irace is called with 'maxTime'
#'     ## - 'error' is a string used to report an error
#'     ## - 'outputRaw' is a string used to report the raw output of calls to
#'     ##   an external program or function.
#'     ## - 'call' is a string used to report how target_runner called the
#'     ##   external program or function.
#'     return(list(cost = res$value))
#' }
#'
#' ## We define a configuration scenario by setting targetRunner to the
#' ## function define above, instances to the first 10 random weights, and
#' ## a maximum budget of 'maxExperiments' calls to targetRunner.
#' scenario <- list(targetRunner = target_runner,
#'                  instances = weights[1:10],
#'                  maxExperiments = 500,
#'                  # Do not create a logFile
#'                  logFile = "",
#'                  parameters = parameters)
#'
#' ## We check that the scenario is valid. This will also try to execute
#' ## target_runner.
#' checkIraceScenario(scenario)
#'
#' \donttest{
#' ## We are now ready to launch irace. We do it by means of the irace
#' ## function. The function will print information about its
#' ## progress. This may require a few minutes, so it is not run by default.
#' tuned_confs <- irace(scenario = scenario)
#'
#' ## We can print the best configurations found by irace as follows:
#' configurations_print(tuned_confs)
#'
#' ## We can evaluate the quality of the best configuration found by
#' ## irace versus the default configuration of the SANN algorithm on
#' ## the other 10 instances previously generated.
#' test_index <- 11:20
#' test_seeds <- sample.int(2147483647L, size = length(test_index), replace = TRUE)
#' test <- function(configuration)
#' {
#'   res <- lapply(seq_along(test_index),
#'                 function(x) target_runner(
#'                               experiment = list(instance = weights[test_index[x]],
#'                                                 seed = test_seeds[x],
#'                                                 configuration = configuration),
#'                               scenario = scenario))
#'   return (sapply(res, getElement, name = "cost"))
#' }
#' ## To do so, first we apply the default configuration of the SANN
#' ## algorithm to these instances:
#' default <- test(data.frame(tmax=10, temp=10))
#'
#' ## We extract and apply the winning configuration found by irace
#' ## to these instances:
#' tuned <- test(removeConfigurationsMetaData(tuned_confs[1,]))
#'
#' ## Finally, we can compare using a boxplot the quality obtained with the
#' ## default parametrization of SANN and the quality obtained with the
#' ## best configuration found by irace.
#' boxplot(list(default = default, tuned = tuned))
#' }
#' @seealso
#'  \describe{
#'  \item{[irace_main()]}{a higher-level interface to [irace()].}
#'  \item{[irace_cmdline()]}{a command-line interface to [irace()].}
#'  \item{[readScenario()]}{for reading a configuration scenario from a file.}
#'  \item{[readParameters()]}{read the target algorithm parameters from a file.}
#'  \item{[defaultScenario()]}{returns the default scenario settings of \pkg{irace}.}
#'  \item{[checkScenario()]}{to check that the scenario is valid.}
#' }
#' @author Manuel López-Ibáñez and Jérémie Dubois-Lacoste
#' @concept running
#' @export
irace <- function(scenario)
  irace_common(scenario, simple = TRUE)

irace_common <- function(scenario, simple, output.width = 9999L)
{
  if (!simple) {
    withr::local_options(width = output.width) # Do not wrap the output.
  }
  scenario <- checkScenario(scenario)
  debugLevel <- scenario$debugLevel

  if (debugLevel >= 1L) {
    op <- list(warning.length = 8170L)
    if (!base::interactive())
      op <- c(op, list(error = irace_dump_frames))
    withr::local_options(op)
    printScenario (scenario)
  }

  elite_configurations <- irace_run(scenario = scenario)
  if (simple) return(elite_configurations)

  if (!scenario$quiet) {
    order_str <- test.type.order.str(scenario$testType)
    cat("# Best configurations (first number is the configuration ID;",
        " listed from best to worst according to the ", order_str, "):\n", sep = "")
    configurations_print(elite_configurations)

    cat("# Best configurations as commandlines (first number is the configuration ID;", " listed from best to worst according to the ", order_str, "):\n", sep = "")
    configurations_print_command (elite_configurations, scenario$parameters)
  }
  testing_fromlog(logFile = scenario$logFile)
  invisible(elite_configurations)
}

irace_run <- function(scenario)
{
  # Recover state from file?
  if (is.null.or.empty(scenario$recoveryFile)) {
    race_state <- RaceState$new(scenario)
  } else {
    irace_note ("Recovering from file: '", scenario$recoveryFile,"'\n")
    race_state <- recoverFromFile(scenario$recoveryFile, scenario = scenario)
  }

  quiet <- scenario$quiet
  catInfo <- if (quiet) do_nothing else function(..., verbose = TRUE) {
    irace_note (..., "\n")
    if (verbose) {
      cat ("# Iteration: ", indexIteration, "\n",
           "# nbIterations: ", nbIterations, "\n",
           "# experimentsUsed: ", experimentsUsed, "\n",
           "# timeUsed: ", timeUsed, "\n",
           "# remainingBudget: ", remainingBudget, "\n",
           "# currentBudget: ", currentBudget, "\n",
           "# number of elites: ", nrow(elite_configurations), "\n",
           "# nbConfigurations: ", nbConfigurations, "\n",
           sep = "")
    }
  }
  # FIXME: use this from psrace?
  irace_finish <- function(iraceResults, scenario, reason) {
    elapsed <- race_state$time_elapsed()
    if (!scenario$quiet)
      cat("# Total CPU user time: ", elapsed["user"], ", CPU sys time: ", elapsed["system"],
          ", Wall-clock time: ", elapsed["wallclock"], "\n", sep="")
    # FIXME: Do we need to clone?
    race_state$completed <- reason
    iraceResults$state <- race_state
    save_irace_logfile(iraceResults, logfile = scenario$logFile)
    # FIXME: Handle scenario$maxTime > 0
    if (scenario$postselection && scenario$maxTime == 0 && floor(remainingBudget / max(scenario$blockSize, scenario$eachTest)) > 1L)
      psRace(iraceResults, max_experiments = remainingBudget, iteration_elites = TRUE)
    else
      elite_configurations
  }

  debugLevel <- scenario$debugLevel
  # Set options controlling debug level.
  # FIXME: This should be the other way around, the options set the debugLevel.
  options(.race.debug.level = debugLevel)
  options(.irace.debug.level = debugLevel)

  firstRace <- TRUE
  # Create a data frame of all configurations ever generated.
  allConfigurations <- allConfigurationsInit(scenario)
  irace_assert(is.integer(allConfigurations[[".ID."]]))
  nbUserConfigurations <- nrow(allConfigurations)

  # To save the logs
  iraceResults <- list(
    scenario = scenario,
    irace_version = irace_version,
    iterationElites = c(),
    allElites = list(),
    experiments = matrix(nrow = 0L, ncol = 0L))
  model <- NULL
  nbConfigurations <- 0L
  elite_configurations <- data.frame(stringsAsFactors=FALSE)

  nbIterations <-  if (scenario$nbIterations == 0)
                     computeNbIterations(scenario$parameters$nbVariable)
                   else scenario$nbIterations
  nbIterations <- floor(nbIterations)

  minSurvival <- if (scenario$minNbSurvival == 0)
                   computeTerminationOfRace(scenario$parameters$nbVariable)
                 else scenario$minNbSurvival
  minSurvival <- floor(minSurvival)
  # FIXME: Do this initialization within race_state.
  race_state$minSurvival <- minSurvival

  # Generate initial instance + seed list
  generateInstances(race_state, scenario,
    n = if (scenario$maxExperiments != 0) ceiling(scenario$maxExperiments / minSurvival)
        else max(scenario$firstTest, length(scenario$instances)))
  indexIteration <- 1L
  experimentsUsed <- 0L
  timeUsed <- 0
  boundEstimate <- NA

  race_state$start_parallel(scenario)
  on.exit(race_state$stop_parallel(), add = TRUE)

  if (scenario$maxTime == 0) {
    if (is.na(scenario$minExperiments)) {
      remainingBudget <- scenario$maxExperiments
    } else {
      remainingBudget <- max(scenario$minExperiments,
        computeMinimumBudget(scenario, minSurvival, nbIterations,
          race_state$elitist_new_instances))
    }
  } else { ## Estimate time when maxTime is defined.
    ## IMPORTANT: This is firstTest because these configurations will be
    ## considered elite later, thus preserved up to firstTest, which is
    ## fine. If a larger number of instances is used, it would prevent
    ## discarding these configurations.
    # Get the number of instances to be used.
    ninstances <- scenario$firstTest * scenario$blockSize
    estimationTime <- ceiling(scenario$maxTime * scenario$budgetEstimation)
    irace_note("Estimating execution time using ", 100 * scenario$budgetEstimation,
      "% of ", scenario$maxTime, " = ", estimationTime, "\n")

    # Estimate the number of configurations to be used
    nconfigurations <- max(2L, floor(scenario$parallel / ninstances))
    next_configuration <- 1L
    nruns <- nconfigurations * ninstances
    boundEstimate <- if (is.null(scenario$boundMax)) 1.0 else scenario$boundMax
    if (estimationTime < boundEstimate * nruns) {
      boundEstimate <- max(ceiling_digits(estimationTime / nruns, scenario$boundDigits), scenario$minMeasurableTime)
      if (!is.null(scenario$boundMax)) {
          irace_warning("boundMax=", scenario$boundMax, " is too large, using ", boundEstimate, " instead.\n")
          # FIXME: We should not modify the scenario
          scenario$boundMax <- boundEstimate
      }
    }

    repeat {
      # Sample new configurations if needed
        if (nrow(allConfigurations) < nconfigurations) {
          newConfigurations <- sampleSobol(scenario$parameters,
            nconfigurations - nrow(allConfigurations),
            repair = scenario$repairConfiguration)
          set(newConfigurations, j = ".ID.",
            value = max(0L, vlast(allConfigurations[[".ID."]])) + seq_nrow(newConfigurations))
          setcolorder(newConfigurations, ".ID.", before=1L)
          setDF(newConfigurations)
          # FIXME: use rbindlist(use.names=TRUE)
          allConfigurations <- rbind(allConfigurations, newConfigurations)
          rownames(allConfigurations) <- allConfigurations[[".ID."]]
          # We may have generated less than the number requested if there were duplicates.
          nconfigurations <- nrow(allConfigurations)
        }
      # Estimate the mean execution time.
      # FIXME: Shouldn't we pass the bounds?
      experiments <- do_experiments(race_state,
        configurations = allConfigurations[next_configuration:nconfigurations, ],
        ninstances = ninstances, scenario = scenario,
        # These experiments are assigned iteration 0.
        iteration = 0L)
      # FIXME: Here we should check if everything timed out and increase the bound dynamically.
      iraceResults$experiments <- merge_matrix(iraceResults$experiments, experiments)
      rownames(iraceResults$experiments) <- seq_nrow(iraceResults$experiments)
      # For the used time, we count the time reported in all configurations
      # including rejected ones.
      timeUsed <- sum(race_state$experiment_log[["time"]], na.rm = TRUE)
      experimentsUsed <- nrow(race_state$experiment_log)
      # User should return time zero for rejected_ids.
      boundEstimate <- timeUsed / experimentsUsed
      boundEstimate <- max(ceiling_digits(boundEstimate, scenario$boundDigits), scenario$minMeasurableTime)
      next_configuration <- nconfigurations + 1L

      # Calculate how many new configurations:
      # 1. We do not want to overrun estimationTime
      new_conf <- floor(((estimationTime - timeUsed) / boundEstimate) / ninstances)
      # 2. But there is no point in executing more configurations than those
      # that we can execute in parallel.
      new_conf <- min(new_conf, max(1L, floor(scenario$parallel / ninstances)))
      if (timeUsed >= estimationTime || new_conf == 0L || nconfigurations == 1024L)
        break
      else
        nconfigurations <- min(1024L, nconfigurations + new_conf)
    } # end of repeat

    if (length(race_state$rejected_ids))
      irace_note ("Immediately rejected configurations: ",
        paste0(race_state$rejected_ids, collapse = ", ") , "\n")

    # Update budget
    remainingBudget <- round((scenario$maxTime - timeUsed) / boundEstimate)
    elite_configurations <- allConfigurations[allConfigurations[[".ID."]] %not_in% race_state$rejected_ids, , drop = FALSE]
    irace_assert(is.integer(elite_configurations[[".ID."]]))
    # Without elitist, the racing does not re-use the results computed during
    # the estimation.  This means that the time used during estimation needs
    # to be spent again during racing, thus leaving less time for racing.  We
    # want to avoid having less time for racing, and this is an
    # implementation detail, thus we assume that the time was not actually
    # wasted.
    if (!scenario$elitist) timeUsed <- 0
    irace_note("Estimated execution time is ", boundEstimate, " based on ",
      next_configuration - 1L, " configurations and ",
      ninstances," instances. Used time: ", timeUsed,
      ", remaining time: ", (scenario$maxTime - timeUsed),
      ", remaining budget (experiments): ", remainingBudget, "\n")
    if (!is.null(scenario$boundMax) && 2 * boundEstimate < scenario$boundMax) {
      irace_warning("boundMax=", scenario$boundMax, " is much larger than estimated execution time, using ",
        2 * boundEstimate, " instead.\n")
      scenario$boundMax <- 2 * boundEstimate
    }
  } # end of time estimation

  # Compute the total initial budget, that is, the maximum number of
  # experiments that we can perform.
  currentBudget <- if (scenario$nbExperimentsPerIteration == 0L)
                     computeComputationalBudget(remainingBudget, indexIteration,
                       nbIterations)
                   else scenario$nbExperimentsPerIteration

  # Check that the budget is enough. For the time estimation case we reduce
  # the number of iterations.
  warn_msg <- NULL
  while (!checkMinimumBudget(scenario, remainingBudget, minSurvival, nbIterations,
    boundEstimate, timeUsed, race_state$elitist_new_instances))
  {
    if (is.null(warn_msg))
      warn_msg <-
        paste0("With the current settings and estimated time per run (",
          boundEstimate,
          ") irace will not have enough budget to execute the minimum",
          " number of iterations (", nbIterations, "). ",
          "Execution will continue by assuming that the estimated time",
          " is too high and reducing the minimum number of iterations,",
          " however, if the estimation was correct or too low,",
          " results might not be better than random sampling.\n")
    nbIterations <- nbIterations - 1L
    scenario$nbConfigurations <- if (scenario$nbConfigurations > 0L)
                                   min(minSurvival * 2L, scenario$nbConfigurations)
                                 else minSurvival * 2L
  }
  if (!is.null(warn_msg))
    irace_warning(warn_msg)

  catInfo("Initialization\n",
          if (scenario$elitist)
            paste0("# Elitist race\n",
                   "# Elitist new instances: ", race_state$elitist_new_instances, "\n",
                   "# Elitist limit: ",         scenario$elitistLimit, "\n")
          else paste0("# Non-elitist race\n"),
          "# nbIterations: ", nbIterations, "\n",
          "# minNbSurvival: ", minSurvival, "\n",
          "# nbParameters: ", scenario$parameters$nbVariable, "\n",
          "# seed: ", race_state$seed, "\n",
          "# confidence level: ", scenario$confidence, "\n",
          "# budget: ", remainingBudget, "\n",
          if (scenario$maxTime == 0) ""
          else paste0("# time budget: ", scenario$maxTime - timeUsed, "\n"),
          "# mu: ", scenario$mu, "\n",
          "# deterministic: ", scenario$deterministic, "\n",

          if (scenario$capping)
            paste0("# capping: ", scenario$cappingType, "\n",
                   "# type bound: ", scenario$boundType, "\n",
                   "# boundMax: ", scenario$boundMax, "\n",
                   "# par bound: ", scenario$boundPar, "\n",
                   "# bound digits: ", scenario$boundDigits, "\n")
          else if (!is.null(scenario$boundMax))
            paste0("# boundMax: ", scenario$boundMax, "\n"),
          verbose = FALSE)

  blockSize <- scenario$blockSize

  repeat {
    # FIXME: We could directly use race_state$timeUsed everywhere.
    race_state$timeUsed <- timeUsed
    ## Save to the log file.
    iraceResults$allConfigurations <- allConfigurations
    race_state$save_recovery(iraceResults, logfile = scenario$logFile)


    # With elitist=TRUE and without targetEvaluator we should never re-run the
    # same configuration on the same (instance,seed) pair.
    if (scenario$elitist) {
      irace_assert(sum(!is.na(iraceResults$experiments)) == experimentsUsed)
      if (is.null(scenario$targetEvaluator))
        irace_assert(experimentsUsed == nrow(race_state$experiment_log))
    }

    if (remainingBudget <= 0) {
      catInfo("Stopped because budget is exhausted")
      return(irace_finish(iraceResults, scenario, reason = "Budget exhausted"))
    }
    if (scenario$maxTime > 0 && timeUsed >= scenario$maxTime) {
      catInfo("Stopped because time budget is exhausted")
      return(irace_finish(iraceResults, scenario, reason = "Time budget exhausted"))
    }

    if (indexIteration > nbIterations) {
      if (scenario$nbIterations == 0L) {
        nbIterations <- indexIteration
      } else {
        if (debugLevel >= 1L)
          catInfo("Limit of iterations reached", verbose = FALSE)
        return(irace_finish(iraceResults, scenario, reason = "Limit of iterations reached"))
      }
    }
    # Compute the current budget (nb of experiments for this iteration),
    # or take the value given as parameter.
    currentBudget <- if (scenario$nbExperimentsPerIteration == 0L)
                       computeComputationalBudget(remainingBudget, indexIteration, nbIterations)
                     else scenario$nbExperimentsPerIteration

    # Compute the number of configurations for this race.
    if (scenario$elitist && !firstRace) {
      nbConfigurations <-
        computeNbConfigurations(currentBudget, indexIteration,
                                mu = scenario$mu,
                                eachTest = scenario$eachTest,
                                blockSize = blockSize,
                                nElites = nrow(elite_configurations),
                                nOldInstances = nrow(iraceResults$experiments),
                                newInstances = race_state$elitist_new_instances)
      # If we don't have enough budget, do not evaluate new instances.
      if (nbConfigurations <= minSurvival) {
        race_state$elitist_new_instances <- 0L
        nbConfigurations <- computeNbConfigurations(currentBudget, indexIteration,
          mu = scenario$mu,
          eachTest = scenario$eachTest,
          blockSize = blockSize,
          nElites = nrow(elite_configurations),
          nOldInstances = nrow(iraceResults$experiments),
          newInstances = race_state$elitist_new_instances)
      }
      # If still not enough budget, then try to do at least one test.
      if (nbConfigurations <= minSurvival) {
        nbConfigurations <- computeNbConfigurations(currentBudget, indexIteration = 1L,
          mu = 1L, eachTest = scenario$eachTest, blockSize = blockSize,
          nElites = nrow(elite_configurations),
          nOldInstances = nrow(iraceResults$experiments),
          newInstances = 0L)
      }
    } else {
      nbConfigurations <-
        computeNbConfigurations(currentBudget, indexIteration,
                                mu = scenario$mu,
                                eachTest = scenario$eachTest,
                                blockSize = blockSize,
                                nElites = 0L, nOldInstances = 0L,
                                newInstances = 0L)
    }

    # If a value was given as a parameter, then this value limits the maximum,
    # but if we have budget only for less than this, then we have run out of
    # budget.
    if (scenario$nbConfigurations > 0L) {
      if (scenario$nbConfigurations <= nbConfigurations) {
        nbConfigurations <- scenario$nbConfigurations
      } else if (currentBudget < remainingBudget) {
        # We skip one iteration
        catInfo("Not enough budget for this iteration, skipping to the next one.")
        indexIteration <- indexIteration + 1L
        next
      } else {
        catInfo("Stopped because ",
          "there is not enough budget to enforce the value of nbConfigurations.")
        return(irace_finish(iraceResults, scenario, reason = "Not enough budget to enforce the value of nbConfigurations"))
      }
    }

    # Stop if the number of configurations to test is NOT larger than the minimum.
    if (nbConfigurations <= minSurvival) {
      catInfo("Stopped because there is not enough budget left to race more than ",
              "the minimum (", minSurvival,").\n",
              "# You may either increase the budget or set 'minNbSurvival' to a lower value.")
      return(irace_finish(iraceResults, scenario, reason = "Not enough budget to race more than the minimum configurations"))
    }


    # If we have too many elite_configurations, reduce their number. This can
    # happen before the first race due to the initial budget estimation.
    if (firstRace) {
      if (nbConfigurations < nrow(elite_configurations)) {
        eliteRanks <- overall_ranks(iraceResults$experiments, test = scenario$testType)
        elite_configurations <- elite_configurations[order(eliteRanks), ]
        elite_configurations <- elite_configurations[seq_len(nbConfigurations), ]
      }
    } else if (nbConfigurations <= nrow(elite_configurations)) {
      # Stop if  the number of configurations to produce is not greater than
      # the number of elites.
      catInfo("Stopped because ",
              "there is not enough budget left to race newly sampled configurations.")
      #(number of elites  + 1) * (mu + min(5, indexIteration)) > remainingBudget"
      return(irace_finish(iraceResults, scenario, reason = "Not enough budget left to race newly sampled configurations"))
    }

    if (scenario$elitist) {
      # The non-elite have to run up to the first test. The elites consume
      # budget at most up to the new instances.
      if ((nbConfigurations - nrow(elite_configurations)) * scenario$mu
          + nrow(elite_configurations) * min(race_state$elitist_new_instances, scenario$mu)
          > currentBudget) {
        catInfo("Stopped because there is not enough budget left to race all configurations up to the first test (or mu).")
        return(irace_finish(iraceResults, scenario, reason = "Not enough budget to race all configurations up to the first test (or mu)"))
      }
    } else if (nbConfigurations * scenario$mu > currentBudget) {
      catInfo("Stopped because there is not enough budget left to race all configurations up to the first test (or mu).")
      return(irace_finish(iraceResults, scenario, reason = "Not enough budget to race all configurations up to the first test (or mu)"))
    }

    catInfo("Iteration ", indexIteration, " of ", nbIterations, "\n",
            "# experimentsUsed: ", experimentsUsed, "\n",
            if (scenario$maxTime == 0) ""
            else paste0("# timeUsed: ", timeUsed, "\n",
                        "# boundEstimate: ", boundEstimate, "\n"),
            "# remainingBudget: ", remainingBudget, "\n",
            "# currentBudget: ", currentBudget, "\n",
            "# nbConfigurations: ", nbConfigurations,
            verbose = FALSE)

    iraceResults$softRestart[indexIteration] <- FALSE
    # Sample for the first time.
    if (firstRace) {
      # If we need more configurations, sample uniformly.
      nbNewConfigurations <- nbConfigurations - sum(allConfigurations[[".ID."]] %not_in% race_state$rejected_ids)
      if (nbNewConfigurations > 0L) {
        # Sample new configurations.
        if (debugLevel >= 1L) {
          catInfo("Sample ", nbNewConfigurations,
                  " configurations from Sobol distribution", verbose = FALSE)
        }
        newConfigurations <- sampleSobol(scenario$parameters, nbNewConfigurations,
          repair = scenario$repairConfiguration)
        # We could get fewer than we asked for due to removing duplicates and forbidden.
        nbNewConfigurations <- nrow(newConfigurations)
        set(newConfigurations, j= ".ID.",
          value = max(0L, vlast(allConfigurations[[".ID."]])) + seq_nrow(newConfigurations))
        setcolorder(newConfigurations, ".ID.", before=1L)
        setDF(newConfigurations)
        allConfigurations <- rbind(allConfigurations, newConfigurations)
        rownames(allConfigurations) <- allConfigurations[[".ID."]]
        raceConfigurations <- allConfigurations[allConfigurations[[".ID."]] %not_in% race_state$rejected_ids, , drop = FALSE]
      } else if (nbNewConfigurations <= 0L) {
        # We let the user know that not all configurations will be used.
        if (nbUserConfigurations > nbConfigurations) {
          catInfo("Only ", nbConfigurations, " from the initial configurations will be used",
            verbose = FALSE)
        }

        # This is made only in case that the number of configurations used in
        # the time estimation is more than needed.
        if (nrow(elite_configurations) == nbConfigurations) {
          raceConfigurations <- elite_configurations
        } else {
          raceConfigurations <- allConfigurations[allConfigurations[[".ID."]] %not_in% race_state$rejected_ids, , drop = FALSE]
          raceConfigurations <- raceConfigurations[seq_len(nbConfigurations), , drop = FALSE]
        }
      } # end of indexIteration == 1

    } else {
      # How many new configurations should be sampled?
      nbNewConfigurations <- nbConfigurations - nrow(elite_configurations)

      # Update the model based on elites configurations
      if (debugLevel >= 1L) irace_note("Update model\n")
      model <- updateModel(scenario$parameters, elite_configurations, model, indexIteration,
                           nbIterations, nbNewConfigurations, elitist = scenario$elitist)
      if (debugLevel >= 2L) printModel (model)
      if (debugLevel >= 1L)
        irace_note("Sample ", nbNewConfigurations, " configurations from model\n")
      irace_assert(is.integer(elite_configurations[[".ID."]]))
      newConfigurations <- sampleModel(scenario$parameters, elite_configurations,
                                       model, nbNewConfigurations,
                                       repair = scenario$repairConfiguration)
      # Set ID of the new configurations.
      set(newConfigurations, j = ".ID.",
        value = vlast(allConfigurations[[".ID."]]) + seq_nrow(newConfigurations))
      setcolorder(newConfigurations, ".ID.", before=1L)
      setDF(newConfigurations)
      raceConfigurations <- rbind(elite_configurations[, colnames(newConfigurations)],
        newConfigurations)
      rownames(raceConfigurations) <- raceConfigurations[[".ID."]]

      if (scenario[["softRestart"]]) {
        #          Rprof("profile.out")
        restart_ids <- similarConfigurations (raceConfigurations, scenario$parameters,
                                              threshold = scenario$softRestartThreshold)
        #          Rprof(NULL)
        if (!is.null(restart_ids)) {
          if (debugLevel >= 1L)
            irace_note("Soft restart: ", paste(collapse = " ", restart_ids), " !\n")
          model <- restartModel(model, raceConfigurations, restart_ids,
                                scenario$parameters, nbNewConfigurations)
          iraceResults$softRestart[indexIteration] <- TRUE
          if (debugLevel >= 2L) { printModel (model) }
          # Re-sample after restart like above
          #cat("# ", format(Sys.time(), usetz=TRUE), " sampleModel()\n")
          newConfigurations <- sampleModel(scenario$parameters, elite_configurations,
                                           model, nbNewConfigurations,
                                           repair = scenario$repairConfiguration)
          #cat("# ", format(Sys.time(), usetz=TRUE), " sampleModel() DONE\n")
          # Set ID of the new configurations.
          # Set ID of the new configurations.
          set(newConfigurations, j = ".ID.",
            value = vlast(allConfigurations[[".ID."]]) + seq_nrow(newConfigurations))
          setcolorder(newConfigurations, ".ID.", before=1L)
          setDF(newConfigurations)
          raceConfigurations <- rbind(elite_configurations[, colnames(newConfigurations)],
                                      newConfigurations)
          rownames(raceConfigurations) <- raceConfigurations[[".ID."]]
        }
      }
      # Append these configurations to the global table.
      allConfigurations <- rbind(allConfigurations, newConfigurations)
      rownames(allConfigurations) <- allConfigurations[[".ID."]]
    }

    if (debugLevel >= 2L) {
      irace_note("Configurations for the race n ", indexIteration,
                 " (elite configurations listed first, then new configurations):\n")
      configurations_print(raceConfigurations, metadata = TRUE)
    }

    # Get data from previous races.
    elite_data <- if (scenario$elitist && nrow(elite_configurations))
                    iraceResults$experiments[, as.character(elite_configurations[[".ID."]]), drop=FALSE]
                  else NULL

    race_state$next_instance <- nrow(iraceResults$experiments) + 1L
    # Add instances if needed.
    # Calculate budget needed for old instances assuming non elitist irace.
    if ((nrow(race_state$instances_log) - (race_state$next_instance - 1L))
        < ceiling(remainingBudget / minSurvival)) {
      generateInstances(race_state, scenario, n = ceiling(remainingBudget / minSurvival),
        update = TRUE)
    }

    if (debugLevel >= 1L) irace_note("Launch race\n")
    raceResults <- elitist_race (race_state, scenario = scenario,
                                 configurations = raceConfigurations,
                                 maxExp = currentBudget,
                                 minSurvival = minSurvival,
                                 elite_data = elite_data,
                                 elitist_new_instances = if (firstRace) 0L
                                                         else race_state$elitist_new_instances)
    # We add indexIteration as an additional column.
    set(raceResults$experiment_log, j = "iteration", value = indexIteration)
    # FIXME: There is a chance that the process stops after we remove
    # race_experiment_log in elitist_race(), but before we update
    # race_state$experiment_log here. Doing the two steps in a different order
    # would be more robust but would need a smarter recovery routine that
    # checks for duplicates.
    race_state$experiment_log <- rbindlist(list(race_state$experiment_log, raceResults$experiment_log),
      use.names=TRUE)
    # Merge new results.
    iraceResults$experiments <- merge_matrix(iraceResults$experiments, raceResults$experiments)

    # Update remaining budget.
    experimentsUsed <- experimentsUsed + raceResults$experimentsUsed
    if (scenario$maxTime > 0L) {
      timeUsed <- timeUsed + sum(raceResults$experiment_log[["time"]], na.rm = TRUE)
      boundEstimate <- timeUsed / experimentsUsed
      remainingBudget <- round((scenario$maxTime - timeUsed) / boundEstimate)
    } else {
      remainingBudget <- remainingBudget - raceResults$experimentsUsed
    }

    if (debugLevel >= 3L) {
      irace_note("Results for the race of iteration ", indexIteration,
                 " (from best to worst, according to the ",
                 test.type.order.str(scenario$testType), "):\n")
      configurations_print(raceResults$configurations, metadata = TRUE)
    }

    if (debugLevel >= 1L) irace_note("Extracting elites\n")
    elite_configurations <- extractElites(raceResults$configurations,
      nbElites = minSurvival, debugLevel = scenario$debugLevel)
    irace_note("Elite configurations (first number is the configuration ID;",
               " listed from best to worst according to the ",
               test.type.order.str(scenario$testType), "):\n")
    if (!quiet) configurations_print(elite_configurations, metadata = debugLevel >= 1L)
    iraceResults$iterationElites[indexIteration] <- elite_configurations[[".ID."]][1L]
    iraceResults$allElites[[indexIteration]] <- elite_configurations[[".ID."]]

    if (firstRace) {
      if (debugLevel >= 1L) irace_note("Initialise model\n")
      model <- initialiseModel(scenario$parameters, elite_configurations)
      if (debugLevel >= 2L) printModel (model)
      firstRace <- FALSE
    }

    if (debugLevel >= 1L)  {
      irace_note("End of iteration ", indexIteration, "\n")
      if (debugLevel >= 3L) {
        irace_note("All configurations (sampling order):\n")
        configurations_print(allConfigurations, metadata = TRUE)
        irace_note("Memory used in irace():\n")
        race_state$print_mem_used()
      }
    }
    indexIteration <- indexIteration + 1L
  } # end of repeat
}

Try the irace package in your browser

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

irace documentation built on April 3, 2025, 10:03 p.m.