# Expected Quantile Improvement Evaluation of the Expected Quantile Improvement (EQI) criterion. ```r EQI( x, model, new.noise.var = 0, beta = 0.9, q.min = NULL, type = "UK", envir = NULL ) ``` ## Arguments - `x`: the input vector at which one wants to evaluate the criterion - `model`: a Kriging model of "km" class - `new.noise.var`: (scalar) noise variance of the future observation. Default value is 0 (noise-free observation). - `beta`: Quantile level (default value is 0.9) - `q.min`: Best kriging quantile. If not provided, this quantity is evaluated. - `type`: Kriging type: "SK" or "UK" - `envir`: environment for saving intermediate calculations and reusing them within EQI.grad ## Returns Expected Quantile Improvement ## Examples ```r ########################################################################## ### EQI SURFACE ASSOCIATED WITH AN ORDINARY KRIGING MODEL #### ### OF THE BRANIN FUNCTION KNOWN AT A 12-POINT LATIN HYPERCUBE DESIGN #### ########################################################################## set.seed(421) # Set test problem parameters doe.size <- 12 dim <- 2 test.function <- get("branin2") lower <- rep(0,1,dim) upper <- rep(1,1,dim) noise.var <- 0.2 # Generate DOE and response doe <- as.data.frame(matrix(runif(doe.size*dim),doe.size)) y.tilde <- rep(0, 1, doe.size) for (i in 1:doe.size) { y.tilde[i] <- test.function(doe[i,]) + sqrt(noise.var)*rnorm(n=1) } y.tilde <- as.numeric(y.tilde) # Create kriging model model <- km(y~1, design=doe, response=data.frame(y=y.tilde), covtype="gauss", noise.var=rep(noise.var,1,doe.size), lower=rep(.1,dim), upper=rep(1,dim), control=list(trace=FALSE)) # Compute actual function and criterion on a grid n.grid <- 12 # Change to 21 for a nicer picture x.grid <- y.grid <- seq(0,1,length=n.grid) design.grid <- expand.grid(x.grid, y.grid) nt <- nrow(design.grid) crit.grid <- apply(design.grid, 1, EQI, model=model, new.noise.var=noise.var, beta=.9) func.grid <- apply(design.grid, 1, test.function) # Compute kriging mean and variance on a grid names(design.grid) <- c("V1","V2") pred <- predict(model, newdata=design.grid, type="UK", checkNames = FALSE) mk.grid <- pred$m sk.grid <- pred$sd # Plot actual function z.grid <- matrix(func.grid, n.grid, n.grid) filled.contour(x.grid,y.grid, z.grid, nlevels=50, color = rainbow, plot.axes = {title("Actual function"); points(model@X[,1],model@X[,2],pch=17,col="blue"); axis(1); axis(2)}) # Plot Kriging mean z.grid <- matrix(mk.grid, n.grid, n.grid) filled.contour(x.grid,y.grid, z.grid, nlevels=50, color = rainbow, plot.axes = {title("Kriging mean"); points(model@X[,1],model@X[,2],pch=17,col="blue"); axis(1); axis(2)}) # Plot Kriging variance z.grid <- matrix(sk.grid^2, n.grid, n.grid) filled.contour(x.grid,y.grid, z.grid, nlevels=50, color = rainbow, plot.axes = {title("Kriging variance"); points(model@X[,1],model@X[,2],pch=17,col="blue"); axis(1); axis(2)}) # Plot EQI criterion z.grid <- matrix(crit.grid, n.grid, n.grid) filled.contour(x.grid,y.grid, z.grid, nlevels=50, color = rainbow, plot.axes = {title("EQI"); points(model@X[,1],model@X[,2],pch=17,col="blue"); axis(1); axis(2)}) ``` ## References Picheny, V., Ginsbourger, D., Richet, Y., Caplin, G. (2013). Quantile-based optimization of noisy computer experiments with tunable precision. **Technometrics**, 55(1), 2-13. ## Author(s) Victor Picheny David Ginsbourger

EQI function