1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
# test one-sided derivatives
library(numDeriv)
fuzz <- 1e-8
##### scalar argument, scalar result (case 1)#####
f <- function(x) if(x<=0) sin(x) else NA
##################################################
## grad
err <- 1.0 - grad(f, x=0, method="simple", side=-1)
if( fuzz < err ) stop("grad case 1 method simple one-sided test 1 failed.")
if( ! is.na(grad(f, x=0, method="simple", side=1))) stop("grad case 1 method simple one-sided test 2 failed.")
err <- 1.0 - grad(f, x=0, method="Richardson", side=-1)
if( fuzz < err ) stop("grad case 1 method Richardson one-sided test 1 failed.")
# print(grad(sin, x=-0.5, method="Richardson") , digits=16) # 0.8775825618862814
# print(grad(sin, x=-0.5, method="Richardson", side=-1), digits=16) # 0.8775807270501326
err <- 0.8775807270501326 - grad(sin, x=-0.5, method="Richardson", side=-1)
if( fuzz < err ) stop("grad case 1 method Richardson one-sided test 2 failed.")
## jacobian
err <- 1.0 - jacobian(f, x=0, method="simple", side= -1)
if( fuzz < err ) stop("jacobian case 1 method simple one-sided test failed.")
err <- 1.0 - jacobian(f, x=0, method="Richardson", side= -1)
if( fuzz < err ) stop("jacobian case 1 method Richardson one-sided test 1 failed.")
if( ! is.na(jacobian(f, x=0, method="Richardson", side= 1))) stop("jacobian case 1 method Richardson one-sided test 2 failed.")
##### vector argument, vector result (case 3)#####
f <- function(x) if(x[1]<=0) sin(x) else c(NA, sin(x[-1]))
##################################################
## grad
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c(-1, -1)) # 1 1
if( fuzz < max(err) ) stop("grad case 3 method simple one-sided test 1 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c(-1, 1)) # 1 1
if( fuzz < max(err) ) stop("grad case 3 method simple one-sided test 2 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c(-1, NA)) # 1 1
if( fuzz < max(err) ) stop("grad case 3 method simple one-sided test 3 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c( 1, 1)) # NA 1
if( fuzz < err[2] ) stop("grad case 3 method simple one-sided test 4 failed.")
if(!is.na( err[1]) ) stop("grad case 3 method simple one-sided test 4b failed.")
err <- 1.0 - grad(f, x=c(0,0), method="Richardson", side=c(-1, -1)) # 1 1
if( fuzz < max(err) ) stop("grad case 3 method Richardson one-sided test 1 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="Richardson", side=c(-1, 1)) # 1 1
if( fuzz < max(err) ) stop("grad case 3 method Richardson one-sided test 2 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="Richardson", side=c(-1, NA)) # 1 1
if( fuzz < max(err) ) stop("grad case 3 method Richardson one-sided test 3 failed.")
## jacobian
err <- 1.0 - jacobian(f, x=0, method="simple", side= -1)
if( fuzz < err ) stop("jacobian case 3 method simple one-sided test failed.")
err <- 1.0 - jacobian(f, x=0, method="Richardson", side= -1)
if( fuzz < err ) stop("jacobian case 3 method Richardson one-sided test 1 failed.")
if( ! is.na(jacobian(f, x=0, method="Richardson", side= 1))) stop("jacobian case 3 method Richardson one-sided test 2 failed.")
##### vector argument, scalar result (case 2)#####
f <- function(x) if(x[1]<=0) sum(sin(x)) else NA
##################################################
## grad
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c(-1, -1)) # 1 1
if( fuzz < max(err) ) stop("grad case 2 method simple one-sided test 1 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c(-1, 1)) # 1 1
if( fuzz < max(err) ) stop("grad case 2 method simple one-sided test 2 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c(-1, NA)) # 1 1
if( fuzz < max(err) ) stop("grad case 2 method simple one-sided test 3 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="simple", side=c( 1, 1)) # NA 1
if( fuzz < err[2] ) stop("grad case 2 method simple one-sided test 4 failed.")
if(!is.na( err[1]) ) stop("grad case 2 method simple one-sided test 4b failed.")
err <- 1.0 - grad(f, x=c(0,0), method="Richardson", side=c(-1, -1)) # 1 1
if( fuzz < max(err) ) stop("grad case 2 method Richardson one-sided test 1 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="Richardson", side=c(-1, 1)) # 1 1
if( fuzz < max(err) ) stop("grad case 2 method Richardson one-sided test 2 failed.")
err <- 1.0 - grad(f, x=c(0,0), method="Richardson", side=c(-1, NA)) # 1 1
if( fuzz < max(err) ) stop("grad case 2 method Richardson one-sided test 3 failed.")
## jacobian
err <- 1.0 - jacobian(f, x=0, method="simple", side= -1)
if( fuzz < err ) stop("jacobian case 2 method simple one-sided test failed.")
err <- 1.0 - jacobian(f, x=0, method="Richardson", side= -1)
if( fuzz < err ) stop("jacobian case 2 method Richardson one-sided test 1 failed.")
if( ! is.na(jacobian(f, x=0, method="Richardson", side= 1))) stop("jacobian case 2 method Richardson one-sided test 2 failed.")
|
