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. > # tgrchk.R -- test gradient check for bad inputs or calls > ## author: John C. Nash > # rm(list=ls()) > cat("Show how grchk works\n") Show how grchk works > require(optimx) Loading required package: optimx > > 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 <- c(1, 2) > > gcans <- grchk(xx, jones, jonesg, trace=1, testtol=(.Machine$double.eps)^(1/3)) gradient test tolerance = 6.055454e-06 fval= 0.3002153 compare to max(abs(gn-ga))/(1+abs(fval)) = 1.312852e-11 > gcans [1] TRUE attr(,"ga") [1] -1.297122 3.311502 attr(,"gn") [1] -1.297122 3.311502 attr(,"maxdiff") [1] 1.70699e-11 > > > > proc.time() user system elapsed 0.20 0.03 0.21