Nothing
# FIXME: This is needed because race.R is not divided in two-stages
# run/evaluate like irace is, so there is no way to communicate data
# from the first stage to the second.
#
# FIXME: In fact, we should use this trick also in irace.R to avoid
# pass-by-copy-on-write of huge matrices and data.frames and instead
# pass-by-reference an environment containing those.
.irace <- new.env(parent = emptyenv())
#' Generate a command-line representation of a configuration
#'
#' @description `buildCommandLine` receives two vectors, one containing
#' the values of the parameters, the other containing the switches of the
#' parameters. It builds a string with the switches and the values that can
#' be used as a command line to call the program to be tuned, thus generating
#' one candidate configuration.
#'
#'
#' @param values A vector containing the value of each parameter for the
#' candidate configuration.
#' @param switches A vector containing the switches of each paramter (in an
#' order that corresponds to the values vector).
#'
#' @return A string concatenating each element of `switches` and
#' `values` for all parameters with a space between each pair of
#' parameters (but none between the switches and the corresponding values).
#'
#' @examples
#' switches <- c("--switch1 ", "--switch2 ")
#' values <- c("value_1", "value_2")
#' buildCommandLine (values, switches)
#' ## Build a command-line from the results produced by a previous run of irace.
#' # First, load the data produced by irace.
#' irace.logfile <- file.path(system.file(package="irace"),
#' "exdata", "irace-acotsp.Rdata")
#' load(irace.logfile)
#' allConfigurations <- iraceResults$allConfigurations
#' parameters <- iraceResults$parameters
#' apply(allConfigurations[1:10, unlist(parameters$names)], 1, buildCommandLine,
#' unlist(parameters$switches))
#'
#' @author Manuel López-Ibáñez and Jérémie Dubois-Lacoste
#' @export
buildCommandLine <- function(values, switches)
{
irace.assert(length(values) == length(switches))
command <- ""
# FIXME: This probably can be implemented faster with apply() and
# paste(collapse=" "). But how to get the index i in that case?
for (i in seq_along(values)) {
value <- values[i]
if (!is.na(value)) {
command <- paste0(command, " ", switches[i],
format(value, digits=15, scientific=FALSE))
}
}
return(command)
}
# This function tries to convert a, possibly empty, character vector into a
# numeric vector.
parse.output <- function(outputRaw, verbose)
{
if (verbose) { cat (outputRaw, sep = "\n") }
# Initialize output as raw. If it is empty stays like this.
output <- outputRaw
# strsplit crashes if outputRaw == character(0)
if (length(outputRaw) > 0) {
outputRaw <- paste0(outputRaw, collapse = "\n")
output <- strsplit(trim(outputRaw), "[[:space:]]+")[[1]]
}
# suppressWarnings to avoid messages about NAs introduced by coercion
return(suppressWarnings (as.numeric (output)))
}
target.error <- function(err.msg, output, scenario, target.runner.call,
target.evaluator.call = NULL)
{
if (!is.null(target.evaluator.call)) {
err.msg <- paste0(err.msg, "\n", .msg.prefix,
"The call to targetEvaluator was:\n", target.evaluator.call)
}
if (!is.null(target.runner.call)) {
err.msg <- paste0(err.msg, "\n", .msg.prefix,
"The call to targetRunner was:\n", target.runner.call)
}
if (is.null(output$outputRaw)) {
# Message for a function call.
# FIXME: Ideally, we should print the list as R would print it.
output$outputRaw <- toString(output)
advice.txt <- paste0(
"This is not a bug in irace, but means that something failed in ",
"a call to the targetRunner or targetEvaluator functions provided by the user.",
" Please check those functions carefully.")
} else {
# Message for an external script.
advice.txt <- paste0(
"This is not a bug in irace, but means that something failed when",
" running the command(s) above or they were terminated before completion.",
" Try to run the command(s) above from the execution directory '",
scenario$execDir, "' to investigate the issue. See also Appendix B (targetRunner troubleshooting checklist) of the User Guide (https://cran.r-project.org/package=irace/vignettes/irace-package.pdf).")
}
irace.error(err.msg, "\n", .msg.prefix,
"The output was:\n", paste(output$outputRaw, collapse = "\n"),
"\n", .msg.prefix, advice.txt)
}
check.output.target.evaluator <- function (output, scenario, target.runner.call = NULL)
{
if (!is.list(output)) {
target.error ("The output of targetEvaluator must be a list",
list(), scenario, target.runner.call = target.runner.call)
return(NULL)
}
err.msg <- output$error
if (is.null(err.msg)) {
if (is.null(output$cost)) {
err.msg <- "The output of targetEvaluator must contain 'cost'!"
} else if (is.na.nowarn (output$cost)) {
err.msg <- "The output of targetEvaluator is not numeric!"
}
if (scenario$batchmode != 0 && scenario$maxTime > 0) {
if (is.null (output$time)) {
err.msg <- "When batchmode != 0 and maxTime > 0, the output of targetEvaluator must be two numbers 'cost time'!"
} else if (is.na.nowarn(output$time)) {
err.msg <- "The time returned by targetEvaluator is not numeric!"
} else if (is.infinite(output$time)) {
err.msg <- "The time returned by targetEvaluator is not finite!"
}
}
}
if (!is.null(err.msg)) {
target.error (err.msg, output, scenario,
target.runner.call = target.runner.call,
target.evaluator.call = output$call)
}
}
exec.target.evaluator <- function (experiment, num.configurations, all.conf.id,
scenario, target.runner.call)
{
output <- .irace$target.evaluator(experiment, num.configurations, all.conf.id,
scenario, target.runner.call)
check.output.target.evaluator (output, scenario, target.runner.call = target.runner.call)
# Fix too small time.
output$time <- if (is.null(output$time)) NA else max(output$time, scenario$minMeasurableTime)
return (output)
}
#' target.evaluator.default
#'
#' `target.evaluator.default` is the default `targetEvaluator` function that is
#' invoked if `targetEvaluator` is a string (by default
#' `targetEvaluator` is `NULL` and this function is not invoked). You can use it as
#' an advanced example of how to create your own `targetEvaluator` function.
#'
#' @param experiment A list describing the experiment. It contains at least:
#' \describe{
#' \item{`id.configuration`}{An alphanumeric string that uniquely identifies a configuration;}
#' \item{`id.instance`}{An alphanumeric string that uniquely identifies an instance;}
#' \item{`seed`}{Seed for the random number generator to be used for
#' this evaluation, ignore the seed for deterministic algorithms;}
#' \item{`instance`}{String giving the instance to be used for this evaluation;}
#' \item{`bound`}{(only when `capping` is enabled) Time bound for the execution;}
#' \item{`configuration`}{1-row data frame with a column per parameter
#' name;}
#' \item{`switches`}{Vector of parameter switches (labels) in the order
#' of parameters used in `configuration`.}
#' }
#' @param num.configurations Number of configurations alive in the race.
#' @param all.conf.id Vector of configuration IDs of the alive configurations.
#' @template arg_scenario
#' @param target.runner.call String describing the call to `targetRunner` that
#' corresponds to this call to `targetEvaluator`. This is used for
#' providing extra information to the user, for example, in case
#' `targetEvaluator` fails.
#'
#' @return The function `targetEvaluator` must return a list with one element
#' `"cost"`, the numerical value corresponding to the cost measure of the
#' given configuration on the given instance.
#'
#' The return list may also contain the following optional elements that are used
#' by \pkg{irace} for reporting errors in `targetEvaluator`:
#' \describe{
#' \item{`error`}{is a string used to report an error;}
#' \item{`outputRaw`}{is a string used to report the raw output of calls to
#' an external program or function;}
#' \item{`call`}{is a string used to report how `targetRunner` called
#' an external program or function.}
#' }
#'
#'
#' @author Manuel López-Ibáñez and Jérémie Dubois-Lacoste
#' @export
target.evaluator.default <- function(experiment, num.configurations, all.conf.id,
scenario, target.runner.call)
{
configuration.id <- experiment$id.configuration
instance.id <- experiment$id.instance
seed <- experiment$seed
instance <- experiment$instance
debugLevel <- scenario$debugLevel
targetEvaluator <- scenario$targetEvaluator
if (as.logical(file.access(targetEvaluator, mode = 1))) {
irace.error ("targetEvaluator", shQuote(targetEvaluator),
"cannot be found or is not executable!\n")
}
cwd <- setwd (scenario$execDir)
args <- c(configuration.id, instance.id, seed, instance, num.configurations, all.conf.id)
output <- runcommand(targetEvaluator, args, configuration.id, debugLevel)
setwd (cwd)
cost <- time <- NULL
err.msg <- output$error
if (is.null(err.msg)) {
v.output <- parse.output(output$output, verbose = (scenario$debugLevel >= 2))
if (length(v.output) > 2) {
err.msg <- paste0("The output of targetEvaluator should not be more than two numbers!")
} else if (length(v.output) == 0) {
err.msg <- paste0("The output of targetEvaluator must be at least one number 'cost'!")
} else if (length(v.output) == 1) {
cost <- v.output[1]
} else if (length(v.output) == 2) {
cost <- v.output[1]
time <- v.output[2]
}
}
return(list(cost = cost, time = time,
error = err.msg, outputRaw = output$output,
call = paste(targetEvaluator, args, collapse=" ")))
}
check.output.target.runner <- function (output, scenario)
{
if (!is.list(output)) {
output <- list()
err.msg <- "The output of targetRunner must be a list"
target.error (err.msg, output, scenario, target.runner.call = NULL)
return(output)
}
err.msg <- output$error
if (is.null(err.msg)) {
if (!is.null (output$cost)) {
if (is.na.or.empty(output$cost)) {
err.msg <- "The cost returned by targetRunner is not numeric!"
}
}
if (!is.null (output$time)) {
if (is.na.or.empty(output$time)) {
err.msg <- paste0("The time returned by targetRunner is not numeric!")
} else if (is.infinite(output$time)) {
err.msg <- paste0("The time returned by targetRunner is not finite!")
}
}
}
if (is.null(err.msg)) {
# When targetEvaluator is provided, targetRunner must return only the time.
if (!is.null(scenario$targetEvaluator)) {
# unless using batchmode, in that case targetRunner returns neither the
# time nor the cost.
if (scenario$batchmode != 0) {
if (!is.null(output$time) || !is.null(output$cost)) {
err.msg <- "When batchmode != 0, the output of targetRunner must not contain a cost nor a time!"
}
} else if (scenario$maxTime > 0 && is.null(output$time)) {
err.msg <- "The output of targetRunner must be one number 'time'!"
} else if (!is.null(output$cost)) {
err.msg <- "The output of targetRunner must be empty or just one number 'time'!"
}
} else if (scenario$maxTime > 0 && (is.null (output$cost) || is.null(output$time))) {
err.msg <- "The output of targetRunner must be two numbers 'cost time'!"
} else if (scenario$maxExperiments > 0 && is.null (output$cost)) {
err.msg <- "The output of targetRunner must be one number 'cost'!"
} else if (!is.null(output$time) && output$time < 0) {
err.msg <- paste0("The value of time returned by targetRunner cannot be negative (", output$time, ")!")
}
}
if (!is.null(err.msg)) {
target.error (err.msg, output, scenario, target.runner.call = output$call)
}
# Fix too small time.
output$time <- if (is.null(output$time)) NA else max(output$time, scenario$minMeasurableTime)
return (output)
}
# This function invokes target.runner. When used on a remote node by Rmpi,
# environments do not seem to be shared and the default value is evaluated too
# late, thus we have to pass .irace$target.runner explicitly.
exec.target.runner <- function(experiment, scenario, target.runner)
{
doit <- function(experiment, scenario)
{
x <- target.runner(experiment, scenario)
return (check.output.target.runner(x, scenario))
}
retries <- scenario$targetRunnerRetries
while (retries > 0) {
output <- try (doit(experiment, scenario))
if (!inherits(output, "try-error") && is.null(output$error)) {
return (output)
}
irace.note("Retrying (", retries, " left).\n")
retries <- retries - 1
}
output <- doit(experiment, scenario)
return (output)
}
parse.aclib.output <- function(outputRaw)
{
outputRaw <- paste0(outputRaw, collapse = "\n")
text <- regmatches(outputRaw,
regexec("Result of this algorithm run:\\s*\\{(.+)\\}\\s*\n",
outputRaw))[[1]][2]
aclib.match <- function(text, key, value) {
pattern <- paste0('"', key, '":\\s*', value)
return(regmatches(text, regexec(pattern, text))[[1]][2])
}
cost <- runtime <- error <- NULL
# AClib wrappers print:
# Result of this algorithm run: {"status": "SUCCESS", "cost": cost, "runtime": time }
# FIXME: This is not very robust. If we are going to be using jsonlite, then we can simply do:
# jsonlite::fromJSON('{\"misc\": \"\", \"runtime\": 164.14, \"status\": \"SUCCESS\", \"cost\": \"0.121340\"}')
status <- aclib.match(text, "status", '"([^"]+)"')
if (!is.character(status)) {
error <- paste0("Not valid AClib output")
} else if (status %in% c("SUCCESS", "TIMEOUT")) {
cost <- aclib.match(text, "cost", "([^[:space:],}]+)")
cost <- suppressWarnings(as.numeric(cost))
runtime <- aclib.match(text, "runtime", "([^[:space:],}]+)")
runtime <- suppressWarnings(as.numeric(runtime))
if (is.null.or.na(cost) && is.null.or.na(runtime))
error <- paste0("Not valid cost or runtime in AClib output")
} else if (status %in% c("CRASHED", "ABORT")) {
# FIXME: Implement ABORT semantics of fatal error
error <- paste0("targetRunner returned status (", status, ")")
} else {
error <- paste0("Not valid AClib output status (", status, ")")
}
return(list(status = status, cost = cost, time = runtime, error = error))
}
target.runner.aclib <- function(experiment, scenario)
{
debugLevel <- scenario$debugLevel
res <- run_target_runner(experiment, scenario)
cmd <- res$cmd
output <- res$output
args <- res$args
err.msg <- output$error
if (is.null(err.msg)) {
return(c(parse.aclib.output(output$output),
list(outputRaw = output$output, call = paste(cmd, args))))
}
list(cost = NULL, time = NULL, error = err.msg,
outputRaw = output$output, call = paste(cmd, args))
}
check_launcher_args <- function(targetRunnerLauncherArgs)
{
if (!grepl("{targetRunner}", targetRunnerLauncherArgs, fixed=TRUE))
irace.error("targetRunnerLauncherArgs '", targetRunnerLauncherArgs, "' must contain '{targetRunner}'")
if (!grepl("{targetRunnerArgs}", targetRunnerLauncherArgs, fixed=TRUE))
irace.error("targetRunnerLauncherArgs '", targetRunnerLauncherArgs, "' must contain '{targetRunnerArgs}'")
}
process_launcher_args <- function(targetRunnerLauncherArgs, targetRunner, args)
{
check_launcher_args(targetRunnerLauncherArgs)
targetRunnerLauncherArgs <- gsub("{targetRunner}", targetRunner, targetRunnerLauncherArgs, fixed=TRUE)
targetRunnerLauncherArgs <- gsub("{targetRunnerArgs}", args, targetRunnerLauncherArgs, fixed=TRUE)
targetRunnerLauncherArgs
}
run_target_runner <- function(experiment, scenario)
{
configuration.id <- experiment$id.configuration
instance.id <- experiment$id.instance
seed <- experiment$seed
configuration <- experiment$configuration
instance <- experiment$instance
switches <- experiment$switches
bound <- experiment$bound
targetRunner <- scenario$targetRunner
debugLevel <- scenario$debugLevel
if (scenario$aclib) {
has_value <- !is.na(configuration)
# <executable> [<arg>] [<arg>] ... [--cutoff <cutoff time>] [--instance <instance name>]
# [--seed <seed>] --config [-param_name_1 value_1] [-param_name_2 value_2] ...
args <- paste("--instance", instance, "--seed", seed, "--config",
paste0("-", switches[has_value], " ", configuration[has_value],
collapse = " "))
if (!is.null.or.na(bound))
args <- paste("--cutoff", bound, args)
} else {
args <- paste(configuration.id, instance.id, seed, instance, bound,
buildCommandLine(configuration, switches))
}
targetRunnerLauncher <- scenario$targetRunnerLauncher
if (is.null.or.empty(scenario$targetRunnerLauncher)) {
if (as.logical(file.access(targetRunner, mode = 1))) {
irace.error ("targetRunner ", shQuote(targetRunner), " cannot be found or is not executable!\n")
}
output <- runcommand(targetRunner, args, configuration.id, debugLevel)
return(list(cmd=targetRunner, output=output, args=args))
}
if (as.logical(file.access(targetRunnerLauncher, mode = 1))) {
irace.error ("targetRunnerLauncher ", shQuote(targetRunnerLauncher), " cannot be found or is not executable!\n")
}
args <- process_launcher_args(scenario$targetRunnerLauncherArgs, targetRunner, args)
output <- runcommand(targetRunnerLauncher, args, configuration.id, debugLevel)
return(list(cmd=targetRunnerLauncher, output=output, args=args))
}
#' Default `targetRunner` function.
#'
#' Use it as an advanced example of how to create your own `targetRunner` function.
#'
#' @param experiment A list describing the experiment. It contains at least:
#' \describe{
#' \item{`id.configuration`}{An alphanumeric string that uniquely identifies a configuration;}
#' \item{`id.instance`}{An alphanumeric string that uniquely identifies an instance;}
#' \item{`seed`}{Seed for the random number generator to be used for
#' this evaluation, ignore the seed for deterministic algorithms;}
#' \item{`instance`}{String giving the instance to be used for this evaluation;}
#' \item{`bound`}{(only when `capping` is enabled) Time bound for the execution;}
#' \item{`configuration`}{1-row data frame with a column per parameter
#' name;}
#' \item{`switches`}{Vector of parameter switches (labels) in the order
#' of parameters used in `configuration`.}
#' }
#' @template arg_scenario
#'
#' @return If `targetEvaluator` is `NULL`, then the `targetRunner`
#' function must return a list with at least one element `"cost"`,
#' the numerical value corresponding to the evaluation of the given
#' configuration on the given instance.
#'
#' If the scenario option `maxTime` is non-zero or if `capping` is enabled
#' then the list must contain at least another element `"time"` that reports the
#' execution time for this call to `targetRunner`.
#' The return list may also contain the following optional elements that are used
#' by \pkg{irace} for reporting errors in `targetRunner`:
#' \describe{
#' \item{`error`}{is a string used to report an error;}
#' \item{`outputRaw`}{is a string used to report the raw output of calls to
#' an external program or function;}
#' \item{`call`}{is a string used to report how `targetRunner` called
#' an external program or function.}
#' }
#'
#'
#' @author Manuel López-Ibáñez and Jérémie Dubois-Lacoste
#' @export
target.runner.default <- function(experiment, scenario)
{
res <- run_target_runner(experiment, scenario)
cmd <- res$cmd
output <- res$output
args <- res$args
debugLevel <- scenario$debugLevel
cost <- time <- NULL
err.msg <- output$error
if (is.null(err.msg)) {
v.output <- parse.output(output$output, verbose = (debugLevel >= 2))
if (length(v.output) > 2) {
err.msg <- "The output of targetRunner should not be more than two numbers!"
} else if (length(v.output) == 1) {
if (!is.null(scenario$targetEvaluator)) {
time <- v.output[1]
} else {
cost <- v.output[1]
}
} else if (length(v.output) == 2) {
cost <- v.output[1]
time <- v.output[2]
}
}
list(cost = cost, time = time,
error = err.msg, outputRaw = output$output,
call = paste(cmd, args, collapse = " "))
}
execute.experiments <- function(experiments, scenario)
{
parallel <- scenario$parallel
mpi <- scenario$mpi
target.runner <- .irace$target.runner
execDir <- scenario$execDir
if (!isTRUE (file.info(execDir)$isdir)) {
irace.error ("Execution directory '", execDir, "' is not found or not a directory\n")
}
cwd <- setwd (execDir)
on.exit(setwd(cwd), add = TRUE)
target.output <- vector("list", length(experiments))
if (!is.null(scenario$targetRunnerParallel)) {
# User-defined parallelization
target.output <-
scenario$targetRunnerParallel(experiments, exec.target.runner,
scenario = scenario,
target.runner = target.runner)
} else if (scenario$batchmode != 0) {
target.output <- cluster.lapply (experiments, scenario = scenario)
} else if (parallel > 1) {
if (mpi) {
if (scenario$loadBalancing) {
target.output <- Rmpi::mpi.applyLB(experiments, exec.target.runner,
scenario = scenario,
target.runner = target.runner)
} else {
# Without load-balancing, we need to split the experiments into chunks
# of size parallel.
target.output <- unlist(use.names = FALSE,
tapply(experiments,
ceiling(1:length(experiments) / parallel),
Rmpi::mpi.apply, exec.target.runner,
scenario = scenario,
target.runner = target.runner))
}
# FIXME: if stop() is called from mpi.applyLB, it does not
# terminate the execution of the parent process, so it will
# continue and give more errors later. We have to terminate
# here, but is there a nicer way to detect this and terminate?
if (any(sapply(target.output, inherits, "try-error"))) {
# FIXME: mclapply has some bugs in case of error. In that
# case, each element of the list does not keep the output of
# each configuration and repetitions may occur.
cat(unique(unlist(target.output[sapply(
target.output, inherits, "try-error")])), file = stderr(), sep = "")
irace.error("A slave process terminated with a fatal error")
}
} else {
if (.Platform$OS.type == 'windows') {
irace.assert(!is.null(.irace$cluster))
if (scenario$loadBalancing) {
target.output <-
parallel::parLapplyLB(.irace$cluster, experiments, exec.target.runner,
scenario = scenario,
target.runner = target.runner)
} else {
target.output <-
parallel::parLapply(.irace$cluster, experiments, exec.target.runner,
scenario = scenario,
target.runner = target.runner)
}
# FIXME: if stop() is called from parLapply, then the parent
# process also terminates, and we cannot give further errors.
} else {
target.output <-
parallel::mclapply(experiments, exec.target.runner,
# FALSE means load-balancing.
mc.preschedule = !scenario$loadBalancing,
mc.cores = parallel,
scenario = scenario,
target.runner = target.runner)
# FIXME: if stop() is called from mclapply, it does not
# terminate the execution of the parent process, so it will
# continue and give more errors later. We have to terminate
# here, but is there a nicer way to detect this and terminate?
if (any(sapply(target.output, inherits, "try-error"))
|| any(sapply(target.output, is.null))) {
# FIXME: mclapply has some bugs in case of error. In that
# case, each element of the list does not keep the output of
# each configuration and repetitions may occur.
cat(unique(unlist(
target.output[sapply(
target.output, inherits, "try-error")])), file = stderr())
irace.error("A child process triggered a fatal error")
}
}
}
} else {
# One process, all sequential
target.output <- lapply(experiments, exec.target.runner,
scenario = scenario,
target.runner = target.runner)
}
target.output
}
execute.evaluator <- function(experiments, scenario, target.output, configurations.id)
{
## FIXME: We do not need the configurations.id argument:
irace.assert(isTRUE(all.equal(configurations.id,
sapply(experiments, getElement, "id.configuration"))))
all.conf.id <- paste(configurations.id, collapse = " ")
## Evaluate configurations sequentially
for (k in seq_along(experiments)) {
output <- exec.target.evaluator(experiment = experiments[[k]],
num.configurations = length(configurations.id),
all.conf.id, scenario = scenario,
target.runner.call = target.output[[k]]$call)
target.output[[k]]$cost <- output$cost
if (is.null(target.output[[k]]$call))
target.output[[k]]$call <- output$call
if (is.null(target.output[[k]]$time) || !is.null.or.na(output$time))
target.output[[k]]$time <- output$time
}
return(target.output)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.