::
x35_rat.ada
with Text_io; use Text_io;
package Pack_types is
type Integer is range -2_000_000_000 .. 2_000_000_000;
procedure put( i:in Integer );
end Pack_types;
with Text_io; use Text_io;
package body Pack_types is
package Class_integer_io is new Text_io.Integer_io( Integer );
procedure put( i:in Integer ) is
begin
put("[Overloaded]");
Class_integer_io.put( i );
end put;
end Pack_types;
package Class_rational is
type Rational is private;
function "+" ( f:in Rational; s:in Rational ) return Rational;
function "-" ( f:in Rational; s:in Rational ) return Rational;
function "*" ( f:in Rational; s:in Rational ) return Rational;
function "/" ( f:in Rational; s:in Rational ) return Rational;
function rat_const( f:in Integer;
s:in Integer:=1 ) return Rational;
procedure put( the:in Rational );
private
function sign( the:in Rational ) return Rational;
function simplify( the:in Rational ) return Rational;
type Rational is record
above : Integer := 0; -- Numerator
below : Integer := 1; -- Denominator
end record;
end Class_rational;
with Simple_io; use Simple_io;
package body Class_rational is
function "+" (f:in Rational; s:in Rational) return Rational is
res : Rational;
begin
res.below := f.below * s.below;
res.above := f.above * s.below + s.above * f.below;
return simplify(res);
end "+";
function "-" (f:in Rational; s:in Rational) return Rational is
res : Rational;
begin
res.below := f.below * s.below;
res.above := f.above * s.below - s.above * f.below;
return simplify(res);
end "-";
function "*" (f:in Rational; s:in Rational) return Rational is
res : Rational;
begin
res.above := f.above * s.above;
res.below := f.below * s.below;
return simplify(res);
end "*";
function "/" (f:in Rational; s:in Rational) return Rational is
res : Rational;
begin
res.above := f.above * s.below;
res.below := f.below * s.above;
return simplify(res);
end "/";
function rat_const( f:in Integer; s:in Integer:=1 ) return Rational is
begin
if f = 0 then
return Rational'(0,1);
else
return simplify( sign( Rational'( f, s ) ) );
end if;
end rat_const;
procedure put( the:in Rational ) is
above : Integer := the.above;
below : Integer := the.below;
begin
if above = 0 then -- Rational 0
put( "0" );
else
if above < 0 then
put("-"); above := -above; -- make +ve
end if;
if above >= below then -- Whole number
put( above/below, width=>1 ); put(" ");
above := above rem below; -- Fraction
end if;
if above /= 0 then
put( above, width=>1 ); put( "/" );
put( below, width=>1 ); -- Fraction
end if;
end if;
end put;
function sign( the:in Rational ) return Rational is
begin
if the.below >= 0 then -- -a/b or a/b
return the;
else -- a/-b or -a/-b
return Rational'( -the.above, -the.below );
end if;
end sign;
function simplify( the:in Rational ) return Rational is
res: Rational := the;
d : Positive; -- Divisor to reduce with
begin
if res.below = 0 then -- Invalid treat as 0
res.above := 0; res.below := 1;
end if;
d := 2; -- Divide by 2, 3, 4 ...
while d < res.below loop
while res.below rem d = 0 and then res.above rem d = 0 loop
res.above := res.above / d;
res.below := res.below / d;
end loop;
d := d + 1;
end loop;
return res;
end simplify;
end Class_rational;
package Pack_procedures is
procedure main1;
procedure main2;
procedure main3;
procedure main4;
procedure main5;
end Pack_procedures;
with Simple_io, Class_rational;
use Simple_io, Class_rational;
package body Pack_procedures is
procedure main1 is
a,b : Rational;
begin
a := rat_const( 1, 2 );
b := rat_const( 1, 3 );
put( "a = " ); put( a ); new_line;
put( "b = " ); put( b ); new_line;
put( "a + b = " ); put( a+b ); new_line;
put( "a - b = " ); put( a-b ); new_line;
put( "b - a = " ); put( b-a ); new_line;
put( "a * b = " ); put( a*b ); new_line;
put( "a / b = " ); put( a/b ); new_line;
end main1;
procedure main2 is
a,b : Rational;
begin
a := rat_const(1, 2);
b := rat_const(1, 3);
put( "a = " ); put( a ); put(" <1/2> "); new_line;
put( "b = " ); put( b ); put(" <1/3> "); new_line;
put( "a + b = " ); put( a+b ); put(" <5/6> "); new_line;
put( "a - b = " ); put( a-b ); put(" <1/6> "); new_line;
put( "b - a = " ); put( b-a ); put(" <-1/6> "); new_line;
put( "a * b = " ); put( a*b ); put(" <1/6> "); new_line;
put( "a / b = " ); put( a/b ); put(" <1 1/2> "); new_line;
new_line;
a := rat_const(3, 2);
b := rat_const(4, 5);
put( "a = " ); put( a ); put(" <3/2> "); new_line;
put( "b = " ); put( b ); put(" <4/5> "); new_line;
put( "a + b = " ); put( a+b ); put(" <2 3/10> "); new_line;
put( "a - b = " ); put( a-b ); put(" <7/10> "); new_line;
put( "b - a = " ); put( b-a ); put(" <-7/10> "); new_line;
put( "a * b = " ); put( a*b ); put(" <1 1/5> "); new_line;
put( "a / b = " ); put( a/b ); put(" <1 7/8> "); new_line;
end main2;
procedure main3 is
a : Rational;
begin
-- put( 8/16 ) is ambiguous;
new_line;
put( " 0, 0 = " ); a := rat_const(0, 0); put( a ); new_line;
put( " 0, 5 = " ); a := rat_const(0, 5); put( a ); new_line;
put( " 5, 0 = " ); a := rat_const(5, 0); put( a ); new_line;
put( " 8, 16 = " ); a := rat_const(8, 16); put( a ); new_line;
put( " 8, 8 = " ); a := rat_const(8, 8); put( a ); new_line;
put( " -17, 8 = " ); a := rat_const(-17, 8); put( a ); new_line;
put( " -17, -8 = " ); a := rat_const(-17, -8);put( a ); new_line;
put( " 17, -8 = " ); a := rat_const(17, -8); put( a ); new_line;
put( " 7, 97 = " ); a := rat_const(7, 97); put( a ); new_line;
put( " 40, 20 = " ); a := rat_const(40, 20); put( a ); new_line;
put( " 20, 40 = " ); a := rat_const(20, 40); put( a ); new_line;
put( " 648, 972 = " ); a := rat_const(648,972);put( a ); new_line;
end main3;
procedure main4 is
a : Rational;
begin
a := rat_const(0, 0);
for i in 1 .. 5 loop
a := a + rat_const(1,i);
end loop;
put("Sum of 1/1 + 1/2 + ... 1/5 is "); put( a ); new_line;
end main4;
procedure main5 is
a : Rational;
UP_TO : CONSTANT := 7;
begin
a := rat_const(1, 1);
for i in 1 .. UP_TO loop
a := a + rat_const(1, i);
end loop;
for i in reverse 1 .. UP_TO loop
a := a - rat_const(1, i);
end loop;
put("Sum check answer should be 1 <=> "); put( a ); new_line;
a := rat_const(1);
for i in 1 .. UP_TO loop
a := a * rat_const(1, i);
end loop;
for i in reverse 1 .. UP_TO loop
a := a / rat_const(1,i);
end loop;
put("Mult check answer should be 1 <=> "); put( a ); new_line;
end main5;
end Pack_procedures;
with Simple_io, Class_rational;
use type Class_rational.Rational;
procedure main6 is
a,b : Class_rational.Rational;
begin
a := Class_rational.rat_const( 1, 2 );
b := Class_rational.rat_const( 1, 3 );
Simple_io.put( "a + b = " ); Class_rational.put( a+b );
Simple_io.new_line;
end main6;
with Text_io, Pack_procedures, main6;
use Text_io, Pack_procedures;
procedure main is
begin
put("Example 1"); new_line; main1;
put("Example 2"); new_line; main2;
put("Example 3"); new_line; main3;
put("Example 4"); new_line; main4;
put("Example 5"); new_line; main5;
put("Example 6"); new_line; main6;
end main;
© M.A.Smith University of Brighton.
Created September 1995 last modified May 1997.
Comments, suggestions, etc.
M.A.Smith@brighton.ac.uk
*
[Home page]