R Under development (unstable) (2024-10-16 r87241 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

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.

> if(!require("GNE"))stop("this test requires package GNE.")
Loading required package: GNE
Loading required package: alabama
Loading required package: numDeriv
Loading required package: nleqslv
Loading required package: BB
Loading required package: SQUAREM
> 
> #-------------------------------------------------------------------------------
> # (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)
$par
[1]  1.8413392 -0.8413392

$value
[1] -10.05924

$counts
function gradient 
     309       49 

$convergence
[1] 0

$message
NULL

$outer.iterations
[1] 3

$barrier.value
[1] -0.0001849919

$optim.function
[1] "constrOptim.nl"

$optim.method
[1] "BFGS"

> 
> 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")
GNE: 1.910396 -0.9103962 
with optimal norm 2.292066e-07 
after  iterations with exit code 1 .
Output message: 
Outer Function/grad/hessian calls: 3 2 
Inner Function/grad/hessian calls: 1865 266 
> 
> z0 <- rexp(sum(dimx))
> 
> fpVIR(z0, dimx, obj, myarg, gtot, NULL, grobj, myarg, jacgtot, NULL)
$par
[1]  186.6525 -185.6525

$value
[1] -3465.011

$counts
function gradient 
     235       37 

$convergence
[1] 0

$message
NULL

$outer.iterations
[1] 7

$barrier.value
[1] -0.003463687

$optim.function
[1] "constrOptim.nl"

$optim.method
[1] "BFGS"

> 
> 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")
GNE: 186.6436 -185.6436 
with optimal norm 2.188923e+24 
after  iterations with exit code 6 .
Output message: 
Outer Function/grad/hessian calls: 19 10 
Inner Function/grad/hessian calls: 375 147 
> 
> 
> proc.time()
   user  system elapsed 
   0.90    0.12    1.00