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

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;