Run tests, where possible, on user objective function and (optionally) gradient and hessian

grchk checks a user-provided R function, ffn.

grchk(xpar, ffn, ggr, trace=0, testtol=(.Machine$double.eps)^(1/3), ...)

Arguments

xpar

parameters to the user objective and gradient functions ffn and ggr

ffn

User-supplied objective function

ggr

User-supplied gradient function

trace

set >0 to provide output from grchk to the console, 0 otherwise

testtol

tolerance for equality tests

...

optional arguments passed to the objective function.

Details

Package:	grchk
Depends:	R (>= 2.6.1)
License:	GPL Version 2.

numDeriv is used to numerically approximate the gradient of function ffn and compare this to the result of function ggr.

Value

grchk returns a single object gradOK which is TRUE if the differences between analytic and approximated gradient are small as measured by the tolerance testtol.

This has attributes "ga" and "gn" for the analytic and numerically approximated gradients, and "maxdiff" for the maximum absolute difference between these vectors.

At the time of preparation, there are no checks for validity of the gradient code in ggr as in the function fnchk.

Author

John C. Nash

Examples

# Would like examples of success and failure. What about "near misses"?
cat("Show how grchk works\n")
#> Show how grchk works
require(numDeriv)
# require(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)
}

jonesg2 <- function(xx) {
  gx <- 1
  gy <- 2
  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

gcans2 <- grchk(xx, jones, jonesg2, 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)) =  4.085094 
#> Gradient function might be wrong - check it! 
gcans2
#> [1] FALSE
#> attr(,"ga")
#> [1] -1 -2
#> attr(,"gn")
#> [1] -1.297122  3.311502
#> attr(,"maxdiff")
#> [1] 5.311502