Data commit

Task/Arithmetic-Rational/Action-/arithmetic-rational.action

@@ -0,0 +1,157 @@
+INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
+
+TYPE Frac=[INT num,den]
+
+REAL half
+
+PROC PrintFrac(Frac POINTER x)
+  PrintI(x.num) Put('/) PrintI(x.den)
+RETURN
+
+INT FUNC Gcd(INT a,b)
+  INT tmp
+
+  IF a<b THEN
+    tmp=a a=b b=tmp
+  FI
+
+  WHILE b#0
+  DO
+    tmp=a MOD b
+    a=b
+    b=tmp
+  OD
+RETURN (a)
+
+PROC Init(INT n,d Frac POINTER res)
+  IF d>0 THEN
+    res.num=n res.den=d
+  ELSEIF d<0 THEN
+    res.num=-n res.den=-d
+  ELSE
+    Print("Denominator cannot be zero!")
+    Break()
+  FI
+RETURN
+
+PROC Assign(Frac POINTER x,res)
+  Init(x.num,x.den,res)
+RETURN
+
+PROC Neg(Frac POINTER x,res)
+  Init(-x.num,x.den,res)
+RETURN
+
+PROC Inverse(Frac POINTER x,res)
+  Init(x.den,x.num)
+RETURN
+
+PROC Abs(Frac POINTER x,res)
+  IF x.num<0 THEN
+    Neg(x,res)
+  ELSE
+    Assign(x,res)
+  FI
+RETURN
+
+PROC Add(Frac POINTER x,y,res)
+  INT common,xDen,yDen
+
+  common=Gcd(x.den,y.den)
+  xDen=x.den/common
+  yDen=y.den/common
+  Init(x.num*yDen+y.num*xDen,xDen*y.den,res)
+RETURN
+
+PROC Sub(Frac POINTER x,y,res)
+  Frac n
+
+  Neg(y,n) Add(x,n,res)
+RETURN
+
+PROC Mult(Frac POINTER x,y,res)
+  Init(x.num*y.num,x.den*y.den,res)
+RETURN
+
+PROC Div(Frac POINTER x,y,res)
+  Frac i
+
+  Inverse(y,i) Mult(x,i,res)
+RETURN
+
+BYTE FUNC Greater(Frac POINTER x,y)
+  Frac diff
+
+  Sub(x,y,diff)
+  IF diff.num>0 THEN
+    RETURN (1)
+  FI
+RETURN (0)
+
+BYTE FUNC Less(Frac POINTER x,y)
+RETURN (Greater(y,x))
+
+BYTE FUNC GreaterEqual(Frac POINTER x,y)
+  Frac diff
+
+  Sub(x,y,diff)
+  IF diff.num>=0 THEN
+    RETURN (1)
+  FI
+RETURN (0)
+
+BYTE FUNC LessEqual(Frac POINTER x,y)
+RETURN (GreaterEqual(y,x))
+
+BYTE FUNC Equal(Frac POINTER x,y)
+  Frac diff
+
+  Sub(x,y,diff)
+  IF diff.num=0 THEN
+    RETURN (1)
+  FI
+RETURN (0)
+
+BYTE FUNC NotEqual(Frac POINTER x,y)
+  IF Equal(x,y) THEN
+    RETURN (0)
+  FI
+RETURN (1)
+
+INT FUNC Sqrt(INT x)
+  REAL r1,r2
+
+  IF x=0 THEN
+    RETURN (0)
+  FI
+  IntToReal(x,r1)
+  Power(r1,half,r2)
+RETURN (RealToInt(r2))
+
+PROC Main()
+  DEFINE MAXINT="32767"
+  INT i,f,max2
+  Frac sum,tmp1,tmp2,tmp3,one
+
+  Put(125) PutE() ;clear screen
+  ValR("0.5",half)
+  Init(1,1,one)
+  FOR i=2 TO MAXINT
+  DO
+    Init(1,i,sum) ;sum=1/i
+    max2=Sqrt(i)
+    FOR f=2 TO max2
+    DO
+      IF i MOD f=0 THEN
+        Init(1,f,tmp1)     ;tmp1=1/f
+        Add(sum,tmp1,tmp2) ;tmp2=sum+1/f
+        Init(f,i,tmp3)     ;tmp3=f/i
+        Add(tmp2,tmp3,sum) ;sum=sum+1/f+f/i
+      FI
+    OD
+
+    IF Equal(sum,one) THEN
+      PrintF("%I is perfect%E",i)
+    FI
+  OD
+RETURN