tests/BWeg.R

In numDeriv: Accurate Numerical Derivatives

if(!require("numDeriv"))stop("this test requires numDeriv.")
Sys.info()
  

#######################################################################

# Test gradient and hessian calculation in genD using  data for calculating 
#   curvatures in Bates and Watts.
#model A p329,data set 3 (table A1.3, p269) Bates & Watts (Puromycin example)

#######################################################################
  


puromycin <- function(th){
   x <- c(0.02,0.02,0.06,0.06,0.11,0.11,0.22,0.22,0.56,0.56,1.10,1.10)
   y <- c(76,47,97,107,123,139,159,152,191,201,207,200)
   ( (th[1] * x)/(th[2] + x) ) - y
  }

D.anal <- function(th){
  # analytic derivatives. Note numerical approximation gives a very good
  # estimate of these, but neither give D below exactly. The results are very
  # sensitive to th, so rounding error in the reported value of th could explain
  # the difference. But more likely th is correct and D has been rounded for
  # publication - and the analytic D with published th seems to work best.
  # th = c(212.70188549 ,  0.06410027) is the nls est of th for BW published D.
  x <- c(0.02,0.02,0.06,0.06,0.11,0.11,0.22,0.22,0.56,0.56,1.10,1.10)
  y <- c(76,47,97,107,123,139,159,152,191,201,207,200)
  cbind(x/(th[2]+x), -th[1]*x/(th[2]+x)^2, 0, -x/(th[2]+x)^2, 2*th[1]*x/(th[2]+x)^3)
 }

# D matrix from p235. This may be useful for rough comparisons, but rounding
# used for publication introduces substantial errors. check D.anal1 - D.BW
D.BW <- t(matrix(c(
0.237812, -601.458, 0, -2.82773, 14303.4,
0.237812, -601.458, 0, -2.82773, 14303.4,
0.483481, -828.658, 0, -3.89590, 13354.7,
0.483481, -828.658, 0, -3.89590, 13354.7,
0.631821, -771.903, 0, -3.62907, 8867.4,
0.631821, -771.903, 0, -3.62907, 8867.4,
0.774375, -579.759, 0, -2.72571, 4081.4,
0.774375, -579.759, 0, -2.72571, 4081.4,
0.897292, -305.807, 0, -1.43774,  980.0,
0.897292, -305.807, 0, -1.43774,  980.0,
0.944936, -172.655, 0, -0.81173,  296.6,
0.944936, -172.655, 0, -0.81173,  296.6),   5,12))

cat("\nanalytic D:\n")
print( D.anal <- D.anal(c(212.7000, 0.0641)), digits=16)


cat("\n********** note the results here are better with d=0.01 ********\n")
cat("\n**********    in both relative and absolute terms.      ********\n")

cat("\nnumerical D:\n")
print( D.calc <- genD(puromycin,c(212.7000, 0.0641), method.args=list(d=0.01)),
      digits=16) 

# increasing r does not always help
#D.calc <- genD(puromycin,c(212.7000, 0.0641), r=10)#compares to 0.01 below
#D.calc <- genD(puromycin,c(212.7000, 0.0641), d=0.001)


cat("\ndiff. between analytic and numerical D:\n")
print( D.calc$D - D.anal, digits=16)

cat("\nmax. abs. diff. between analtic and numerical D:\n")
print( max(abs(D.calc$D - D.anal)), digits=16)

# These are better tests except for 0 column, so add an epsilon
cat("\nrelative diff. between numerical D and analytic D (plus epsilon):\n")
print(z <- (D.calc$D - D.anal) / (D.anal + 1e-4), digits=16)
#  d=0.0001 [12,] 1.184044172787111e-04 7.451545953037876e-03
#  d=0.01   [12,] 1.593395089728741e-08  2.814629092064831e-07


cat("\nmax. abs. relative diff. between analtic and numerical D:")
print( max(abs(z)), digits=16)

if(max(abs(z)) > 1e-6)  stop("BW test FAILED")