fastfun {GPareto}

Fast-to-evaluate function wrapper

Description

Modification of an R function to be used with methods predict and update (similar to a km object). It creates an S4 object which contains the values corresponding to evaluations of other costly observations. It is useful when an objective can be evaluated fast.

Usage

fastfun(fn, design, response = NULL)

Arguments

fn

the evaluator function, found by a call to match.fun,

design

a data frame representing the design of experiments. The ith row contains the values of the d input variables corresponding to the ith evaluation.

response

optional vector (or 1-column matrix or data frame) containing the values of the 1-dimensional output given by the objective function at the design points.

Value

An object of class fastfun-class.

Examples

########################################################
## Example with a fast to evaluate objective
########################################################
## Not run: 
set.seed(25468)
library(DiceDesign)

d <- 2 

fname <- P1
n.grid <- 21
nappr <- 11 
design.grid <- maximinESE_LHS(lhsDesign(nappr, d, seed = 42)$design)$design
response.grid <- t(apply(design.grid, 1, fname))
Front_Pareto <- t(nondominated_points(t(response.grid)))

mf1 <- km(~., design = design.grid, response = response.grid[,1])
mf2 <- km(~., design = design.grid, response = response.grid[,2])
model <- list(mf1, mf2)

nsteps <- 5 
lower <- rep(0, d)
upper <- rep(1, d)

# Optimization reference: SMS with discrete search
optimcontrol <- list(method = "pso")
omEGO1 <- GParetoptim(model = model, fn = fname, crit = "SMS", nsteps = nsteps,
                     lower = lower, upper = upper, optimcontrol = optimcontrol)
print(omEGO1$par)
print(omEGO1$values)
plot(response.grid, xlim = c(0,300), ylim = c(-40,0), pch = 17, col = "blue")
points(omEGO1$values, pch = 20, col ="green") 

# Optimization with fastfun: SMS with discrete search
# Separation of the problem P1 in two objectives: 
# the first one to be kriged, the second one with fastobj
f1 <-   function(x){
  if(is.null(dim(x))) x <- matrix(x, nrow = 1) 
  b1 <- 15*x[,1] - 5
  b2 <- 15*x[,2]
  return(  (b2 - 5.1*(b1/(2*pi))^2 + 5/pi*b1 - 6)^2 +10*((1 - 1/(8*pi))*cos(b1) + 1))
}

f2 <-   function(x){
  if(is.null(dim(x))) x <- matrix(x, nrow = 1) 
  b1<-15*x[,1] - 5
  b2<-15*x[,2]
  return(-sqrt((10.5 - b1)*(b1 + 5.5)*(b2 + 0.5))
         - 1/30*(b2 - 5.1*(b1/(2*pi))^2 - 6)^2
         - 1/3*((1 - 1/(8*pi))*cos(b1) + 1)) 
}

optimcontrol <- list(method = "pso")
model2 <- list(mf1)
omEGO2 <- GParetoptim(model = model2, fn = f1, cheapfn = f2, crit = "SMS", nsteps = nsteps,
                     lower = lower, upper = upper, optimcontrol = optimcontrol)
print(omEGO2$par)
print(omEGO2$values)

points(omEGO2$values, col = "red", pch = 15)

## End(Not run)