Return to ts_matfun.adb CVS log

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

Import the second public release of PHCpack.

OKed by Jan Verschelde.

with text_io,integer_io;                 use text_io,integer_io;
with Standard_Floating_Numbers;          use Standard_Floating_Numbers;
with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
with Standard_Mathematical_Functions;    use Standard_Mathematical_Functions;
with Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
with Multprec_Floating_Numbers_io;       use Multprec_Floating_Numbers_io;
with Multprec_Mathematical_Functions;    use Multprec_Mathematical_Functions;

procedure ts_matfun is

  procedure Read ( f : in out Floating_Number; name : in string ) is

    n : natural;

  begin
    put("Give " & name & " : "); get(f);
    put("Current size is "); put(Size_Fraction(f),1);
    put(".  Give expansion factor : "); get(n);
    if n > 0
     then Expand(f,n);
    end if;
  end Read;

  procedure Test_Standard_COS_and_SIN is

    x,cx,sx : double_float;
    ans : character;
    
  begin
    new_line;
    put_line("Testing whether cos^2(x) + sin^2(x) = 1 holds.");
    loop
      new_line;
      put("Give x : "); get(x);
      cx := COS(x);  cx := cx*cx;
      sx := SIN(x);  sx := sx*sx;
      put("cos^2(x) + sin^2(x) = "); put(cx+sx); new_line;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when (ans /= 'y');
    end loop;
  end Test_Standard_COS_and_SIN;

  procedure Test_Standard_SQRT is

    x,y,diff : double_float;

  begin
    put("Give x : "); get(x);
    y := SQRT(x);
    put("SQRT(x) : "); put(y); new_line;
    y := y*y;
    put("(SQRT(x))**2 : "); put(y); new_line;
    diff := x - y;
    put("x - (SQRT(x))**2 : "); put(diff); new_line;
  end Test_Standard_SQRT;

  procedure Test_Multprec_SQRT is

    x,y,diff : Floating_Number;

  begin
    Read(x,"x");
   -- put("Give x : "); get(x);
    y := SQRT(x);
    put("SQRT(x) : "); put(y); new_line;
    Mul(y,y);
    put("SQRT(x))**2 : "); put(y); new_line;
    diff := x - y;
    put("x - (SQRT(x))**2 : "); put(diff); new_line;
  end Test_Multprec_SQRT;

  procedure Main is

    ans : character;

  begin
    new_line;
    put_line("Testing some mathematical functions.");
    loop
      new_line;
      put_line("Choose one of the following : ");
      put_line("  0. Exit this program.");
      put_line("  1. COS/SIN for standard floating-point numbers.");
      put_line("  2. SQRT for standard floating-point numbers.");
      put_line("  3. SQRT for multi-precision floating-point numbers.");
      put("Type 0,1,2 or 3 to make your selection : "); get(ans);
      exit when (ans = '0');
      case ans is
        when '1' => Test_Standard_COS_and_SIN;
        when '2' => Test_Standard_SQRT;
        when '3' => Test_Multprec_SQRT;
        when others => null;
      end case;
    end loop;
  end Main;

begin
  Main;
end ts_matfun;