-
-
Notifications
You must be signed in to change notification settings - Fork 9
/
ObjectiveRFun.R
99 lines (94 loc) · 2.71 KB
/
ObjectiveRFun.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
#' @title Objective interface with custom R function
#'
#' @description
#' Objective interface where the user can pass a custom R function that expects a list as input.
#' If the return of the function is unnamed, it is named with the ids of the codomain.
#'
#' @template param_domain
#' @template param_codomain
#' @template param_check_values
#' @template param_constants
#'
#' @export
#' @examples
#' # define objective function
#' fun = function(xs) {
#' -(xs[[1]] - 2)^2 - (xs[[2]] + 3)^2 + 10
#' }
#'
#' # set domain
#' domain = ps(
#' x1 = p_dbl(-10, 10),
#' x2 = p_dbl(-5, 5)
#' )
#'
#' # set codomain
#' codomain = ps(y = p_dbl(tags = "maximize"))
#'
#' # create Objective object
#' obfun = ObjectiveRFun$new(
#' fun = fun,
#' domain = domain,
#' codomain = codomain,
#' properties = "deterministic"
#' )
ObjectiveRFun = R6Class("ObjectiveRFun",
inherit = Objective,
public = list(
#' @description
#' Creates a new instance of this [R6][R6::R6Class] class.
#'
#' @param fun (`function`)\cr
#' R function that encodes objective and expects a list with the input for a single point
#' (e.g. `list(x1 = 1, x2 = 2)`) and returns the result either as a numeric vector or a
#' list (e.g. `list(y = 3)`).
#' @param id (`character(1)`).
#' @param properties (`character()`).
initialize = function(
fun,
domain,
codomain = NULL,
id = "function",
properties = character(),
constants = ps(),
check_values = TRUE
) {
if (is.null(codomain)) {
codomain = ps(y = p_dbl(tags = "minimize"))
}
private$.fun = assert_function(fun, "xs")
# asserts id, domain, codomain, properties
super$initialize(
id = id,
domain = domain,
codomain = codomain,
properties = properties,
constants = constants,
check_values = check_values,
label = "Objective Custom R Function",
man = "bbotk::ObjectiveRFun")
},
#' @description
#' Evaluates input value(s) on the objective function. Calls the R function
#' supplied by the user.
#' @param xs Input values.
eval = function(xs) {
if (self$check_values) self$domain$assert(xs)
res = invoke(private$.fun, xs, .args = self$constants$values)
if (!test_named(res)) names(res)[seq_len(self$codomain$length)] = self$codomain$ids()
if (self$check_values) self$codomain$assert(as.list(res)[self$codomain$ids()])
return(res)
}
),
active = list(
#' @field fun (`function`)\cr
#' Objective function.
fun = function(lhs) {
if (!missing(lhs) && !identical(lhs, private$.fun)) stop("fun is read-only")
private$.fun
}
),
private = list(
.fun = NULL
)
)