qEI_loop {hetGP} | R Documentation |
BO loop with qEI
Description
Bayesian optimization loop with parallel EI starting from initial observations
Usage
qEI_loop(X0, Y0, model, q, nrep = 1, fun, budget, lower, upper, control = NULL)
Arguments
X0 |
initial design of experiments matrix |
Y0 |
initial vector of responses at |
model |
|
q |
batch size |
nrep |
number of replicates at the q points, default to 1 |
fun |
test function to minimize |
budget |
optimization budget |
lower , upper |
domain bounds |
control |
list with parameters
|
Value
A list with components:
-
par
: all points evaluated, -
value
: the matrix of objective values at the points given inpar
, -
model
: the last kriging models fitted. -
membest
: a matrix of best estimated designs at each iteration. -
estbest
: corresponding predicted mean values.
Examples
d <- 2
n <- 10*d
N <- 5*n
budget <- 130 # Increase for better results
## Noise field via standard deviation
noiseFun <- function(x){
if(is.null(nrow(x)))
x <- matrix(x, nrow = 1)
return(1/5*(3*(2 + 2*sin(x[,1]*pi)*cos(x[,2]*3*pi) + 5*rowSums(x^2))))
}
## Branin redefined in [0,1]^2
branin <- function(x){
if(is.null(nrow(x))) x <- matrix(x, nrow = 1)
x1 <- x[,1] * 15 - 5
x2 <- x[,2] * 15
return((x2 - 5/(4 * pi^2) * (x1^2) + 5/pi * x1 - 6)^2 + 10 * (1 - 1/(8 * pi)) * cos(x1) + 10)
}
## data generating function combining mean and noise fields
ftest <- function(x){
if(is.null(nrow(x))) x <- matrix(x, nrow = 1)
return(branin(x) + rnorm(nrow(x), mean = 0, sd = noiseFun(x)))
}
ngrid <- 51
Xgrid <- as.matrix(expand.grid(seq(0,1,length.out = ngrid), seq(0,1,length.out = ngrid)))
Ygrid <- branin(Xgrid)
Ygrid <- cbind(Ygrid, noiseFun(Xgrid)^2)
x1 <- c(0.9616520, 0.15); x2 <- c(0.1238946, 0.8166644); x3 <- c(0.5427730, 0.15)
fstar <- 0.3978874
X0 <- matrix(runif(n*d),n, d)
X0 <- X0[sample(1:n, size = N, replace = TRUE),]
Y0 <- ftest(X0)
mod <- mleHetGP(X0, Y0, covtype = "Matern5_2", known = list(beta0 = 0))
opt <- qEI_loop(X0, Y0, mod, q = 10, nrep = 1, fun = ftest, budget = budget,
lower = rep(0, d), upper = rep(1, d))
est <- predict(opt$model, opt$model$X0)$mean
xbest <- opt$model$X0[which.min(est),,drop=FALSE]
par(mfrow = c(1, 2))
contour(matrix(Ygrid[,1], ngrid), nlevels = 21,
main = "True function")
points(opt$model$X0, col = 4, pch = 20, cex = opt$model$mult/10)
points(rbind(t(x1), t(x2), t(x3)), pch=20, col="red")
points(xbest, col = "pink", pch = 15)
contour(matrix(sqrt(Ygrid[,2]^2), ngrid), nlevels = 21,
main = "True variance")
points(rbind(t(x1), t(x2), t(x3)), pch=20, col="red")
points(opt$model$X0, col = 4, pch = 20, cex = opt$model$mult/10)
points(xbest, col = "pink", pch = 15)
par(mfrow = c(1, 1))