# tests/testthat/test_to_tune.R In paradox: Define and Work with Parameter Spaces for Complex Algorithms

```context("to_tune")

test_that("TuneToken printers", {

expect_output(print(to_tune()), "<entire parameter range>")

expect_output(print(to_tune(1, 2)), "range \\[1, 2\\]")

expect_output(print(to_tune(upper = 2, 1)), "range \\[1, 2\\]")

expect_output(print(to_tune(1)), "p_fct\\(levels = c\\(`1` = 1\\)\\)")

expect_output(print(to_tune(c("a", "b"))), "p_fct\\(levels = c\\(\"a\", \"b\"\\)\\)")

expect_output(print(to_tune(p_dbl(1, 2))), "p_dbl\\(lower = 1, upper = 2\\)")

expect_output(print(to_tune(ps(x = p_int(0, 1)))), "ParamSet.*id.*class.*lower.*upper")

})

test_that("validity checks", {

expect_error(to_tune(p_dbl(2, 1)), "lower <= upper")

expect_error(to_tune(p_dbl()), "must be bounded")

expect_error(to_tune(ParamDbl\$new("x")), "must be bounded")

expect_error(to_tune(ps(x = p_dbl())), "must be bounded")

expect_error(ParamSet_legacy\$new(list(ParamInt\$new("x")))\$search_space(list(x = to_tune())), "must give a range for unbounded parameter")

})

test_that("\$check() works on TuneToken", {

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamInt\$new("xub"),
ParamDbl\$new("y", lower = 0, upper = 10, special_vals = list("x")),
ParamUty\$new("uty"),
ParamUty\$new("uty1", custom_check = function(x) if (!identical(x, 1)) "uty1 must be 1" else TRUE),
ParamFct\$new("fct", c("x", "y")),
ParamLgl\$new("lgl")
))

expect_equal(pars\$check(list(x = 1, xub = 1, y = 1, uty = 1, uty1 = 1, fct = "x", lgl = TRUE)), TRUE)
expect_string(pars\$check(list(x = 1, xub = 1, y = 1, uty = 1, uty1 = 1, fct = "x", lgl = 1)),
pattern = "Must be of type .*logical.*not.*double")

expect_equal(pars\$check(list(x = to_tune(), xub = to_tune(0, 1), y = to_tune(p_int(1, 10)),
uty = to_tune(c("a", "b")), uty1 = to_tune(1), fct = to_tune(), lgl = to_tune(c(TRUE, FALSE)))), TRUE)

expect_class(pars\$search_space(list(x = to_tune(), xub = to_tune(0, 1), y = to_tune(p_int(1, 10)),
uty = to_tune(c("a", "b")), uty1 = to_tune(1), fct = to_tune(), lgl = to_tune(c(TRUE, FALSE)))), "ParamSet")

expect_string(pars\$check(list(x = to_tune(0, 11))), "not compatible with param x.*upper.*11")
expect_error(pars\$search_space(list(x = to_tune(0, 11))), "not compatible with param x.*upper.*11")

expect_string(pars\$check(list(xub = to_tune())), "must give a range for unbounded parameter xub")
expect_error(pars\$search_space(list(xub = to_tune())), "must give a range for unbounded parameter xub")

expect_equal(pars\$check(list(y = to_tune(list(1, 2, "x")))), TRUE)
expect_string(pars\$check(list(y = to_tune(list(1, 2, "z")))), "y: tune token invalid.*\"z\"")
expect_error(pars\$search_space(list(y = to_tune(list(1, 2, "z")))), "generates points that are not compatible.*\"z\"")

expect_string(pars\$check(list(uty = to_tune())), "must give a range for unbounded parameter uty")
expect_error(pars\$search_space(list(uty = to_tune())), "must give a range for unbounded parameter uty")
expect_equal(pars\$check(list(uty = to_tune(1))), TRUE)
expect_equal(pars\$check(list(uty1 = to_tune(1))), TRUE)
expect_string(pars\$check(list(uty1 = to_tune(2))), "not compatible with param uty1.*2")
expect_error(pars\$search_space(list(uty1 = to_tune(2))), "not compatible with param uty1.*2")

expect_string(pars\$check(list(fct = to_tune("z"))), "not compatible with param fct.*\"z\"")
expect_error(pars\$search_space(list(fct = to_tune("z"))), "not compatible with param fct.*\"z\"")

expect_string(pars\$check(list(lgl = to_tune("z"))), "not compatible with param lgl.*\"z\"")
expect_error(pars\$search_space(list(lgl = to_tune("z"))), "not compatible with param lgl.*\"z\"")

expect_string(pars\$check(list(lgl = to_tune(0, 1))), "must have zero or one argument")
expect_error(pars\$search_space(list(lgl = to_tune(0, 1))), "must have zero or one argument")

expect_error(pars\$search_space(list(xxx = to_tune())), "ust be a subset of .*x.*xub.*y.*uty.*uty1.*fct.*lgl")
})

test_that("Tune ParamSet is created", {

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamDbl\$new("y", lower = 0, upper = 10, special_vals = list("x")),
ParamFct\$new("fct", c("x", "y")),
ParamLgl\$new("lgl")
))

pars_tune = pars\$search_space(list(x = to_tune(), y = to_tune(), fct = to_tune(), lgl = to_tune()))

# the following is necessary because \$add modifies index of the .deps table, and one of the `\$values` is not named.
pars_tune\$values = list()

reset_indices(pars)
reset_indices(pars_tune)
expect_equal_ps(pars, pars_tune)

pars_unbound = ParamSet_legacy\$new(list(
ParamDbl\$new("x"),
ParamDbl\$new("y", special_vals = list("x")),
ParamFct\$new("fct", letters),
ParamUty\$new("lgl")
))

pars_tune = pars_unbound\$search_space(list(x = to_tune(p_int(0, 10)), y = to_tune(p_dbl(0, 10, special_vals = list("x"))), fct = to_tune(c("x", "y")), lgl = to_tune(p_lgl())))
pars_tune\$values = list()
setindex(pars_tune\$deps, NULL)
expect_equal_ps(pars, pars_tune)

pars_unbound_2 = ParamSet_legacy\$new(list(
ParamInt\$new("x"),
ParamDbl\$new("y"),
ParamFct\$new("fct", letters),
ParamUty\$new("lgl")
))

pars_tune = pars_unbound_2\$search_space(list(x = to_tune(0, 10), y = to_tune(p_dbl(0, 10, special_vals = list("x"))), fct = to_tune(c("x", "y")), lgl = to_tune(p_lgl())))
pars_tune\$values = list()
setindex(pars_tune\$deps, NULL)
expect_equal_ps(pars, pars_tune)

pars_tune = pars_unbound\$search_space(list(x = to_tune(ParamInt\$new("y", 0, 10)), y = to_tune(ps(z = p_dbl(0, 10, special_vals = list("x")))),
fct = to_tune(c("x", "y")), lgl = to_tune(p_lgl())))

# to_tune from ps() generates messed up value order
expect_equal(rbindlist(generate_design_grid(pars_tune, 2)\$transpose()), rbindlist(generate_design_grid(pars, 2)\$transpose()), ignore.col.order = TRUE)

pars\$values = list(x = 1, y = 2, fct = to_tune(), lgl = to_tune(TRUE))
pars_tune = pars\$search_space()
expect_equal(generate_design_grid(pars_tune)\$transpose(),
list(list(fct = "x", lgl = TRUE), list(fct = "y", lgl = TRUE)))

})

test_that("Trafo works as expected", {

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamDbl\$new("y", lower = 0, upper = 10, special_vals = list("x")),
ParamFct\$new("fct", c("x", "y")),
ParamLgl\$new("lgl")
))

grid = generate_design_grid(pars\$search_space(list(lgl = to_tune(TRUE))))
expect_equal(grid\$data, data.table(lgl = "TRUE"))
expect_equal(grid\$transpose(), list(list(lgl = TRUE)))

grid = generate_design_grid(pars\$search_space(list(lgl = to_tune(p_fct(TRUE, trafo = function(x) !x)))))
expect_equal(grid\$data, data.table(lgl = "TRUE"))
expect_equal(grid\$transpose(), list(list(lgl = FALSE)))

inpars = ParamSet_legacy\$new(list(
ParamFct\$new("x", c("a", "b")),
ParamFct\$new("y", c("a", "b"))
))
inpars\$extra_trafo = function(x, param_set) list(x\$x != x\$y)
indesign = generate_design_grid(inpars)

outdesign = generate_design_grid(pars\$search_space(list(lgl = to_tune(inpars))))

expect_equal(indesign\$data, outdesign\$data)

expect_equal(outdesign\$transpose(), list(list(lgl = FALSE), list(lgl = TRUE), list(lgl = TRUE), list(lgl = FALSE)))

})

test_that("Dependencies work", {

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 1),
ParamInt\$new("y", lower = 0, upper = 1),
ParamInt\$new("z", lower = 0, upper = 1),
ParamInt\$new("z2", lower = 0, upper = 1)
))

# if the tune paramset contains a "z2" in place of "y2", then the x->"z2" dependency is actually kept. This may be useful.
# if some parameter depends on y, that dependency is lost. nothing we can do here.

tuneps = pars\$search_space(list(x = to_tune(), y = to_tune(ps(y1 = p_int(0, 1), y2 = p_int(0, 1), .extra_trafo = function(x, param_set) list(abs(x\$y1 - x\$y2))))))

# all dependencies lost
expect_equal(nrow(tuneps\$deps), 0)

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 1),
ParamInt\$new("y", lower = 0, upper = 1),
ParamInt\$new("z", lower = 0, upper = 1),
ParamInt\$new("z2", lower = 0, upper = 1)
))

# only the relevant dependency is kept
tuneps = pars\$search_space(list(x = to_tune(), y = to_tune()))
expect_equal(setindex(tuneps\$deps, NULL), data.table(id = "y", on = "x", cond = list(CondEqual(1))))

#dependencies are kept between params, even if the dependor is trafo'd from other params
tuneps = pars\$search_space(list(x = to_tune(), y = to_tune(ps(y1 = p_int(0, 1), y2 = p_int(0, 1), .extra_trafo = function(x, param_set) list(abs(x\$y1 - x\$y2))))))

expect_equal(setindex(tuneps\$deps, NULL), data.table(id = c("y1", "y2"), on = c("x", "x"), cond = list(CondEqual(1))))

tuneps = pars\$search_space(list(x = to_tune(), y = to_tune(ps(y1 = p_int(0, 1), y2 = p_int(0, 1, depends = y1 == 1),
.extra_trafo = function(x, param_set) list(min(x\$y1, x\$y2, na.rm = TRUE))))))

# mixing dependencies from inside and outside
expect_equal(setindex(tuneps\$deps, NULL), data.table(id = c("y2", "y1", "y2"), on = c("y1", "x", "x"), cond = list(CondEqual(1))))

parsnodep = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 1),
ParamInt\$new("y", lower = 0, upper = 1),
ParamInt\$new("z", lower = 0, upper = 1),
ParamInt\$new("z2", lower = 0, upper = 1)
))

# amazing: dependencies across to_tune
tuneps = parsnodep\$search_space(list(x = to_tune(p_int(0, 1, depends = y == 0)), y = to_tune()))

expect_equal(setindex(tuneps\$deps, NULL), data.table(id = "x", on = "y", cond = list(CondEqual(0))))

tuneps = pars\$search_space(list(x = to_tune(), y = to_tune(ps(y1 = p_int(0, 1), y2 = p_int(0, 1, depends = x == 1),
.extra_trafo = function(x, param_set) list(min(x\$y1, x\$y2, na.rm = TRUE)), .allow_dangling_dependencies = TRUE))))

# mixing dependencies from inside and across to_tune. I am the only person in this building capable of coding this.
expect_equal(setindex(tuneps\$deps, NULL), data.table(id = c("y2", "y1", "y2"), on = c("x", "x", "x"), cond = list(CondEqual(1))))

expect_error(pars\$search_space(list(x = to_tune(), y = to_tune(ps(y1 = p_int(0, 1), y2 = p_int(0, 1, depends = z == 1),
.extra_trafo = function(x, param_set) list(min(x\$y1, x\$y2, na.rm = TRUE)), .allow_dangling_dependencies = TRUE)))),
"Dependencies on z dangling")

# make sure dependency check of `pars` work with tune tokens.
pars\$values\$z = 0
pars\$values\$x = to_tune()
expect_equal(capture.output(print(pars\$search_space())), capture.output(print(ps(x = p_int(0, 1)))))

pars\$values\$z = to_tune(p_int(0, 1))
pars\$values\$x = to_tune()
expect_equal(capture.output(print(pars\$search_space())),
capture.output(print(ps(z = p_int(0, 1), x = p_int(0, 1, depends = z == 1)))))

pars\$values\$z = to_tune(p_int(0, 1))
pars\$values\$x = 1

expect_equal(capture.output(print(pars\$search_space())), capture.output(print(ps(z = p_int(0, 1)))))

# dependency after subsetting factorials works, even if the dependency now
# contains infeasible values
largeps = ParamSet_legacy\$new(list(
ParamFct\$new("x", c("a", "b", "c")),
ParamLgl\$new("y")
))

res = largeps\$search_space(list(x = to_tune(c("a", "b")), y = to_tune()))
expect_equal(res\$deps\$cond[[1]]\$rhs, c("a", "b"))

res = largeps\$search_space(list(x = to_tune("a"), y = to_tune()))
expect_equal(res\$deps\$cond[[1]]\$rhs, "a")

res = largeps\$search_space(list(x = to_tune("c"), y = to_tune()))
expect_false(res\$has_deps)

})

test_that("ParamSetCollection works", {

ps1 = ParamSet_legacy\$new(list(ParamInt\$new("x"), ParamInt\$new("y")))
ps2 = ParamSet_legacy\$new(list(ParamInt\$new("a")))

psc = ParamSetCollection\$new(list(prefix = ps1, ps2))

ps1\$values\$x = to_tune(0, 10)
ps1\$values\$y = to_tune(ps(y1 = p_int(0, 1), y2 = p_int(0, 1), .extra_trafo = function(x, param_set) list(y = x\$y1 * x\$y2)))

expect_equal(generate_design_grid(ps1\$search_space(), 2)\$transpose()[[1]], list(x = 0, y = 0))
expect_equal(generate_design_grid(ps1\$search_space(), 2)\$transpose(trafo = FALSE)[[1]], list(x = 0, y1 = 0, y2 = 0))

expect_equal(generate_design_grid(psc\$search_space(), 2)\$transpose()[[1]], list(prefix.x = 0, prefix.y = 0))

expect_equal(generate_design_grid(psc\$search_space(), 2)\$transpose(trafo = FALSE)[[1]], list(prefix.x = 0, y1 = 0, y2 = 0))

psc\$values\$a = 1
psc\$values\$a = to_tune(0, 1)

expect_equal(generate_design_grid(psc\$search_space(), 2)\$transpose(trafo = FALSE)[[1]], list(prefix.x = 0, y1 = 0, y2 = 0, a = 0))

psc\$values\$a = to_tune(p_int(0, 1, depends = prefix.x == 10))

expect_equal(generate_design_grid(psc\$search_space(), 2)\$transpose(trafo = FALSE)[[1]], list(prefix.x = 0, y1 = 0, y2 = 0))
expect_equal(generate_design_grid(psc\$search_space(), 2)\$transpose(trafo = FALSE)[[12]], list(prefix.x = 10, y1 = 1, y2 = 1, a = 1))

})

test_that("ParamSet\$get_values() works", {
pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamDbl\$new("y", lower = 0, upper = 10),
ParamDbl\$new("z", lower = 0, upper = 10)
))

pars\$values\$x = to_tune()
pars\$values\$y = 2
pars\$values\$z = 2

expect_named(pars\$get_values(type = "with_token"), c("x", "y", "z"))
expect_named(pars\$get_values(type = "without_token"), c("y", "z"))
expect_named(pars\$get_values(type = "only_token"), "x")

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamDbl\$new("y", lower = 0, upper = 10),
ParamDbl\$new("z", lower = 0, upper = 10)
))

pars\$values\$y = 2
expect_list(pars\$get_values(type = "only_token"), len = 0)

pars\$values\$y = to_tune()
expect_list(pars\$get_values(type = "without_token"), len = 0)
})

test_that("partial bounds in tunetoken", {

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamDbl\$new("y", lower = 0),
ParamDbl\$new("z", upper = 10)
))

expect_equal_ps(pars\$search_space(list(x = to_tune())), ParamInt\$new("x", lower = 0, upper = 10))

expect_equal_ps(pars\$search_space(list(x = to_tune(lower = 1))), ParamInt\$new("x", lower = 1, upper = 10))
expect_equal_ps(pars\$search_space(list(x = to_tune(upper = 1))), ParamInt\$new("x", lower = 0, upper = 1))
expect_equal_ps(pars\$search_space(list(x = to_tune(lower = 1, upper = 2))), ParamInt\$new("x", lower = 1, upper = 2))

expect_error(pars\$search_space(list(y = to_tune(lower = 1))), "y range must be bounded, but is \\[1, Inf\\]")
expect_equal_ps(pars\$search_space(list(y = to_tune(upper = 1))), ParamDbl\$new("y", lower = 0, upper = 1))
expect_equal_ps(pars\$search_space(list(y = to_tune(lower = 1, upper = 2))), ParamDbl\$new("y", lower = 1, upper = 2))

expect_error(pars\$search_space(list(z = to_tune(upper = 1))), "z range must be bounded, but is \\[-Inf, 1\\]")
expect_equal_ps(pars\$search_space(list(z = to_tune(lower = 1))), ParamDbl\$new("z", lower = 1, upper = 10))
expect_equal_ps(pars\$search_space(list(z = to_tune(lower = 1, upper = 2))), ParamDbl\$new("z", lower = 1, upper = 2))

expect_output(print(to_tune()), "entire parameter range")
expect_output(print(to_tune(lower = 1)), "range \\[1, \\.\\.\\.]")
expect_output(print(to_tune(upper = 1)), "range \\[\\.\\.\\., 1]")
expect_output(print(to_tune(lower = 0, upper = 1)), "range \\[0, 1]")

expect_output(print(to_tune(logscale = FALSE)), "<entire parameter range>")
expect_output(print(to_tune(lower = 1, logscale = FALSE)), "range \\[1, \\.\\.\\.]\\n\$")
expect_output(print(to_tune(upper = 1, logscale = FALSE)), "range \\[\\.\\.\\., 1]\\n\$")
expect_output(print(to_tune(lower = 0, upper = 1, logscale = FALSE)), "range \\[0, 1]\\n\$")

})

test_that("logscale in tunetoken", {

pars = ParamSet_legacy\$new(list(
ParamInt\$new("x", lower = 0, upper = 10),
ParamDbl\$new("y", lower = 0)
))

expect_equal(reset_indices(pars\$search_space(list(x = to_tune(logscale = TRUE))))\$.__enclos_env__\$private\$.params[, cargo := list(list(NULL))],
reset_indices(ParamDbl\$new("x", lower = log(.5), upper = log(11)))\$.__enclos_env__\$private\$.params)
expect_equal(reset_indices(pars\$search_space(list(y = to_tune(lower = 1, upper = 10, logscale = TRUE))))\$.__enclos_env__\$private\$.params[, cargo := list(list(NULL))],
reset_indices(ParamDbl\$new("y", lower = log(1), upper = log(10)))\$.__enclos_env__\$private\$.params)

expect_error(pars\$search_space(list(y = to_tune(upper = 10, logscale = TRUE))), "When logscale is TRUE then lower bound must be strictly greater than 0")

expect_equal(
generate_design_grid(pars\$search_space(list(x = to_tune(logscale = TRUE))), 4)\$transpose(),
list(list(x = 0), list(x = 1), list(x = 3), list(x = 10))
)

expect_equal(
generate_design_grid(pars\$search_space(list(y = to_tune(lower = 1, upper = 100, logscale = TRUE))), 3)\$transpose(),
list(list(y = 1), list(y = 10), list(y = 100))
)

expect_output(print(to_tune(logscale = TRUE)), "entire parameter range \\(log scale\\)")
expect_output(print(to_tune(lower = 1, logscale = TRUE)), "range \\[1, \\.\\.\\.] \\(log scale\\)")
expect_output(print(to_tune(upper = 1, logscale = TRUE)), "range \\[\\.\\.\\., 1] \\(log scale\\)")
expect_output(print(to_tune(lower = 0, upper = 1, logscale = TRUE)), "range \\[0, 1] \\(log scale\\)")
expect_output(print(to_tune(internal = TRUE)), "Internal")
})

test_that("internal and aggr", {
param_set = ps(a = p_dbl(lower = 1, upper = 2, tags = "internal_tuning", in_tune_fn = function(domain, param_vals) domain\$upper,
disable_in_tune = list(), aggr = function(x) round(mean(unlist(x))))
)

# full tune token + internal
expect_equal(
param_set\$set_values(a = to_tune(aggr = function(x) -99))\$search_space()\$aggr_internal_tuned_values(
list(a = list(1, 2, 3))),
list(a = -99)
)

# logscale + internal: now allowed
expect_error(
param_set\$set_values(a = to_tune(logscale = TRUE, aggr = function(x) -99)),
"internal tuning"
)

# other trafos + internal: not allowed
expect_error(
param_set\$set_values(a = to_tune(ps(a = p_dbl(0, 1), .extra_trafo = function(x) 1L), aggr = function(x) -99)),
"can currently not be combined"
)

# range + internal
param_set\$set_values(a = to_tune(lower = 1.2, upper = 1.3, aggr = function(x) 1.5))
expect_equal(param_set\$search_space()\$aggr_internal_tuned_values(list(a = list(1, 2))), list(a = 1.5))
expect_equal(param_set\$convert_internal_search_space(param_set\$search_space()), list(a = 1.3))

# full + internal
param_set\$set_values(a = to_tune(internal = TRUE, aggr = function(x) 1.5))
expect_equal(param_set\$convert_internal_search_space(param_set\$search_space()), list(a = 2))

# domain + internal
expect_error(
param_set\$set_values(a = to_tune(p_dbl(1.21, 1.22), aggr = function(x) 1.5, internal = TRUE)),
"specify lower and upper"
)

# param set + internal
param_set = ps(a = p_int(lower = 1, upper = 10000, tags = "internal_tuning", in_tune_fn = function(domain, param_vals) domain\$upper,
aggr = function(x) max(unlist(x)), disable_in_tune = list()))

# default aggregation function is used when not overwritten
param_set\$set_values(
a = to_tune(internal = TRUE)
)
expect_equal(param_set\$search_space()\$aggr_internal_tuned_values(list(a = list(1, 2, 3))), list(a = 3))

# can overwrite existing aggregation function
param_set\$set_values(
a = to_tune(internal = TRUE, aggr = function(x) -60)
)
expect_equal(param_set\$search_space()\$aggr_internal_tuned_values(list(a = list(1, 2, 3))), list(a = -60))
})
```