crit_PNash {GPGame}

Probability for a strategy of being a Nash Equilibrium

Description

Acquisition function for solving game problems based on the probability for a strategy of being a Nash Equilibrium. The probability can be computed exactly using the mutivariate Gaussian CDF (mnormt, pmvnorm) or by Monte Carlo.

Usage

crit_PNash(
  idx,
  integcontrol,
  type = "simu",
  model,
  ncores = 1,
  control = list(nsim = 100, eps = 1e-06)
)

Arguments

idx

is the index on the grid of the strategy evaluated

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 containting the number of strategies per player

type

'exact' or 'simu'

model

is a list of nobj km models

ncores

mclapply is used if > 1 for parallel evaluation

control

list with slots nsim (number of conditional simulations for computation) and eps

eps

numerical jitter for stability

Value

Probability of being a Nash equibrium corrsponding to idx.

References

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

See Also

crit_SUR_Eq for an alternative infill criterion

Examples

##############################################
# Example 1: 2 variables, 2 players, no filter
##############################################
library(DiceKriging)
set.seed(42)

# Define 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(11, 2)
x.to.obj   <- c(1,2)
gridtype <- 'cartesian'
integcontrol <- generate_integ_pts(n.s=n.s, d=2, nobj=2, x.to.obj = x.to.obj, gridtype=gridtype)

test.grid <- integcontrol$integ.pts
expanded.indices <- integcontrol$expanded.indices
n.init <- 11
design <- test.grid[sample.int(n=nrow(test.grid), 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)

crit_sim <- crit_PNash(idx=1:nrow(test.grid), integcontrol=integcontrol,
                       type = "simu", model=model, control = list(nsim = 100))
crit_ex <- crit_PNash(idx=1:nrow(test.grid), integcontrol=integcontrol, type = "exact", model=model)

filled.contour(seq(0, 1, length.out = n.s[1]), seq(0, 1, length.out = n.s[2]), zlim = c(0, 0.7),
               matrix(pmax(0, crit_sim), n.s[1], n.s[2]), main = "Pnash criterion (MC)",
               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")
                           }
)

filled.contour(seq(0, 1, length.out = n.s[1]), seq(0, 1, length.out = n.s[2]), zlim = c(0, 0.7),
               matrix(pmax(0, crit_ex), n.s[1], n.s[2]), main = "Pnash criterion (exact)",
               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")
                           }
)