-- CXG2017.A
|
-- CXG2017.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that the TANH function returns
|
-- Check that the TANH function returns
|
-- a result that is within the error bound allowed.
|
-- a result that is within the error bound allowed.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test consists of a generic package that is
|
-- This test consists of a generic package that is
|
-- instantiated to check both Float and a long float type.
|
-- instantiated to check both Float and a long float type.
|
-- The test for each floating point type is divided into
|
-- The test for each floating point type is divided into
|
-- several parts:
|
-- several parts:
|
-- Special value checks where the result is a known constant.
|
-- Special value checks where the result is a known constant.
|
-- Checks that use an identity for determining the result.
|
-- Checks that use an identity for determining the result.
|
--
|
--
|
-- SPECIAL REQUIREMENTS
|
-- SPECIAL REQUIREMENTS
|
-- The Strict Mode for the numerical accuracy must be
|
-- The Strict Mode for the numerical accuracy must be
|
-- selected. The method by which this mode is selected
|
-- selected. The method by which this mode is selected
|
-- is implementation dependent.
|
-- is implementation dependent.
|
--
|
--
|
-- APPLICABILITY CRITERIA:
|
-- APPLICABILITY CRITERIA:
|
-- This test applies only to implementations supporting the
|
-- This test applies only to implementations supporting the
|
-- Numerics Annex.
|
-- Numerics Annex.
|
-- This test only applies to the Strict Mode for numerical
|
-- This test only applies to the Strict Mode for numerical
|
-- accuracy.
|
-- accuracy.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 20 Mar 96 SAIC Initial release for 2.1
|
-- 20 Mar 96 SAIC Initial release for 2.1
|
-- 17 Aug 96 SAIC Incorporated reviewer comments.
|
-- 17 Aug 96 SAIC Incorporated reviewer comments.
|
-- 03 Jun 98 EDS Add parens to remove the potential for overflow.
|
-- 03 Jun 98 EDS Add parens to remove the potential for overflow.
|
-- Remove the invocation of Identity_Test that checks
|
-- Remove the invocation of Identity_Test that checks
|
-- Tanh values that are too close to zero for the
|
-- Tanh values that are too close to zero for the
|
-- test's error bounds.
|
-- test's error bounds.
|
--!
|
--!
|
|
|
--
|
--
|
-- References:
|
-- References:
|
--
|
--
|
-- Software Manual for the Elementary Functions
|
-- Software Manual for the Elementary Functions
|
-- William J. Cody, Jr. and William Waite
|
-- William J. Cody, Jr. and William Waite
|
-- Prentice-Hall, 1980
|
-- Prentice-Hall, 1980
|
--
|
--
|
-- CRC Standard Mathematical Tables
|
-- CRC Standard Mathematical Tables
|
-- 23rd Edition
|
-- 23rd Edition
|
--
|
--
|
-- Implementation and Testing of Function Software
|
-- Implementation and Testing of Function Software
|
-- W. J. Cody
|
-- W. J. Cody
|
-- Problems and Methodologies in Mathematical Software Production
|
-- Problems and Methodologies in Mathematical Software Production
|
-- editors P. C. Messina and A. Murli
|
-- editors P. C. Messina and A. Murli
|
-- Lecture Notes in Computer Science Volume 142
|
-- Lecture Notes in Computer Science Volume 142
|
-- Springer Verlag, 1982
|
-- Springer Verlag, 1982
|
--
|
--
|
|
|
with System;
|
with System;
|
with Report;
|
with Report;
|
with Ada.Numerics.Generic_Elementary_Functions;
|
with Ada.Numerics.Generic_Elementary_Functions;
|
procedure CXG2017 is
|
procedure CXG2017 is
|
Verbose : constant Boolean := False;
|
Verbose : constant Boolean := False;
|
Max_Samples : constant := 1000;
|
Max_Samples : constant := 1000;
|
|
|
E : constant := Ada.Numerics.E;
|
E : constant := Ada.Numerics.E;
|
|
|
generic
|
generic
|
type Real is digits <>;
|
type Real is digits <>;
|
package Generic_Check is
|
package Generic_Check is
|
procedure Do_Test;
|
procedure Do_Test;
|
end Generic_Check;
|
end Generic_Check;
|
|
|
package body Generic_Check is
|
package body Generic_Check is
|
package Elementary_Functions is new
|
package Elementary_Functions is new
|
Ada.Numerics.Generic_Elementary_Functions (Real);
|
Ada.Numerics.Generic_Elementary_Functions (Real);
|
|
|
function Tanh (X : Real) return Real renames
|
function Tanh (X : Real) return Real renames
|
Elementary_Functions.Tanh;
|
Elementary_Functions.Tanh;
|
|
|
function Log (X : Real) return Real renames
|
function Log (X : Real) return Real renames
|
Elementary_Functions.Log;
|
Elementary_Functions.Log;
|
|
|
-- flag used to terminate some tests early
|
-- flag used to terminate some tests early
|
Accuracy_Error_Reported : Boolean := False;
|
Accuracy_Error_Reported : Boolean := False;
|
|
|
|
|
-- The following value is a lower bound on the accuracy
|
-- The following value is a lower bound on the accuracy
|
-- required. It is normally 0.0 so that the lower bound
|
-- required. It is normally 0.0 so that the lower bound
|
-- is computed from Model_Epsilon. However, for tests
|
-- is computed from Model_Epsilon. However, for tests
|
-- where the expected result is only known to a certain
|
-- where the expected result is only known to a certain
|
-- amount of precision this bound takes on a non-zero
|
-- amount of precision this bound takes on a non-zero
|
-- value to account for that level of precision.
|
-- value to account for that level of precision.
|
Error_Low_Bound : Real := 0.0;
|
Error_Low_Bound : Real := 0.0;
|
|
|
procedure Check (Actual, Expected : Real;
|
procedure Check (Actual, Expected : Real;
|
Test_Name : String;
|
Test_Name : String;
|
MRE : Real) is
|
MRE : Real) is
|
Max_Error : Real;
|
Max_Error : Real;
|
Rel_Error : Real;
|
Rel_Error : Real;
|
Abs_Error : Real;
|
Abs_Error : Real;
|
begin
|
begin
|
-- In the case where the expected result is very small or 0
|
-- In the case where the expected result is very small or 0
|
-- we compute the maximum error as a multiple of Model_Small instead
|
-- we compute the maximum error as a multiple of Model_Small instead
|
-- of Model_Epsilon and Expected.
|
-- of Model_Epsilon and Expected.
|
Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
|
Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
|
Abs_Error := MRE * Real'Model_Small;
|
Abs_Error := MRE * Real'Model_Small;
|
if Rel_Error > Abs_Error then
|
if Rel_Error > Abs_Error then
|
Max_Error := Rel_Error;
|
Max_Error := Rel_Error;
|
else
|
else
|
Max_Error := Abs_Error;
|
Max_Error := Abs_Error;
|
end if;
|
end if;
|
-- take into account the low bound on the error
|
-- take into account the low bound on the error
|
if Max_Error < Error_Low_Bound then
|
if Max_Error < Error_Low_Bound then
|
Max_Error := Error_Low_Bound;
|
Max_Error := Error_Low_Bound;
|
end if;
|
end if;
|
|
|
if abs (Actual - Expected) > Max_Error then
|
if abs (Actual - Expected) > Max_Error then
|
Accuracy_Error_Reported := True;
|
Accuracy_Error_Reported := True;
|
Report.Failed (Test_Name &
|
Report.Failed (Test_Name &
|
" actual: " & Real'Image (Actual) &
|
" actual: " & Real'Image (Actual) &
|
" expected: " & Real'Image (Expected) &
|
" expected: " & Real'Image (Expected) &
|
" difference: " & Real'Image (Actual - Expected) &
|
" difference: " & Real'Image (Actual - Expected) &
|
" max err:" & Real'Image (Max_Error) );
|
" max err:" & Real'Image (Max_Error) );
|
elsif Verbose then
|
elsif Verbose then
|
if Actual = Expected then
|
if Actual = Expected then
|
Report.Comment (Test_Name & " exact result");
|
Report.Comment (Test_Name & " exact result");
|
else
|
else
|
Report.Comment (Test_Name & " passed");
|
Report.Comment (Test_Name & " passed");
|
end if;
|
end if;
|
end if;
|
end if;
|
end Check;
|
end Check;
|
|
|
|
|
procedure Special_Value_Test is
|
procedure Special_Value_Test is
|
-- In the following tests the expected result is accurate
|
-- In the following tests the expected result is accurate
|
-- to the machine precision so the minimum guaranteed error
|
-- to the machine precision so the minimum guaranteed error
|
-- bound can be used.
|
-- bound can be used.
|
Minimum_Error : constant := 8.0;
|
Minimum_Error : constant := 8.0;
|
E2 : constant := E * E;
|
E2 : constant := E * E;
|
begin
|
begin
|
Check (Tanh (1.0),
|
Check (Tanh (1.0),
|
(E - 1.0 / E) / (E + 1.0 / E),
|
(E - 1.0 / E) / (E + 1.0 / E),
|
"tanh(1)",
|
"tanh(1)",
|
Minimum_Error);
|
Minimum_Error);
|
Check (Tanh (2.0),
|
Check (Tanh (2.0),
|
(E2 - 1.0 / E2) / (E2 + 1.0 / E2),
|
(E2 - 1.0 / E2) / (E2 + 1.0 / E2),
|
"tanh(2)",
|
"tanh(2)",
|
Minimum_Error);
|
Minimum_Error);
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Constraint_Error raised in special value test");
|
Report.Failed ("Constraint_Error raised in special value test");
|
when others =>
|
when others =>
|
Report.Failed ("exception in special value test");
|
Report.Failed ("exception in special value test");
|
end Special_Value_Test;
|
end Special_Value_Test;
|
|
|
|
|
|
|
procedure Exact_Result_Test is
|
procedure Exact_Result_Test is
|
No_Error : constant := 0.0;
|
No_Error : constant := 0.0;
|
begin
|
begin
|
-- A.5.1(38);6.0
|
-- A.5.1(38);6.0
|
Check (Tanh (0.0), 0.0, "tanh(0)", No_Error);
|
Check (Tanh (0.0), 0.0, "tanh(0)", No_Error);
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Constraint_Error raised in Exact_Result Test");
|
Report.Failed ("Constraint_Error raised in Exact_Result Test");
|
when others =>
|
when others =>
|
Report.Failed ("exception in Exact_Result Test");
|
Report.Failed ("exception in Exact_Result Test");
|
end Exact_Result_Test;
|
end Exact_Result_Test;
|
|
|
|
|
procedure Identity_Test (A, B : Real) is
|
procedure Identity_Test (A, B : Real) is
|
-- For this test we use the identity
|
-- For this test we use the identity
|
-- TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)]
|
-- TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)]
|
-- which is transformed to
|
-- which is transformed to
|
-- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
|
-- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
|
-- where C = TANH(1/8) and y = x - 1/8
|
-- where C = TANH(1/8) and y = x - 1/8
|
--
|
--
|
-- see Cody pg 248-249 for details on the error analysis.
|
-- see Cody pg 248-249 for details on the error analysis.
|
-- The net result is a relative error bound of 16 * Model_Epsilon.
|
-- The net result is a relative error bound of 16 * Model_Epsilon.
|
--
|
--
|
-- The second part of this test checks the identity
|
-- The second part of this test checks the identity
|
-- TANH(-x) = -TANH(X)
|
-- TANH(-x) = -TANH(X)
|
|
|
X, Y : Real;
|
X, Y : Real;
|
Actual1, Actual2 : Real;
|
Actual1, Actual2 : Real;
|
C : constant := 1.2435300177159620805e-1;
|
C : constant := 1.2435300177159620805e-1;
|
begin
|
begin
|
if Real'Digits > 20 then
|
if Real'Digits > 20 then
|
-- constant C is accurate to 20 digits. Set the low bound
|
-- constant C is accurate to 20 digits. Set the low bound
|
-- on the error to 16*10**-20
|
-- on the error to 16*10**-20
|
Error_Low_Bound := 0.00000_00000_00000_00016;
|
Error_Low_Bound := 0.00000_00000_00000_00016;
|
Report.Comment ("tanh accuracy checked to 20 digits");
|
Report.Comment ("tanh accuracy checked to 20 digits");
|
end if;
|
end if;
|
|
|
Accuracy_Error_Reported := False; -- reset
|
Accuracy_Error_Reported := False; -- reset
|
for I in 1..Max_Samples loop
|
for I in 1..Max_Samples loop
|
X := (B - A) * (Real (I) / Real (Max_Samples)) + A;
|
X := (B - A) * (Real (I) / Real (Max_Samples)) + A;
|
Actual1 := Tanh(X);
|
Actual1 := Tanh(X);
|
|
|
-- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
|
-- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
|
Y := X - (1.0 / 8.0);
|
Y := X - (1.0 / 8.0);
|
Actual2 := (Tanh (Y) + C) / (1.0 + Tanh(Y) * C);
|
Actual2 := (Tanh (Y) + C) / (1.0 + Tanh(Y) * C);
|
|
|
Check (Actual1, Actual2,
|
Check (Actual1, Actual2,
|
"Identity_1_Test " & Integer'Image (I) & ": tanh(" &
|
"Identity_1_Test " & Integer'Image (I) & ": tanh(" &
|
Real'Image (X) & ") ",
|
Real'Image (X) & ") ",
|
16.0);
|
16.0);
|
|
|
-- TANH(-x) = -TANH(X)
|
-- TANH(-x) = -TANH(X)
|
Actual2 := Tanh(-X);
|
Actual2 := Tanh(-X);
|
Check (-Actual1, Actual2,
|
Check (-Actual1, Actual2,
|
"Identity_2_Test " & Integer'Image (I) & ": tanh(" &
|
"Identity_2_Test " & Integer'Image (I) & ": tanh(" &
|
Real'Image (X) & ") ",
|
Real'Image (X) & ") ",
|
16.0);
|
16.0);
|
|
|
if Accuracy_Error_Reported then
|
if Accuracy_Error_Reported then
|
-- only report the first error in this test in order to keep
|
-- only report the first error in this test in order to keep
|
-- lots of failures from producing a huge error log
|
-- lots of failures from producing a huge error log
|
return;
|
return;
|
end if;
|
end if;
|
|
|
end loop;
|
end loop;
|
Error_Low_Bound := 0.0; -- reset
|
Error_Low_Bound := 0.0; -- reset
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed
|
Report.Failed
|
("Constraint_Error raised in Identity_Test" &
|
("Constraint_Error raised in Identity_Test" &
|
" for X=" & Real'Image (X));
|
" for X=" & Real'Image (X));
|
when others =>
|
when others =>
|
Report.Failed ("exception in Identity_Test" &
|
Report.Failed ("exception in Identity_Test" &
|
" for X=" & Real'Image (X));
|
" for X=" & Real'Image (X));
|
end Identity_Test;
|
end Identity_Test;
|
|
|
|
|
|
|
procedure Do_Test is
|
procedure Do_Test is
|
begin
|
begin
|
Special_Value_Test;
|
Special_Value_Test;
|
Exact_Result_Test;
|
Exact_Result_Test;
|
-- cover a large range
|
-- cover a large range
|
Identity_Test (1.0, Real'Safe_Last);
|
Identity_Test (1.0, Real'Safe_Last);
|
end Do_Test;
|
end Do_Test;
|
end Generic_Check;
|
end Generic_Check;
|
|
|
-----------------------------------------------------------------------
|
-----------------------------------------------------------------------
|
-----------------------------------------------------------------------
|
-----------------------------------------------------------------------
|
package Float_Check is new Generic_Check (Float);
|
package Float_Check is new Generic_Check (Float);
|
|
|
-- check the floating point type with the most digits
|
-- check the floating point type with the most digits
|
type A_Long_Float is digits System.Max_Digits;
|
type A_Long_Float is digits System.Max_Digits;
|
package A_Long_Float_Check is new Generic_Check (A_Long_Float);
|
package A_Long_Float_Check is new Generic_Check (A_Long_Float);
|
|
|
-----------------------------------------------------------------------
|
-----------------------------------------------------------------------
|
-----------------------------------------------------------------------
|
-----------------------------------------------------------------------
|
|
|
|
|
begin
|
begin
|
Report.Test ("CXG2017",
|
Report.Test ("CXG2017",
|
"Check the accuracy of the TANH function");
|
"Check the accuracy of the TANH function");
|
|
|
if Verbose then
|
if Verbose then
|
Report.Comment ("checking Standard.Float");
|
Report.Comment ("checking Standard.Float");
|
end if;
|
end if;
|
|
|
Float_Check.Do_Test;
|
Float_Check.Do_Test;
|
|
|
if Verbose then
|
if Verbose then
|
Report.Comment ("checking a digits" &
|
Report.Comment ("checking a digits" &
|
Integer'Image (System.Max_Digits) &
|
Integer'Image (System.Max_Digits) &
|
" floating point type");
|
" floating point type");
|
end if;
|
end if;
|
|
|
A_Long_Float_Check.Do_Test;
|
A_Long_Float_Check.Do_Test;
|
|
|
|
|
Report.Result;
|
Report.Result;
|
end CXG2017;
|
end CXG2017;
|
|
|