Return to ts_intnum.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 Multprec_Natural_Numbers;           use Multprec_Natural_Numbers;
with Multprec_Natural_Numbers_io;        use Multprec_Natural_Numbers_io;
with Multprec_Integer_Numbers;           use Multprec_Integer_Numbers;
with Multprec_Integer_Numbers_io;        use Multprec_Integer_Numbers_io;
with Multprec_Random_Numbers;            use Multprec_Random_Numbers;

procedure ts_intnum is

-- DESCRIPTION :
--   This procedure offers interactive and random testers for the
--   operations with multi-precision natural numbers.  See the menu below.

  procedure Test_Creation is

    i1 : integer;
    i2 : Integer_Number;
    ans : character;

  begin
    put_line("Testing the creation of an integer number.");
    loop
      put("Give a standard integer number : "); get(i1);
      i2 := Create(i1);
      put("-> as integer number : "); put(i2); new_line;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Creation;

  procedure Test_io is

    ans : character;
    i : Integer_Number;

  begin
    put_line("Testing the input/output operations.");
    loop
      put("Give a number : "); get(i);
      put("-> your number : "); put(i); new_line;
      put("#decimal places : "); put(Decimal_Places(i),1); new_line;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_io;

  procedure Test_Sign ( i : in Integer_Number ) is

  -- DESCRIPTION :
  --   Applies the operations to determine the sign of a number.

  begin
    if Multprec_Integer_Numbers.Positive(i)
     then put("This number is positive,");
     else put("This number is not positive,");
    end if;
    if Negative(i)
     then put(" is negative ");
     else put(" is not negative ");
    end if;
    put("and its sign is ");
	if Sign(i) > 0
     then put("+"); 
     elsif Sign(i) < 0
         then put("-"); 
         else put("0");
    end if;
    put_line(".");
  end Test_Sign;

  procedure Test_Compare ( i1,i2 : in Integer_Number ) is

  -- DESCRIPTION :
  --   Compares the number i1 and i2.

  begin
    if Equal(i1,i2)
     then put_line("The numbers are equal.");
     else put_line("The numbers are different.");
    end if;
    if i1 < i2
     then put_line("First is less than second.");
     else put_line("First not less than second.");
    end if;
    if i1 > i2
     then put_line("First is greater than second.");
     else put_line("First is not greater than second.");
    end if;
  end Test_Compare;

  procedure Zero_Test ( i : Integer_Number ) is
  begin
    if Equal(i,0)
     then put_line(" equals zero");
     else put_line(" is different from zero");
    end if;
  end Zero_Test;

  procedure Test_Comparison is

  -- DESCRIPTION :
  --   Test of all comparison and copying operations.

    ans : character;
    i1,i2 : Integer_Number;

  begin 
    put_line("Testing the comparison operations.");
    loop
      put("Give 1st number i1 : "); get(i1);
      put("-> i1 : "); put(i1); 
      Zero_Test(i1);
      Test_Sign(i1);
      put("Give 2nd number i2 : "); get(i2);
      put("-> i2 : "); put(i2);
      Zero_Test(i2);
      Test_Sign(i2);
      Test_Compare(i1,i2);
      Copy(i1,i2);
      put_line("Tests after copying : ");
      Test_Compare(i1,i2);
      Div(i1,10);
      put_line("After dividing i1 by 10 :");
      put(" i1 : "); put(i1); new_line;
      put(" i2 : "); put(i2); new_line;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Comparison;

  procedure Test_Addition is

  -- NOTE : to test i1+i2 with i2 : integer, change the declaration of i2.
 
    ans : character;
    i1,i2,sum1,sum2 : Integer_Number;

  begin
    put_line("Testing the addition operations.");
    loop
      put("Give 1st number : "); get(i1);
      put("-> your 1st number i1 : "); put(i1); new_line;
      put("Give 2nd number : "); get(i2);
      put("-> your 2nd number i2 : "); put(i2); new_line;
      sum1 := i1+i2;
      put("i1+i2 : "); put(sum1); new_line;
      sum2 := i2+i1;
      put("i2+i1 : "); put(sum2); new_line;
      if Equal(sum1,sum2)
       then put_line("Test on commutativity is successful.");
       else put_line("Failure, bug detected.");
      end if;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Addition;

  function Mult_by_Add ( i1 : Integer_Number; i2 : integer ) 
                       return Integer_Number is

  -- DESCRIPTION :
  --   Does the multiplication by adding up i1 to itself as many times
  --   as the number i2.  Only to be used as test of course.

    res : Integer_Number;
    n : natural;

  begin
    if i2 = 0
     then return res;
     else Copy(i1,res);
          if i2 < 0
           then n := -i2;
           else n := i2;
          end if;
          for i in 1..n-1 loop
            Add(res,i1);
          end loop;
          if i2 < 0
           then Min(res);
          end if;
          return res;
    end if;
  end Mult_by_Add;

  function Mult_by_Add ( i1,i2 : Integer_Number ) return Integer_Number is

  -- DESCRIPTION :
  --   Does the multiplication by adding up n1 to itself as many times
  --   as the number i2.  Only to be used as test of course.
  --   This can be quite time consuming as i2 gets large.

    res : Integer_Number;
    cnt,tot : Natural_Number;

  begin
    if Equal(i2,0)
     then return res;
     else Copy(i1,res);
          cnt := Create(1);
          tot := Unsigned(i2);
          while not Equal(cnt,tot) loop
            Add(res,i1);
            Add(cnt,1);
          end loop;
          Clear(cnt);
          if Negative(i2)
           then Min(res);
          end if;
          return res;
    end if;
  end Mult_by_Add;

  procedure Test_Multiplication is

  -- NOTE : to test i1*i2 with i2 : integer, change the declaration of i2.
 
    ans : character;
    i1,i2,prod1,prod2,prod3 : Integer_Number;
   -- i2 : integer;

  begin
    put_line("Testing the multiplication operations.");
    loop
      put("Give 1st number : "); get(i1);
      put("-> your 1st number i1 : "); put(i1); new_line;
      put("Give 2nd number : "); get(i2);
      put("-> your 2nd number i2 : "); put(i2); new_line;
      prod1 := i1*i2;
      put("Product i1*i2 : "); put(prod1); new_line;
      prod2 := i2*i1;
      put("Product i2*i1 : "); put(prod2); new_line;
      if Equal(prod1,prod2)
       then put_line("Test on commutativity is successful.");
       else put_line("Failure, bug detected.");
      end if;
      put("Do you want multiplication by addition ? (y/n) "); get(ans);
      if ans = 'y'
       then put_line("Testing the multiplication by addition.  Be patient...");
            prod3 := Mult_by_Add(i1,i2);
            put("After adding "); put(i2); put(" times : "); put(prod3);
            new_line;
            if Equal(prod1,prod3)
             then put_line("Test of multiplication is successful.");
             else put_line("Failure, bug detected.");
            end if;
      end if;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Multiplication;

  procedure Test_Exponentiation is

    ans : character;
    e1,e2 : Natural_Number;
    i,exp1,exp2,prod,expo : Integer_Number;

  begin
    put_line("Testing the exponentiation operations.");
    loop
      put("Give a number : "); get(i);
      put("-> your number i : "); put(i); new_line;
      put("Give 1st exponent : "); get(e1);
      put("-> your 1st exponent e1 : "); put(e1); new_line;
      exp1 := i**e1;
      put("i**e1 : "); put(exp1); new_line;
      put("Give 2nd exponent : "); get(e2);
      put("-> your 2nd exponent e2 : "); put(e2); new_line;
      exp2 := i**e2;
      put("i**e2 : "); put(exp2); new_line;
      prod := exp1*exp2;
      put("(i**e1)*(i**e2) : "); put(prod); new_line;
      expo := i**(e1+e2);
      put("i**(e1+e2)      : "); put(expo); new_line;
      if Equal(prod,expo)
       then put_line("Test of exponentiation is successful.");
       else put_line("Failure, bug detected.");
      end if;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Exponentiation;

  procedure Test_Subtraction is

    ans : character;
    i1,i2,diff : Integer_Number;
   -- i2 : integer;

  begin
    put_line("Testing the subtraction operations.");
    loop
      put("Give 1st number : "); get(i1);
      put("-> your 1st number i1 : "); put(i1); new_line;
      put("Give 2nd number : "); get(i2);
      put("-> your 2nd number i2 : "); put(i2); new_line;
      diff := i1-i2;
      put("i1 - i2 : "); put(diff); new_line;
      Add(diff,i2);
      put("(i1-i2)+i2 : "); put(diff); new_line;
      if Equal(diff,i1)
       then put_line("Test of subtraction is successful.");
       else put_line("Failure, bug detected.");
      end if;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Subtraction;

  procedure Divide10 ( i : in Integer_Number ) is

  -- DESCRIPTION :
  --   Checks whether the number i is divisible by 1..10.

    quot,prod : Integer_Number;
    rest : integer;

  begin
    put("i : "); put(i); new_line;
    for j in 1..10 loop
      rest := Rmd(i,j);
      quot := i/j;
      if rest = 0
       then put("Divisible by "); put(j,1);
       else put("Not divisible by "); put(j,1);
      end if;
      put("  rest : "); put(rest,1); new_line;
      put("quotient : "); put(quot); new_line;
      prod := quot*j + rest;
      if Equal(prod,i)
       then put_line("Test on Remainder/Division is successful.");
       else put_line("Failure, bug detected.");
      end if;
    end loop;
  end Divide10;

  procedure Test_Division is

    ans : character;
    i1,quot,prod : Integer_Number;
   -- i2,rest : Integer_Number;
    i2,rest : integer;

  begin
    put_line("Testing the division operations.");
    loop
      put("Give 1st number : "); get(i1);
      put("-> your 1st number i1 : "); put(i1); new_line;
      put("Give 2nd number : "); get(i2);
      put("-> your 2nd number i2 : "); put(i2); new_line;
      prod := i1*i2;
      put("i1*i2 : "); put(prod); new_line;
      quot := prod/i2; rest := Rmd(prod,i2);
      put("(i1*i2)/i2 : "); put(quot); new_line;
      put("Remainder : "); put(rest); new_line;
      if Equal(quot,i1) and rest = 0 -- Equal(rest,0)
       then put_line("Test of division is successful.");
       else put_line("Failure, bug detected.");
      end if;
      Div(i1,i2,quot,rest);
      put("i1/i2 : "); put(quot); new_line;
      put("rest : "); put(rest); new_line;
      prod := quot*i2 + rest;
      if Equal(prod,i1)
       then put_line("Test of division/remainder computation is successful.");
       else put_line("Failure, bug detected.");
      end if;
      if i2 <= 10
       then Divide10(i1);
      end if;
      put("Do you want more tests ? (y/n) "); get(ans);
      exit when ans /= 'y';
    end loop;
  end Test_Division;

  procedure Random_Addition_and_Subtraction ( sz1,sz2 : in natural ) is

  -- DESCRIPTION :
  --   Three tests are performed:
  --   1) n1+n2-n2 = n1, with "+" and "-".
  --   2) Add(n1,n2) is the same as n1 := n1+n2?
  --   3) Sub(n1+n2,n1) leads to n2?

    n1,n2,sum1,sum2 : Integer_Number;

    procedure Report_Bug is
    begin
      new_line;
      put("  n1 : "); put(n1); new_line;
      put("  n2 : "); put(n2); new_line;
    end Report_Bug;

  begin
    n1 := Random(sz1);
    n2 := Random(sz2);
    sum1 := n1+n2;
    sum2 := sum1-n2;
    if Equal(sum2,n1)
     then put("n1+n2-n2 okay");
     else put("n1+n2-n2 Bug!"); Report_Bug;
    end if;
    Add(sum2,n2);
    if Equal(sum2,sum1)
     then put("  Add okay");
     else put("  Add Bug!"); Report_Bug;
    end if;
    Sub(sum2,n1);
    if Equal(sum2,n2)
     then put("  Sub okay"); new_line;
     else put("  Sub Bug!"); Report_Bug;
    end if;
    Clear(n1); Clear(n2);
    Clear(sum1); Clear(sum2);
  end Random_Addition_and_Subtraction;

  procedure Additions_and_Subtractions_on_Randoms is

  -- DESCRIPTION :
  --   Generates a number of random integers and performs repeated
  --   additions and subtractions with checks on consistencies.

    nb,sz1,sz2 : natural;

  begin
    put("Give the number of tests : "); get(nb);
    put("Give the size of the 1st number : "); get(sz1);
    put("Give the size of the 2nd number : "); get(sz2);
    for i in 1..nb loop
      Random_Addition_and_Subtraction(sz1,sz2);
    end loop;
  end Additions_and_Subtractions_on_Randoms;

  procedure Random_Multiplication_and_Division ( sz1,sz2 : in natural ) is

  -- DESCRIPTION :
  --   Four tests are performed :
  --   1) n1*n2/n2 = n1, with "*" and "/".
  --   2) Mul(n1,n2) is the same as n1 := n1*n2 ?
  --   3) Div(n1*n2,n1) leads to n2 ?
  --   4) n1 = (n1/n2)*n2 + Rmd(n1,n2) ?
  --   5) Div(n1,n2,q,r) satisfies n1 = q*n2 + r ?

    n1,n2,prod1,prod2,quot1,quot2,quot3,rest1,rest2 : Integer_Number;

    procedure Report_Bug is
    begin
      new_line;
      put("  n1 : "); put(n1); new_line;
      put("  n2 : "); put(n2); new_line;
    end Report_Bug;

  begin
    n1 := Random(sz1);
    n2 := Random(sz2);
    prod1 := n1*n2;
    quot1 := prod1/n2;
    if Equal(quot1,n1)
     then put("n1*n2/n2 okay");
     else put("n1*n2/n2 Bug!"); Report_Bug;
    end if;
    Mul(quot1,n2);
    if Equal(prod1,quot1)
     then put("  Mul okay");
     else put("  Mul Bug!"); Report_Bug;
    end if;
    Div(prod1,n1);
    if Equal(prod1,n2)
     then put("  Div okay");
     else put("  Div Bug!"); Report_Bug;
    end if;
    rest1 := Rmd(n1,n2);
    quot2 := n1/n2;
    prod2 := quot2*n2;
    Add(prod2,rest1);
    if Equal(prod2,n1)
     then put("  Rmd okay");
     else put("  Rmd Bug!"); Report_Bug;
    end if;
    Div(n1,n2,quot3,rest2);
    Mul(quot3,n2);
    Add(quot3,rest2);
    if Equal(quot3,n1)
     then put("  Div/Rmd okay"); new_line;
     else put("  Div/Rmd Bug!"); Report_Bug;
    end if;
    Clear(n1);    Clear(n2);
    Clear(prod1); Clear(quot1);
    Clear(prod2); Clear(quot2);
    Clear(quot3); Clear(rest1); Clear(rest2);
  end Random_Multiplication_and_Division;

  procedure Multiplications_and_Divisions_on_Randoms is

  -- DESCRIPTION :
  --   Generates a number of random integers and performs repeated
  --   multiplications and divisions with checks on consistencies.

    nb,sz1,sz2 : natural;

  begin
    put("Give the number of tests : "); get(nb);
    put("Give the size of the 1st number : "); get(sz1);
    put("Give the size of the 2nd number : "); get(sz2);
    for i in 1..nb loop
      Random_Multiplication_and_Division(sz1,sz2);
    end loop;
  end Multiplications_and_Divisions_on_Randoms;

  procedure Main is

    ans : character;

  begin
    new_line;
    put_line("Interactive testing of multi-precision integer numbers.");
    loop
      new_line;
      put_line("Choose one of the following : ");
      put_line("  0. exit program      1. Input/Output     2. Creation      ");
      put_line("  3. Comparison/Copy   4. Addition         5. Subtraction   ");
      put_line("  6. Multiplication    7. Exponentiation   8. Division      ");
      put_line("  9. Addition/subtraction on randomly generated numbers.    ");
      put_line("  A. Multiplication/division/remainder on random numbers.   ");
      put("Type in your choice (0,1,2,3,4,5,6,7,8,9 or A) : "); get(ans);
      exit when (ans = '0');
      new_line;
      case ans is
        when '1' => Test_io;
        when '2' => Test_Creation;
        when '3' => Test_Comparison;
        when '4' => Test_Addition;
        when '5' => Test_Subtraction;
        when '6' => Test_Multiplication;
        when '7' => Test_Exponentiation;
        when '8' => Test_Division;
        when '9' => Additions_and_Subtractions_on_Randoms;
        when 'A' => Multiplications_and_Divisions_on_Randoms;
        when others => null;
      end case;
    end loop;
  end Main;

begin
  Main;
end ts_intnum;