Learn R Programming

DiceOptim (version 2.0)

crit_SUR_cst: Stepwise Uncertainty Reduction criterion

Description

Computes the Stepwise Uncertainty Reduction (SUR) criterion at current location

Usage

crit_SUR_cst(x, model.fun, model.constraint, equality = FALSE, critcontrol = NULL, type = "UK")

Arguments

x
a vector representing the input for which one wishes to calculate SUR,
model.fun
object of class km corresponding to the objective function, or, if the objective function is fast-to-evaluate, a fastfun object,
model.constraint
either one or a list of objects of class km, one for each constraint function,
equality
either FALSE if all constraints are for inequalities, else a vector of boolean indicating which are equalities
critcontrol
optional list with arguments:
  • tolConstraints optional vector giving a tolerance (> 0) for each of the constraints (equality or inequality). It is highly recommended to use it when there are equality constraints since the default tolerance of 0.05 in such case might not be suited;
  • integration.points and integration.weights: optional matrix and vector of integration points;
  • precalc.data.cst, precalc.data.obj, mn.X.cst, sn.X.cst, mn.X.obj, sn.X.obj: useful quantities for the fast evaluation of the criterion.
  • Options for the checkPredict function: threshold (1e-4) and distance (covdist) are used to avoid numerical issues occuring when adding points too close to the existing ones.
type
"SK" or "UK" (by default), depending whether uncertainty related to trend estimation has to be taken into account.

Value

The Stepwise Uncertainty Reduction criterion at x.

References

V. Picheny (2014), A stepwise uncertainty reduction approach to constrained global optimization, Proceedings of the 17th International Conference on Artificial Intelligence and Statistics, JMLR W&CP 33, 787-795.

See Also

EI from package DiceOptim, crit_EFI, crit_AL.

Examples

Run this code
#---------------------------------------------------------------------------
# Stepwise Uncertainty Reduction criterion surface with one inequality constraint
#---------------------------------------------------------------------------

set.seed(25468)
library(DiceDesign)

n_var <- 2
fun.obj <- goldsteinprice
fun.cst <- function(x){return(-branin(x) + 25)}
n.grid <- 21
test.grid <- expand.grid(X1 = seq(0, 1, length.out = n.grid), X2 = seq(0, 1, length.out = n.grid))
obj.grid <- apply(test.grid, 1, fun.obj)
cst.grid <- apply(test.grid, 1, fun.cst)

n_appr <- 15
design.grid <- round(maximinESE_LHS(lhsDesign(n_appr, n_var, seed = 42)$design)$design, 1)
obj.init <- apply(design.grid, 1, fun.obj)
cst.init <- apply(design.grid, 1, fun.cst)
model.fun <- km(~., design = design.grid, response = obj.init)
model.constraint <- km(~., design = design.grid, response = cst.init)

integration.param <- integration_design_cst(integcontrol =list(integration.points = test.grid),
                                            lower = rep(0, n_var), upper = rep(1, n_var))

SUR_grid <- apply(test.grid, 1, crit_SUR_cst, model.fun = model.fun,
                  model.constraint = model.constraint, critcontrol=integration.param)

filled.contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid), nlevels = 50,
               matrix(SUR_grid, n.grid), main = "SUR criterion",
               xlab = expression(x[1]), ylab = expression(x[2]), color = terrain.colors,
               plot.axes = {axis(1); axis(2);
                            points(design.grid[,1], design.grid[,2], pch = 21, bg = "white")
                            contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid),
                            matrix(obj.grid, n.grid), nlevels = 10,
                                   add=TRUE,drawlabels=TRUE, col = "black")
                            contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid),
                            matrix(cst.grid, n.grid), level = 0, add=TRUE,
                                   drawlabels=FALSE,lwd=1.5, col = "red")
                            }
              )

#---------------------------------------------------------------------------
# SUR with one inequality and one equality constraint
#---------------------------------------------------------------------------

set.seed(25468)
library(DiceDesign)

n_var <- 2
fun.obj <- goldsteinprice
fun.cstineq <- function(x){return(3/2 - x[1] - 2*x[2] - .5*sin(2*pi*(x[1]^2 - 2*x[2])))}
fun.csteq <- function(x){return(branin(x) - 25)}
n.grid <- 21
test.grid <- expand.grid(X1 = seq(0, 1, length.out = n.grid), X2 = seq(0, 1, length.out = n.grid))
obj.grid <- apply(test.grid, 1, fun.obj)
cstineq.grid <- apply(test.grid, 1, fun.cstineq)
csteq.grid <- apply(test.grid, 1, fun.csteq)
n_appr <- 25
design.grid <- round(maximinESE_LHS(lhsDesign(n_appr, n_var, seed = 42)$design)$design, 1)
obj.init <- apply(design.grid, 1, fun.obj)
cstineq.init <- apply(design.grid, 1, fun.cstineq)
csteq.init <- apply(design.grid, 1, fun.csteq)
model.fun <- km(~., design = design.grid, response = obj.init)
model.constraintineq <- km(~., design = design.grid, response = cstineq.init)
model.constrainteq <- km(~., design = design.grid, response = csteq.init)

models.cst <- list(model.constraintineq, model.constrainteq)

SUR_grid <- apply(test.grid, 1, crit_SUR_cst, model.fun = model.fun, model.constraint = models.cst,
                  equality = c(FALSE, TRUE), critcontrol = list(tolConstraints = c(0.05, 3),
                  integration.points=integration.param$integration.points))

filled.contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid), nlevels = 50,
               matrix(SUR_grid, n.grid), main = "SUR criterion",
               xlab = expression(x[1]), ylab = expression(x[2]), color = terrain.colors,
               plot.axes = {axis(1); axis(2);
                            points(design.grid[,1], design.grid[,2], pch = 21, bg = "white")
                            contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid),
                            matrix(obj.grid, n.grid), nlevels = 10,
                                   add=TRUE,drawlabels=TRUE, col = "black")
                            contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid),
                            matrix(cstineq.grid, n.grid), level = 0, add=TRUE,
                                   drawlabels=FALSE,lwd=1.5, col = "red")
                            contour(seq(0, 1, length.out = n.grid), seq(0, 1, length.out = n.grid),
                            matrix(csteq.grid, n.grid), level = 0, add=TRUE,
                                   drawlabels=FALSE,lwd=1.5, col = "orange")
                            }
              )

Run the code above in your browser using DataLab