# demo objective
# Define the objective to optimize
# The 'budget' here simulates averaging 'b' samples from a noisy function
# single objective
objective <- ObjectiveRFun$new(
fun = function(xs) {
z <- exp(-xs$x^2 - xs$y^2) + 2 * exp(-(2 - xs$x)^2 - (2 - xs$y)^2)
z <- z + rnorm(1, sd = 1 / sqrt(xs$b))
list(Obj = z)
},
domain = ps(x = p_dbl(-2, 4), y = p_dbl(-2, 4), b = p_int(1)),
codomain = ps(Obj = p_dbl(tags = "maximize"))
)
# single objective
objective_no_noise <- ObjectiveRFun$new(
fun = function(xs) {
z <- exp(-xs$x^2 - xs$y^2) + 2 * exp(-(2 - xs$x)^2 - (2 - xs$y)^2)
list(Obj = z)
},
domain = ps(x = p_dbl(-2, 4), y = p_dbl(-2, 4), b = p_int(1)),
codomain = ps(Obj = p_dbl(tags = "maximize"))
)
search_space = objective$domain$search_space(list(
x = to_tune(),
y = to_tune(),
b = to_tune(p_int(1, 2^10, logscale = TRUE, tags = "budget"))
))
# single objective, complex search space
objective_complex <- ObjectiveRFun$new(
fun = function(xs) {
z <- exp(-xs$x^2 - xs$y^2) + 2 * exp(-(2 - xs$x)^2 - (2 - xs$y)^2)
if (xs$n == "a") {
z <- z + xs$x^2 / 8
}
if (xs$n == "b") {
z <- z + xs$a^2 / 8
}
z <- z + rnorm(1, sd = 1 / sqrt(xs$b))
list(Obj = z)
},
domain = ps(x = p_dbl(-2, 4), y = p_int(-2, 4), a = p_dbl(-2, 2, depends = n == "b"), n = p_fct(c("a", "b", "c")), b = p_int(1)),
codomain = ps(Obj = p_dbl(tags = "maximize"))
)
# single objective, complex search space
objective_complex_no_noise <- ObjectiveRFun$new(
fun = function(xs) {
z <- exp(-xs$x^2 - xs$y^2) + 2 * exp(-(2 - xs$x)^2 - (2 - xs$y)^2)
if (xs$n == "a") {
z <- z + xs$x^2 / 8
}
if (xs$n == "b") {
z <- z + xs$a^2 / 8
}
list(Obj = z)
},
domain = ps(x = p_dbl(-2, 4), y = p_int(-2, 4), a = p_dbl(-2, 2, depends = n == "b"), n = p_fct(c("a", "b", "c")), b = p_int(1)),
codomain = ps(Obj = p_dbl(tags = "maximize"))
)
search_space_complex = objective_complex$domain$search_space(list(
x = to_tune(),
y = to_tune(),
a = to_tune(),
n = to_tune(),
b = to_tune(p_int(1, 2^10, logscale = TRUE, tags = "budget"))
))
# multi-objective
objective.mo <- ObjectiveRFun$new(
fun = function(xs) {
list(
obj1 = xs$x * sin(xs$y) + rnorm(1, sd = 1 / sqrt(xs$b)),
obj2 = xs$x * cos(xs$y) + rnorm(1, sd = 1 / sqrt(xs$b))
)
},
domain = ps(x = p_dbl(0, 1), y = p_dbl(0, 2 * pi), b = p_int(1)),
codomain = ps(obj1 = p_dbl(tags = "maximize"), obj2 = p_dbl(tags = "maximize"))
)
objective.mo_no_noise <- ObjectiveRFun$new(
fun = function(xs) {
list(
obj1 = xs$x * sin(xs$y),
obj2 = xs$x * cos(xs$y)
)
},
domain = ps(x = p_dbl(0, 1), y = p_dbl(0, 2 * pi), b = p_int(1)),
codomain = ps(obj1 = p_dbl(tags = "maximize"), obj2 = p_dbl(tags = "maximize"))
)
search_space.mo = objective.mo$domain$search_space(list(
x = to_tune(),
y = to_tune(),
b = to_tune(p_int(1, 2^10, logscale = TRUE, tags = "budget"))
))
# Example call:
# res <- opt_objective(objective.mo, search_space.mo, budget_limit = 2^13, budget_log_step = log(2), survival_fraction = .5, mu = 20, sample = "random", filter_algorithm = "tournament", surrogate_learner = lrn("regr.ranger"), filter_with_max_budget = FALSE, filter_factor_first = 1, filter_factor_last = 100, filter_select_per_tournament = 1, random_interleave_fraction = 0.1, random_interleave_random = TRUE)
# res <- opt_objective(objective, search_space, budget_limit = 2^13, budget_log_step = log(2), survival_fraction = .5, mu = 20, sample = "random", filter_algorithm = "tournament", surrogate_learner = lrn("regr.ranger"), filter_with_max_budget = FALSE, filter_factor_first = 1, filter_factor_last = 100, filter_select_per_tournament = 1, random_interleave_fraction = 0.1, random_interleave_random = TRUE)
## res <- opt_objective_optimizable(objective.mo, objective.mo_no_noise, search_space.mo, budget_limit = 2^13, budget_log_step = log(2), survival_fraction = .5, mu = 20, sample = "random", filter_algorithm = "tournament", surrogate_learner = lrn("regr.ranger"), filter_with_max_budget = FALSE, filter_factor_first = 1, filter_factor_last = 100, filter_select_per_tournament = 1, random_interleave_fraction = 0.1, random_interleave_random = TRUE, highest_budget_only = TRUE, nadir = c(-1, -1))
## res <- opt_objective_optimizable(objective, objective_no_noise, search_space, budget_limit = 2^13, budget_log_step = log(2), survival_fraction = .5, mu = 20, sample = "random", filter_algorithm = "tournament", surrogate_learner = lrn("regr.ranger"), filter_with_max_budget = FALSE, filter_factor_first = 1, filter_factor_last = 100, filter_select_per_tournament = 1, random_interleave_fraction = 0.1, random_interleave_random = TRUE, highest_budget_only = TRUE)
# Example call for tuning
# numopts = 10
# calls <- generate_design_random(suggested_meta_searchspace, numopts)$transpose()
# ## multiobjective
# res <- lapply(calls, function(ci) mlr3misc::invoke(opt_objective, objective.mo, search_space.mo, budget_limit = 2^13, .args = ci))
# ## singleobjective
# res <- lapply(calls, function(ci) mlr3misc::invoke(opt_objective, objective, search_space, budget_limit = 2^13, .args = ci))
## calls <- calls[[1]]
## calls
## calls$filter_factor_first <- 1000
## calls$filter_factor_first.end <- 1
## calls$filter_factor_last <- 1000
## calls$filter_factor_last.end <- 1
## calls$filter_select_per_tournament <- 1
## calls$filter_select_per_tournament.end <- 1
## calls$filter_algorithm <- "tournament"
## calls$budget_log_step <- log(2)/4
## calls$random_interleave_fraction <- 1
## calls$random_interleave_fraction.end <- 1
## calls$survival_fraction <- .01
## calls$mu <- 100
## prr <- profvis::profvis(res <- lapply(list(calls), function(ci) mlr3misc::invoke(opt_objective, objective, search_space, budget_limit = 2^13, .args = ci)), interval = .005)
## prr
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.