Add all the A tasks

Task/Arithmetic-Rational/0DESCRIPTION

@@ -0,0 +1,16 @@
+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 a new type called '''frac''' with binary 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 unary '''operators''' '''abs''' and '-', with the binary '''operators''' for addition '+', subtraction '-', multiplication '&times;', division '/', integer division '&divide;', modulo division, the comparison operators (e.g. '<', '&le;', '>', & '&ge;') and equality operators (e.g. '=' & '&ne;').
+
+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|perfect numbers]] less than 2<sup>19</sup> by summing the reciprocal of the factors.
+
+'''See also'''
+* [[Perfect Numbers]]

Task/Arithmetic-Rational/1META.yaml

@@ -0,0 +1,4 @@
+---
+category:
+- Arithmetic
+note: Arithmetic operations

Task/Arithmetic-Rational/ALGOL-68/arithmetic-rational.alg

@@ -0,0 +1,131 @@
+ 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);
+
+ # Unary 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:
+ 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 % b) ),
+    %*:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a %* b );
+
+ # OP aliases for extended character sets (eg: Unicode, APL, ALCOR and GOST 10859) #
+ OP ×  = (FRAC a, b)FRAC: a * b,
+    ÷  = (FRAC a, b)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 a, b)BOOL: 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 );
+
+ # BOLD aliases for CPU that only support uppercase for 6-bit bytes  - wrist watches #
+ OP OVER = (FRAC a, b)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 );
+
+END 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

Task/Arithmetic-Rational/C/arithmetic-rational.c

@@ -0,0 +1,69 @@
+#include <stdio.h>
+#include <stdlib.h>
+#define FMT "%lld"
+typedef long long int fr_int_t;
+typedef struct { fr_int_t num, den; } frac;
+
+fr_int_t gcd(fr_int_t m, fr_int_t n)
+{
+	fr_int_t t;
+	while (n) { t = n; n = m % n; m = t; }
+	return m;
+}
+
+frac frac_new(fr_int_t num, fr_int_t den)
+{
+	frac a;
+	if (!den) {
+		printf("divide by zero: "FMT"/"FMT"\n", num, den);
+		abort();
+	}
+
+	int g = gcd(num, den);
+
+	if (g)	{ num /= g; den /= g; }
+	else	{ num = 0; den = 1;   }
+
+	if (den < 0) {
+		den = -den;
+		num = -num;
+	}
+	a.num = num; a.den = den;
+	return a;
+}
+
+#define BINOP(op, n, d) frac frac_##op(frac a, frac b) { return frac_new(n,d); }
+BINOP(add, a.num * b.den + b.num * a.den, a.den * b.den);
+BINOP(sub, a.num * b.den - b.num + a.den, a.den * b.den);
+BINOP(mul, a.num * b.num, a.den * b.den);
+BINOP(div, a.num * b.den, a.den * b.num);
+
+int frac_cmp(frac a, frac b) {
+	int l = a.num * b.den, r = a.den * b.num;
+	return l < r ? -1 : l > r;
+}
+#define frac_cmp_int(a, b) frac_cmp(a, frac_new(b, 1))
+int frtoi(frac a) { return a.den / a.num; }
+double frtod(frac a) { return (double)a.den / a.num; }
+
+int main()
+{
+	int n, k;
+	frac sum, kf;
+
+	for (n = 2; n < 1<<19; n++) {
+		sum = frac_new(1, n);
+
+		for (k = 2; k * k < n; k++) {
+			if (n % k) continue;
+			kf = frac_new(1, k);
+			sum = frac_add(sum, kf);
+
+			kf = frac_new(1, n / k);
+			sum = frac_add(sum, kf);
+		}
+		if (frac_cmp_int(sum, 1) == 0) printf("%d\n", n);
+	}
+
+	return 0;
+}

Task/Arithmetic-Rational/Clojure/arithmetic-rational.clj

@@ -0,0 +1,6 @@
+user> 22/7
+22/7
+user> 34/2
+17
+user> (+ 37/5 42/9)
+181/15

Task/Arithmetic-Rational/Forth/arithmetic-rational.fth

