Nothing
context("Capping")
withr::with_output_sink("test-capping.Rout", {
nsize <- 0.1
## Functions ##########################################################
f_ackley <- function (x,y) {
# Transformation of parameter values
# from [0,1] to [vmin,vmax]
vmin <- -5
vmax <- 5
x <- (x*(vmax-vmin)) + vmin
y <- (y*(vmax-vmin)) + vmin
a <- -20 * exp (-0.2 * sqrt(0.5 * (x^2 + y^2)))
b <- exp(0.5 * (cos(2*pi*x) + cos(2*pi*y)))
f <- a - b + exp(1) + 20
# Simulating stochasticity
noise <- runif(1, min = (1-nsize), max = (1+nsize))
f <- f*noise
# Transform result from [fmin,fmax]
# to [0,100]
fmin <- 0
fmax <- 15*nsize
f <- ((f - fmin) / (fmax-fmin)) * (100-0) + 0
return(f)
}
f_goldestein_price <- function (x,y) {
# Trasfomation of parameter values
# from [0,1] to [vmin,vmax]
vmin <- -2
vmax <- 2
x <- (x*(vmax-vmin)) + vmin
y <- (y*(vmax-vmin)) + vmin
a <- 1 + ((x + y + 1)^2) * (19 - 14*x + 3*x^2 - 14*y + 6*x*y + 3*y^2)
b <- 30 + ((2*x - 3*y)^2) * (18 - 32*x + 12*x^2 + 48*y - 36*x*y + 27*y^2)
f <- a*b
# Simulating stochasticity
noise <- runif(1, min = (1-nsize), max = (1+nsize))
f <- f*noise
# Transform result from [fmin,fmax]
# to [0,100]
fmin <- 0
fmax <- 1000000*nsize
f <- ((f - fmin) / (fmax-fmin)) * (100-0) + 0
return(f)
}
f_matyas <- function (x,y) {
# Trasfomation of parameter values
# from [0,1] to [vmin,vmax]
vmin <- -10
vmax <- 10
x <- (x*(vmax-vmin)) + vmin
y <- (y*(vmax-vmin)) + vmin
f <- 0.26 * (x^2 + y^2) - (0.48*x*y)
# Simulating stochasticity
noise <- runif(1, min = (1-nsize), max = (1+nsize))
f <- f*noise
# Transform result from [fmin,fmax]
# to [0,100]
fmin <- 0
fmax <- 100*nsize
f <- ((f - fmin) / (fmax-fmin)) * (100-0) + 0
return(f)
}
f_himmelblau <- function (x,y) {
# Trasfomation of parameter values
# from [0,1] to [vmin,vmax]
vmin <- -5
vmax <- 5
x <- (x*(vmax-vmin)) + vmin
y <- (y*(vmax-vmin)) + vmin
f <- (x^2 + y - 11)^2 + (x + y^2 - 7)^2
# Simulating stochasticity
noise <- runif(1, min = (1-nsize), max = (1+nsize))
f <- f*noise
# Transform result from [fmin,fmax]
# to [0,100]
fmin <- 0
fmax <- 2000*nsize
f <- ((f - fmin) / (fmax-fmin)) * (100-0) + 0
return(f)
}
## target runner ###########################################################
target.runner <- function(experiment, scenario)
{
debugLevel <- scenario$debugLevel
configuration.id <- experiment$id.configuration
instance.id <- experiment$id.instance
seed <- experiment$seed
configuration <- experiment$configuration
instance <- experiment$instance
bound <- experiment$bound
value <- switch(instance,
ackley = f_ackley(as.numeric(configuration[["x"]]), as.numeric(configuration[["y"]])),
goldestein = f_goldestein_price(as.numeric(configuration[["x"]]), as.numeric(configuration[["y"]])),
matyas = f_matyas(as.numeric(configuration[["x"]]), as.numeric(configuration[["y"]])),
himmelblau = f_himmelblau(as.numeric(configuration[["x"]]), as.numeric(configuration[["y"]])))
# Simulate execution bound
if (value > bound) value <- bound
result <- list(cost = value, time=value, call = toString(experiment))
return(result)
}
## target runner ###########################################################
target.runner.reject <- function(experiment, scenario)
{
if (runif(1) <= 0.05) return (list(cost = -Inf, time = 80, call = toString(experiment)))
return (target.runner(experiment, scenario))
}
cap.irace <- function(...)
{
args <- list(...)
parameters.table <- '
x "" r (0, 1.00)
y "" r (0, 1.00)
'
parameters <- readParameters(text = parameters.table)
scenario <- list(instances = c("ackley", "goldestein", "matyas", "himmelblau"),
targetRunner = target.runner,
capping = TRUE,
boundMax = 80,
testType = "t-test",
parallel = test_irace_detectCores())
scenario <- modifyList(scenario, args)
scenario <- checkScenario (scenario)
irace:::checkTargetFiles(scenario = scenario, parameters = parameters)
confs <- irace(scenario = scenario, parameters = parameters)
best.conf <- getFinalElites(scenario$logFile, n = 1L, drop.metadata = TRUE)
expect_identical(removeConfigurationsMetaData(confs[1L, , drop = FALSE]),
best.conf)
}
test_that("cap.irace maxExperiments = 1000", {
generate.set.seed()
cap.irace(maxExperiments = 1000)
})
test_that("cap.irace maxExperiments = 50000", {
generate.set.seed()
cap.irace(maxTime = 50000)
})
test_that("cap.irace targetRunner = target.runner.reject, maxTime = 10000", {
skip_on_cran() # This sometimes fails randomly
generate.set.seed()
cap.irace(targetRunner = target.runner.reject, maxTime = 10000)
})
}) # withr::with_output_sink()
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.