⚠️ Warning: This is a draft ⚠️
This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.
If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.
This is incomplete as the Perfect Numbers task has not been addressed.
;Definition Module
DEFINITION MODULE Rational;
TYPE RAT = RECORD
numerator : INTEGER;
denominator : INTEGER;
END;
PROCEDURE IGCD( i : INTEGER; j : INTEGER ) : INTEGER;
PROCEDURE ILCM( i : INTEGER; j : INTEGER ) : INTEGER;
PROCEDURE IABS( i : INTEGER ) : INTEGER;
PROCEDURE RNormalize( i : RAT ) : RAT;
PROCEDURE RCreate( num : INTEGER; dem : INTEGER ) : RAT;
PROCEDURE RAdd( i : RAT; j : RAT ) : RAT;
PROCEDURE RSubtract( i : RAT; j : RAT ) : RAT;
PROCEDURE RMultiply( i : RAT; j : RAT ) : RAT;
PROCEDURE RDivide( i : RAT; j : RAT ) : RAT;
PROCEDURE RAbs( i : RAT ) : RAT;
PROCEDURE RInv( i : RAT ) : RAT;
PROCEDURE RNeg( i : RAT ) : RAT;
PROCEDURE RInc( i : RAT ) : RAT;
PROCEDURE RDec( i : RAT ) : RAT;
PROCEDURE REQ( i : RAT; j : RAT ) : BOOLEAN;
PROCEDURE RNE( i : RAT; j : RAT ) : BOOLEAN;
PROCEDURE RLT( i : RAT; j : RAT ) : BOOLEAN;
PROCEDURE RLE( i : RAT; j : RAT ) : BOOLEAN;
PROCEDURE RGT( i : RAT; j : RAT ) : BOOLEAN;
PROCEDURE RGE( i : RAT; j : RAT ) : BOOLEAN;
PROCEDURE RIsZero( i : RAT ) : BOOLEAN;
PROCEDURE RIsNegative( i : RAT ) : BOOLEAN;
PROCEDURE RIsPositive( i : RAT ) : BOOLEAN;
PROCEDURE RToString( i : RAT; VAR S : ARRAY OF CHAR );
PROCEDURE RToRational( s : ARRAY OF CHAR ) : RAT;
PROCEDURE WriteRational( i : RAT );
END Rational.
;Implementation Module
IMPLEMENTATION MODULE Rational;
FROM Strings IMPORT Assign, Append, Pos, Copy, Length;
FROM NumberConversion IMPORT IntToString, StringToInt;
FROM InOut IMPORT WriteString (*, WriteCard,WriteLine, WriteInt, WriteLn *);
PROCEDURE IGCD( i : INTEGER; j : INTEGER ) : INTEGER;
VAR
res : INTEGER;
BEGIN
IF j = 0 THEN
res := i;
ELSE
res := IGCD( j, i MOD j );
END;
RETURN res;
END IGCD;
PROCEDURE ILCM( i : INTEGER; j : INTEGER ) : INTEGER;
VAR
res : INTEGER;
BEGIN
res := (i DIV IGCD( i, j ) ) * j;
RETURN res;
END ILCM;
PROCEDURE IABS( i : INTEGER ) : INTEGER;
VAR
res : INTEGER;
BEGIN
IF i < 0 THEN
res := i * (-1);
ELSE
res := i;
END;
RETURN res;
END IABS;
PROCEDURE RNormalize( i : RAT ) : RAT;
VAR
gcd : INTEGER;
res : RAT;
BEGIN
gcd := IGCD( ABS( i.numerator ), ABS( i.denominator ) );
IF gcd <> 0 THEN
res.numerator := i.numerator DIV gcd;
res.denominator := i.denominator DIV gcd;
IF ( res.denominator < 0 ) THEN
res.numerator := res.numerator * (-1);
res.denominator := res.denominator * (-1);
END;
ELSE
WITH res DO
numerator := 0;
denominator := 0;
END;
END;
RETURN res;
END RNormalize;
PROCEDURE RCreate( num : INTEGER; dem : INTEGER ) : RAT;
VAR
rat : RAT;
BEGIN
WITH rat DO
numerator := num;
denominator := dem;
END;
RETURN RNormalize(rat);
END RCreate;
PROCEDURE RAdd( i : RAT; j : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator * j.denominator + j.numerator * i.denominator, i.denominator * j.denominator );
END RAdd;
PROCEDURE RSubtract( i : RAT; j : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator * j.denominator - j.numerator * i.denominator, i.denominator * j.denominator );
END RSubtract;
PROCEDURE RMultiply( i : RAT; j : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator * j.numerator, i.denominator * j.denominator );
END RMultiply;
PROCEDURE RDivide( i : RAT; j : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator * j.denominator, i.denominator * j.numerator );
END RDivide;
PROCEDURE RAbs( i : RAT ) : RAT;
BEGIN
RETURN RCreate( IABS( i.numerator ), i.denominator );
END RAbs;
PROCEDURE RInv( i : RAT ) : RAT;
BEGIN
RETURN RCreate( i.denominator, i.numerator );
END RInv;
PROCEDURE RNeg( i : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator * (-1), i.denominator );
END RNeg;
PROCEDURE RInc( i : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator + i.denominator, i.denominator );
END RInc;
PROCEDURE RDec( i : RAT ) : RAT;
BEGIN
RETURN RCreate( i.numerator - i.denominator, i.denominator );
END RDec;
PROCEDURE REQ( i : RAT; j : RAT ) : BOOLEAN;
VAR
ii : RAT;
jj : RAT;
BEGIN
ii := RNormalize( i );
jj := RNormalize( j );
RETURN ( ( ii.numerator = jj.numerator ) AND ( ii.denominator = jj.denominator ) );
END REQ;
PROCEDURE RNE( i : RAT; j : RAT ) : BOOLEAN;
BEGIN
RETURN NOT REQ( i, j );
END RNE;
PROCEDURE RLT( i : RAT; j : RAT ) : BOOLEAN;
BEGIN
RETURN RIsNegative( RSubtract( i, j ) );
END RLT;
PROCEDURE RLE( i : RAT; j : RAT ) : BOOLEAN;
BEGIN
RETURN NOT RGT( i, j );
END RLE;
PROCEDURE RGT( i : RAT; j : RAT ) : BOOLEAN;
BEGIN
RETURN RIsPositive( RSubtract( i, j ) );
END RGT;
PROCEDURE RGE( i : RAT; j : RAT ) : BOOLEAN;
BEGIN
RETURN NOT RLT( i, j );
END RGE;
PROCEDURE RIsZero( i : RAT ) : BOOLEAN;
BEGIN
RETURN i.numerator = 0;
END RIsZero;
PROCEDURE RIsNegative( i : RAT ) : BOOLEAN;
BEGIN
RETURN i.numerator < 0;
END RIsNegative;
PROCEDURE RIsPositive( i : RAT ) : BOOLEAN;
BEGIN
RETURN i.numerator > 0;
END RIsPositive;
PROCEDURE RToString( i : RAT; VAR S : ARRAY OF CHAR );
VAR
num : ARRAY [1..15] OF CHAR;
den : ARRAY [1..15] OF CHAR;
BEGIN
IF RIsZero( i ) THEN
Assign("0", S );
ELSE
IntToString( i.numerator, num, 1 );
Assign( num, S );
IF ( i.denominator <> 1 ) THEN
IntToString( i.denominator, den, 1 );
Append( S, "/" );
Append( S, den );
END;
END;
END RToString;
PROCEDURE RToRational( s : ARRAY OF CHAR ) : RAT;
VAR
n : CARDINAL;
numer : INTEGER;
denom : INTEGER;
LHS, RHS : ARRAY [ 1..20 ] OF CHAR;
Flag : BOOLEAN;
BEGIN
numer := 0;
denom := 0;
n := Pos( "/", s );
IF n > HIGH( s ) THEN
StringToInt( s, numer, Flag );
IF Flag THEN
denom := 1;
END;
ELSE
Copy( s, 0, n, LHS );
Copy( s, n+1, Length( s ), RHS );
StringToInt( LHS, numer, Flag );
IF Flag THEN
StringToInt( RHS, denom, Flag );
END;
END;
RETURN RCreate( numer, denom );
END RToRational;
PROCEDURE WriteRational( i : RAT );
VAR
res : ARRAY [0 .. 80] OF CHAR;
BEGIN
RToString( i, res );
WriteString( res );
END WriteRational;
END Rational.
;Test Program
MODULE TestRat;
FROM InOut IMPORT WriteString, WriteLine;
FROM Terminal IMPORT KeyPressed;
FROM Strings IMPORT CompareStr;
FROM Rational IMPORT RAT, IGCD, RCreate, RToString, RIsZero, RNormalize,
RToRational, REQ, RNE, RLT, RLE, RGT, RGE, WriteRational,
RAdd, RSubtract, RMultiply, RDivide, RAbs, RNeg, RInv;
VAR
res : INTEGER;
a, b, c, d, e, f : RAT;
ans : ARRAY [1..100] OF CHAR;
PROCEDURE Assert( F : BOOLEAN; S : ARRAY OF CHAR );
BEGIN
IF ( NOT F) THEN
WriteLine( S );
END;
END Assert;
BEGIN
a := RCreate( 0, 0 );
Assert( RIsZero( a ), "RIsZero( a )");
a := RToRational("2");
RToString( a, ans );
res := CompareStr( ans, "2" );
Assert( (res = 0), "CompareStr( RToString( a ), '2' ) = 0");
a := RToRational("1/2");
RToString( a, ans );
res := CompareStr( ans, "1/2");
Assert( res = 0, "CompareStr( RToString( a, ans ), '1/2') = 0");
b := RToRational( "2/-12" );
RToString( b, ans );
res := CompareStr( ans, "-1/6");
Assert( res = 0, "CompareStr( RToString( b, ans ), '-1/6') = 0");
f := RCreate( 0, 9 ); (* rationalizes internally to zero *)
a := RToRational("1/3");
b := RToRational("1/2");
c := RCreate( 1, 3 );
Assert( NOT REQ( a, b ), "1/3 == 1/2" );
Assert( REQ( a, c ), "1/3 == 1/3" );
Assert( RNE( a, b ), "1/3 != 1/2" );
Assert( RLT( a, b ), "1/3 < 1/2" );
Assert( NOT RLT(b,a), "1/2 < 1/3" );
Assert( NOT RLT(a,c), "1/3 < 1/3" );
Assert( NOT RGT(a,b), "1/3 > 1/2" );
Assert( RGT(b,a), "1/2 > 1/3" );
Assert( NOT RGT(a,c), "1/3 > 1/3" );
Assert( RLE( a, b ), "1/3 <= 1/2" );
Assert( NOT RLE( b, a ), "1/2 <= 1/3" );
Assert( RLE( a, c ), "1/3 <= 1/3" );
Assert( NOT RGE(a,b), "1/3 >= 1/2" );
Assert( RGE(b,a), "1/2 >= 1/3" );
Assert( RGE( a,c ), "1/3 >= 1/3" );
a := RCreate(1,2);
b := RCreate(1,6);
a := RAdd( a, b );
Assert( REQ( a, RToRational("2/3")), "1/2 + 1/6 == 2/3" );
c := RNeg( a );
Assert( REQ( a, RCreate( 2,3)), "2/3 == 2/3" );
Assert( REQ( c, RCreate( 2,-3)), "Neg 1/2 == -1/2" );
a := RCreate( 2,-3);
d := RAbs( c );
Assert( REQ( d, RCreate( 2,3 ) ), "abs(neg(1/2))==1/2" );
a := RToRational( "1/2");
b := RSubtract( b, a );
Assert( REQ( b, RCreate(-1,3) ), "1/6 - 1/2 == -1/3" );
c := RInv(b);
RToString( c, ans );
res := CompareStr( ans, "-3" );
Assert( res = 0, "inv(1/6 - 1/2) == -3" );
f := RInv( f ); (* as f normalized to zero, the reciprocal is still zero *)
b := RCreate( 1, 6);
b := RAdd( b, RAdd( RCreate( 2,3), RCreate( 4,2 )));
RToString( b, ans );
res := CompareStr( ans, "17/6" );
Assert( res = 0, "1/6 + 2/3 + 4/2 = 17/6" );
a := RCreate(1,3);
b := RCreate(1,6);
c := RCreate(5,6);
d := RToRational("1/5");
e := RToRational("2");
f := RToRational("0/9");
Assert( REQ( RMultiply( c, d ), b ), "5/6 * 1/5 = 1/6" );
Assert( REQ( RMultiply( c, RMultiply( d, e ) ), a ), "5/6 * 1/5 * 2 = 1/3" );
Assert( REQ( RMultiply( c, RMultiply( d, RMultiply( e, f ) ) ), f ), "5/6 * 1/5 * 2 * 0" );
Assert( REQ( b, RDivide( c, RToRational("5" ) ) ), "5/6 / 5 = 1/6" );
e := RDivide( c, f ); (* RDivide multiplies so no divide by zero *)
WriteString("Press any key..."); WHILE NOT KeyPressed() DO END;
END TestRat.