Arithmetic/Rational

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 ('<', '≤', '>', & '≥') and equality operators ('=' & '≠').

Define standard coercion operators for casting int to frac etc.

Define standard increment and decrement operators ('+:=' & '-:=' etc.).

Present a simple test each one of the operators above and also use the new type frac to find all perfect numbers less then 2¹⁹ 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( LONG 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 long gcd = (LONG INT a, b) LONG INT: # greatest common divisor #
  (a = 0 | b |: b = 0 | a |: ABS a > ABS b  | long gcd(b, a MOD b) | long gcd(a, b MOD a));

PROC long lcm = (LONG INT a, b)LONG INT: # least common multiple #
  a OVER long 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 // = (LONG INT num, den)FRAC: ( # overload LONG version #
  LONG INT common = long 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: (
  LONG INT common = long 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
);

# Monadic - OPerator #
OP - = (FRAC frac)FRAC: (-num OF frac, den OF frac);

# Diadic - OPerator #
OP - = (FRAC a, b)FRAC: a + -b;

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

OP /  = (FRAC a, b)FRAC: a * FRAC(den OF b, num OF b),
   %  = (FRAC a, b)LONG INT: ENTIER (a / b),
   %* = (FRAC a, b)FRAC: a / b - FRACINIT ENTIER (a / b),
   ** = (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 +:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a + b ),
   +=: = (FRAC a, REF FRAC b)REF FRAC: ( b := a + b ),
   -:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a - b ),
   *:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a * b ),
   /:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a / b ),
   %:= = (REF FRAC a, FRAC b)REF FRAC: ( a := FRACINIT (a OVER b) ),
   %*:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a %* b );

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);

OP ABS = (FRAC frac)FRAC: (ABS num OF frac, ABS den OF frac),
   ENTIER = (FRAC frac)LONG INT: (num OF frac OVER den OF frac) * den OF frac,

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

COMMENT
# OP aliases for extended character sets (eg: Unicode, APL, ALCOR and GOST 10859) #
OP ×  = (FRAC a, b)FRAC: a * b,
   ÷  = (FRAC a, b)LONG INT: a OVER b,
   ÷× = (FRAC a, b)FRAC: a MOD b,
   ÷* = (FRAC a, b)FRAC: a MOD b,
   %× = (FRAC a, b)FRAC: a MOD b,
   ≤  = (FRAC a, b)FRAC: a <= b,
   ≥  = (FRAC a, b)FRAC: a >= b;
   ↑  = (FRAC frac, INT exponent)FRAC: frac ** exponent,

   ÷×:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a MOD b ),
   %×:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a MOD b ),
   ÷*:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a MOD b );
END COMMENT

# BOLD aliases for CPU that only support uppercase for 6-bit bytes  - wrist watches #
OP OVER = (FRAC a, b)LONG INT: a % b,
   MOD = (FRAC a, b)FRAC: a %*b,
   LT = (FRAC a, b)BOOL: a <  b,
   GT = (FRAC a, b)BOOL: a >  b,
   LE = (FRAC a, b)BOOL: a <= b,
   GE = (FRAC a, b)BOOL: a >= b,
   EQ = (FRAC a, b)BOOL: a =  b,
   NE = (FRAC a, b)BOOL: a /= b,
   UP = (FRAC frac, INT exponent)FRAC: frac**exponent;

# the required standard assignment operators #
OP PLUSAB  = (REF FRAC a, FRAC b)REF FRAC: ( a +:= b ), # PLUS #
   PLUSTO  = (FRAC a, REF FRAC b)REF FRAC: ( a +=: b ), # PRUS #
   MINUSAB = (REF FRAC a, FRAC b)REF FRAC: ( a *:= b ),
   DIVAB   = (REF FRAC a, FRAC b)REF FRAC: ( a /:= b ),
   OVERAB  = (REF FRAC a, FRAC b)REF FRAC: ( a %:= b ),
   MODAB   = (REF FRAC a, FRAC b)REF FRAC: ( a %*:= b );

