# Arithmetic/Rational/Modula-2

Arithmetic/Rational/Modula-2 is part of Rational Arithmetic. You may find other members of Rational Arithmetic at Category:Rational Arithmetic.
Works with: FST Modula-2 v4.0 version no object oriented code used

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.`