File: OptPath.R

package info (click to toggle)
r-cran-paramhelpers 1.14.2-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 992 kB
  • sloc: ansic: 102; sh: 13; makefile: 2
file content (139 lines) | stat: -rw-r--r-- 5,663 bytes parent folder | download | duplicates (3)
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
#' @title Create optimization path.
#'
#' @description Optimizers can iteratively log their evaluated points into this
#' object. Can be converted into a data.frame with `as.data.frame(x,
#' discretes.as.factor = TRUE / FALSE)`.
#'
#' A optimization path has a number of path elements, where each element
#' consists of: the value of the decision variables at this point, the values of
#' the performance measures at this point, the date-of-birth (dob) of this
#' point, the end-of-life (eol) of this point and possibly an error message. See
#' also [addOptPathEl()].
#'
#' For discrete parameters always the name of the value is stored as a
#' character. When you retrieve an element with [getOptPathEl()], this name is
#' converted to the actual discrete value.
#'
#' If parameters have associated transformation you are free to decide whether
#' you want to add x values before or after transformation, see argument
#' `add.transformed.x` and [trafoOptPath()].
#'
#' The S3 class is a list which stores at least these elements:
#' \describe{
#' \item{par.set [ParamSet()]}{See argument of same name.}
#' \item{y.names [`character`]}{See argument of same name.}
#' \item{minimize [`logical`]}{See argument of same name.}
#' \item{add.transformed.x `logical(1)`}{See argument of same name.}
#' \item{env [`environment`]}{Environment which stores the optimization path.
#'   Contents depend on implementation.}
#' }
#'
#' @template arg_parset
#' @param y.names (`character`)\cr
#'   Names of performance measures that are optimized or logged.
#' @param minimize (`logical`)\cr
#'   Which of the performance measures in y.names should be minimized?
#'   Vector of booleans in the same order as `y.names`.
#' @param add.transformed.x (`logical(1)`)\cr
#'   If some parameters have associated transformations, are you going to add x
#'   values after they have been transformed? Default is `FALSE`.
#' @param include.error.message (`logical(1)`)\cr
#'   Should it be possible to include an error message string (or NA if no error
#'   occurred) into the path for each evaluation? This is useful if you have
#'   complex, long running objective evaluations that might fail. Default is
#'   `FALSE`.
#' @param include.exec.time (`logical(1)`)\cr
#'   Should it be possible to include execution time of evaluations into the
#'   path for each evaluation? Note that execution time could also be entered in
#'   `y.names` as a direct performance measure. If you use this option here,
#'   time is regarded as an extra measurement you might be curious about.
#'   Default is `FALSE`.
#' @param include.extra (`logical(1)`)\cr
#'   Should it be possible to include extra info
#'   into the path for each evaluation?
#'   Default is `FALSE`.
#' @name OptPath
#' @rdname OptPath
#' @family optpath
NULL

makeOptPath = function(par.set, y.names, minimize, add.transformed.x = FALSE,
  include.error.message = FALSE, include.exec.time = FALSE, include.extra = FALSE) {

  n.y = length(y.names)
  ok = c("numeric", "integer", "numericvector", "integervector", "logical",
    "logicalvector", "discrete", "discretevector", "character", "charactervector")
  if (length(par.set$pars) > length(filterParams(par.set, type = ok)$pars)) {
    stop("OptPath can currently only be used for: ", paste(ok, collapse = ","))
  }
  x.names = getParamIds(par.set)
  # be really sure that x and y columns are uniquely named
  x.names2 = c(getParamIds(par.set, with.nr = TRUE), getParamIds(par.set, with.nr = FALSE))
  if (length(intersect(x.names2, y.names)) > 0) {
    stop("'x.names' and 'y.names' must not contain common elements!")
  }
  if (length(minimize) != n.y) {
    stop("'y.names' and 'minimize' must be of the same length!")
  }
  if (is.character(names(minimize)) && !setequal(names(minimize), y.names)) {
    stop("Given names for 'minimize' must be the same as 'y.names'!")
  }
  if (is.null(names(minimize))) {
    names(minimize) = y.names
  }
  if (any(c("dob", "eol", "error.message") %in% (union(x.names, y.names)))) {
    stop("'dob', 'eol' and 'error.message' are not allowed in parameter names or 'y.names'!")
  }
  ee = new.env(parent = emptyenv())
  ee$dob = ee$eol = integer(0)

  # potentially init error.message and exec.time in env
  ee$error.message = if (include.error.message) character(0L) else NULL
  ee$exec.time = if (include.exec.time) numeric(0L) else NULL
  ee$extra = if (include.extra) list() else NULL

  makeS3Obj("OptPath",
    par.set = par.set,
    y.names = y.names,
    minimize = minimize,
    add.transformed.x = add.transformed.x,
    env = ee
  )
}

#' @export
print.OptPath = function(x, ...) {

  n = getOptPathLength(x)
  em = x$env$error.message
  et = x$env$exec.time
  ex = x$env$extra
  catf("Optimization path")
  catf("  Dimensions: x = %i/%i, y = %i",
    length(x$par.set$pars), sum(getParamLengths(x$par.set)), length(x$y.names))
  catf("  Length: %i", n)
  catf("  Add x values transformed: %s", x$add.transformed.x)
  s = if (is.null(em)) "" else sprintf(" Errors: %i / %i.", sum(!is.na(em)), n)
  catf("  Error messages: %s.%s", !is.null(em), s)
  s = if (is.null(et)) {
    s = ""
  } else {
    ntimes = sum(!is.na(et))
    ntime.nas = length(et) - ntimes
    # no non-na exec times in path
    if (ntimes == 0L) {
      et1 = 0
      et2 = 0
    } else {
      et1 = min(et, na.rm = TRUE)
      et2 = max(et, na.rm = TRUE)
    }
    s = sprintf(" Range: %g - %g. %i NAs.", et1, et2, ntime.nas)
  }
  catf("  Exec times: %s.%s", !is.null(et), s)
  if (!is.null(ex)) {
    nondot.extra.length = ifelse(length(ex) > 0L,
      length(removeDotEntries(ex[[1L]])), NA)
    catf("  Extras: %i columns", nondot.extra.length)
  }
}