Data commit

Task/Arithmetic-Rational/BBC-BASIC/arithmetic-rational.basic

@@ -0,0 +1,62 @@
+      *FLOAT64
+      DIM frac{num, den}
+      DIM Sum{} = frac{}, Kf{} = frac{}, One{} = frac{}
+      One.num = 1 : One.den = 1
+
+      FOR n% = 2 TO 2^19-1
+        Sum.num = 1 : Sum.den = n%
+        FOR k% = 2 TO SQR(n%)
+          IF (n% MOD k%) = 0 THEN
+            Kf.num = 1 : Kf.den = k%
+            PROCadd(Sum{}, Kf{})
+            PROCnormalise(Sum{})
+            Kf.den = n% DIV k%
+            PROCadd(Sum{}, Kf{})
+            PROCnormalise(Sum{})
+          ENDIF
+        NEXT
+        IF FNeq(Sum{}, One{}) PRINT n% " is perfect"
+      NEXT n%
+      END
+
+      DEF PROCabs(a{}) : a.num = ABS(a.num) : ENDPROC
+      DEF PROCneg(a{}) : a.num = -a.num : ENDPROC
+
+      DEF PROCadd(a{}, b{})
+      LOCAL t : t = a.den * b.den
+      a.num = a.num * b.den + b.num * a.den
+      a.den = t
+      ENDPROC
+
+      DEF PROCsub(a{}, b{})
+      LOCAL t : t = a.den * b.den
+      a.num = a.num * b.den - b.num * a.den
+      a.den = t
+      ENDPROC
+
+      DEF PROCmul(a{}, b{})
+      a.num *= b.num : a.den *= b.den
+      ENDPROC
+
+      DEF PROCdiv(a{}, b{})
+      a.num *= b.den : a.den *= b.num
+      ENDPROC
+
+      DEF FNeq(a{}, b{}) = a.num * b.den = b.num * a.den
+      DEF FNlt(a{}, b{}) = a.num * b.den < b.num * a.den
+      DEF FNgt(a{}, b{}) = a.num * b.den > b.num * a.den
+      DEF FNne(a{}, b{}) = a.num * b.den <> b.num * a.den
+      DEF FNle(a{}, b{}) = a.num * b.den <= b.num * a.den
+      DEF FNge(a{}, b{}) = a.num * b.den >= b.num * a.den
+
+      DEF PROCnormalise(a{})
+      LOCAL a, b, t
+      a = a.num : b = a.den
+      WHILE b <> 0
+        t = a
+        a = b
+        b = t - b * INT(t / b)
+      ENDWHILE
+      a.num /= a : a.den /= a
+      IF a.den < 0 a.num *= -1 : a.den *= -1
+      ENDPROC