tests/NIRandVIPexample.R

In GNE: Computation of Generalized Nash Equilibria

if(!require("GNE"))stop("this test requires package GNE.")

#-------------------------------------------------------------------------------
# (4) Example of GNE with 4 solutions(!)
#-------------------------------------------------------------------------------

myarg <- list(C=c(2, 3), D=c(4,0))

dimx <- c(1, 1)


#O_i(x)
obj <- function(x, i, arg)
	(x[i] - arg$C[i])^2*(x[-i] - arg$D[i])^4




#Gr_x_j O_i(x)
grobj <- function(x, i, j, arg)
{
	dij <- 1*(i == j)
	other <- ifelse(i == 1, 2, 1)
	2*(x[i] - arg$C[i])*(x[other] - arg$D[i])^4*dij + 4*(x[i] - arg$C[i])^2*(x[other] - arg$D[i])^3*(1-dij) 
}
#Gr_x_k Gr_x_j O_i(x)
heobj <- function(x, i, j, k, arg)
{
	dij <- 1*(i == j)
	dik <- 1*(i == k)
	other <- ifelse(i == 1, 2, 1)
	res <- 2*(x[other] - arg$D[i])^4*dij*dik + 8*(x[i] - arg$C[i])*(x[other] - arg$D[i])^3*dij*(1-dik)
	res <- res + 8*(x[i] - arg$C[i])*(x[other] - arg$D[i])^3*(1-dij)*dik
	res + 12*(x[i] - arg$C[i])^2*(x[other] - arg$D[i])^2*(1-dij)*(1-dik)
}

dimlam <- c(1, 1)
#g(x)
gtot <- function(x)
	sum(x[1:2]) - 1
#	c(sum(x[1:2]) - 1, 2*x[1]+x[2]-2)
#Gr_x_j g(x)
jacgtot <- function(x)
	cbind(1, 1)
#	cbind(c(1, 1), c(2, 1))




z0 <- rexp(sum(dimx))

fpNIR(z0, dimx, obj, myarg, gtot, NULL, grobj, myarg, jacgtot, NULL)

GNE.fpeq(z0, dimx, obj, myarg, grobj, myarg, heobj, myarg, gtot, NULL, jacgtot, NULL, silent=TRUE, control.outer=list(maxit=10), problem="NIR", merit="NI")

z0 <- rexp(sum(dimx))

fpVIR(z0, dimx, obj, myarg, gtot, NULL, grobj, myarg, jacgtot, NULL)

GNE.fpeq(z0, dimx, obj, myarg, grobj, myarg, heobj, myarg, gtot, NULL, jacgtot, NULL, silent=TRUE, control.outer=list(maxit=10), problem="VIR", merit="VI")