158 lines
2.4 KiB
Plaintext
158 lines
2.4 KiB
Plaintext
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
|