crit_SUR_Eq: SUR criterion for equilibria
In GPGame: Solving Complex Game Problems using Gaussian Processes

Description Usage Arguments Value References See Also Examples

View source: R/crit_SUR.R

Computes the SUR criterion associated to an equilibrium for a given xnew and a set of trajectories of objective functions on a predefined grid.

crit_SUR_Eq(
  idx,
  model,
  integcontrol,
  Simu,
  precalc.data = NULL,
  equilibrium,
  n.ynew = NULL,
  cross = FALSE,
  IS = FALSE,
  plot = FALSE,
  kweights = NULL,
  Nadir = NULL,
  Shadow = NULL,
  calibcontrol = NULL
)

`idx`	is the index on the grid of the strategy evaluated
`model`	is a list of `nobj` `km` models
`integcontrol`	is a list containing: `integ.pts`, a [`npts x dim`] matrix defining the grid, `expanded.indices` a matrix containing the indices of the `integ.pts` on the grid and `n.s`, a `nobj` vector containing the number of strategies per player
`Simu`	is a matrix of size [`npts x nsim*nobj`] containing the trajectories of the objective functions (one column per trajectory, first all the trajectories for obj1, then obj2, etc.)
`precalc.data`	is a list of length `nobj` of precalculated data (based on kriging models at integration points) for faster computation - computed if not provided
`equilibrium`	equilibrium type: either "`NE`", "`KSE`", "`CKSE`" or "`NKSE`"
`n.ynew`	is the number of `ynew` simulations (if not provided, equal to the number of trajectories)
`cross`	if `TRUE`, all the combinations of trajectories are used (increases accuracy but also cost)
`IS`	if `TRUE`, importance sampling is used for ynew
`plot`	if `TRUE`, draws equilibria samples (should always be turned off)
`kweights`	kriging weights for `CKS` (TESTING)
`Nadir, Shadow`	optional vectors of size `nobj`. Replaces the nadir or shadow point for `KSE`. If only a subset of values needs to be defined, the other coordinates can be set to `Inf` (resp. -`Inf` for the shadow).
`calibcontrol`	an optional list for calibration problems, containing `target` a vector of target values for the objectives, `log` a Boolean stating if a log transformation should be used or not aand , and `offset` a (small) scalar so that each objective is log(offset + (y-T^2)).

Criterion value.

V. Picheny, M. Binois, A. Habbal (2016+), A Bayesian optimization approach to find Nash equilibria, https://arxiv.org/abs/1611.02440.

crit_PNash for an alternative infill criterion

##############################################
# 2 variables, 2 players
##############################################
library(DiceKriging)
set.seed(42)

# Objective function (R^2 -> R^2)
fun <- function (x)
{
  if (is.null(dim(x)))    x <- matrix(x, nrow = 1)
 b1 <- 15 * x[, 1] - 5
 b2 <- 15 * x[, 2]
 return(cbind((b2 - 5.1*(b1/(2*pi))^2 + 5/pi*b1 - 6)^2 + 10*((1 - 1/(8*pi)) * cos(b1) + 1),
               -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)))
}

# Grid definition
n.s <- rep(14, 2)
x.to.obj   <- c(1,2)
gridtype <- 'cartesian'
integcontrol <- generate_integ_pts(n.s=n.s, d=4, nobj=2, x.to.obj = x.to.obj, gridtype=gridtype)
integ.pts <- integcontrol$integ.pts
expanded.indices <- integcontrol$expanded.indices

# Kriging models
n.init <- 11
design <- integ.pts[sample.int(n=nrow(integ.pts), size=n.init, replace=FALSE),]
response <- t(apply(design, 1, fun))
mf1 <- km(~., design = design, response = response[,1], lower=c(.1,.1))
mf2 <- km(~., design = design, response = response[,2], lower=c(.1,.1))
model <- list(mf1, mf2)

# Conditional simulations
Simu <- t(Reduce(rbind, lapply(model, simulate, nsim=10, newdata=integ.pts, cond=TRUE,
                                   checkNames=FALSE, nugget.sim = 10^-8)))

# Useful precalculations with the package KrigInv can be reused for computational speed.
# library(KrigInv)
# precalc.data <- lapply(model, FUN=KrigInv:::precomputeUpdateData, integration.points=integ.pts)

# Compute criterion for all points on the grid
crit_grid <- lapply(X=1:prod(n.s), FUN=crit_SUR_Eq, model=model,
                    integcontrol=integcontrol, equilibrium = "NE",
                    # precalc.data=precalc.data, # Uncomment if precalc.data is computed
                    Simu=Simu, n.ynew=10, IS=FALSE, cross=FALSE)
crit_grid <- unlist(crit_grid)

# Draw contour of the criterion
filled.contour(seq(0, 1, length.out = n.s[1]), seq(0, 1, length.out = n.s[2]),
               matrix(pmax(0, crit_grid), n.s[1], n.s[2]), main = "SUR criterion",
               xlab = expression(x[1]), ylab = expression(x[2]), color = terrain.colors,
               plot.axes = {axis(1); axis(2);
                            points(design[,1], design[,2], pch = 21, bg = "white")
                           }
)