@@ -0,0 +1,38 @@
+\ Rationals can use any double cell operations:  2!, 2@, 2dup, 2swap, etc.
+\ Uses the stack convention of the built-in "*/" for int * frac -> int
+
+: numerator  drop ;
+: denominator nip ;
+
+: s>rat      1 ;		\ integer to rational  (n/1)
+: rat>s      / ;		\ integer
+: rat>frac   mod ;		\ fractional part
+: rat>float  swap s>f s>f f/ ;
+
+: rat.  swap 1 .r [char] / emit . ;
+
+\ normalize: factors out gcd and puts sign into numerator
+: gcd ( a b -- gcd ) begin ?dup while tuck mod repeat ;
+: rat-normalize ( rat -- rat ) 2dup gcd tuck / >r / r> ;
+
+: rat-abs     swap abs    swap ;
+: rat-negate  swap negate swap ;
+: 1/rat       over 0< if negate swap negate else swap then ;
+
+: rat+ ( a b c d -- ad+bc bd )
+  rot 2dup * >r
+   rot * >r * r> +
+  r> rat-normalize ;
+: rat-  rat-negate rat+ ;
+
+: rat* ( a b c d -- ac bd )
+  rot * >r * r> rat-normalize ;
+: rat/  swap rat* ;
+
+: rat-equal  d= ;
+: rat-less ( a b c d -- ad<bc )
+  -rot * >r * r> < ;
+: rat-more  2swap rat-less ;
+
+: rat-inc  tuck + swap ;
+: rat-dec  tuck - swap ;

Task/Arithmetic-Rational/Fortran/arithmetic-rational-1.f

