Expected improvement per second

NAMESPACE

@@ -19,6 +19,7 @@ export(crit.cb1)
 export(crit.cb2)
 export(crit.dib1)
 export(crit.ei)
+export(crit.eis)
 export(crit.eqi)
 export(crit.mr)
 export(crit.se)
@@ -34,6 +35,7 @@ export(getMBOInfillCritParams)
 export(getSupportedInfillOptFunctions)
 export(getSupportedMultipointInfillOptFunctions)
 export(hasRequiresInfillCritStandardError)
+export(hasRequiresInfillCritTime)
 export(initCrit)
 export(initSMBO)
 export(makeMBOControl)
@@ -42,6 +44,7 @@ export(makeMBOInfillCritAEI)
 export(makeMBOInfillCritCB)
 export(makeMBOInfillCritDIB)
 export(makeMBOInfillCritEI)
+export(makeMBOInfillCritEIs)
 export(makeMBOInfillCritEQI)
 export(makeMBOInfillCritMeanResponse)
 export(makeMBOInfillCritStandardError)

R/OptState_getter.R

@@ -41,7 +41,7 @@ getOptStateTimeModel = function(opt.state) {
   if (is.null(time.model) || getTaskSize(time.model) != length(na.omit(exec.times))) {
     opt.problem = getOptStateOptProblem(opt.state)
     opt.path = getOptStateOptPath(opt.state)
-    time.task = cbind(getOptPathX(opt.path), exec.time = getOptPathExecTimes(opt.path))
+    time.task = cbind(getOptPathX(opt.path), exec.time = log(getOptPathExecTimes(opt.path)))
     time.task = time.task[!is.na(time.task$exec.time), ]
     time.task = makeRegrTask(id = "time.task", data = time.task, target = "exec.time")
     time.model = train(learner = getOptProblemLearner(opt.problem), task = time.task)

R/getMBOInfillCrit.R

@@ -47,6 +47,14 @@ hasRequiresInfillCritStandardError = function(x) {
   return(x$requires.se)
 }
 
+#' @export
+#' @rdname getMBOInfillCrit
+hasRequiresInfillCritTime = function(x) {
+  assertClass(x, "MBOInfillCrit")
+  return(x$requires.time)
+}
+
+
 #' @export
 #' @rdname getMBOInfillCrit
 getMBOInfillCritComponents = function(x) {

R/infill_crits.R

@@ -240,6 +240,44 @@ makeMBOInfillCritEQI = function(eqi.beta = 0.75, se.threshold = 1e-6) {
   )
 }
 
+#' @export
+#' @rdname infillcrits
+makeMBOInfillCritEIs = function(se.threshold = 1e-6) {
+  assertNumber(se.threshold, lower = 1e-20)
+  force(se.threshold)
+  makeMBOInfillCrit(
+    fun = function(points, models, control, par.set, design, iter, attributes = FALSE) {
+      model = models[[1L]]
+      time.model = models$time.model
+      maximize.mult = ifelse(control$minimize, 1, -1)
+      y = maximize.mult * design[, control$y.name]
+      p = predict(model, newdata = points)$data
+      p.time = exp(predict(time.model, newdata = points)$data$response) #time is modeled on log-scale
+      p.mu = maximize.mult * p$response
+      p.se = p$se
+      y.min = min(y)
+      d = y.min - p.mu
+      xcr = d / p.se
+      xcr.prob = pnorm(xcr)
+      xcr.dens = dnorm(xcr)
+      ei = (d * xcr.prob + p.se * xcr.dens) / p.time
+      res = ifelse(p.se < se.threshold, 0, -ei)
+      if (attributes) {
+        res = setAttribute(res, "crit.components", data.frame(se = p$se, mean = p$response))
+      }
+      return(res)
+    },
+    name = "Expected improvement per second",
+    id = "eis",
+    components = c("se", "mean"),
+    params = list(se.threshold = se.threshold),
+    opt.direction = "maximize",
+    requires.se = TRUE,
+    requires.time = TRUE
+  )
+}
+
+
 # ====================
 # MULTI-CRITERIA STUFF
 # ====================

R/makeMBOInfillCrit.R

@@ -42,13 +42,16 @@
 #'   Does the infill criterion require the regression learner to provide a standard
 #'   error estimation?
 #'   Default is \code{FALSE}.
+#' @param requires.time [\code{logical(1)}]\cr
+#'   Does the infill criterion require estimated runtime of the target function based on the \code{time.model}?
+#'   Default is \code{FALSE}.
 #' @return [\code{\link{MBOInfillCrit}}]
 #' @rdname MBOInfillCrit
 #' @aliases MBOInfillCrit
 #' @export
 makeMBOInfillCrit = function(fun, name, id,
   opt.direction = "minimize", components = character(0L), params = list(),
-  requires.se = FALSE) {
+  requires.se = FALSE, requires.time = FALSE) {
   assertFunction(
     fun,
     args = c("points", "models", "control",
@@ -61,6 +64,7 @@ makeMBOInfillCrit = function(fun, name, id,
   assertCharacter(components, unique = TRUE)
   assertList(params)
   assertFlag(requires.se)
+  assertFlag(requires.time)
 
   ic = makeS3Obj(c(paste0("InfillCrit", toupper(id)), "MBOInfillCrit"),
     fun = fun,
@@ -69,7 +73,8 @@ makeMBOInfillCrit = function(fun, name, id,
     opt.direction = opt.direction,
     components = components,
     params = params,
-    requires.se = requires.se
+    requires.se = requires.se,
+    requires.time = requires.time
   )
   return(ic)
 }
@@ -78,11 +83,16 @@ makeMBOInfillCrit = function(fun, name, id,
 print.MBOInfillCrit = function(x, ...) {
   components = getMBOInfillCritComponents(x)
   params = getMBOInfillCritParams(x)
+  requirements = c()
+  if (hasRequiresInfillCritStandardError(x))
+    requirements = c(requirements, "SE estimation")
+  if (hasRequiresInfillCritTime(x))
+    requirements = c(requirements, "runtime estimation")
   catf("Infill criterion            : %s (%s)", getMBOInfillCritName(x),
     getMBOInfillCritId(x))
     catf("  Direction of optimization : %s", x$opt.direction)
-  if (hasRequiresInfillCritStandardError(x))
-    catf("  Requirement               : SE estimation")
+  if (length(requirements) > 0)
+    catf("  Requirements              : %s", collapse(requirements, sep = ", "))
   if (length(components) > 0)
     catf("  Components                : %s", collapse(components, sep = ", "))
   if (length(params) > 0)

R/proposePointsByInfillOptimization.R

@@ -34,6 +34,8 @@ proposePointsByInfillOptimization = function(opt.state, par.set = NULL, control
   if (!ch$ok) return(ch$prop)
 
   design = convertOptPathToDf(opt.path, control)
+  if (hasRequiresInfillCritTime(control$infill.crit))
+    models$time.model = getOptStateTimeModel(opt.state)
   infill.crit.fun = control$infill.crit$fun
   infill.opt.fun = getInfillOptFunction(control$infill.opt)
   # store time to propose single point

R/zzz.R

@@ -23,6 +23,7 @@ NULL
 #' @section Predefined standard infill criteria:
 #' \describe{
 #' \item{crit.ei}{Expected Improvement}
+#' \item{crit.eis}{Expected Improvement per second}
 #' \item{crit.mr}{Mean response}
 #' \item{crit.se}{Standard error}
 #' \item{crit.cb}{Confidence bound with lambda automatically chosen, see \code{\link{infillcrits}}}
@@ -46,6 +47,13 @@ crit.ei = makeMBOInfillCritEI()
 #' @docType NULL
 #' @format NULL
 #' @keywords NULL
+crit.eis = makeMBOInfillCritEIs()
+#' @rdname MBOInfillCrit
+#' @export
+#' @usage NULL
+#' @docType NULL
+#' @format NULL
+#' @keywords NULL
 crit.mr = makeMBOInfillCritMeanResponse()
 #' @rdname MBOInfillCrit
 #' @export

tests/testthat/test_infillcrits.R

@@ -44,16 +44,18 @@ test_that("infill crits", {
     opdf = as.data.frame(or$opt.path)
     opdf = split(opdf, opdf$prop.type)
 
-    if (!is.null(opdf$infill_ei))
+    if (!is.null(opdf[["infill_ei"]]))
       expect_true(!anyMissing(opdf$infill_ei[, c("ei","se","mean")]))
-    if (!is.null(opdf$infill_cb)) {
-      expect_true(!anyMissing(opdf$infill_cb[, c("se","mean","lambda")]))
+    if (!is.null(opdf[["infill_eis"]]))
+      expect_true(!anyMissing(opdf$infill_ei[, c("eis","se","mean")]))
+    if (!is.null(opdf[["infill_cb"]])) {
+      expect_true(!anyMissing(opdf[["infill_cb"]][, c("se","mean","lambda")]))
       expect_true(all(opdf$infill_cb$lambda == 2))
     }
     if (!is.null(opdf$infill_aei))
-      expect_true(!anyMissing(opdf$infill_aei[, c("se","mean","tau")]))
+      expect_true(!anyMissing(opdf[["infill_aei"]][, c("se","mean","tau")]))
     if (!is.null(opdf$infill_eqi))
-      expect_true(!anyMissing(opdf$infill_eqi[, c("se","mean","tau")]))
+      expect_true(!anyMissing(opdf[["infill_eqi"]][, c("se","mean","tau")]))
     expect_true(nrow(opdf$final_eval) == 10L)
   }
 
@@ -94,6 +96,20 @@ test_that("infill crits", {
   des = generateTestDesign(ninit, getParamSet(funs[[1]]$f1))
   or = mbo(funs[[1]]$f1, des, learner = makeLearner("regr.km", predict.type = "se", nugget.estim = TRUE), control = ctrl)
   expect_lt(or$y, 50)
+
+  # special function for EIs
+  f3 = makeSingleObjectiveFunction("test",
+    fn = function(x) {
+      Sys.sleep(runif(1, 0.01, 0.05))
+      sin(x)
+    },
+  par.set = makeParamSet(makeNumericParam("x", lower = -5, upper = 5))
+  )
+  des = generateTestDesign(ninit, getParamSet(f3))
+  for (lrn in learners) {
+    or = mbo(f3, des, learner = lrn, control = mycontrol(crit.eis))
+    mycheck(or, TRUE)
+  }
 })