Anonymous user
Arithmetic-geometric mean: Difference between revisions
Added solution for Action!
Not a robot (talk | contribs) (Add BQN) |
(Added solution for Action!) |
||
Line 150:
<pre>
agn(1, 1/sqrt(2)) = 0.8472130848
</pre>
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
<lang Action!>INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
BYTE FUNC Equal(REAL POINTER a,b)
BYTE ARRAY x,y
x=a y=b
IF x(0)=y(0) AND x(1)=y(1) AND x(2)=y(2) THEN
RETURN (1)
FI
RETURN (0)
BYTE FUNC GreaterOrEqual(REAL POINTER left,right)
REAL diff
BYTE ARRAY x
RealSub(left,right,diff)
x=diff
IF (x(0)&$80)=$00 THEN
RETURN (1)
FI
RETURN (0)
PROC Sqrt(REAL POINTER a,b)
REAL z,half
IntToReal(0,z)
ValR("0.5",half)
IF Equal(a,z) THEN
RealAssign(z,b)
ELSE
Power(a,half,b)
FI
RETURN
PROC Agm(REAL POINTER a0,g0,result)
REAL a,g,prevA,tmp,r2
RealAssign(a0,a)
RealAssign(g0,g)
IntToReal(2,r2)
DO
RealAssign(a,prevA)
RealAdd(a,g,tmp)
RealDiv(tmp,r2,a)
RealMult(prevA,g,tmp)
Sqrt(tmp,g)
IF GreaterOrEqual(a,prevA) THEN
EXIT
FI
OD
RealAssign(a,result)
RETURN
PROC Main()
REAL r1,r2,tmp,g,res
Put(125) PutE() ;clear screen
IntToReal(1,r1)
IntToReal(2,r2)
Sqrt(r2,tmp)
RealDiv(r1,tmp,g)
Agm(r1,g,res)
Print("agm(") PrintR(r1)
Print(",") PrintR(g)
Print(")=") PrintRE(res)
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Arithmetic-geometric_mean.png Screenshot from Atari 8-bit computer]
<pre>
agm(1,.7071067873)=.847213085
</pre>
| |||