#####################################################################
#a 9-point full factorial initial design
design.fact <- expand.grid(seq(0,1,length=3), seq(0,1,length=3))
design.fact <- data.frame(design.fact)
names(design.fact) <- c ( "x1","x2")
testfun <- camelback2 #our test function
#the response
response <- testfun(design.fact)
#the initial km model
model <- km(formula=~., design = design.fact, response = response,
covtype="matern5_2")
#the integration points
n.grid <- 20
x.grid <- y.grid <- seq(0,1,length=n.grid)
design.grid <- expand.grid(x.grid, y.grid)
#compute weight on the grid
T <- 0
epsilon <- 0.01
krig <- predict.km(model, newdata=as.data.frame(design.grid), "UK")
mk <- krig$mean
sk <- krig$sd
weight <- 1/sqrt(2*pi*(sk^2+epsilon^2))*exp(-0.5*((mk-T)/sqrt(sk^2+epsilon^2))^2)
weight[is.nan(weight)] <- 0
#evaluate criterion on the grid
timse.EI.grid <- apply(design.grid, 1, timse_optim, weight=weight,
model=model, integration.points=design.grid)
z.grid <- matrix(timse.EI.grid, n.grid, n.grid)
#plots: contour of the criterion, doe points and new point
contour(x.grid,y.grid,z.grid,25)
points(design.fact, col="black", pch=20, lwd=4)
#plots: contour of the actual function at threshold
testfun.grid <- testfun(design.grid)
z.grid.2 <- matrix(testfun.grid, n.grid, n.grid)
contour(x.grid,y.grid,z.grid.2,levels=T,col="blue",add=TRUE)
title("Contour lines of timse criterion (black) and of f(x)=T (blue)")
#search best point with Genoud
opt <- max_timse(lower=c(0,0), upper=c(1,1), T=T, epsilon=epsilon,
model=model, integration.points=design.grid)
points(opt$par, col="blue", pch=20, lwd=4)
#####################################################################
Run the code above in your browser using DataLab