@@ -0,0 +1,236 @@
+module module_rational
+
+  implicit none
+  private
+  public :: rational
+  public :: rational_simplify
+  public :: assignment (=)
+  public :: operator (//)
+  public :: operator (+)
+  public :: operator (-)
+  public :: operator (*)
+  public :: operator (/)
+  public :: operator (<)
+  public :: operator (<=)
+  public :: operator (>)
+  public :: operator (>=)
+  public :: operator (==)
+  public :: operator (/=)
+  public :: abs
+  public :: int
+  public :: modulo
+  type rational
+    integer :: numerator
+    integer :: denominator
+  end type rational
+  interface assignment (=)
+    module procedure assign_rational_int, assign_rational_real
+  end interface
+  interface operator (//)
+    module procedure make_rational
+  end interface
+  interface operator (+)
+    module procedure rational_add
+  end interface
+  interface operator (-)
+    module procedure rational_minus, rational_subtract
+  end interface
+  interface operator (*)
+    module procedure rational_multiply
+  end interface
+  interface operator (/)
+    module procedure rational_divide
+  end interface
+  interface operator (<)
+    module procedure rational_lt
+  end interface
+  interface operator (<=)
+    module procedure rational_le
+  end interface
+  interface operator (>)
+    module procedure rational_gt
+  end interface
+  interface operator (>=)
+    module procedure rational_ge
+  end interface
+  interface operator (==)
+    module procedure rational_eq
+  end interface
+  interface operator (/=)
+    module procedure rational_ne
+  end interface
+  interface abs
+    module procedure rational_abs
+  end interface
+  interface int
+    module procedure rational_int
+  end interface
+  interface modulo
+    module procedure rational_modulo
+  end interface
+
+contains
+
+  recursive function gcd (i, j) result (res)
+    integer, intent (in) :: i
+    integer, intent (in) :: j
+    integer :: res
+    if (j == 0) then
+      res = i
+    else
+      res = gcd (j, modulo (i, j))
+    end if
+  end function gcd
+
+  function rational_simplify (r) result (res)
+    type (rational), intent (in) :: r
+    type (rational) :: res
+    integer :: g
+    g = gcd (r % numerator, r % denominator)
+    res = r % numerator / g // r % denominator / g
+  end function rational_simplify
+
+  function make_rational (numerator, denominator) result (res)
+    integer, intent (in) :: numerator
+    integer, intent (in) :: denominator
+    type (rational) :: res
+    res = rational (numerator, denominator)
+  end function make_rational
+
+  subroutine assign_rational_int (res, i)
+    type (rational), intent (out), volatile :: res
+    integer, intent (in) :: i
+    res = i // 1
+  end subroutine assign_rational_int
+
+  subroutine assign_rational_real (res, x)
+    type (rational), intent(out), volatile :: res
+    real, intent (in) :: x
+    integer :: x_floor
+    real :: x_frac
+    x_floor = floor (x)
+    x_frac = x - x_floor
+    if (x_frac == 0) then
+      res = x_floor // 1
+    else
+      res = (x_floor // 1) + (1 // floor (1 / x_frac))
+    end if
+  end subroutine assign_rational_real
+
+  function rational_add (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: res
+    res = r % numerator * s % denominator + r % denominator * s % numerator // &
+        & r % denominator * s % denominator
+  end function rational_add
+
+  function rational_minus (r) result (res)
+    type (rational), intent (in) :: r
+    type (rational) :: res
+    res = - r % numerator // r % denominator
+  end function rational_minus
+
+  function rational_subtract (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: res
+    res = r % numerator * s % denominator - r % denominator * s % numerator // &
+        & r % denominator * s % denominator
+  end function rational_subtract
+
+  function rational_multiply (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: res
+    res = r % numerator * s % numerator // r % denominator * s % denominator
+  end function rational_multiply
+
+  function rational_divide (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: res
+    res = r % numerator * s % denominator // r % denominator * s % numerator
+  end function rational_divide
+
+  function rational_lt (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: r_simple
+    type (rational) :: s_simple
+    logical :: res
+    r_simple = rational_simplify (r)
+    s_simple = rational_simplify (s)
+    res = r_simple % numerator * s_simple % denominator < &
+        & s_simple % numerator * r_simple % denominator
+  end function rational_lt
+
+  function rational_le (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: r_simple
+    type (rational) :: s_simple
+    logical :: res
+    r_simple = rational_simplify (r)
+    s_simple = rational_simplify (s)
+    res = r_simple % numerator * s_simple % denominator <= &
+        & s_simple % numerator * r_simple % denominator
+  end function rational_le
+
+  function rational_gt (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: r_simple
+    type (rational) :: s_simple
+    logical :: res
+    r_simple = rational_simplify (r)
+    s_simple = rational_simplify (s)
+    res = r_simple % numerator * s_simple % denominator > &
+        & s_simple % numerator * r_simple % denominator
+  end function rational_gt
+
+  function rational_ge (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    type (rational) :: r_simple
+    type (rational) :: s_simple
+    logical :: res
+    r_simple = rational_simplify (r)
+    s_simple = rational_simplify (s)
+    res = r_simple % numerator * s_simple % denominator >= &
+        & s_simple % numerator * r_simple % denominator
+  end function rational_ge
+
+  function rational_eq (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    logical :: res
+    res = r % numerator * s % denominator == s % numerator * r % denominator
+  end function rational_eq
+
+  function rational_ne (r, s) result (res)
+    type (rational), intent (in) :: r
+    type (rational), intent (in) :: s
+    logical :: res
+    res = r % numerator * s % denominator /= s % numerator * r % denominator
+  end function rational_ne
+
+  function rational_abs (r) result (res)
+    type (rational), intent (in) :: r
+    type (rational) :: res
+    res = sign (r % numerator, r % denominator) // r % denominator
+  end function rational_abs
+
+  function rational_int (r) result (res)
+    type (rational), intent (in) :: r
+    integer :: res
+    res = r % numerator / r % denominator
+  end function rational_int
+
+  function rational_modulo (r) result (res)
+    type (rational), intent (in) :: r
+    integer :: res
+    res = modulo (r % numerator, r % denominator)
+  end function rational_modulo
+
+end module module_rational

Task/Arithmetic-Rational/Fortran/arithmetic-rational-2.f

@@ -0,0 +1,28 @@
+program perfect_numbers
+
+  use module_rational
+  implicit none
+  integer, parameter :: n_min = 2
+  integer, parameter :: n_max = 2 ** 19 - 1
+  integer :: n
+  integer :: factor
+  type (rational) :: sum
+
+  do n = n_min, n_max
+    sum = 1 // n
+    factor = 2
+    do
+      if (factor * factor >= n) then
+        exit
+      end if
+      if (modulo (n, factor) == 0) then
+        sum = rational_simplify (sum + (1 // factor) + (factor // n))
+      end if
+      factor = factor + 1
+    end do
+    if (sum % numerator == 1 .and. sum % denominator == 1) then
+      write (*, '(i0)') n
+    end if
+  end do
+
+end program perfect_numbers

Task/Arithmetic-Rational/Go/arithmetic-rational.go

@@ -0,0 +1,32 @@
+package main
+
+import (
+    "fmt"
+    "math"
+    "math/big"
+)
+
+func main() {
+    var recip big.Rat
+    max := int64(1 << 19)
+    for candidate := int64(2); candidate < max; candidate++ {
+        sum := big.NewRat(1, candidate)
+        max2 := int64(math.Sqrt(float64(candidate)))
+        for factor := int64(2); factor <= max2; factor++ {
+            if candidate%factor == 0 {
+                sum.Add(sum, recip.SetFrac64(1, factor))
+                if f2 := candidate / factor; f2 != factor {
+                    sum.Add(sum, recip.SetFrac64(1, f2))
+                }
+            }
+        }
+        if sum.Denom().Int64() == 1 {
+            perfectstring := ""
+            if sum.Num().Int64() == 1 {
+                perfectstring = "perfect!"
+            }
+            fmt.Printf("Sum of recipr. factors of %d = %d exactly %s\n",
+                candidate, sum.Num().Int64(), perfectstring)
+        }
+    }
+}

Task/Arithmetic-Rational/Haskell/arithmetic-rational.hs

@@ -0,0 +1,10 @@
+import Data.Ratio
+
+-- simply prints all the perfect numbers
+main = mapM_ print [candidate
+                   | candidate <- [2 .. 2^19],
+                     getSum candidate == 1]
+  where getSum candidate = 1 % candidate +
+                           sum [1 % factor + 1 % (candidate `div` factor)
+                               | factor <- [2 .. floor(sqrt(fromIntegral(candidate)))],
+                                 candidate `mod` factor == 0]

Task/Arithmetic-Rational/Java/arithmetic-rational.java

@@ -0,0 +1,30 @@
+class BigRationalFindPerfectNumbers {
+  public static void main(String[] args) {
+    System.out.println("Running BigRational built-in tests");
+    if (BigRational.testFeatures()) {
+      int MAX_NUM = (1 << 19);
+      System.out.println();
+      System.out.println("Searching for perfect numbers in the range [1, " + (MAX_NUM - 1) + "]");
+      BigRational TWO = BigRational.valueOf(2);
+      for (int i = 1; i < MAX_NUM; i++) {
+        BigRational reciprocalSum = BigRational.ONE;
+        if (i > 1)
+          reciprocalSum = reciprocalSum.add(BigRational.valueOf(i).reciprocal());
+        int maxDivisor = (int)Math.sqrt(i);
+        if (maxDivisor >= i)
+          maxDivisor--;
+        for (int divisor = 2; divisor <= maxDivisor; divisor++) {
+          if ((i % divisor) == 0) {
+            reciprocalSum = reciprocalSum.add(BigRational.valueOf(divisor).reciprocal());
+            int dividend = i / divisor;
+            if (divisor != dividend)
+              reciprocalSum = reciprocalSum.add(BigRational.valueOf(dividend).reciprocal());
+          }
+        }
+        if (reciprocalSum.equals(TWO))
+          System.out.println(String.valueOf(i) + " is a perfect number");
+      }
+    }
+    return;
+  }
+}

Task/Arithmetic-Rational/Lua/arithmetic-rational.lua

@@ -0,0 +1,58 @@
+function gcd(a,b) return a == 0 and b or gcd(b % a, a) end
+
+do
+  local function coerce(a, b)
+    if type(a) == "number" then return rational(a, 1), b end
+    if type(b) == "number" then return a, rational(b, 1) end
+    return a, b
+  end
+  rational = setmetatable({
+  __add = function(a, b)
+      local a, b = coerce(a, b)
+      return rational(a.num * b.den + a.den * b.num, a.den * b.den)
+    end,
+  __sub = function(a, b)
+      local a, b = coerce(a, b)
+      return rational(a.num * b.den - a.den * b.num, a.den * b.den)
+    end,
+  __mul = function(a, b)
+      local a, b = coerce(a, b)
+      return rational(a.num * b.num, a.den * b.den)
+    end,
+  __div = function(a, b)
+      local a, b = coerce(a, b)
+      return rational(a.num * b.den, a.den * b.num)
+    end,
+  __pow = function(a, b)
+      if type(a) == "number" then return a ^ (b.num / b.den) end
+      return rational(a.num ^ b, a.den ^ b) --runs into a problem if these aren't integers
+    end,
+  __concat = function(a, b)
+      if getmetatable(a) == rational then return a.num .. "/" .. a.den .. b end
+      return a .. b.num .. "/" .. b.den
+    end,
+  __unm = function(a) return rational(-a.num, -a.den) end}, {
+  __call = function(z, a, b) return setmetatable({num = a / gcd(a, b),den = b / gcd(a, b)}, z) end} )
+end
+
+print(rational(2, 3) + rational(3, 5) - rational(1, 10) .. "") --> 7/6
+print((rational(4, 5) * rational(5, 9)) ^ rational(1, 2) .. "") --> 2/3
+print(rational(45, 60) / rational(5, 2) .. "") --> 3/10
+print(5 + rational(1, 3) .. "") --> 16/3
+
+function findperfs(n)
+  local ret = {}
+  for i = 1, n do
+    sum = rational(1, i)
+    for fac = 2, i^.5 do
+      if i % fac == 0 then
+        sum = sum + rational(1, fac) + rational(fac, i)
+      end
+    end
+    if sum.den == sum.num then
+      ret[#ret + 1] = i
+    end
+  end
+  return table.concat(ret, '\n')
+end
+print(findperfs(2^19))

Task/Arithmetic-Rational/Perl/arithmetic-rational.pl

@@ -0,0 +1,13 @@
+use bigrat;
+
+foreach my $candidate (2 .. 2**19) {
+    my $sum = 1 / $candidate;
+    foreach my $factor (2 .. sqrt($candidate)+1) {
+        if ($candidate % $factor == 0) {
+            $sum += 1 / $factor + 1 / ($candidate / $factor);
+        }
+    }
+    if ($sum->denominator() == 1) {
+        print "Sum of recipr. factors of $candidate = $sum exactly ", ($sum == 1 ? "perfect!" : ""), "\n";
+    }
+}

Task/Arithmetic-Rational/PicoLisp/arithmetic-rational.l

@@ -0,0 +1,14 @@
+(load "@lib/frac.l")
+
+(for (N 2  (> (** 2 19) N)  (inc N))
+   (let (Sum (frac 1 N)  Lim (sqrt N))
+      (for (F 2  (>= Lim F) (inc F))
+         (when (=0 (% N F))
+            (setq Sum
+               (f+ Sum
+                  (f+ (frac 1 F) (frac 1 (/ N F))) ) ) ) )
+      (when (= 1 (cdr Sum))
+         (prinl
+            "Perfect " N
+            ", sum is " (car Sum)
+            (and (= 1 (car Sum)) ": perfect") ) ) ) )

Task/Arithmetic-Rational/Python/arithmetic-rational-1.py

@@ -0,0 +1,10 @@
+from fractions import Fraction
+
+for candidate in range(2, 2**19):
+  sum = Fraction(1, candidate)
+  for factor in range(2, int(candidate**0.5)+1):
+    if candidate % factor == 0:
+      sum += Fraction(1, factor) + Fraction(1, candidate // factor)
+  if sum.denominator == 1:
+    print("Sum of recipr. factors of %d = %d exactly %s" %
+           (candidate, int(sum), "perfect!" if sum == 1 else ""))

Task/Arithmetic-Rational/Python/arithmetic-rational-2.py

@@ -0,0 +1,33 @@
+def lcm(a, b):
+    return a // gcd(a,b) * b
+
+def gcd(u, v):
+    return gcd(v, u%v) if v else abs(u)
+
+class Fraction:
+    def __init__(self, numerator, denominator):
+        common = gcd(numerator, denominator)
+        self.numerator = numerator//common
+        self.denominator = denominator//common
+    def __add__(self, frac):
+        common = lcm(self.denominator, frac.denominator)
+        n = common // self.denominator * self.numerator + common // frac.denominator * frac.numerator
+        return Fraction(n, common)
+    def __sub__(self, frac):
+        return self.__add__(-frac)
+    def __neg__(self):
+        return Fraction(-self.numerator, self.denominator)
+    def __abs__(self):
+        return Fraction(abs(self.numerator), abs(self.denominator))
+    def __mul__(self, frac):
+        return Fraction(self.numerator * frac.numerator, self.denominator * frac.denominator)
+    def __div__(self, frac):
+        return self.__mul__(frac.reciprocal())
+    def reciprocal(self):
+        return Fraction(self.denominator, self.numerator)
+    def __cmp__(self, n):
+        return int(float(self) - float(n))
+    def __float__(self):
+        return float(self.numerator / self.denominator)
+    def __int__(self):
+        return (self.numerator // self.denominator)

Task/Arithmetic-Rational/REXX/arithmetic-rational.rexx

@@ -0,0 +1,92 @@
+/*REXX pgm implements a reasonably complete rational arithmetic (fract.)*/
+L=length(2**19-1)                      /*saves time by checking even #s.*/
+     do j=2  to 2**19-1  by 2          /*ignore unity (can't be perfect)*/
+     $=divisors(j);  s=0;  @=          /*get divisors, zero sum, null @.*/
+                               do k=2  to  words($)      /*ignore unity.*/
+                               r='1/'word($,k);  @=@ r;   s=fractFun(r,,s)
+                               end   /*k*/
+     if s\==1  then iterate
+     say 'perfect number:' right(j,L)  '   fractions:' @
+     end   /*j*/
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────FRACTDIV subroutine─────────────────*/
+fractDiv: procedure;  parse arg x;    x=space(x,0);       f='FractDiv'
+parse var x n '/' d;                  d=p(d 1)
+if d=0        then call err 'division by zero:'           x
+if \isNum(n)  then call err 'a not numeric numerator:'    x
+if \isNum(d)  then call err 'a not numeric denominator:'  x
+return n/d
+/*──────────────────────────────────FRACTFUN subroutine─────────────────*/
+fractFun: procedure;  parse arg z.1,,z.2 1 zz.2,f;  arg ,op;  op=p(op '+')
+f='FractFun';    do j=1  for 2;   z.j=translate(z.j,'/',"_");   end  /*j*/
+if abbrev('ADD'       ,op)    then op='+'
+if abbrev('DIVIDE'    ,op)    then op='/'
+if abbrev('INTDIVIDE' ,op,4)  then op='÷'
+if abbrev('MODULO'    ,op,3) | abbrev('MODULUS'   ,op,3)  then op='//'
+if abbrev('MULTIPLY'  ,op)    then op='*'
+if abbrev('POWER'     ,op)    then op='^'
+if abbrev('SUBTRACT'  ,op)    then op='-'
+if z.1==''                    then z.1=(op\=="+" & op\=='-') /*unary +,-*/
+if z.2==''                    then z.2=(op\=="+" & op\=='-')
+z_=z.2
+
+  do j=1  for 2                        /*verification of both fractions.*/
+  if pos('/',z.j)==0  then z.j=z.j"/1";     parse var  z.j  n.j  '/'  d.j
+  if \isNum(n.j)  then call err 'a not numeric numerator:'    n.j
+  if \isNum(d.j)  then call err 'a not numeric denominator:'  d.j
+  n.j=n.j/1;      d.j=d.j/1
+             do  while \isInt(n.j);   n.j=(n.j*10)/1;     d.j=(d.j*10)/1
+             end  /*while*/            /* [↑]  normalize both numbers.  */
+  if d.j=0          then call err 'a denominator of zero:'    d.j
+  g=gcd(n.j,d.j);   if g=0  then iterate;     n.j=n.j/g;      d.j=d.j/g
+  end    /*j*/
+
+ select
+ when op=='**' | op=='↑'  |,
+      op=='^' then do; if \isInt(z_) then call err 'a not integer power:' z_
+                   t=1;  u=1;     do j=1  for abs(z_);  t=t*n.1;  u=u*d.1
+                                  end   /*j*/
+                   if z_<0  then parse value t u with u t
+                   end
+ when op=='/' then do;      if n.2=0 then call err 'a zero divisor:' zz.2
+                   t=n.1*d.2;    u=n.2*d.1
+                   end
+ when op=='÷' then do;      if n.2=0 then call err 'a zero divisor:' zz.2
+                   t=trunc(fractDiv(n.1 '/' d.1));    u=1
+                   end                 /* [↑] integer division.         */
+ when op=='//' then do;     if n.2=0 then call err 'a zero divisor:' zz.2
+                    _=trunc(fractDiv(n.1 '/' d.1)); t=_-trunc(_)*d.1;  u=1
+                    end                /* [↑] modulus division.         */
+ when op=='+' |,
+      op=='-' then do; l=lcm(d.1 d.2); do j=1  for 2; n.j=l*n.j/d.j; d.j=l
+                                       end   /*j*/
+                   if op=='-'  then n.2=-n.2;         t=n.1+n.2;       u=l
+                   end
+ when op=='ABS'  then do;   t=abs(n.1);    u=abs(d.1);    end
+ when op=='*'    then do;   t=n.1*n.2;     u=d.1*d.2;     end
+ when op=='EQ' |,
+      op=='='  then return fractDiv(n.1 '/' d.1)  =  fractDiv(n.2 '/' d.2)
+ when op=='NE' | op=='\=' | op=='╪'  |,
+      op=='¬=' then return fractDiv(n.1 '/' d.1) \=  fractDiv(n.2 '/' d.2)
+ when op=='GT' |,
+      op=='>'  then return fractDiv(n.1 '/' d.1)  >  fractDiv(n.2 '/' d.2)
+ when op=='LT' |,
+      op=='<'  then return fractDiv(n.1 '/' d.1)  <  fractDiv(n.2 '/' d.2)
+ when op=='GE' | op=='≥'  |,
+      op=='>=' then return fractDiv(n.1 '/' d.1)  >= fractDiv(n.2 '/' d.2)
+ when op=='LE' | op=='≤'  |,
+      op=='<=' then return fractDiv(n.1 '/' d.1)  <= fractDiv(n.2 '/' d.2)
+ otherwise     call err 'an illegal function:'  op
+ end   /*select*/
+
+if t==0  then return 0;        g=gcd(t,u);           t=t/g;          u=u/g
+if u==1  then return t
+              return t'/'u
+/*─────────────────────────────general 1─line subs─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
+divisors: procedure; parse arg x 1 b; if x=1 then return 1; a=1; o=x//2; do j=2+o by 1+o while j*j<x; if x//j\==0 then iterate; a=a j; b=x%j b; end; if j*j==x then b=j b; return a b
+err:      say; say '***error!***'; say; say f "detected" arg(1); say; exit 13
+gcd:procedure;$=;do i=1 for arg();$=$ arg(i);end;parse var $ x z .;if x=0 then x=z;x=abs(x);do j=2 to words($);y=abs(word($,j));if y=0 then iterate;do until _==0;_=x//y;x=y;y=_;end;end;return x
+isInt:    return datatype(arg(1),'W')
+isNum:    return datatype(arg(1),'N')
+lcm: procedure;  $=;    do j=1 for arg();  $=$ arg(j);  end;        x=abs(word($,1));         do k=2 to words($);  !=abs(word($,k));  if !=0 then return 0;  x=x*!/gcd(x,!);  end;       return x
+p:        return word(arg(1),1)

Task/Arithmetic-Rational/Ruby/arithmetic-rational.rb

@@ -0,0 +1,14 @@
+require 'rational' #Only needed in Ruby < 1.9
+
+for candidate in 2 .. 2**19:
+  sum = Rational(1, candidate)
+  for factor in 2 ... candidate**0.5
+    if candidate % factor == 0
+      sum += Rational(1, factor) + Rational(1, candidate / factor)
+    end
+  end
+  if sum.denominator == 1
+    puts "Sum of recipr. factors of %d = %d exactly %s" %
+           [candidate, sum.to_i, sum == 1 ? "perfect!" : ""]
+  end
+end

Task/Arithmetic-Rational/Scala/arithmetic-rational-1.scala

@@ -0,0 +1,44 @@
+class Rational(n: Long, d:Long) extends Ordered[Rational]
+{
+   require(d!=0)
+   private val g:Long = gcd(n, d)
+   val numerator:Long = n/g
+   val denominator:Long = d/g
+
+   def this(n:Long)=this(n,1)
+
+   def +(that:Rational):Rational=new Rational(
+      numerator*that.denominator + that.numerator*denominator,
+      denominator*that.denominator)
+
+   def -(that:Rational):Rational=new Rational(
+      numerator*that.denominator - that.numerator*denominator,
+      denominator*that.denominator)
+
+   def *(that:Rational):Rational=
+      new Rational(numerator*that.numerator, denominator*that.denominator)
+
+   def /(that:Rational):Rational=
+      new Rational(numerator*that.denominator, that.numerator*denominator)
+
+   def unary_~ :Rational=new Rational(denominator, numerator)
+
+   def unary_- :Rational=new Rational(-numerator, denominator)
+
+   def abs :Rational=new Rational(Math.abs(numerator), Math.abs(denominator))
+
+   override def compare(that:Rational):Int=
+      (this.numerator*that.denominator-that.numerator*this.denominator).toInt
+
+   override def toString()=numerator+"/"+denominator
+
+   private def gcd(x:Long, y:Long):Long=
+      if(y==0) x else gcd(y, x%y)
+}
+
+object Rational
+{
+   def apply(n: Long, d:Long)=new Rational(n,d)
+   def apply(n:Long)=new Rational(n)
+   implicit def longToRational(i:Long)=new Rational(i)
+}

Task/Arithmetic-Rational/Scala/arithmetic-rational-2.scala

@@ -0,0 +1,15 @@
+def find_perfects():Unit=
+{
+   for (candidate <- 2 until 1<<19)
+   {
+      var sum= ~Rational(candidate)
+      for (factor <- 2 until (Math.sqrt(candidate)+1).toInt)
+      {
+         if (candidate%factor==0)
+            sum+= ~Rational(factor)+ ~Rational(candidate/factor)
+      }
+
+      if (sum.denominator==1 && sum.numerator==1)
+         printf("Perfect number %d sum is %s\n", candidate, sum)
+   }
+}

Task/Arithmetic-Rational/Scheme/arithmetic-rational.ss

@@ -0,0 +1,8 @@
+; simply prints all the perfect numbers
+(do ((candidate 2 (+ candidate 1))) ((>= candidate (expt 2 19)))
+  (let ((sum (/ 1 candidate)))
+    (do ((factor 2 (+ factor 1))) ((>= factor (sqrt candidate)))
+      (if (= 0 (modulo candidate factor))
+          (set! sum (+ sum (/ 1 factor) (/ factor candidate)))))
+    (if (= 1 (denominator sum))
+        (begin (display candidate) (newline)))))

Task/Arithmetic-Rational/Smalltalk/arithmetic-rational.st

@@ -0,0 +1,18 @@
+| sum |
+2 to: (2 raisedTo: 19) do: [ :candidate |
+  sum := candidate reciprocal.
+  2 to: (candidate sqrt) do: [ :factor |
+     ( (candidate \\ factor) = 0 )
+        ifTrue: [
+           sum := sum + (factor reciprocal) + ((candidate / factor) reciprocal)
+        ]
+  ].
+  ( (sum denominator) = 1 )
+      ifTrue: [
+           ('Sum of recipr. factors of %1 = %2 exactly %3' %
+                     { candidate printString .
+                       (sum asInteger) printString .
+                       ( sum = 1 ) ifTrue: [ 'perfect!' ]
+                                   ifFalse: [ ' ' ] }) displayNl
+      ]
+].