Anonymous user
Arithmetic/Rational: Difference between revisions
Added solution for Action!
(add fermat) |
(Added solution for Action!) |
||
Line 22:
* [[Perfect Numbers]]
<br><br>
=={{header|Action!}}==
Calculations on a real Atari 8-bit computer take quite long time. It is recommended to use an emulator capable with increasing speed of Atari CPU.
{{libheader|Action! Tool Kit}}
<lang Action!>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</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Rational.png Screenshot from Atari 8-bit computer]
<pre>
6 is perfect
28 is perfect
496 is perfect
8128 is perfect
</pre>
=={{header|Ada}}==
| |||