Arithmetic/Rational

From Rosetta Code
Task
Arithmetic/Rational
You are encouraged to solve this task according to the task description, using any language you may know.

The objective of this task is to create a reasonably complete implementation of rational arithmetic in the particular language using the idioms of the language.

For example: Define an new type called frac with dyadic operator "//" of two integers that returns a structure made up of the numerator and the denominator (as per a rational number).

Further define the appropriate rational monadic operators abs and '-', with the dyadic operators for addition '+', subtraction '-', multiplication '×', division '/', integer division '÷', modulo division, the comparison operators (e.g. '<', '≤', '>', & '≥') and equality operators (e.g. '=' & '≠').

Define standard coercion operators for casting int to frac etc.

If space allows, define standard increment and decrement operators (e.g. '+:=' & '-:=' etc.).

Finally test the operators: Use the new type frac to find all perfect numbers less then 219 by summing the reciprocal of the factors.

ALGOL 68

Works with: ALGOL 68 version Standard - no extensions to language used
Works with: ALGOL 68G version Any - tested with release mk15-0.8b.fc9.i386
MODE FRAC = STRUCT( INT num #erator#,  den #ominator#);
FORMAT frac repr = $g(-0)"//"g(-0)$;

PROC gcd = (INT a, b) INT: # greatest common divisor #
  (a = 0 | b |: b = 0 | a |: ABS a > ABS b  | gcd(b, a MOD b) | gcd(a, b MOD a));

PROC lcm = (INT a, b)INT: # least common multiple #
  a OVER gcd(a, b) * b;

PROC raise not implemented error = ([]STRING args)VOID: (
  put(stand error, ("Not implemented error: ",args, newline));
  stop
);

PRIO // = 9; # higher then the ** operator #
OP // = (INT num, den)FRAC: ( # initialise and normalise #
  INT common = gcd(num, den);
  IF den < 0 THEN
    ( -num OVER common, -den OVER common)
  ELSE
    ( num OVER common, den OVER common)
  FI
);

OP + = (FRAC a, b)FRAC: (
  INT common = lcm(den OF a, den OF b);
  FRAC result := ( common OVER den OF a * num OF a + common OVER den OF b * num OF b, common );
  num OF result//den OF result
);

OP - = (FRAC a, b)FRAC: a + -b,
   * = (FRAC a, b)FRAC: (
  INT num = num OF a * num OF b,
      den = den OF a * den OF b;
  INT common = gcd(num, den);
  (num OVER common) // (den OVER common)
);

OP /  = (FRAC a, b)FRAC: a * FRAC(den OF b, num OF b),# real division #
   %  = (FRAC a, b)INT: ENTIER (a / b),               # integer divison #
   %* = (FRAC a, b)FRAC: a/b - FRACINIT ENTIER (a/b), # modulo division #
   ** = (FRAC a, INT exponent)FRAC: 
    IF exponent >= 0 THEN
      (num OF a ** exponent, den OF a ** exponent )
    ELSE
      (den OF a ** exponent, num OF a ** exponent )
    FI;

OP REALINIT = (FRAC frac)REAL: num OF frac / den OF frac,
   FRACINIT = (INT num)FRAC: num // 1,
   FRACINIT = (REAL num)FRAC: (
     # express real number as a fraction # # a future execise! #
     raise not implemented error(("Convert a REAL to a FRAC","!"));
     SKIP
   );

OP <  = (FRAC a, b)BOOL: num OF (a - b) <  0,
   >  = (FRAC a, b)BOOL: num OF (a - b) >  0,
   <= = (FRAC a, b)BOOL: NOT ( a > b ),
   >= = (FRAC a, b)BOOL: NOT ( a < b ),
   =  = (FRAC a, b)BOOL: (num OF a, den OF a) = (num OF b, den OF b),
   /= = (FRAC a, b)BOOL: (num OF a, den OF a) /= (num OF b, den OF b);

# Monadic operators #
OP - = (FRAC frac)FRAC: (-num OF frac, den OF frac),
   ABS = (FRAC frac)FRAC: (ABS num OF frac, ABS den OF frac),
   ENTIER = (FRAC frac)INT: (num OF frac OVER den OF frac) * den OF frac;

COMMENT Operators for extended characters set, and increment/decrement "commented out" to save space. COMMENT

Example: searching for Perfect Numbers.

FRAC sum:= FRACINIT 0; 
FORMAT perfect = $b(" perfect!","")$;

FOR i FROM 2 TO 2**19 DO 
  INT candidate := i;
  FRAC sum := 1 // candidate;
  REAL real sum := 1 / candidate;
  FOR factor FROM 2 TO ENTIER sqrt(candidate) DO
    IF candidate MOD factor = 0 THEN
      sum :=  sum + 1 // factor + 1 // ( candidate OVER factor);
      real sum +:= 1 / factor + 1 / ( candidate OVER factor)
    FI
  OD;
  IF den OF sum  = 1 THEN
    printf(($"Sum of reciprocal factors of "g(-0)" = "g(-0)" exactly, about "g(0,real width) f(perfect)l$, 
            candidate, ENTIER sum, real sum, ENTIER sum = 1))
  FI
OD

Output:

Sum of reciprocal factors of 6 = 1 exactly, about 1.0000000000000000000000000001 perfect!
Sum of reciprocal factors of 28 = 1 exactly, about 1.0000000000000000000000000001 perfect!
Sum of reciprocal factors of 120 = 2 exactly, about 2.0000000000000000000000000002
Sum of reciprocal factors of 496 = 1 exactly, about 1.0000000000000000000000000001 perfect!
Sum of reciprocal factors of 672 = 2 exactly, about 2.0000000000000000000000000001
Sum of reciprocal factors of 8128 = 1 exactly, about 1.0000000000000000000000000001 perfect!
Sum of reciprocal factors of 30240 = 3 exactly, about 3.0000000000000000000000000002
Sum of reciprocal factors of 32760 = 3 exactly, about 3.0000000000000000000000000003
Sum of reciprocal factors of 523776 = 2 exactly, about 2.0000000000000000000000000005