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

63 lines
1.7 KiB
Plaintext

*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