MODE MIXEDFRAC = STRUCT(LONG INT whole, FRAC fraction);
FORMAT mixed frac repr = $g(-0)" "g(-0)"/"g(-0)$;

OP FRACINIT = (MIXEDFRAC frac)FRAC: 
     (FRACINIT whole OF frac + fraction OF frac ),
   MIXEDFRACINIT = (FRAC frac)MIXEDFRAC: ( 
     LONG INT whole = num OF frac OVER den OF frac;
     ( whole, frac - FRACINIT whole)
   );

OP + = (LONG INT whole, FRAC frac)FRAC: FRACINIT whole + frac;

########################################################
# Do the basic test cases for the OPerators +, -, *, / #
########################################################

FORMAT tab=$30k$; # tab to the 30th character #

FRAC la = 2//4, ra = 1//4;
printf(($"Addition: "f(tab)f(frac repr)" + "f(frac repr)" gives "f(frac repr)l$, 
        la, ra, la + ra));

FRAC lb = 3//4, rb = 2//3;
printf(($"Adding unlike quantities: "f(tab)f(frac repr)" + "f(frac repr)" gives "f(mixed frac repr)l$, 
        lb, rb, MIXEDFRACINIT(lb + rb)));

FRAC lc = 2//3, rc = 1//2;
printf(($"Subtraction: "f(tab)f(frac repr)" - "f(frac repr)" gives "f(mixed frac repr)l$, 
        lc, rc, MIXEDFRACINIT(lc - rc)));

FRAC ld = 2//7, rd = 7//8;
printf(($"Multiplication: "f(tab)f(frac repr)" * "f(frac repr)" gives "f(mixed frac repr)l$, 
        ld, rd, MIXEDFRACINIT(ld * rd)));

FRAC le = FRACINIT 3, re = FRACINIT 3 + 3//4;
printf(($"Mixed numbers: "f(tab)f(mixed frac repr)" * "f(mixed frac repr)" gives "f(mixed frac repr)l$, 
        MIXEDFRACINIT le, MIXEDFRACINIT re, MIXEDFRACINIT(le * re)));

FRAC lf = 2//3, rf = 2//5;
printf(($"Division: "f(tab)f(frac repr)" / "f(frac repr)" gives "f(mixed frac repr)l$, 
        lf, rf, MIXEDFRACINIT(lf / rf)));

FORMAT bool repr = $b("Yes","No")$;

FRAC lg = 5//18, rg = 4//17;
printf(($"Comparing fractions"f(tab)
    "Q:  Is "f(mixed frac repr)" > "f(mixed frac repr)"? - A:  "f(bool repr)"!"l$, 
    MIXEDFRACINIT lg, MIXEDFRACINIT rg, lg > rg));

FRAC frac pi = 355 // 113; # approximately #
MIXEDFRAC mixed frac pi = MIXEDFRACINIT(frac pi);

printf(($"The exact fraction "f(mixed frac repr)" ("f(frac repr)") is approximately equal to "gl$, 
        mixed frac pi, frac pi, LONGREALINIT(frac pi)));

##################################################################
# Perform a more complicated test searching for Perfect Numbers. #
##################################################################
FRAC sum:= FRACINIT 0; 
FORMAT perfect = $b(" perfect!","")$;

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

Output:

Addition:                    1//2 + 1//4 gives 3//4
Adding unlike quantities:    3//4 + 2//3 gives 1 5/12
Subtraction:                 2//3 - 1//2 gives 0 1/6
Multiplication:              2//7 * 7//8 gives 0 1/4
Mixed numbers:               3 0/1 * 3 3/4 gives 11 1/4
Division:                    2//3 / 2//5 gives 1 2/3
Comparing fractions          Q:  Is 0 5/18 > 0 4/17? - A:  Yes!
The exact fraction 3 16/113 (355//113) is approximately equal to +3.141592920353982300884955752e  +0
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