Return to ts_matfun.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers

Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/ts_matfun.adb, Revision 1.1

1.1     ! maekawa     1: with text_io,integer_io;                 use text_io,integer_io;
        !             2: with Standard_Floating_Numbers;          use Standard_Floating_Numbers;
        !             3: with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
        !             4: with Standard_Mathematical_Functions;    use Standard_Mathematical_Functions;
        !             5: with Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
        !             6: with Multprec_Floating_Numbers_io;       use Multprec_Floating_Numbers_io;
        !             7: with Multprec_Mathematical_Functions;    use Multprec_Mathematical_Functions;
        !             8:
        !             9: procedure ts_matfun is
        !            10:
        !            11:   procedure Read ( f : in out Floating_Number; name : in string ) is
        !            12:
        !            13:     n : natural;
        !            14:
        !            15:   begin
        !            16:     put("Give " & name & " : "); get(f);
        !            17:     put("Current size is "); put(Size_Fraction(f),1);
        !            18:     put(".  Give expansion factor : "); get(n);
        !            19:     if n > 0
        !            20:      then Expand(f,n);
        !            21:     end if;
        !            22:   end Read;
        !            23:
        !            24:   procedure Test_Standard_COS_and_SIN is
        !            25:
        !            26:     x,cx,sx : double_float;
        !            27:     ans : character;
        !            28:
        !            29:   begin
        !            30:     new_line;
        !            31:     put_line("Testing whether cos^2(x) + sin^2(x) = 1 holds.");
        !            32:     loop
        !            33:       new_line;
        !            34:       put("Give x : "); get(x);
        !            35:       cx := COS(x);  cx := cx*cx;
        !            36:       sx := SIN(x);  sx := sx*sx;
        !            37:       put("cos^2(x) + sin^2(x) = "); put(cx+sx); new_line;
        !            38:       put("Do you want more tests ? (y/n) "); get(ans);
        !            39:       exit when (ans /= 'y');
        !            40:     end loop;
        !            41:   end Test_Standard_COS_and_SIN;
        !            42:
        !            43:   procedure Test_Standard_SQRT is
        !            44:
        !            45:     x,y,diff : double_float;
        !            46:
        !            47:   begin
        !            48:     put("Give x : "); get(x);
        !            49:     y := SQRT(x);
        !            50:     put("SQRT(x) : "); put(y); new_line;
        !            51:     y := y*y;
        !            52:     put("(SQRT(x))**2 : "); put(y); new_line;
        !            53:     diff := x - y;
        !            54:     put("x - (SQRT(x))**2 : "); put(diff); new_line;
        !            55:   end Test_Standard_SQRT;
        !            56:
        !            57:   procedure Test_Multprec_SQRT is
        !            58:
        !            59:     x,y,diff : Floating_Number;
        !            60:
        !            61:   begin
        !            62:     Read(x,"x");
        !            63:    -- put("Give x : "); get(x);
        !            64:     y := SQRT(x);
        !            65:     put("SQRT(x) : "); put(y); new_line;
        !            66:     Mul(y,y);
        !            67:     put("SQRT(x))**2 : "); put(y); new_line;
        !            68:     diff := x - y;
        !            69:     put("x - (SQRT(x))**2 : "); put(diff); new_line;
        !            70:   end Test_Multprec_SQRT;
        !            71:
        !            72:   procedure Main is
        !            73:
        !            74:     ans : character;
        !            75:
        !            76:   begin
        !            77:     new_line;
        !            78:     put_line("Testing some mathematical functions.");
        !            79:     loop
        !            80:       new_line;
        !            81:       put_line("Choose one of the following : ");
        !            82:       put_line("  0. Exit this program.");
        !            83:       put_line("  1. COS/SIN for standard floating-point numbers.");
        !            84:       put_line("  2. SQRT for standard floating-point numbers.");
        !            85:       put_line("  3. SQRT for multi-precision floating-point numbers.");
        !            86:       put("Type 0,1,2 or 3 to make your selection : "); get(ans);
        !            87:       exit when (ans = '0');
        !            88:       case ans is
        !            89:         when '1' => Test_Standard_COS_and_SIN;
        !            90:         when '2' => Test_Standard_SQRT;
        !            91:         when '3' => Test_Multprec_SQRT;
        !            92:         when others => null;
        !            93:       end case;
        !            94:     end loop;
        !            95:   end Main;
        !            96:
        !            97: begin
        !            98:   Main;
        !            99: end ts_matfun;