# NOT RUN {
set.seed(15)
# Example 1 - validation by comparison to finite difference approximations
# a 9-points factorial design, and the corresponding response
d <- 2
n <- 9
design <- expand.grid(seq(0,1,length=3), seq(0,1,length=3))
names(design)<-c("x1", "x2")
design <- data.frame(design)
names(design)<-c("x1", "x2")
y <- apply(design, 1, branin)
y <- data.frame(y)
names(y) <- "y"
# learning
model <- km(~1, design=design, response=y)
# pick up 2 points sampled from the simple expected improvement
q <- 2 # increase to 4 for a more meaningful test
X <- sampleFromEI(model,n=q)
# compute the gradient at the 4-point batch
grad.analytic <- qEI.grad(X,model)
# numerically compute the gradient
grad.numeric <- matrix(NaN,q,d)
eps <- 10^(-6)
EPS <- matrix(0,q,d)
for (i in 1:q) {
for (j in 1:d) {
EPS[i,j] <- eps
grad.numeric[i,j] <- 1/eps*(qEI(X+EPS,model,fastCompute=FALSE)-qEI(X,model,fastCompute=FALSE))
EPS[i,j] <- 0
}
}
print(grad.numeric)
print(grad.analytic)
# }
# NOT RUN {
# graphics: displays the EI criterion, the design points in black,
# the batch points in red and the gradient in blue.
nGrid <- 15
gridAxe1 <- seq(lower[1],upper[1],length=nGrid)
gridAxe2 <- seq(lower[2],upper[2],length=nGrid)
grid <- expand.grid(gridAxe1,gridAxe2)
aa <- apply(grid,1,EI,model=model)
myMat <- matrix(aa,nrow=nGrid)
image(x = gridAxe1, y = gridAxe2, z = myMat,
col = colorRampPalette(c("darkgray","white"))(5*10),
ylab = names(design)[1], xlab=names(design)[2],
main = "qEI-gradient of a batch of 4 points", axes = TRUE,
zlim = c(min(myMat), max(myMat)))
contour(x = gridAxe1, y = gridAxe2, z = myMat,
add = TRUE, nlevels = 10)
points(X[,1],X[,2],pch=19,col='red')
points(model@X[,1],model@X[,2],pch=19)
arrows(X[,1],X[,2],X[,1]+0.012*grad.analytic[,1],X[,2]+0.012*grad.analytic[,2],col='blue')
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab