add function to check for constant model while focussearch

R/doc_mbo_OptPath.R

@@ -19,6 +19,7 @@
 #' }
 #' \item{multipoint.cb.lambda}{Random lambda-value used in q-CB point proposal. One lambda for each point in that case.}
 #' \item{parego.weight}{Weight vector sampled for multipoint ParEGO}
+#' \item{constant.model}{If CMAES or Focussearch is used to optimize the infill crit, they can automatically determine if the model is constant in this iteration.}
 #' }
 #'
 #' Moreover, the user may pass additional \dQuote{user extras} by appending a named list

R/getExtras.R

@@ -61,6 +61,12 @@ getExtras = function(n, prop, train.time, control) {
     if (control$filter.proposed.points) {
       ex$filter.replace = prop$filter.replace[i]
     }
+    if (isTRUE(attr(prop$prop.points, "constant.model"))) {
+      ex$constant.model = TRUE
+    } else {
+      ex$constant.model = FALSE
+    }
+    # if we use asyn MBO store node information and evaluation starte
     ex$train.time = if (i == 1) train.time else NA_real_
     ex$prop.type = prop$prop.type[i]
     ex$propose.time = NA_real_

R/infillOptCMAES.R

@@ -45,12 +45,15 @@ infillOptCMAES = function(infill.crit, models, control, par.set, opt.path, desig
   for (i in 1:control$infill.opt.restarts) {
     if (i == 1) {
       start = getOptPathEl(opt.path, getOptPathBestIndex(opt.path))$x
+      cmaes.control = insert(list(diag.value = TRUE), control$infill.opt.cmaes.control)
     } else {
       start = sampleValue(par.set)
     }
     start = unlist(start)
-    results[[i]] = cmaes::cma_es(par = start, fn = f, lower = low, upper = upp, control = control$infill.opt.cmaes.control)
+    results[[i]] = cmaes::cma_es(par = start, fn = f, lower = low, upper = upp, control = cmaes.control)
   }
+  # check if the model just gives constant values
+  constant.model = (length(unique(as.vector(results[[i]]$diagnostic$value))) == 1)
   ys = extractSubList(results, "value")
   ys = ys[!is.infinite(ys)]
   res = NULL
@@ -62,7 +65,8 @@ infillOptCMAES = function(infill.crit, models, control, par.set, opt.path, desig
     j = which(rank(ys, ties.method = "random") == 1L)
     res = t(results[[j]]$par)
   }
-  setColNames(as.data.frame(res), rep.pids)
+  res = setColNames(as.data.frame(res), rep.pids)
+  setAttribute(res, "constant.model", constant.model)
 }
 
 # FIXME: allow DiceOptim optimizer later...

R/infillOptFocus.R

@@ -8,6 +8,7 @@
 # See infillOptCMAES.R for interface explanation.
 infillOptFocus = function(infill.crit, models, control, par.set, opt.path, design, iter, ...) {
   global.y = Inf
+  constant.model = FALSE
 
   # restart the whole crap some times
   for (restart.iter in seq_len(control$infill.opt.restarts)) {
@@ -24,11 +25,15 @@ infillOptFocus = function(infill.crit, models, control, par.set, opt.path, desig
       y = infill.crit(newdesign, models, control, ps.local, design, iter, ...)
 
       # get current best value
-      local.index = getMinIndex(y, ties.method = "random")
+      local.index = getMinIndex(y, ties.method = "random", na.rm = TRUE)
       local.y = y[local.index]
       local.x.df = newdesign[local.index, , drop = FALSE]
       local.x.list = dfRowToList(recodeTypes(local.x.df, ps.local), ps.local, 1)
 
+      # check if the model just gives constant values
+      if (local.iter == 1 && length(unique(y)) == 1) 
+        constant.model = TRUE
+
       # if we found a new best value, store it
       if (local.y < global.y) {
         global.x.df = local.x.df
@@ -64,7 +69,7 @@ infillOptFocus = function(infill.crit, models, control, par.set, opt.path, desig
       })
     }
   }
-  recodeTypes(global.x.df, par.set)
+  setAttribute(recodeTypes(global.x.df, par.set), "constant.model", constant.model)
 }
 
 # as we operate on other types for the learner (ints are nums, logs are factors),

R/makeMBOControl.R

@@ -122,7 +122,7 @@ makeMBOControl = function(n.objectives = 1L,
   assertList(resample.measures, types = "Measure")
 
   assertString(output.num.format)
-
+ 
   control = makeS3Obj("MBOControl",
     n.objectives = n.objectives,
     propose.points = propose.points,

tests/testthat/test_mbo_km.R

@@ -67,3 +67,17 @@ test_that("mbo works with impute and failure model", {
   expect_true(!is.na(op$error.model[13L]))
   expect_true(!is.na(op$error.model[14L]))
 })
+
+test_that("mbo recognizes constant model prediction", {
+  des = testd.fsphere.2d
+  des$y = mean(apply(des, 1, testf.fsphere.2d))
+  # make sure model does not break, and we get a failure model
+  learner = makeLearner("regr.km")
+  ctrl = makeMBOControl()
+  ctrl = setMBOControlTermination(ctrl, iters = 4L)
+  ctrl = setMBOControlInfill(ctrl, opt.focussearch.points = 100L)
+  or = mbo(testf.fsphere.2d, des, learner = learner, control = ctrl)
+  expect_equal(getOptPathLength(or$opt.path), 14)
+  op = as.data.frame(or$opt.path)
+  expect_true(sum(op$constant.model)<5)
+})