3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
27 -- Check that the TANH function returns
28 -- a result that is within the error bound allowed.
31 -- This test consists of a generic package that is
32 -- instantiated to check both Float and a long float type.
33 -- The test for each floating point type is divided into
35 -- Special value checks where the result is a known constant.
36 -- Checks that use an identity for determining the result.
38 -- SPECIAL REQUIREMENTS
39 -- The Strict Mode for the numerical accuracy must be
40 -- selected. The method by which this mode is selected
41 -- is implementation dependent.
43 -- APPLICABILITY CRITERIA:
44 -- This test applies only to implementations supporting the
46 -- This test only applies to the Strict Mode for numerical
51 -- 20 Mar 96 SAIC Initial release for 2.1
52 -- 17 Aug 96 SAIC Incorporated reviewer comments.
53 -- 03 Jun 98 EDS Add parens to remove the potential for overflow.
54 -- Remove the invocation of Identity_Test that checks
55 -- Tanh values that are too close to zero for the
56 -- test's error bounds.
62 -- Software Manual for the Elementary Functions
63 -- William J. Cody, Jr. and William Waite
64 -- Prentice-Hall, 1980
66 -- CRC Standard Mathematical Tables
69 -- Implementation and Testing of Function Software
71 -- Problems and Methodologies in Mathematical Software Production
72 -- editors P. C. Messina and A. Murli
73 -- Lecture Notes in Computer Science Volume 142
74 -- Springer Verlag, 1982
79 with Ada
.Numerics
.Generic_Elementary_Functions
;
81 Verbose
: constant Boolean := False;
82 Max_Samples
: constant := 1000;
84 E
: constant := Ada
.Numerics
.E
;
87 type Real
is digits <>;
88 package Generic_Check
is
92 package body Generic_Check
is
93 package Elementary_Functions
is new
94 Ada
.Numerics
.Generic_Elementary_Functions
(Real
);
96 function Tanh
(X
: Real
) return Real
renames
97 Elementary_Functions
.Tanh
;
99 function Log
(X
: Real
) return Real
renames
100 Elementary_Functions
.Log
;
102 -- flag used to terminate some tests early
103 Accuracy_Error_Reported
: Boolean := False;
106 -- The following value is a lower bound on the accuracy
107 -- required. It is normally 0.0 so that the lower bound
108 -- is computed from Model_Epsilon. However, for tests
109 -- where the expected result is only known to a certain
110 -- amount of precision this bound takes on a non-zero
111 -- value to account for that level of precision.
112 Error_Low_Bound
: Real
:= 0.0;
114 procedure Check
(Actual
, Expected
: Real
;
121 -- In the case where the expected result is very small or 0
122 -- we compute the maximum error as a multiple of Model_Small instead
123 -- of Model_Epsilon and Expected.
124 Rel_Error
:= MRE
* abs Expected
* Real
'Model_Epsilon;
125 Abs_Error
:= MRE
* Real
'Model_Small;
126 if Rel_Error
> Abs_Error
then
127 Max_Error
:= Rel_Error
;
129 Max_Error
:= Abs_Error
;
131 -- take into account the low bound on the error
132 if Max_Error
< Error_Low_Bound
then
133 Max_Error
:= Error_Low_Bound
;
136 if abs (Actual
- Expected
) > Max_Error
then
137 Accuracy_Error_Reported
:= True;
138 Report
.Failed
(Test_Name
&
139 " actual: " & Real
'Image (Actual
) &
140 " expected: " & Real
'Image (Expected
) &
141 " difference: " & Real
'Image (Actual
- Expected
) &
142 " max err:" & Real
'Image (Max_Error
) );
144 if Actual
= Expected
then
145 Report
.Comment
(Test_Name
& " exact result");
147 Report
.Comment
(Test_Name
& " passed");
153 procedure Special_Value_Test
is
154 -- In the following tests the expected result is accurate
155 -- to the machine precision so the minimum guaranteed error
156 -- bound can be used.
157 Minimum_Error
: constant := 8.0;
158 E2
: constant := E
* E
;
161 (E
- 1.0 / E
) / (E
+ 1.0 / E
),
165 (E2
- 1.0 / E2
) / (E2
+ 1.0 / E2
),
169 when Constraint_Error
=>
170 Report
.Failed
("Constraint_Error raised in special value test");
172 Report
.Failed
("exception in special value test");
173 end Special_Value_Test
;
177 procedure Exact_Result_Test
is
178 No_Error
: constant := 0.0;
181 Check
(Tanh
(0.0), 0.0, "tanh(0)", No_Error
);
183 when Constraint_Error
=>
184 Report
.Failed
("Constraint_Error raised in Exact_Result Test");
186 Report
.Failed
("exception in Exact_Result Test");
187 end Exact_Result_Test
;
190 procedure Identity_Test
(A
, B
: Real
) is
191 -- For this test we use the identity
192 -- TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)]
193 -- which is transformed to
194 -- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
195 -- where C = TANH(1/8) and y = x - 1/8
197 -- see Cody pg 248-249 for details on the error analysis.
198 -- The net result is a relative error bound of 16 * Model_Epsilon.
200 -- The second part of this test checks the identity
201 -- TANH(-x) = -TANH(X)
204 Actual1
, Actual2
: Real
;
205 C
: constant := 1.2435300177159620805e-1;
207 if Real
'Digits > 20 then
208 -- constant C is accurate to 20 digits. Set the low bound
209 -- on the error to 16*10**-20
210 Error_Low_Bound
:= 0.00000_00000_00000_00016
;
211 Report
.Comment
("tanh accuracy checked to 20 digits");
214 Accuracy_Error_Reported
:= False; -- reset
215 for I
in 1..Max_Samples
loop
216 X
:= (B
- A
) * (Real
(I
) / Real
(Max_Samples
)) + A
;
219 -- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
220 Y
:= X
- (1.0 / 8.0);
221 Actual2
:= (Tanh
(Y
) + C
) / (1.0 + Tanh
(Y
) * C
);
223 Check
(Actual1
, Actual2
,
224 "Identity_1_Test " & Integer'Image (I
) & ": tanh(" &
225 Real
'Image (X
) & ") ",
228 -- TANH(-x) = -TANH(X)
230 Check
(-Actual1
, Actual2
,
231 "Identity_2_Test " & Integer'Image (I
) & ": tanh(" &
232 Real
'Image (X
) & ") ",
235 if Accuracy_Error_Reported
then
236 -- only report the first error in this test in order to keep
237 -- lots of failures from producing a huge error log
242 Error_Low_Bound
:= 0.0; -- reset
244 when Constraint_Error
=>
246 ("Constraint_Error raised in Identity_Test" &
247 " for X=" & Real
'Image (X
));
249 Report
.Failed
("exception in Identity_Test" &
250 " for X=" & Real
'Image (X
));
259 -- cover a large range
260 Identity_Test
(1.0, Real
'Safe_Last);
264 -----------------------------------------------------------------------
265 -----------------------------------------------------------------------
266 package Float_Check
is new Generic_Check
(Float);
268 -- check the floating point type with the most digits
269 type A_Long_Float
is digits System
.Max_Digits
;
270 package A_Long_Float_Check
is new Generic_Check
(A_Long_Float
);
272 -----------------------------------------------------------------------
273 -----------------------------------------------------------------------
277 Report
.Test
("CXG2017",
278 "Check the accuracy of the TANH function");
281 Report
.Comment
("checking Standard.Float");
287 Report
.Comment
("checking a digits" &
288 Integer'Image (System
.Max_Digits
) &
289 " floating point type");
292 A_Long_Float_Check
.Do_Test
;