Arithmetic-geometric mean: Difference between revisions

</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