a numeric vector z containing x then lambda values.
dimx
dimension of x.
dimlam
dimension of lambda.
grobj
gradient of the objective function, see details.
arggrobj
a list of additional arguments of the objective gradient.
constr
constraint function, see details.
argconstr
a list of additional arguments of the constraint function.
grconstr
gradient of the constraint function, see details.
arggrconstr
a list of additional arguments of the constraint gradient.
dimmu
a vector of dimension for mu.
joint
joint function, see details.
argjoint
a list of additional arguments of the joint function.
grjoint
gradient of the joint function, see details.
arggrjoint
a list of additional arguments of the joint gradient.
heobj
Hessian of the objective function, see details.
argheobj
a list of additional arguments of the objective Hessian.
heconstr
Hessian of the constraint function, see details.
argheconstr
a list of additional arguments of the constraint Hessian.
hejoint
Hessian of the joint function, see details.
arghejoint
a list of additional arguments of the joint Hessian.
echo
a logical to show some traces.
Details
Compute the H function or the Jacobian of the H function defined in Dreves et al.(2009).
Arguments of the H function
The arguments which are functions must respect the following features
grobj
The gradient Grad Obj of an objective function Obj (to be minimized) must have 3 arguments for Grad Obj(z, playnum, ideriv): vector z, player number, derivative index
, and optionnally additional arguments in arggrobj.
constr
The constraint function g must have 2 arguments: vector z, player number,
such that g(z, playnum) <= 0. Optionnally, g may have additional arguments in argconstr.
grconstr
The gradient of the constraint function g must have 3 arguments: vector z, player number, derivative index,
and optionnally additional arguments in arggrconstr.
Arguments of the Jacobian of H
The arguments which are functions must respect the following features
heobj
It must have 4 arguments: vector z, player number, two derivative indexes.
heconstr
It must have 4 arguments: vector z, player number, two derivative indexes.
Optionnally, heobj and heconstr can have additional arguments argheobj and argheconstr.
See the example below.
Value
A vector for funCER or a matrix for jacCER.
Author(s)
Christophe Dutang
References
Dreves, A., Facchinei, F., Kanzow, C. and Sagratella, S. (2011),
On the solutions of the KKT conditions of generalized Nash equilibrium problems,
SIAM Journal on Optimization.
F. Facchinei, A. Fischer and V. Piccialli (2009),
Generalized Nash equilibrium problems and Newton methods,
Math. Program.
See Also
See also GNE.ceq.
Examples
#-------------------------------------------------------------------------------
# (1) Example 5 of von Facchinei et al. (2007)
#-------------------------------------------------------------------------------
dimx <- c(1, 1)
#Gr_x_j O_i(x)
grobj <- function(x, i, j)
{
if(i == 1)
res <- c(2*(x[1]-1), 0)
if(i == 2)
res <- c(0, 2*(x[2]-1/2))
res[j]
}
#Gr_x_k Gr_x_j O_i(x)
heobj <- function(x, i, j, k)
2 * (i == j && j == k)
dimlam <- c(1, 1)
#constraint function g_i(x)
g <- function(x, i)
sum(x[1:2]) - 1
#Gr_x_j g_i(x)
grg <- function(x, i, j)
1
#Gr_x_k Gr_x_j g_i(x)
heg <- function(x, i, j, k)
0
x0 <- rep(0, sum(dimx))
z0 <- c(x0, 2, 2, max(10, 5-g(x0, 1) ), max(10, 5-g(x0, 2) ) )
#true value is (3/4, 1/4, 1/2, 1/2)
funCER(z0, dimx, dimlam, grobj=grobj,
constr=g, grconstr=grg)
jacCER(z0, dimx, dimlam, heobj=heobj,
constr=g, grconstr=grg, heconstr=heg)
#-------------------------------------------------------------------------------
# (2) Duopoly game of Krawczyk and Stanislav Uryasev (2000)
#-------------------------------------------------------------------------------
#constants
myarg <- list(d= 20, lambda= 4, rho= 1)
dimx <- c(1, 1)
#Gr_x_j O_i(x)
grobj <- function(x, i, j, arg)
{
res <- -arg$rho * x[i]
if(i == j)
res <- res + arg$d - arg$lambda - arg$rho*(x[1]+x[2])
-res
}
#Gr_x_k Gr_x_j O_i(x)
heobj <- function(x, i, j, k, arg)
arg$rho * (i == j) + arg$rho * (j == k)
dimlam <- c(1, 1)
#constraint function g_i(x)
g <- function(x, i)
-x[i]
#Gr_x_j g_i(x)
grg <- function(x, i, j)
-1*(i == j)
#Gr_x_k Gr_x_j g_i(x)
heg <- function(x, i, j, k)
0
#true value is (16/3, 16/3, 0, 0)
x0 <- rep(0, sum(dimx))
z0 <- c(x0, 2, 2, max(10, 5-g(x0, 1) ), max(10, 5-g(x0, 2) ) )
funCER(z0, dimx, dimlam, grobj=grobj, arggrobj=myarg,
constr=g, grconstr=grg)
jacCER(z0, dimx, dimlam, heobj=heobj,
argheobj=myarg, constr=g, grconstr=grg, heconstr=heg)
Results
R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> library(GNE)
Loading required package: alabama
Loading required package: numDeriv
Loading required package: nleqslv
Loading required package: BB
Loading required package: SQUAREM
> png(filename="/home/ddbj/snapshot/RGM3/R_CC/result/GNE/util-CER.Rd_%03d_medium.png", width=480, height=480)
> ### Name: CER
> ### Title: Constrained Equation Reformulation
> ### Aliases: CER funCER jacCER
> ### Keywords: math optimize
>
> ### ** Examples
>
>
>
>
> #-------------------------------------------------------------------------------
> # (1) Example 5 of von Facchinei et al. (2007)
> #-------------------------------------------------------------------------------
>
> dimx <- c(1, 1)
> #Gr_x_j O_i(x)
> grobj <- function(x, i, j)
+ {
+ if(i == 1)
+ res <- c(2*(x[1]-1), 0)
+ if(i == 2)
+ res <- c(0, 2*(x[2]-1/2))
+ res[j]
+ }
> #Gr_x_k Gr_x_j O_i(x)
> heobj <- function(x, i, j, k)
+ 2 * (i == j && j == k)
>
> dimlam <- c(1, 1)
> #constraint function g_i(x)
> g <- function(x, i)
+ sum(x[1:2]) - 1
> #Gr_x_j g_i(x)
> grg <- function(x, i, j)
+ 1
> #Gr_x_k Gr_x_j g_i(x)
> heg <- function(x, i, j, k)
+ 0
>
>
> x0 <- rep(0, sum(dimx))
> z0 <- c(x0, 2, 2, max(10, 5-g(x0, 1) ), max(10, 5-g(x0, 2) ) )
>
> #true value is (3/4, 1/4, 1/2, 1/2)
> funCER(z0, dimx, dimlam, grobj=grobj,
+ constr=g, grconstr=grg)
[1] 0 1 9 9 20 20
>
> jacCER(z0, dimx, dimlam, heobj=heobj,
+ constr=g, grconstr=grg, heconstr=heg)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 2 0 1 0 0 0
[2,] 0 2 0 1 0 0
[3,] 1 1 0 0 1 0
[4,] 1 1 0 0 0 1
[5,] 0 0 10 0 2 0
[6,] 0 0 0 10 0 2
>
>
>
> #-------------------------------------------------------------------------------
> # (2) Duopoly game of Krawczyk and Stanislav Uryasev (2000)
> #-------------------------------------------------------------------------------
>
>
> #constants
> myarg <- list(d= 20, lambda= 4, rho= 1)
>
> dimx <- c(1, 1)
> #Gr_x_j O_i(x)
> grobj <- function(x, i, j, arg)
+ {
+ res <- -arg$rho * x[i]
+ if(i == j)
+ res <- res + arg$d - arg$lambda - arg$rho*(x[1]+x[2])
+ -res
+ }
> #Gr_x_k Gr_x_j O_i(x)
> heobj <- function(x, i, j, k, arg)
+ arg$rho * (i == j) + arg$rho * (j == k)
>
>
> dimlam <- c(1, 1)
> #constraint function g_i(x)
> g <- function(x, i)
+ -x[i]
> #Gr_x_j g_i(x)
> grg <- function(x, i, j)
+ -1*(i == j)
> #Gr_x_k Gr_x_j g_i(x)
> heg <- function(x, i, j, k)
+ 0
>
> #true value is (16/3, 16/3, 0, 0)
>
> x0 <- rep(0, sum(dimx))
> z0 <- c(x0, 2, 2, max(10, 5-g(x0, 1) ), max(10, 5-g(x0, 2) ) )
>
>
> funCER(z0, dimx, dimlam, grobj=grobj, arggrobj=myarg,
+ constr=g, grconstr=grg)
[1] -18 -18 10 10 20 20
>
> jacCER(z0, dimx, dimlam, heobj=heobj,
+ argheobj=myarg, constr=g, grconstr=grg, heconstr=heg)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 2 1 -1 0 0 0
[2,] 1 2 0 -1 0 0
[3,] -1 0 0 0 1 0
[4,] 0 -1 0 0 0 1
[5,] 0 0 10 0 2 0
[6,] 0 0 0 10 0 2
>
>
>
>
>
>
>
>
>
>
> dev.off()
null device
1
>