File: [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers / ts_intnum.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:26 2000 UTC (23 years, 10 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
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;