Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / math / cwaite.tst < prev next >

Wrap

Text File | 1988-05-03 | 104.4 KB | 3,193 lines

--:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTMATH --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_Io; with Generic_Math_Functions; procedure Test_Math_Functions is type Floating is new Float; -- type Floating is new Long_Float; -- Alternatively package Integer_Io is new Text_Io.Integer_Io (Integer); package Floating_Io is new Text_Io.Float_Io (Floating); package Boolean_Io is new Text_Io.Enumeration_Io (Boolean); use Text_Io; use Integer_Io; use Floating_Io; use Boolean_Io; package Math_Functions is new Generic_Math_Functions (Floating); use Math_Functions; Output : File_Type; -- ########### S Y S T E M D E P E N D E N C I E S ############ Output_File_Name : constant String := "math_test.out;"; Test_Error_Log_File_Name : constant String := "math_test.out;"; -- ################################################################ One : constant Floating := Floating (1.0); Zero : constant Floating := One - One; Half : constant Floating := One / (One + One); Ibeta : Integer; -- The radix of the floating-point representation It : Integer; -- The number of base IBETA digits in the floating significand Irnd : Integer; -- TRUE (1) if floating addition rounds, FALSE (0) if truncates Ngrd : Integer; -- Number of guard digits for multiplication Machep : Integer; -- The largest negative integer such that -- 1.0 + floating(IBETA) ** MACHEP /= 1.0 -- except that MACHEP is bounded below by -(IT + 3) Negep : Integer; -- The largest negative integer such that -- 1.0 -0 floating(IBETA) ** NEGEP /= 1.0 -- except that NEGEP is bounded below by -(IT + 3) Iexp : Integer; -- The number of bits (decimal places if IBETA = 10) -- reserved for the representation of the exponent (including -- the bias or sign) of a floating-point number Minexp : Integer; -- The largest in magnitude negative integer such that -- floating(IBETA) ** MINEXP is a positive floating-point number Maxexp : Integer; -- The largest positive exponent for a finite floating-point number Eps : Floating; -- The smallest positive floating-point number such that -- 1.0 + EPS /= 1.0 -- In particular, if IBETA = 2 or IRND = 0, -- EPS = floating(IBETA) ** MACHEP -- Otherwise, EPS = (floating(IBETA) ** MACHEP) / 2 Epsneg : Floating; -- A small positive floating-poin number such that 1.0-EPSNEG /= 1.0 Xmin : Floating; -- The smallest non-vanishing floating-point power of the radix -- In particular, XMIN = floating(IBETA) ** MINEXP Xmax : Floating; -- The largest finite floating-point number procedure Machar is -- This initialization is the MACHAR routine of Cody and Waite Appendix B. A, B, Y, Z : Floating; I, K, Mx, Iz : Integer; Beta, Betam1, Betain : Floating; begin A := One; while (((A + One) - A) - One) = Zero loop A := A + A; end loop; B := One; while ((A + B) - A) = Zero loop B := B + B; end loop; Ibeta := Integer ((A + B) - A); Beta := Floating (Ibeta); It := 0; B := One; while (((B + One) - B) - One) = Zero loop It := It + 1; B := B * Beta; end loop; Irnd := 0; Betam1 := Beta - One; if ((A + Betam1) - A) /= Zero then Irnd := 1; end if; Negep := It + 3; Betain := One / Beta; A := One; for I in 1..Negep loop exit when I > Negep; A := A * Betain; end loop; B := A; while ((One - A) - One) = Zero loop A := A * Beta; Negep := Negep - 1; end loop; Negep := - Negep; Epsneg := A; if (Ibeta /= 2) and (Irnd /= 0) then A := (A * (One + A)) / (One + One); if ((One - A) - One) /= Zero then Epsneg := A; end if; end if; Machep := - It - 3; A := B; while ((One + A) - One) = Zero loop A := A * Beta; Machep := Machep + 1; end loop; Eps := A; if (Ibeta /= 2) and (Irnd /= 0) then A := (A * (One + A)) / (One + One); if ((One + A) - One) /= Zero then Eps := A; end if; end if; Ngrd := 0; if ((Irnd = 0) and ((One + Eps) * One - One) /= Zero) then Ngrd := 1; end if; Find_Iexp: declare Y : Floating := 1.0; A : Floating := Betain; I : Integer := 0; begin loop Y := A * A; exit when Y = 0.0; I := I + 1; A := Y; end loop; Iexp := I; end Find_Iexp; Find_Smallest: declare A, Y : Floating := 1.0; I : Integer := 0; begin loop Y := A / Beta; exit when Y = 0.0; I := I - 1; A := Y; end loop; Minexp := I; Xmin := A; end Find_Smallest; Find_Largest: declare A, Y : Floating := 1.0; I : Integer := 1; begin loop Y := A * Beta; I := I + 1; A := Y; end loop; exception when others => Maxexp := I; Xmax := A * ((1.0 - Epsneg) * Beta); end Find_Largest; New_Page; New_Line; Put ("IBETA "); Put (Ibeta); Put (" MACHINE_RADIX "); Put (Float'Machine_Radix); New_Line; Put ("IT "); Put (It); Put (" MACHINE_MANTISSA "); Put (Floating'Base'Machine_Mantissa); New_Line; Put ("IRND "); Put (Irnd); Put (" MACHINE_ROUNDS "); Put (Floating'Base'Machine_Rounds); New_Line; Put ("NEGEP "); Put (Negep); New_Line; Put ("EPSNEG "); Put (Epsneg); New_Line; Put ("MACHEP "); Put (Machep); New_Line; Put ("EPS "); Put (Eps); Put (" EPSILON "); Put (Float'Epsilon); New_Line; Put ("NGRD "); Put (Ngrd); New_Line; Put ("IEXP "); Put (Iexp); New_Line; Put ("MINEXP "); Put (Minexp); Put (" MACHINE_EMIN "); Put (Floating'Base'Machine_Emin); New_Line; Put ("XMIN "); Put (Xmin); New_Line; Put ("MAXEXP "); Put (Maxexp); Put (" MACHINE_EMAX "); Put (Floating'Base'Machine_Emax); New_Line; Put ("XMAX "); Put (Xmax); Put (" LAST "); Put (Floating'Base'Last); New_Line; New_Page; end Machar; Procedure Test_Sqrt is separate; Procedure Test_Cbrt is separate; Procedure Test_Log is separate; Procedure Test_Exp is separate; Procedure Test_Power is separate; Procedure Test_Sin_Cos is separate; Procedure Test_Tan_Cot is separate; Procedure Test_Asin_Acos is separate; Procedure Test_Atan is separate; Procedure Test_Sinh_Cosh is separate; Procedure Test_Tanh is separate; begin Create (Output, Out_File, Output_File_Name); Set_Output (Output); What_To_Do_When_There_Is_An_Error := Return_Default_And_Log; if Is_Open (Error_Log) then Delete (Error_Log); end if; Create (Error_Log, Out_File, Test_Error_Log_File_Name); Machar; Test_Sqrt; Test_Cbrt; Test_Log; Test_Exp; Test_Power; Test_Sin_Cos; Test_Tan_Cot; Test_Asin_Acos; Test_Atan; Test_Sinh_Cosh; Test_Tanh; Close (Output); Close (Error_Log); end Test_Math_Functions; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTSQRT --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Sqrt is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Y, Z : Floating; X1 : Floating; A, B, C : Floating; Beta : constant Floating := Floating (Ibeta); Sqbeta : constant Floating := Sqrt (Beta); Albeta : constant Floating := Log (Beta); Ait : constant Floating := Floating (It); Xn : constant Floating := Floating (N); begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- A := One / Sqbeta; B := One; for J in 1..2 loop C := Log (B / A); K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; for I in 1..N loop X := A * Exp (C * Ran); Y := X * X; Z := Sqrt (Y); W := (Z - X) / X; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + (W * W); end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); Put (" TEST OF SQRT(X*X)-X"); New_Line (3); Put (" "); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (A); Put (", "); Put (B); New_Line; Put (" SQRT(X) WAS LARGER "); Put (K1, 6); Put_Line (" TIMES"); Put (" AGREED "); Put (K2, 6); Put_Line (" TIMES"); Put (" WAS SMALLER "); Put (K3, 6); Put_Line (" TIMES"); New_Line; Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1, 5, 6); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); A := One; B := Sqbeta; end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" TEST OF SPECIAL ARGUMENTS"); New_Line (3); X := Xmin; Y := Sqrt (X); Put (" SQRT(XMIN) = SQRT("); Put (Xmin); Put (") = "); Put (Y); New_Line (3); X := One - Epsneg; Y := Sqrt (X); Put (" SQRT(1 - EPSNEG) = SQRT(1 - "); Put (Epsneg); Put (") = "); Put (Y); New_Line (3); X := One; Y := Sqrt (X); Put (" SQRT(1.0) = SQRT("); Put (X); Put (") = "); Put (Y); New_Line (3); X := One + Eps; Y := Sqrt (X); Put (" SQRT(1 + EPS) = SQRT(1 + "); Put (Eps); Put (") = "); Put (Y); New_Line (3); X := Xmax; Y := Sqrt (X); Put (" SQRT(XMAX) = SQRT("); Put (Xmax); Put (") = "); Put (Y); New_Line (3); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Zero; Put (" SQRT WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line (2); Y := Sqrt (X); Put (" SQRT RETURNED THE VALUE "); Put (Y); New_Line (4); X := - One; Put (" SQRT WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (2); Y := Sqrt (X); Put (" SQRT RETURNED THE VALUE "); Put (Y); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Sqrt; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTCBRT --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Cbrt is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Y, Z : Floating; X1 : Floating; A, B, C : Floating; Beta : constant Floating := Floating (Ibeta); Cbbeta : constant Floating := Cbrt (Beta); Albeta : constant Floating := Log (Beta); Ait : constant Floating := Floating (It); Xn : constant Floating := Floating (N); begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- A := One / Cbbeta / Cbbeta; for J in 1..3 loop A := A * Cbbeta; B := A * Cbbeta; C := Log (B / A); K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; for I in 1..N loop X := A * Exp (C * Ran); Y := X * X * X; Z := Cbrt (Y); W := (Z - X) / X; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + (W * W * W); end loop; K2 := N - K1 - K3; R7 := Cbrt (R7 / Xn); New_Line (6); Put (" TEST OF CBRT(X*X*X)-X"); New_Line (3); Put (" "); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (A); Put (", "); Put (B); New_Line; Put (" CBRT(X) WAS LARGER "); Put (K1, 6); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2, 6); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3, 6); Put (" TIMES"); New_Line; New_Line; Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1, 5, 6); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" TEST OF SPECIAL ARGUMENTS"); New_Line (3); X := Xmin; Y := Cbrt (X); Put (" CBRT(XMIN) = CBRT("); Put (Xmin); Put (") = "); Put (Y); New_Line (3); X := One - Epsneg; Y := Cbrt (X); Put (" CBRT(1 - EPSNEG) = CBRT(1 - "); Put (Epsneg); Put (") = "); Put (Y); New_Line (3); X := One; Y := Cbrt (X); Put (" CBRT(1.0) = CBRT("); Put (X); Put (") = "); Put (Y); New_Line (3); X := One + Eps; Y := Cbrt (X); Put (" CBRT(1 + EPS) = CBRT(1 + "); Put (Eps); Put (") = "); Put (Y); New_Line (3); X := Xmax; Y := Cbrt (X); Put (" CBRT(XMAX) = CBRT("); Put (Xmax); Put (") = "); Put (Y); New_Line (3); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Zero; Put (" CBRT WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line (3); Y := Cbrt (X); Put (" CBRT RETURNED THE VALUE "); Put (Y); New_Line (4); X := - One; Put (" CBRT WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line (3); Y := Cbrt (X); Put (" CBRT RETURNED THE VALUE "); Put (Y); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Cbrt; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTLOG --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Log is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, Del : Floating; Tenth : constant Floating := 0.1; Eight : constant Floating := 8.0; Beta : constant Floating := Floating (Ibeta); Albeta : constant Floating := Log (Beta); Ait : constant Floating := Floating (It); Xn : constant Floating := Floating (N); begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..4 loop case J is when 1 => C := One; for I in 1..It / 3 loop C := C / Beta; end loop; A := One - C; B := One + C; when 2 => A := Sqrt (Half); B := 15.0 / 16.0; when 3 => A := Sqrt (Tenth); B := 0.9; when 4 => A := 16.0; B := 240.0; end case; -- C := Log (B / A); K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; case J is when 1 => Y := (X - Half) - Half; Zz := Log (X); Z := One / 3.0; Z := Y * (Z - Y / 4.0); Z := (Z - Half) * Y * Y + Y; when 2 => X := (X + Eight) - Eight; Y := X + X / 16.0; Z := Log (X); Zz := Log (Y) - 7.77468_16434_84258_1E-5; Zz := Zz - 31.0 / 512.0; when 3 => X := (X + Eight) - Eight; Y := X + X * Tenth; Z := Log10 (X); Zz := Log10 (Y) - 3.77060_15822_50407_5E-4; Zz := Zz - 21.0 / 512.0; when 4 => Z := Log (X * X); Zz := Log (X); Zz := Zz + Zz; end case; W := One; if Z /= Zero then W := (Z - Zz) / Z; end if; Z := Sign (W, Z); if Z > Zero then K1 := K1 + 1; end if; if Z < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); case J is when 1 => Put (" TEST OF LOG(X) VS T.S. EXPANSION OF LOG(1+Y) "); New_Line (3); when 2 => Put (" TEST OF LOG(X) VS LOG(17X/16) - LOG(17/16) "); New_Line (3); when 3 => Put (" TEST OF LOG(X*X) VS 2 * LOG(X) "); New_Line (3); when 4 => Put (" TEST OF LOG10(X) VS LOG10(11X/10) - LOG10(11/10) "); New_Line (3); end case; Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; case J is when 1 => Put (" (1-EPS, 1+EPS), WHERE EPS = "); Put (C); New_Line (3); when 2 | 3 | 4 => Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; end case; case J is when 1 | 2 | 4 => Put (" LOG(X) WAS LARGER "); when 3 => Put (" LOG10(X) WAS LARGER "); end case; Put (K1, 6); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2, 6); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3, 6); Put (" TIMES"); New_Line (3); Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY LOG(X) = -LOG(1/X) WILL BE TESTED."); New_Line; for I in 1..5 loop X := Ran; X := X + X + 15.0; Y := One / X; Z := Log (X) + Log (Y); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (2); Put (" TEST OF SPECIAL ARGUMENTS "); New_Line (2); X := One; Y := Log (X); Put (" LOG(1.0) = "); Put (Y); New_Line (3); X := Xmin; Y := Log (X); Put (" LOG(XMIN) = LOG("); Put (Xmin); Put (") = "); Put (Y); New_Line (3); X := Xmax; Y := Log (X); Put (" LOG(XMAX) = LOG("); Put (Xmax); Put (") = "); Put (Y); New_Line (3); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put_Line (" TEST OF ERROR RETURNS"); New_Line (2); X := - 2.0; Put (" LOG WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (3); Y := Log (X); Put (" LOG RETURNED THE VALUE "); Put (Y); New_Line (4); X := Zero; Put (" LOG WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (3); Y := Log (X); Put (" LOG RETURNED THE VALUE "); Put (Y); New_Line (4); Put_Line (" THIS CONCLUDES THE TESTS"); end Test_Log; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTEXP --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Exp is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, D, Del : Floating; Tenth : constant Floating := 0.1; Ten : constant Floating := 10.0; V : Floating := 0.0625; Beta : Floating := Floating (Ibeta); Albeta : Floating := Log (Beta); Ait : Floating := Floating (It); Xn : Floating := Floating (N); Two : constant Floating := One + One; Half : constant Floating := One / Two; begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..3 loop case J is when 1 => A := Two; B := Log (A) * Half; A := - B + V; when 2 => V := 45.0 / 16.0; A := - Ten * B; B := Ten * Xmin * Beta ** It; -- Occasional underflow when 4.0 B := Log (B); when 3 => A := - Two * A; B := Ten * A; D := Log ((One - Tenth) * Xmax); -- if B < D then Cody-Waite seems to err here if B > D then B := D; end if; end case; K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; ----------------------------------------------------------- -- PURIFY ARGUMENTS ----------------------------------------------------------- Y := X - V; if Y < Zero then X := Y + V; end if; Z := Exp (X); Zz := Exp (Y); if J = 1 then Z := Z - Z * 6.05869_37186_52421_388E-2; else if Ibeta /= 10 then Z := Z * 0.0625 - Z * 2.44533_21046_92057_0389E-3; else Z := Z * 6.0E-2 + Z * 5.46678_95307_94296_106E-5; end if; end if; W := One; if Zz /= Zero then W := (Z - Zz) / Z; end if; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); Put (" TEST OF EXP(X - "); Put (V, 2, 4, 0); Put (") VS EXP(X)/EXP("); Put (V, 2, 4, 0); Put (") "); New_Line (3); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" EXP(X-V) WAS LARGER "); Put (K1, 6); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2, 6); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3, 6); Put (" TIMES"); New_Line (3); Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1, 5, 6); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY EXP(X)*EXP(-X) = 1.0) WILL BE TESTED."); New_Line; for I in 1..5 loop X := Ran * Beta; Y := - X; Z := Exp (X) * Exp (Y) - One; Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (2); Put (" TEST OF SPECIAL ARGUMENTS "); New_Line (2); X := Zero; Y := Exp (X) - One; Put (" EXP(0.0) - 1.0 = "); Put (Y); New_Line (3); X := Truncate (Log (Xmin)); Y := Exp (X); Put (" EXP("); Put (X); Put (") = "); Put (Y); New_Line (2); X := Truncate (Log (Xmax)); Y := Exp (X); Put (" EXP("); Put (X); Put (") = "); Put (Y); New_Line (2); X := X / Two; C := X / Two; Y := Exp (X); Z := Exp (C); Z := Z * Z; New_Line; Put (" IF EXP("); Put (X); Put (") = "); Put (Y); Put (" IS NOT ABOUT "); New_Line; Put (" EXP("); Put (C); Put (")**2 = "); Put (Z); Put (" THERE IS AN ARG RED ERROR"); New_Line (4); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := - One / Sqrt (Xmin); Put (" EXP WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (2); Y := Exp (X); Put (" EXP RETURNED THE VALUE "); Put (Y); New_Line (4); X := - X; Put (" EXP WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (2); Y := Exp (X); Put (" EXP RETURNED THE VALUE "); Put (Y); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Exp; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTPOWER --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Power is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; J, K1, K2, K3 : Integer; R6, R7 : Floating; W, X, X1, Xl, Xsq, Y, Y2, Z, Zz : Floating; A, B, C, D, Del, Dely, Scale : Floating; Y1 : Floating := One; Beta : constant Floating := Floating (Ibeta); Albeta : constant Floating := Log (Beta); Ait : Floating := Floating (It); Xn : Floating := Floating (N); Alxmax : constant Floating := Log (Xmax); Two : constant Floating := One + One; Onep5 : constant Floating := (Two + One) / Two; begin New_Page; Scale := One; J := (It + 1) / 2; for I in 1..J loop Scale := Scale * Beta; end loop; A := One / Beta; B := One; C := Max (Alxmax, Log (Xmin)) / Log (100.0); Dely := - C - C; ----------------------------------------------------------------------- -- RANDOM ARGUMENT ACCURACY TESTS ----------------------------------------------------------------------- for J in 1..4 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; case J is when 1 => Zz := X ** One; Z := X; when 2 | 3 => W := Scale * X; X := (X + W) - W; Xsq := X * X; Zz := Xsq ** Onep5; Z := X * Xsq; when 4 => W := Scale * X; X := (X + W) - W; Xsq := X * X; Y := Dely * Ran + C; Y2 := (Y / Two + Y) - Y; Y := Y2 + Y2; Z := X ** Y; Zz := Xsq ** Y2; end case; W := One; if Z /= Zero then W := (Z - Zz) / Z; end if; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; if J = 4 then Y1 := Y; end if; else R7 := R7 + W * W; Xl := Xl + Del; end if; end loop; K2 := N - K3 - K1; R7 := Sqrt (R7 / Xn); New_Line (6); case J is when 1 => Put ("TEST OF X ** 1.0 VS X"); New_Line (2); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL"); New_Line; Put (" ("); Put (A); Put (", "); Put (B); Put (")"); New_Line; Put ("X ** 1.0 WAS LARGER "); when 2 | 3 => Put ("TEST OF XSQ ** 1.5 VS XSQ * X"); New_Line (2); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL"); New_Line; Put (" ("); Put (A); Put (", "); Put (B); Put (")"); New_Line; Put ("X ** 1.5 WAS LARGER "); when 4 => Put ("TEST OF XSQ ** 1.5 VS XSQ ** Y/2"); New_Line (2); D := C + Dely; Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE REGION"); New_Line; Put ("X IN "); Put (A); Put (", "); Put (B); New_Line; Put ("Y IN "); Put (C); Put (", "); Put (D); New_Line; Put ("X ** Y WAS LARGER "); end case; Put (K1, 6); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2, 6); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3, 6); Put (" TIMES"); New_Line (3); Put ("THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line; W := - 999.0; if R6 /= Zero then W := Log (abs (R6)) / Albeta; end if; Put ("THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" ** "); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); case J is when 1 | 2 | 3 => New_Line; when 4 => Put (", Y = "); Put (Y1); New_Line; end case; W := Max (Ait + W, Zero); Put ("THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS"); Put (W, 4, 2, 0); New_Line (2); W := - 999.0; if R7 /= Zero then W := Log (abs (R7)) / Albeta; end if; Put ("THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" ** "); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put ("THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS"); Put (W, 4, 2, 0); New_Line (2); case J is when 1 => null; when 2 | 4 => A := One; B := Exp (Alxmax / 3.0); when 3 => B := 10.0; A := 0.01; end case; end loop; ------------------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------------------ New_Line (6); Put ("SPECIAL TESTS "); New_Line (3); Put ("THE IDENTITY X ** Y = (1/X) ** (-Y) WILL BE TESTED"); New_Line; B := 10.0; for I in 1..5 loop X := Ran * B + One; Y := Ran * B + One; Z := X ** Y; Zz := (One / X) ** (- Y); W := (Z - Zz) / Z; Put (X); Put (" "); Put (Y); Put (" "); Put (W); New_Line; end loop; -------------------------------------------------------------------------- -- TEST OF ERROR RETURNS -------------------------------------------------------------------------- New_Line (6); Put ("TEST OF ERROR RETURNS "); New_Line (2); X := Beta; Y := Floating (Minexp); Put (X); Put (" ** "); Put (Y); Put (" WILL BE COMPUTED"); New_Line; Put ("THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line (2); Z := X ** Y; Put ("THE VALUE RETURNED IS "); Put (Z); New_Line (4); Y := Floating (Maxexp - 1); Put (X); Put (" ** "); Put (Y); Put (" WILL BE COMPUTED"); New_Line; Put ("THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line (2); Z := X ** Y; Put ("THE VALUE RETURNED IS "); Put (Z); New_Line (4); X := Zero; Y := Two; Put (X); Put (" ** "); Put (Y); Put (" WILL BE COMPUTED"); New_Line; Put ("THIS SHOULD NOT TRIGGER AN ERROR MESSAGE "); New_Line (2); Z := X ** Y; Put ("THE VALUE RETURNED IS "); Put (Z); New_Line (4); X := - Two; Y := Zero; Put (X); Put (" ** "); Put (Y); Put (" WILL BE COMPUTED"); New_Line; Put ("THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (2); Z := X ** Y; Put ("THE VALUE RETURNED IS "); Put (Z); New_Line (4); X := - Two; Y := Two; Put (X); Put (" ** "); Put (Y); Put (" WILL BE COMPUTED"); New_Line; Put ("THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (2); Z := X ** Y; Put ("THE VALUE RETURNED IS "); Put (Z); New_Line (4); X := Zero; Y := Zero; Put (X); Put (" ** "); Put (Y); Put (" WILL BE COMPUTED"); New_Line; Put ("THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line (2); Z := X ** Y; Put ("THE VALUE RETURNED IS "); Put (Z); New_Line (4); Put_Line ("THIS CONCLUDES THE TESTS"); end Test_Power; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTSIN --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Sin_Cos is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, D, Del : Floating; Beta : constant Floating := Floating (Ibeta); Albeta : constant Floating := Log (Beta); Betap : Floating := Beta ** It; Ait : Floating := Floating (It); Xn : Floating := Floating (N); Three : constant Floating := One + One + One; begin New_Page; A := Zero; B := 1.57079_63267_94896_61923; C := B; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..3 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; ----------------------------------------------------------- -- PURIFY ARGUMENTS ----------------------------------------------------------- Y := X / Three; Y := (X + Y) - X; X := Three * Y; case J is when 1 | 2 => Z := Sin (X); Zz := Sin (Y); if Z = 0.0 then W := One; else W := (Z - Zz * (Three - 4.0 * Zz * Zz)) / Z; end if; when 3 => Z := Cos (X); Zz := Cos (Y); if Z = 0.0 then W := One; else W := (Z + Zz * (Three - 4.0 * Zz * Zz)) / Z; end if; end case; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); case J is when 1 | 2 => Put (" TEST OF SIN(X) VS 3*SIN(X/3) - 4*SIN(X/3)**3 "); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" SIN(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line; New_Line; New_Line; when 3 => Put (" TEST OF COS(X) VS 4*COS(X/3)**3 - 3*COS(X/3) "); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" COS(X) WAS LARGER "); Put (K1, 6); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2, 6); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3, 6); Put (" TIMES"); New_Line (3); end case; Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1, 5, 9); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); A := 18.84955592; if J = 2 then A := B + C; end if; B := A + C; end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); C := One / Beta ** (It / 2); Z := (Sin (A + C) - Sin (A - C)) / (C + C); Put (" IF "); Put (Z); Put (" IS NOT ALMOST 1.0, SIN HAS THE WRONG PERIOD. "); New_Line (3); Put (" THE IDENTITY SIN(-X) = -SIN(X) WILL BE TESTED."); New_Line (3); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Sin (X) + Sin (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (2); Put (" THE IDENTITY SIN(X) = X X SMALL, WILL BE TESTED"); New_Line (2); Put (" X X - F(X)"); New_Line; X := Ran / Betap; for I in 1..5 loop Z := X - Sin (X); Put (X); Put (" "); Put (Z); New_Line; X := X / Beta; end loop; New_Line (3); Put (" THE IDENTITY COS(-X) = COS(X) WILL BE TESTED"); New_Line (2); Put (" X F(X) - F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Cos (X) - Cos (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT. "); New_Line; X := Beta ** (- It); Y := Sin (X); New_Line; Put (" SIN("); Put (X); Put (") = "); Put (Y); New_Line (4); Put (" THE FOLLOWING 3 LINES ILLUSTRATE THE LOSS IN SIGNIFICANCE"); New_Line; Put (" FOR LARGE ARGUMENTS. "); Put (" THE ARGUMENTS ARE CONSECUTIVE."); New_Line; Z := Sqrt (Betap); X := Z * (One - Epsneg); Y := Sin (X); Put (" SIN("); Put (X); Put (") = "); Put (Y); New_Line; Y := Sin (Z); Put (" SIN("); Put (X); Put (") = "); Put (Y); New_Line; X := Z * (One + Eps); Y := Sin (X); Put (" SIN("); Put (X); Put (") = "); Put (Y); New_Line; ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Betap; Put (" SIN WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line; Y := Sin (X); Put (" SIN RETURNED THE VALUE "); Put (Y); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Sin_Cos; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTTAN --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Tan_Cot is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, D, Del : Floating; Beta : Floating := Floating (Ibeta); Albeta : Floating := Log (Beta); Betap : Floating := Beta ** It; Ait : Floating := Floating (It); Xn : Floating := Floating (N); Half : constant Floating := One / (One + One); begin New_Page; A := Zero; B := Pi * 0.25; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..4 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; ----------------------------------------------------------- -- PURIFY ARGUMENTS ----------------------------------------------------------- Y := X * Half; X := Y + Y; case J is when 1..3 => Z := Tan (X); Zz := Tan (Y); if Z = 0.0 then W := One; else W := ((Half - Zz) + Half) * ((Half + Zz) + Half); W := (Z - (Zz + Zz) / W) / Z; end if; when 4 => Z := Cot (X); Zz := Cot (Y); if Z = 0.0 then W := One; else W := ((Half - Zz) + Half) * ((Half + Zz) + Half); W := (Z + W / (Zz + Zz)) / Z; end if; end case; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); case J is when 1..3 => Put (" TEST OF TAN(X) VS 2*TAN(X/2) / (1-TAN(X/2)**2) "); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" TAN(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line (3); when 4 => Put (" TEST OF COT(X) VS (COT(X/2)**2-1) / (2*COT(X/2)) "); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" COT(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line; New_Line; New_Line; end case; Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); if J = 1 then A := Pi * 0.875; B := Pi * 1.125; else A := Pi * 6.0; B := A + Pi * 0.25; end if; end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY TAN(-X) = -TAN(X) WILL BE TESTED."); New_Line (2); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Tan (X) + Tan (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" THE IDENTITY TAN(X) = X X SMALL WILL BE TESTED."); New_Line (2); Put (" X X - F(X) "); New_Line (2); X := Ran / Betap; for I in 1..5 loop Z := X - Tan (X); Put (X); Put (" "); Put (Z); New_Line; X := X / Beta; end loop; New_Line (3); Put (" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT. "); New_Line; X := Beta ** ((Minexp * 3) / 4); Y := Tan (X); Put (" TAN("); Put (X); Put (") = "); Put (Y); New_Line (4); A := - 225.0; B := - 0.95084_64541_95142_026; X := 11.0; Y := Tan (X); W := ((A - Y) + B) / (A + B); Z := Log (abs (W)) / Albeta; Put (" THE RELATIVE ERROR IN TAN(11) IS "); Put (W, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (Z, 4, 2, 0); Put (" WHERE "); New_Line; Put (" TAN("); Put (X); Put (") = "); Put (Y); New_Line; W := Max (Ait + Z, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Beta ** (It / 2); Put (" TAN WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Y := Tan (X); New_Line; Put (" TAN RETURNED THE VALUE "); Put (Y); New_Line (4); X := Betap; Put (" TAN WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line; Y := Tan (X); New_Line; Put (" TAN RETURNED THE VALUE "); Put (Y); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Tan_Cot; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTASIN --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Asin_Acos is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, D, Del : Floating; type Routine is (F_Asin, F_Acos); L : Routine; Sum, Xm, Ysq, S : Floating; C1, C2 : Floating; Beta : Floating := Floating (Ibeta); Albeta : Floating := Log (Beta); Betap : Floating := Beta ** It; Ait : Floating := Floating (It); Xn : Floating := Floating (N); K : Integer := Integer (Log10 (Beta ** It) + 0.5) + 1; Half : constant Floating := One / (One + One); begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..5 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; case J is when 1 => A := - 0.125; B := 0.125; C1 := 201.0 / 128.0; C2 := 4.83826_79489_66192_3132E-4; L := F_Asin; when 2 => A := - 0.125; B := 0.125; L := F_Acos; when 3 => A := 0.75; B := 1.00; L := F_Asin; when 4 => A := 0.75; B := 1.00; L := F_Acos; when 5 => A := - 1.00; B := - 0.75; C1 := C1 + C1; C2 := C2 + C2; L := F_Acos; end case; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; case J is when 1 | 2 => Y := X; Ysq := Y * Y; when 3 | 4 => Ysq := Half - Half * abs (X); X := (Half - (Ysq + Ysq)) + Half; Y := Sqrt (Ysq); Y := Y + Y; when 5 => Ysq := Half - Half * abs (X); X := (Half - (Ysq + Ysq)) + Half; X := - X; Y := Sqrt (Ysq); Y := Y + Y; end case; Sum := Zero; Xm := Floating (K + K + 1); case L is when F_Asin => Z := Asin (X); when F_Acos => Z := Acos (X); end case; for M in 1..K loop Sum := Ysq * (Sum + 1.0 / Xm); Xm := Xm - 2.0; Sum := Sum * (Xm / (Xm + 1.0)); end loop; Sum := Sum * Y; case J is when 1 | 4 => Zz := Y + Sum; Sum := (Y - Zz) + Sum; when 2 | 3 | 5 => S := C1 + C2; Sum := ((C1 - S) + C2) - Sum; Zz := S + Sum; Sum := ((S - Zz) + Sum) - Y; S := Zz; Zz := S + Sum; Sum := (S - Zz) + Sum; end case; if Irnd /= 1 then Zz := Zz + (Sum + Sum); end if; W := 1.0; if Z /= 0.0 then W := (Z - Zz) / Z; end if; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); case L is when F_Asin => Put (" TEST OF ASIN(X) VS TAYLOR SERIES "); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" ASIN(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line (3); when F_Acos => Put (" TEST OF ACOS(X) VS TAYLOR SERIES "); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" ACOS(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line (3); end case; Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY ASIN(-X) = -ASIN(X) WILL BE TESTED."); New_Line (2); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Asin (X) + Asin (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" THE IDENTITY ASIN(X) = X X SMALL WILL BE TESTED."); New_Line (2); Put (" X X - F(X) "); New_Line (2); X := Ran / Betap; for I in 1..5 loop Z := X - Asin (X); Put (X); Put (" "); Put (Z); New_Line; X := X / Beta; end loop; New_Line (3); Put (" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT. "); New_Line; X := Beta ** ((Minexp * 3) / 4); Y := Asin (X); Put (" ASIN("); Put (X); Put (") = "); Put (Y); New_Line (4); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := 1.2; Put (" ASIN WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line; Y := Asin (X); New_Line; Put (" ASIN RETURNED THE VALUE "); Put (Y); New_Line (3); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Asin_Acos; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTATAN --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Atan is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, D, Del : Floating; Sum, Xsq, Ob32, Em : Floating; Beta : Floating := Floating (Ibeta); Albeta : Floating := Log (Beta); Betap : Floating := Beta ** It; Ait : Floating := Floating (It); Xn : Floating := Floating (N); Two : constant Floating := One + One; Half : constant Floating := One / Two; begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..4 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; case J is when 1 => A := - 0.0625; B := - A; Ob32 := B * Half; when 2 => A := B; B := Two - Sqrt (3.0); when 3 => A := B; B := Sqrt (2.0) - One; when 4 => A := B; B := One; end case; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; case J is when 1 => Z := Atan (X); Xsq := X * X; Em := 17.0; Sum := Xsq / Em; for Ii in 1..7 loop Em := Em - Two; Sum := (One / Em - Sum) * Xsq; end loop; Sum := - X * Sum; Zz := X + Sum; Sum := (X - Zz) + Sum; if Irnd = 0 then Zz := Zz + (Sum + Sum); end if; when 2 => X := ((One + X * A) - One) * 16.0; Z := Atan (X); Y := X - 0.0625; Y := Y / (One + X * A); Zz := (Atan (Y) - 8.11900_04042_65152_6021E-5) + Ob32; Zz := Zz + Ob32; when 3..4 => Z := Atan (X); Z := Z + Z; Y := X / ((Half + X * Half) * ((Half - X) + Half)); Zz := Atan (Y); end case; W := 1.0; if Z /= 0.0 then W := (Z - Zz) / Z; end if; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); case J is when 1 => Put (" TEST OF ATAN(X) VS TRUNCATED TAYLOR SERIES "); when 2 => Put (" TEST OF ATAN(X) VS ATAN(1/16) + ATAN((X-1/16)/(1+X/16))"); when 3..4 => Put (" TEST OF 2*ATAN(X) VS ATAN(2X/(1-X*X))"); end case; New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" ATAN(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line (3); Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY ATAN(-X) = -ATAN(X) WILL BE TESTED."); New_Line (2); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Atan (X) + Atan (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" THE IDENTITY ATAN(X) = X X SMALL WILL BE TESTED."); New_Line (2); Put (" X X - F(X) "); New_Line (2); X := Ran / Betap; for I in 1..5 loop Z := X - Atan (X); Put (X); Put (" "); Put (Z); New_Line; X := X / Beta; end loop; New_Line (3); Put (" THE IDENTITY ATAN(X/Y) = ATAN2(X,Y) WILL BE TESTED"); New_Line; Put (" THE FIRST COLUMN OF RESULTS SHOULD BE 0, THE SECOND +-PI"); New_Line (2); Put (" X Y "); Put ("F1(X/Y)-F2(X,Y) F1(X/Y)-F2(X/(-Y))"); New_Line (2); A := - 2.0; B := 4.0; for I in 1..5 loop X := Ran * B + A; Y := Ran; W := - Y; Z := Atan (X / Y) - Atan2 (X, Y); Zz := Atan (X / W) - Atan2 (X, W); Put (X); Put (" "); Put (Y); Put (" "); Put (Z); Put (" "); Put (Zz); New_Line; end loop; New_Line (3); Put (" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT. "); New_Line; X := Beta ** ((Minexp * 3) / 4); Y := Atan (X); Put (" ATAN("); Put (X); Put (") = "); Put (Y); New_Line (4); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Xmax; Put (" ATAN WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Atan (X); New_Line; Put (" ATAN RETURNED THE VALUE "); Put (Z); New_Line (4); X := One; Y := Zero; Put (" ATAN2 WILL BE CALLED WITH THE ARGUMENTS "); Put (X); Put (" "); Put (Y); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Atan2 (X, Y); New_Line; Put (" ATAN2 RETURNED THE VALUE "); Put (Z); New_Line (4); X := Xmin; Y := Xmax; Put (" ATAN2 WILL BE CALLED WITH THE ARGUMENTS "); Put (X); Put (" "); Put (Y); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Atan2 (X, Y); New_Line; Put (" ATAN2 RETURNED THE VALUE "); Put (Z); New_Line (4); X := Xmax; Y := Xmin; Put (" ATAN2 WILL BE CALLED WITH THE ARGUMENTS "); Put (X); Put (" "); Put (Y); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Atan2 (X, Y); New_Line; Put (" ATAN2 RETURNED THE VALUE "); Put (Z); New_Line (4); X := Zero; Y := Zero; Put (" ATAN2 WILL BE CALLED WITH THE ARGUMENTS "); Put (X); Put (" "); Put (Y); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line; Z := Atan2 (X, Y); New_Line; Put (" ATAN2 RETURNED THE VALUE "); Put (Z); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Atan; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTSINH --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Sinh_Cosh is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; Two : constant Floating := One + One; Three : constant Floating := One + One + One; Half : constant Floating := One / Two; N : Integer := 2000; K1, K2, K3 : Integer; I2 : Integer; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; Xn : Floating := Floating (N); A, B, C, D, Del : Floating; Den, Xsq : Floating; Nit : Integer := 2 - Integer (Truncate (Log (Eps) * Three)) / 20; Aind : Floating := Floating (Nit + Nit + 1); Beta : Floating := Floating (Ibeta); Alxmax : Floating := Log (Xmax); Albeta : Floating := Log (Beta); Ait : Floating := Floating (It); Betap : Floating := Beta ** It; C0 : Floating := 5.0 / 16.0 + 1.15271_36831_94269_979E-2; begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- for J in 1..4 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; case J is when 1 => A := Zero; B := Half; when 2 => A := Zero; B := Half; Aind := Aind - One; when 3..4 => A := Three; B := Alxmax; end case; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; case J is when 1 => Xsq := X * X; Zz := One; Den := Aind; for Ii in 2..Nit loop W := Zz * Xsq / (Den * (Den - One)); Zz := W + One; Den := Den - Two; end loop; W := X * Xsq * Zz / 6.0; Zz := X + W; Z := Sinh (X); if Irnd = 0 then W := (X - Zz) + W; Zz := Zz + (W + W); end if; when 2 => Xsq := X * X; Zz := One; Den := Aind; for Ii in 1..Nit loop W := Zz * Xsq / (Den * (Den - One)); Zz := W + One; Den := Den - Two; end loop; Z := Cosh (X); if Irnd = 0 then W := (One - Zz) + W; Zz := Zz + (W + W); end if; when 3 => Y := X; X := Y - One; W := X - One; Z := Sinh (X); Zz := (Sinh (Y) + Sinh (W)) * C0; when 4 => Y := X; X := Y - One; W := X - One; Z := Cosh (X); Zz := (Cosh (Y) + Cosh (W)) * C0; end case; W := 1.0; if Z /= 0.0 then W := (Z - Zz) / Z; end if; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); case J is when 1 => Put (" TEST OF SINH(X) VS TAYLOR SERIES EXPANSION OF SINH(X) "); when 2 => Put (" TEST OF COSH(X) VS TAYLOR SERIES EXPANSION OF COSH(X) "); when 3 => Put (" TEST OF SINH(X) VS C * (SINH(X+1) + SINH(X-1)) "); when 4 => Put (" TEST OF COSH(X) VS C * (COSH(X+1) + COSH(X-1)) "); end case; New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; case J is when 1 | 3 => Put (" SINH(X)"); when 2 | 4 => Put (" COSH(X)"); end case; Put (" WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line (3); Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY SINH(-X) = -SINH(X) WILL BE TESTED."); New_Line (2); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Sinh (X) + Sinh (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" THE IDENTITY SINH(X) = X X SMALL WILL BE TESTED."); New_Line (2); Put (" X X - F(X) "); New_Line (2); X := Ran / Betap; for I in 1..5 loop Z := X - Sinh (X); Put (X); Put (" "); Put (Z); New_Line; X := X / Beta; end loop; New_Line (3); Put (" THE IDENTITY COSH(-X) = COSH(X) WILL BE TESTED."); New_Line (2); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran * A; Z := Cosh (X) - Cosh (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT. "); New_Line; X := Beta ** ((Minexp * 3) / 4); Y := Sinh (X); Put (" SINH("); Put (X); Put (") = "); Put (Y); New_Line (4); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Alxmax + 0.125; Put (" SINH WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Sinh (X); New_Line; Put (" SINH RETURNED THE VALUE "); Put (Z); New_Line (4); X := Betap; Put (" SINH WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD TRIGGER AN ERROR MESSAGE"); New_Line; Z := Sinh (X); New_Line; Put (" SINH RETURNED THE VALUE "); Put (Z); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Sinh_Cosh; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TESTTANH --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: separate (Test_Math_Functions) procedure Test_Tanh is use Text_Io; use Integer_Io, Floating_Io; use Math_Functions; N : Integer := 2000; K1, K2, K3 : Integer; I2 : Integer := 2; R6, R7 : Floating; W, X, Xl, Y, Z, Zz : Floating; X1 : Floating; A, B, C, D, Del : Floating; Den, Xsq : Floating; Beta : Floating := Floating (Ibeta); Albeta : Floating := Log (Beta); Alxmax : Floating := Log (Xmax); Betap : Floating := Beta ** It; Ait : Floating := Floating (It); Xn : Floating := Floating (N); Half : constant Floating := One / (One + One); begin New_Page; ----------------------------------------------------------- -- RANDOM ARGUMENT TESTS ----------------------------------------------------------- C := 1.24353_00177_15962_0805E-1; D := Log (2.0) + (Ait + One) * Log (Beta) * Half; for J in 1..2 loop K1 := 0; K3 := 0; X1 := Zero; R6 := Zero; R7 := Zero; case J is when 1 => A := 0.125; B := Log (3.0) * Half; when 2 => A := B + A; B := D; end case; Del := (B - A) / Xn; Xl := A; for I in 1..N loop X := Del * Ran + Xl; Z := Tanh (X); Y := X - 0.125; Zz := Tanh (Y); Zz := (Zz + C) / (One + C * Zz); W := 1.0; if Z /= 0.0 then W := (Z - Zz) / Z; end if; if W > Zero then K1 := K1 + 1; end if; if W < Zero then K3 := K3 + 1; end if; W := abs (W); if W > R6 then R6 := W; X1 := X; end if; R7 := R7 + W * W; Xl := Xl + Del; end loop; K2 := N - K1 - K3; R7 := Sqrt (R7 / Xn); New_Line (6); Put (" TEST OF TANH(X) VS "); Put ("(TANH(X-1/8)+TANH(1/8))/(1+TANH(X-1/8)TANH(1/8))"); New_Line (3); Put (N); Put (" RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL "); New_Line; Put (" ("); Put (A); Put (","); Put (B); Put (")"); New_Line; Put (" TANH(X) WAS LARGER "); Put (K1); Put (" TIMES"); New_Line; Put (" AGREED "); Put (K2); Put (" TIMES"); New_Line; Put (" WAS SMALLER "); Put (K3); Put (" TIMES"); New_Line (3); Put (" THERE ARE "); Put (It, 4); Put (" BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER"); New_Line (3); W := - 999.0E0; if (R6 /= Zero) then W := Log (abs (R6)) / Albeta; end if; Put (" THE MAXIMUM RELATIVE ERROR OF "); Put (R6, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; Put (" OCCURED FOR X = "); Put (X1); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); W := - 999.0E0; if (R7 /= Zero) then W := Log (abs (R7)) / Albeta; end if; Put (" THE ROOT MEAN SQUARE RELATIVE ERROR WAS "); Put (R7, 5, 4, 2); Put (" = "); Put (Ibeta, 4); Put (" **"); Put (W, 4, 2, 0); New_Line; W := Max (Ait + W, Zero); Put (" THE ESTIMATED LOSS OF BASE "); Put (Ibeta, 4); Put (" SIGNIFICANT DIGITS IS "); Put (W, 4, 2, 0); New_Line (2); end loop; ------------------------------------------------------------ -- SPECIAL TESTS ------------------------------------------------------------ New_Line (6); Put (" SPECIAL TESTS"); New_Line (3); Put (" THE IDENTITY TANH(-X) = -TANH(X) WILL BE TESTED."); New_Line (2); Put (" X F(X) + F(-X)"); New_Line (2); for I in 1..5 loop X := Ran; Z := Tanh (X) + Tanh (- X); Put (X); Put (" "); Put (Z); New_Line; end loop; New_Line (3); Put (" THE IDENTITY TANH(X) = X X SMALL WILL BE TESTED."); New_Line (2); Put (" X X - F(X) "); New_Line (2); X := Ran / Betap; for I in 1..5 loop Z := X - Tanh (X); Put (X); Put (" "); Put (Z); New_Line; X := X / Beta; end loop; New_Line (3); Put (" THE IDENTITY TANH(X) = 1 X LARGE WILL BE TESTED."); New_Line (2); Put (" X F(X) - 1 "); New_Line (2); X := D; B := 4.0; for I in 1..5 loop Z := (Tanh (X) - Half) - Half; Put (X); Put (" "); Put (Z); New_Line; X := X + B; end loop; New_Line (3); Put (" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT. "); New_Line; X := Beta ** ((Minexp * 3) / 4); Y := Tanh (X); Put (" TANH("); Put (X); Put (") = "); Put (Y); New_Line (4); ------------------------------------------------------------ -- TESTS OF ERROR RETURNS ------------------------------------------------------------ New_Line (6); Put (" TEST OF ERROR RETURNS"); New_Line (3); X := Xmax; Put (" TANH WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Tanh (X); New_Line; Put (" TANH RETURNED THE VALUE "); Put (Z); New_Line (4); X := Xmin; Put (" TANH WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Tanh (X); New_Line; Put (" TANH RETURNED THE VALUE "); Put (Z); New_Line (4); X := Zero; Put (" TANH WILL BE CALLED WITH THE ARGUMENT "); Put (X); New_Line; Put (" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE"); New_Line; Z := Tanh (X); New_Line; Put (" TANH RETURNED THE VALUE "); Put (Z); New_Line (4); Put (" THIS CONCLUDES THE TESTS"); New_Line; end Test_Tanh;