R Under development (unstable) (2023-10-23 r85401 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 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.

> # tkktc.R -- test how kkt check works
> ##  author: John C. Nash
> # rm(list=ls())
> cat("Show how kktc works\n")
Show how kktc works
> require(optimx)
Loading required package: optimx
> sessionInfo()
R Under development (unstable) (2023-10-23 r85401 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows Server 2022 x64 (build 20348)

Matrix products: default


locale:
[1] LC_COLLATE=C                 LC_CTYPE=German_Germany.utf8
[3] LC_MONETARY=C                LC_NUMERIC=C                
[5] LC_TIME=C                   

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] optimx_2023-10.21

loaded via a namespace (and not attached):
[1] compiler_4.4.0      nloptr_2.0.3        numDeriv_2016.8-1.1
[4] pracma_2.4.2       
> 
> jones<-function(xx){
+    x<-xx[1]
+    y<-xx[2]
+    ff<-sin(x*x/2 - y*y/4)*cos(2*x-exp(y))
+    ff<- -ff
+ }
> 
> jonesg <- function(xx) {
+    x<-xx[1]
+    y<-xx[2]
+    gx <-  cos(x * x/2 - y * y/4) * ((x + x)/2) * cos(2 * x - exp(y)) - 
+          sin(x * x/2 - y * y/4) * (sin(2 * x - exp(y)) * 2)
+    gy <- sin(x * x/2 - y * y/4) * (sin(2 * x - exp(y)) * exp(y)) - cos(x * 
+           x/2 - y * y/4) * ((y + y)/4) * cos(2 * x - exp(y))
+    gg <- - c(gx, gy)
+ }
> 
> xx<-0.5*c(pi,pi)
> ans <- list() # set up structure
> 
> 
> # can call following if optimx present and updated
> ans <- optimr(xx, jones, jonesg, method="Rvmmin")
> ans
$par
[1]  3.154083 -3.689620
attr(,"status")
[1] " " " "

$value
[1] -1
attr(,"fname")
[1] "(no_name)"
attr(,"method")
[1] "Rvmmin"
attr(,"ptype")
[1] "U"

$counts
function gradient 
      28       17 

$convergence
[1] 0

$message
[1] "Rvmminu appears to have converged"

$scounts
[1] 28 17  0

> 
> ans$par <- c(3.154083, -3.689620)
> # 20230823 may want to set dowarn
> kkans <- kktchk(ans$par, jones, jonesg)
Warning message:
In kktchk(ans$par, jones, jonesg) :
  kktchk: pHes not symmetric -- symmetrizing
> kkans
$gmax
[1] 3.10669e-06

$evratio
[1] 0.052218

$kkt1
[1] TRUE

$kkt2
[1] TRUE

$hev
[1] 16.49106  0.86113

$ngatend
[1] -3.106690e-06 -8.608104e-07

$nhatend
          [,1]     [,2]
[1,] 13.948239 5.768721
[2,]  5.768721 3.403948

> 
> proc.time()
   user  system elapsed 
   0.21    0.03    0.25