Public Type Complex
    re As Double
    im As Double
End Type

Function CAdd(a As Complex, b As Complex) As Complex
    CAdd.re = a.re + b.re
    CAdd.im = a.im + b.im
End Function

Function CSub(a As Complex, b As Complex) As Complex
    CSub.re = a.re - b.re
    CSub.im = a.im - b.im
End Function

Function CMult(a As Complex, b As Complex) As Complex
    CMult.re = (a.re * b.re) - (a.im * b.im)
    CMult.im = (a.re * b.im) + (a.im * b.re)
End Function

Function CConj(a As Complex) As Complex
    CConj.re = a.re
    CConj.im = -a.im
End Function

Function CNeg(a As Complex) As Complex
    CNeg.re = -a.re
    CNeg.im = -a.im
End Function

Function CInv(a As Complex) As Complex
    CInv.re = a.re / (a.re * a.re + a.im * a.im)
    CInv.im = -a.im / (a.re * a.re + a.im * a.im)
End Function

Function CDiv(a As Complex, b As Complex) As Complex
    CDiv = CMult(a, CInv(b))
End Function

Function CAbs(a As Complex) As Double
    CAbs = Math.Sqr(a.re * a.re + a.im * a.im)
End Function

Function CSqr(a As Complex) As Complex
    CSqr.re = Math.Sqr((a.re + Math.Sqr(a.re * a.re + a.im * a.im)) / 2)
    CSqr.im = Math.Sgn(a.im) * Math.Sqr((-a.re + Math.Sqr(a.re * a.re + a.im * a.im)) / 2)
End Function

Function CPrint(a As Complex) As String
    If a.im > 0 Then
        Sep = "+"
    Else
        Sep = ""
    End If
    CPrint = a.re & Sep & a.im & "i"
End Function

Sub ShowComplexCalc()
Dim a As Complex
Dim b As Complex
Dim c As Complex

a.re = 1.5
a.im = 3
b.re = 1.5
b.im = 1.5

Debug.Print "a = " & CPrint(a)
Debug.Print "b = " & CPrint(b)

c = CAdd(a, b)
Debug.Print "a + b = " & CPrint(c)
c = CSub(a, b)
Debug.Print "a - b = " & CPrint(c)
c = CMult(a, b)
Debug.Print "a * b = " & CPrint(c)
c = CConj(a)
Debug.Print "Conj(a) = " & CPrint(c)
c = CNeg(a)
Debug.Print "-a = " & CPrint(c)
c = CInv(a)
Debug.Print "Inv(a) = " & CPrint(c)
c = CDiv(a, b)
Debug.Print "a / b = " & CPrint(c)
Debug.Print "Abs(a) = " & CAbs(a)
c = CSqr(a)
Debug.Print "Sqrt(a) = " & CPrint(c)
End Sub


with javascript_semantics
requires("1.0.0") -- (mpfr_set_default_prec[ision] has been renamed)
include mpfr.e

mpfr_set_default_precision(-200) -- set precision to 200 decimal places
mpfr a = mpfr_init(1),
     n = mpfr_init(1),
     g = mpfr_init(1),
     z = mpfr_init(0.25),
     half = mpfr_init(0.5),
     x1 = mpfr_init(2),
     x2 = mpfr_init(),
     v = mpfr_init()
mpfr_sqrt(x1,x1)
mpfr_div(g,g,x1)    -- g:= 1/sqrt(2)
string prev, curr
for i=1 to 18 do
    mpfr_add(x1,a,g)
    mpfr_mul(x1,x1,half)
    mpfr_mul(x2,a,g)
    mpfr_sqrt(x2,x2)
    mpfr_sub(v,x1,a)
    mpfr_mul(v,v,v)
    mpfr_mul(v,v,n)
    mpfr_sub(z,z,v)
    mpfr_add(n,n,n)
    mpfr_set(a,x1)
    mpfr_set(g,x2)
    mpfr_mul(v,a,a)
    mpfr_div(v,v,z)
    curr = mpfr_get_fixed(v,200)
    if i>1 then
        if curr=prev then exit end if
        for j=3 to length(curr) do
            if prev[j]!=curr[j] then
                printf(1,"iteration %d matches previous to %d places\n",{i,j-3})
                exit
            end if
        end for
    end if
    prev = curr
end for
if curr=prev then
    printf(1,"identical result to last iteration:\n%s\n",{curr})
else
    printf(1,"insufficient iterations\n")
end if


defmodule ArithhGeom do
  def mean(a,g,tol) when abs(a-g) <= tol, do: a
  def mean(a,g,tol) do
    mean((a+g)/2,:math.pow(a*g, 0.5),tol)
  end
end

IO.puts ArithhGeom.mean(1,1/:math.sqrt(2),0.0000000001)


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


import math.complex
fn main() {
    a := complex.complex(1, 1)
    b := complex.complex(3.14159, 1.25)
    println("a:      $a")
    println("b:      $b")
    println("a + b:  ${a+b}")
    println("a * b:  ${a*b}")
    println("-a:     ${a.addinv()}")
    println("1 / a:  ${complex.complex(1,0)/a}")
    println("a̅:      ${a.conjugate()}")
}


from decimal import *

D = Decimal
getcontext().prec = 100
a = n = D(1)
g, z, half = 1 / D(2).sqrt(), D(0.25), D(0.5)
for i in range(18):
    x = [(a + g) * half, (a * g).sqrt()]
    var = x[0] - a
    z -= var * var * n
    n += n
    a, g = x
print(a * a / z)


library(Rmpfr)

agm <- function(n, prec) {
  s <- mpfr(0, prec)
  a <- mpfr(1, prec)
  g <- sqrt(mpfr("0.5", prec))
  p <- as.bigz(4)
  for (i in seq(n)) {
    m <- (a + g) / 2L
    g <- sqrt(a * g)
    a <- m
    s <- s + p * (a * a - g * g)
    p <- p + p
  }
  4L * a * a / (1L - s)
}

1e6 * log(10) / log(2)
# [1] 3321928

# Compute pi to one million decimal digits:
p <- 3322000
x <- agm(20, p)

# Check
roundMpfr(x - Const("pi", p), 64)
# 1 'mpfr' number of precision  64   bits
# [1] 4.90382361286485830568e-1000016

# Save to disk
f <- file("pi.txt", "w")
writeLines(formatMpfr(x, 1e6), f)
close(f)


%% Arithmetic Geometric Mean of 1 and 1 / sqrt(2)
%% Author: Abhay Jain

-module(agm_calculator).
-export([find_agm/0]).
-define(TOLERANCE, 0.0000000001).

find_agm() ->
    A = 1,
    B = 1 / (math:pow(2, 0.5)),
    AGM = agm(A, B),
    io:format("AGM = ~p", [AGM]).

agm (A, B) when abs(A-B) =< ?TOLERANCE ->
    A;
agm (A, B) ->
    A1 = (A+B) / 2,
    B1 = math:pow(A*B, 0.5),
    agm(A1, B1).


PROGRAM AGM

!
! for rosettacode.org
!

!$DOUBLE

PROCEDURE AGM(A,G->A)
   LOCAL TA
   REPEAT
      TA=A
      A=(A+G)/2
      G=SQR(TA*G)
   UNTIL A=TA
END PROCEDURE

BEGIN
   AGM(1.0,1/SQR(2)->A)
   PRINT(A)
END PROGRAM


generic
   type Number is range <>;
package Generic_Rational is
   type Rational is private;

   function "abs"   (A : Rational) return Rational;
   function "+"     (A : Rational) return Rational;
   function "-"     (A : Rational) return Rational;
   function Inverse (A : Rational) return Rational;

   function "+" (A : Rational; B : Rational) return Rational;
   function "+" (A : Rational; B : Number  ) return Rational;
   function "+" (A : Number;   B : Rational) return Rational;

   function "-" (A : Rational; B : Rational) return Rational;
   function "-" (A : Rational; B : Number  ) return Rational;
   function "-" (A : Number;   B : Rational) return Rational;

   function "*" (A : Rational; B : Rational) return Rational;
   function "*" (A : Rational; B : Number  ) return Rational;
   function "*" (A : Number;   B : Rational) return Rational;

   function "/" (A : Rational; B : Rational) return Rational;
   function "/" (A : Rational; B : Number  ) return Rational;
   function "/" (A : Number;   B : Rational) return Rational;
   function "/" (A : Number;   B : Number)   return Rational;

   function ">"  (A : Rational; B : Rational) return Boolean;
   function ">"  (A : Number;   B : Rational) return Boolean;
   function ">"  (A : Rational; B : Number)   return Boolean;

   function "<"  (A : Rational; B : Rational) return Boolean;
   function "<"  (A : Number;   B : Rational) return Boolean;
   function "<"  (A : Rational; B : Number)   return Boolean;

   function ">=" (A : Rational; B : Rational) return Boolean;
   function ">=" (A : Number;   B : Rational) return Boolean;
   function ">=" (A : Rational; B : Number)   return Boolean;

   function "<=" (A : Rational; B : Rational) return Boolean;
   function "<=" (A : Number;   B : Rational) return Boolean;
   function "<=" (A : Rational; B : Number)   return Boolean;

   function "="  (A : Number;   B : Rational) return Boolean;
   function "="  (A : Rational; B : Number)   return Boolean;

   function Numerator   (A : Rational) return Number;
   function Denominator (A : Rational) return Number;

   Zero : constant Rational;
   One  : constant Rational;
private
   type Rational is record
      Numerator   : Number;
      Denominator : Number;
   end record;

   Zero : constant Rational := (0, 1);
   One  : constant Rational := (1, 1);
end Generic_Rational;


import "/complex" for Complex

var x = Complex.new(1, 3)
var y = Complex.new(5, 2)
System.print("x     =  %(x)")
System.print("y     =  %(y)")
System.print("x + y =  %(x + y)")
System.print("x - y =  %(x - y)")
System.print("x * y =  %(x * y)")
System.print("x / y =  %(x / y)")
System.print("-x    =  %(-x)")
System.print("1 / x =  %(x.inverse)")
System.print("x*    =  %(x.conj)")


include c:\cxpl\codes;

func real CAdd(A, B, C);        \Return complex sum of two complex numbers
real A, B, C;
[C(0):= A(0) + B(0);
 C(1):= A(1) + B(1);
return C;
];

func real CMul(A, B, C);        \Return complex product of two complex numbers
real A, B, C;
[C(0):= A(0)*B(0) - A(1)*B(1);
 C(1):= A(1)*B(0) + A(0)*B(1);
return C;
];

func real CNeg(A, C);           \Return negative of a complex number
real A, C;
[C(0):= -A(0);
 C(1):= -A(1);
return C;
];

func real CInv(A, C);           \Return inversion (reciprical) of complex number
real A, C;
real D;
[D:= sq(A(0)) + sq(A(1));
C(0):= A(0)/D;
C(1):=-A(1)/D;
return C;
];

func real Conj(A, C);           \Return conjugate of a complex number
real A, C;
[C(0):= A(0);
 C(1):=-A(1);
return C;
];

proc COut(D, A);                \Output a complex number to specified device
int D; real A;
[RlOut(D, A(0));
  Text(D, if A(1)>=0.0 then " +" else " -");
 RlOut(D, abs(A(1)));
ChOut(D, ^i);
];

real U, V, W(2);
[Format(2,2);
U:= [1.0,  1.0];
V:= [3.14, 1.2];
COut(0, CAdd(U,V,W)); CrLf(0);
COut(0, CMul(U,V,W)); CrLf(0);
COut(0, CNeg(U,W));   CrLf(0);
COut(0, CInv(U,W));   CrLf(0);
COut(0, Conj(U,W));   CrLf(0);
]


#lang racket
(require math/bigfloat)

(define (pi/a-g rep)
  (let loop ([a 1.bf]
             [g (bf1/sqrt 2.bf)]
             [z (bf/ 1.bf 4.bf)]
             [n (bf 1)]
             [r 0])
    (if (< r rep)
        (let* ([a-p (bf/ (bf+ a g) 2.bf)]
               [g-p (bfsqrt (bf* a g))]
               [z-p (bf- z (bf* (bfsqr (bf- a-p a)) n))])
          (loop a-p g-p z-p (bf* n 2.bf) (add1 r)))
        (bf/ (bfsqr a) z))))

(parameterize ([bf-precision 100])
  (displayln (bigfloat->string (pi/a-g 5)))
  (displayln (bigfloat->string pi.bf)))

(parameterize ([bf-precision 200])
  (displayln (bigfloat->string (pi/a-g 6)))
  (displayln (bigfloat->string pi.bf)))


constant number-of-decimals = 100;

multi sqrt(Int $n) {
    my $guess = 10**($n.chars div 2);
    my $iterator = { ( $^x   +   $n div ($^x) ) div 2 };
    my $endpoint = { $^x == $^y|$^z };
    return min (+$guess, $iterator … $endpoint)[*-1, *-2];
}

multi sqrt(FatRat $r --> FatRat) {
    return FatRat.new:
    sqrt($r.nude[0] * 10**(number-of-decimals*2) div $r.nude[1]),
    10**number-of-decimals;
}

my FatRat ($a, $n) = 1.FatRat xx 2;
my FatRat $g = sqrt(1/2.FatRat);
my $z = .25;

for ^10 {
    given [ ($a + $g)/2, sqrt($a * $g) ] {
	$z -= (.[0] - $a)**2 * $n;
	$n += $n;
	($a, $g) = @$_;
	say ($a ** 2 / $z).substr: 0, 2 + number-of-decimals;
    }
}


let rec agm a g precision  =
    if precision > abs(a - g) then a else
    agm (0.5 * (a + g)) (sqrt (a * g)) precision

printfn "%g" (agm 1. (sqrt(0.5)) 1e-15)


USING: kernel math math.functions prettyprint ;
IN: rosetta-code.arithmetic-geometric-mean

: agm ( a g -- a' g' ) 2dup [ + 0.5 * ] 2dip * sqrt ;

1 1 2 sqrt / [ 2dup - 1e-15 > ] [ agm ] while drop .


: agm ( a g -- m )
  begin
    fover fover f+ 2e f/
    frot frot f* fsqrt
    fover fover 1e-15 f~
  until
  fdrop ;

1e  2e -0.5e f**  agm f.   \ 0.847213084793979


 MODE FRAC = STRUCT( INT num #erator#,  den #ominator#);
 FORMAT frac repr = $g(-0)"//"g(-0)$;

 PROC gcd = (INT a, b) INT: # greatest common divisor #
   (a = 0 | b |: b = 0 | a |: ABS a > ABS b  | gcd(b, a MOD b) | gcd(a, b MOD a));

 PROC lcm = (INT a, b)INT: # least common multiple #
   a OVER gcd(a, b) * b;

 PROC raise not implemented error = ([]STRING args)VOID: (
   put(stand error, ("Not implemented error: ",args, newline));
   stop
 );

 PRIO // = 9; # higher then the ** operator #
 OP // = (INT num, den)FRAC: ( # initialise and normalise #
   INT common = gcd(num, den);
   IF den < 0 THEN
     ( -num OVER common, -den OVER common)
   ELSE
     ( num OVER common, den OVER common)
   FI
 );

 OP + = (FRAC a, b)FRAC: (
   INT common = lcm(den OF a, den OF b);
   FRAC result := ( common OVER den OF a * num OF a + common OVER den OF b * num OF b, common );
   num OF result//den OF result
 );

 OP - = (FRAC a, b)FRAC: a + -b,
    * = (FRAC a, b)FRAC: (
   INT num = num OF a * num OF b,
       den = den OF a * den OF b;
   INT common = gcd(num, den);
   (num OVER common) // (den OVER common)
 );

 OP /  = (FRAC a, b)FRAC: a * FRAC(den OF b, num OF b),# real division #
    %  = (FRAC a, b)INT: ENTIER (a / b),               # integer divison #
    %* = (FRAC a, b)FRAC: a/b - FRACINIT ENTIER (a/b), # modulo division #
    ** = (FRAC a, INT exponent)FRAC:
     IF exponent >= 0 THEN
       (num OF a ** exponent, den OF a ** exponent )
     ELSE
       (den OF a ** exponent, num OF a ** exponent )
     FI;

 OP REALINIT = (FRAC frac)REAL: num OF frac / den OF frac,
    FRACINIT = (INT num)FRAC: num // 1,
    FRACINIT = (REAL num)FRAC: (
      # express real number as a fraction # # a future execise! #
      raise not implemented error(("Convert a REAL to a FRAC","!"));
      SKIP
    );

 OP <  = (FRAC a, b)BOOL: num OF (a - b) <  0,
    >  = (FRAC a, b)BOOL: num OF (a - b) >  0,
    <= = (FRAC a, b)BOOL: NOT ( a > b ),
    >= = (FRAC a, b)BOOL: NOT ( a < b ),
    =  = (FRAC a, b)BOOL: (num OF a, den OF a) = (num OF b, den OF b),
    /= = (FRAC a, b)BOOL: (num OF a, den OF a) /= (num OF b, den OF b);

 # Unary operators #
 OP - = (FRAC frac)FRAC: (-num OF frac, den OF frac),
    ABS = (FRAC frac)FRAC: (ABS num OF frac, ABS den OF frac),
    ENTIER = (FRAC frac)INT: (num OF frac OVER den OF frac) * den OF frac;

 COMMENT Operators for extended characters set, and increment/decrement:
 OP +:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a + b ),
    +=: = (FRAC a, REF FRAC b)REF FRAC: ( b := a + b ),
    -:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a - b ),
    *:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a * b ),
    /:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a / b ),
    %:= = (REF FRAC a, FRAC b)REF FRAC: ( a := FRACINIT (a % b) ),
    %*:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a %* b );

 # OP aliases for extended character sets (eg: Unicode, APL, ALCOR and GOST 10859) #
 OP ×  = (FRAC a, b)FRAC: a * b,
    ÷  = (FRAC a, b)INT: a OVER b,
    ÷× = (FRAC a, b)FRAC: a MOD b,
    ÷* = (FRAC a, b)FRAC: a MOD b,
    %× = (FRAC a, b)FRAC: a MOD b,
    ≤  = (FRAC a, b)FRAC: a <= b,
    ≥  = (FRAC a, b)FRAC: a >= b,
    ≠  = (FRAC a, b)BOOL: a /= b,
    ↑  = (FRAC frac, INT exponent)FRAC: frac ** exponent,

    ÷×:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a MOD b ),
    %×:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a MOD b ),
    ÷*:= = (REF FRAC a, FRAC b)REF FRAC: ( a := a MOD b );

 # BOLD aliases for CPU that only support uppercase for 6-bit bytes  - wrist watches #
 OP OVER = (FRAC a, b)INT: a % b,
    MOD = (FRAC a, b)FRAC: a %*b,
    LT = (FRAC a, b)BOOL: a <  b,
    GT = (FRAC a, b)BOOL: a >  b,
    LE = (FRAC a, b)BOOL: a <= b,
    GE = (FRAC a, b)BOOL: a >= b,
    EQ = (FRAC a, b)BOOL: a =  b,
    NE = (FRAC a, b)BOOL: a /= b,
    UP = (FRAC frac, INT exponent)FRAC: frac**exponent;

 # the required standard assignment operators #
 OP PLUSAB  = (REF FRAC a, FRAC b)REF FRAC: ( a +:= b ), # PLUS #
    PLUSTO  = (FRAC a, REF FRAC b)REF FRAC: ( a +=: b ), # PRUS #
    MINUSAB = (REF FRAC a, FRAC b)REF FRAC: ( a *:= b ),
    DIVAB   = (REF FRAC a, FRAC b)REF FRAC: ( a /:= b ),
    OVERAB  = (REF FRAC a, FRAC b)REF FRAC: ( a %:= b ),
    MODAB   = (REF FRAC a, FRAC b)REF FRAC: ( a %*:= b );

END COMMENT
Example: searching for Perfect Numbers.
 FRAC sum:= FRACINIT 0;
 FORMAT perfect = $b(" perfect!","")$;

 FOR i FROM 2 TO 2**19 DO
   INT candidate := i;
   FRAC sum := 1 // candidate;
   REAL real sum := 1 / candidate;
   FOR factor FROM 2 TO ENTIER sqrt(candidate) DO
     IF candidate MOD factor = 0 THEN
       sum :=  sum + 1 // factor + 1 // ( candidate OVER factor);
       real sum +:= 1 / factor + 1 / ( candidate OVER factor)
     FI
   OD;
   IF den OF sum  = 1 THEN
     printf(($"Sum of reciprocal factors of "g(-0)" = "g(-0)" exactly, about "g(0,real width) f(perfect)l$,
             candidate, ENTIER sum, real sum, ENTIER sum = 1))
   FI
 OD


/*REXX program calculates the value of  pi  using the  AGM  algorithm.                  */
parse arg d .;   if d=='' | d==","  then d= 500  /*D  not specified?  Then use default. */
numeric digits d+5                               /*set the numeric decimal digits to D+5*/
z= 1/4;                a= 1;     g= sqrt(1/2)    /*calculate some initial values.       */
n= 1
       do j=1   until a==old;       old= a       /*keep calculating until no more noise.*/
       x= (a+g) * .5;               g= sqrt(a*g) /*calculate the next set of terms.     */
       z= z - n*(x-a)**2;  n= n+n;  a= x         /*Z  is used in the final calculation. */
       end   /*j*/                               /* [↑]  stop if  A  equals  OLD.       */

pi= a**2 / z                                     /*compute the finished  value of  pi.  */
numeric digits d                                 /*set the numeric decimal digits to  D.*/
say pi / 1                                       /*display the computed value of  pi.   */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x;  if x=0  then return 0;  d=digits();  numeric digits;  h=d+6
      numeric form; m.=9; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g *.5'e'_ %2
            do j=0  while h>9;        m.j=h;                 h=h%2+1;          end  /*j*/
            do k=j+5  to 0  by -1;    numeric digits m.k;    g=(g+x/g)*.5;     end  /*k*/
      numeric digits d;     return g/1


# Calculate Pi using the Arithmetic Geometric Mean of 1 and 1/sqrt(2)
#
#
#  Nigel_Galloway
#  March 8th., 2012.
#
require 'flt'
Flt::BinNum.Context.precision = 8192
a = n = 1
g = 1 / Flt::BinNum(2).sqrt
z = 0.25
(0..17).each{
  x = [(a + g) * 0.5, (a * g).sqrt]
  var = x[0] - a
  z -= var * var * n
  n += n
  a = x[0]
  g = x[1]
}
puts a * a / z


      function agm(a,b)
      implicit none
      double precision agm,a,b,eps,c
      parameter(eps=1.0d-15)
   10 c=0.5d0*(a+b)
      b=sqrt(a*b)
      a=c
      if(a-b.gt.eps*a) go to 10
      agm=0.5d0*(a+b)
      end
      program test
      implicit none
      double precision agm
      print*,agm(1.0d0,1.0d0/sqrt(2.0d0))
      end


' version 16-09-2015
' compile with: fbc -s console

Function agm(a As Double, g As Double) As Double

    Dim As Double t_a

    Do
        t_a = (a + g) / 2
        g = Sqr(a * g)
        Swap a, t_a
    Loop Until a = t_a

    Return a

End Function

' ------=< MAIN >=------

Print agm(1, 1 / Sqr(2) )

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


import "futlib/math"

fun agm(a: f64, g: f64): f64 =
  let eps = 1.0E-16
  loop ((a,g)) = while f64.abs(a-g) > eps do
    ((a+g) / 2.0,
     f64.sqrt (a*g))
  in a

fun main(x: f64, y: f64): f64 =
  agm(x,y)


a: to :rational [1 2]
b: to :rational [3 4]

print ["a:" a]
print ["b:" b]

print ["a + b  :" a + b]
print ["a - b  :" a - b]
print ["a * b  :" a * b]
print ["a / b  :" a / b]
print ["a // b :" a // b]
print ["a % b  :" a % b]

print ["reciprocal b:" reciprocal b]
print ["neg a:" neg a]

print ["pi ~=" to :rational 3.14]


      *FLOAT64
      DIM frac{num, den}
      DIM Sum{} = frac{}, Kf{} = frac{}, One{} = frac{}
      One.num = 1 : One.den = 1

      FOR n% = 2 TO 2^19-1
        Sum.num = 1 : Sum.den = n%
        FOR k% = 2 TO SQR(n%)
          IF (n% MOD k%) = 0 THEN
            Kf.num = 1 : Kf.den = k%
            PROCadd(Sum{}, Kf{})
            PROCnormalise(Sum{})
            Kf.den = n% DIV k%
            PROCadd(Sum{}, Kf{})
            PROCnormalise(Sum{})
          ENDIF
        NEXT
        IF FNeq(Sum{}, One{}) PRINT n% " is perfect"
      NEXT n%
      END

      DEF PROCabs(a{}) : a.num = ABS(a.num) : ENDPROC
      DEF PROCneg(a{}) : a.num = -a.num : ENDPROC

      DEF PROCadd(a{}, b{})
      LOCAL t : t = a.den * b.den
      a.num = a.num * b.den + b.num * a.den
      a.den = t
      ENDPROC

      DEF PROCsub(a{}, b{})
      LOCAL t : t = a.den * b.den
      a.num = a.num * b.den - b.num * a.den
      a.den = t
      ENDPROC

      DEF PROCmul(a{}, b{})
      a.num *= b.num : a.den *= b.den
      ENDPROC

      DEF PROCdiv(a{}, b{})
      a.num *= b.den : a.den *= b.num
      ENDPROC

      DEF FNeq(a{}, b{}) = a.num * b.den = b.num * a.den
      DEF FNlt(a{}, b{}) = a.num * b.den < b.num * a.den
      DEF FNgt(a{}, b{}) = a.num * b.den > b.num * a.den
      DEF FNne(a{}, b{}) = a.num * b.den <> b.num * a.den
      DEF FNle(a{}, b{}) = a.num * b.den <= b.num * a.den
      DEF FNge(a{}, b{}) = a.num * b.den >= b.num * a.den

      DEF PROCnormalise(a{})
      LOCAL a, b, t
      a = a.num : b = a.den
      WHILE b <> 0
        t = a
        a = b
        b = t - b * INT(t / b)
      ENDWHILE
      a.num /= a : a.den /= a
      IF a.den < 0 a.num *= -1 : a.den *= -1
      ENDPROC


module Numbers;
type
	{public,immutable}
	Complex = record
		re,im: real;
	end Complex;

operator {public} "+" (a,b: Complex): Complex;
var
	r: Complex;
begin
	r.re := a.re + b.re;
	r.im := a.im + b.im;
	return r
end "+";

operator {public} "-" (a,b: Complex): Complex;
var
	r: Complex;
begin
	r.re := a.re - b.re;
	r.im := a.im - b.im;
	return r
end "-";

operator {public} "*" (a,b: Complex): Complex;
var
	r: Complex;
begin
	r.re := a.re*b.re - a.im*b.im;
	r.im := a.re*b.im + a.im*b.re;
	return r
end "*";

operator {public} "/" (a,b: Complex): Complex;
var
	r: Complex;
	d: real;
begin
	d := b.re * b.re + b.im * b.im;
	r.re := (a.re * b.re + a.im * b.im)/d;
	r.im := (a.im * b.re - a.re * b.im)/d;
	return r
end "/";

operator {public} "-" (a: Complex): Complex;
begin
	a.im := -1 * a.im;
	return a
end "-";

operator {public} "~" (a: Complex): Complex;
var
	d: real;
	c: Complex;
begin
	d := a.re * a.re + a.im * a.im;
	c.re := a.re/d;
	c.im := (-1.0 * a.im)/d;
	return c
end "~";

end Numbers.

module Main;
import Numbers;

var
	a,b,c: Numbers.Complex;

	procedure Writeln(c: Numbers.Complex);
	begin
		writeln("(",c.re:4:2,";",c.im:4:2,"i)");
	end Writeln;

	procedure NewComplex(x,y: real): Numbers.Complex;
	var
		r: Numbers.Complex;
	begin
		r.re := x;r.im := y;
		return r
	end NewComplex;

begin
	a := NewComplex(1.5,3.0);
	b := NewComplex(1.0,1.0);
	Writeln(a + b);
	Writeln(a - b);
	Writeln(a * b);
	Writeln(a / b);
	Writeln(-a);
	Writeln(~b);
end Main.


5 LET complex=2: LET r=1: LET i=2
10 DIM a(complex): LET a(r)=1.0: LET a(i)=1.0
20 DIM b(complex): LET b(r)=PI: LET b(i)=1.2
30 DIM o(complex)
40 REM add
50 LET o(r)=a(r)+b(r)
60 LET o(i)=a(i)+b(i)
70 PRINT "Result of addition is:": GO SUB 1000
80 REM mult
90 LET o(r)=a(r)*b(r)-a(i)*b(i)
100 LET o(i)=a(i)*b(r)+a(r)*b(i)
110 PRINT "Result of multiplication is:": GO SUB 1000
120 REM neg
130 LET o(r)=-a(r)
140 LET o(i)=-a(i)
150 PRINT "Result of negation is:": GO SUB 1000
160 LET denom=a(r)^2+a(i)^2
170 LET o(r)=a(r)/denom
180 LET o(i)=-a(i)/denom
190 PRINT "Result of inversion is:": GO SUB 1000
200 STOP
1000 IF o(i)>=0 THEN PRINT o(r);" + ";o(i);"i": RETURN
1010 PRINT o(r);" - ";-o(i);"i": RETURN


/// calculate pi with algebraic/geometric mean
pub fn pi(n: usize) -> f64 {
    let mut a : f64 = 1.0;
    let two : f64= 2.0;
    let mut g = 1.0 / two.sqrt();
    let mut s = 0.0;
    let mut k = 1;
    while k<=n  {

        let a1 = (a+g)/two;
        let g1 = (a*g).sqrt();
        a = a1;
        g = g1;
        s += (a.powi(2)-g.powi(2)) * two.powi((k+1) as i32);
        k += 1;

    }

    4.0 * a.powi(2) / (1.0-s)
}


import java.math.MathContext

import scala.annotation.tailrec
import scala.compat.Platform.currentTime
import scala.math.BigDecimal

object Calculate_Pi extends App {
  val precision = new MathContext(32768 /*65536*/)
  val (bigZero, bigOne, bigTwo, bigFour) =
    (BigDecimal(0, precision), BigDecimal(1, precision), BigDecimal(2, precision), BigDecimal(4, precision))

  def bigSqrt(bd: BigDecimal) = {
    @tailrec
    def iter(x0: BigDecimal, x1: BigDecimal): BigDecimal =
      if (x0 == x1) x1 else iter(x1, (bd / x1 + x1) / bigTwo)

    iter(bigZero, BigDecimal(Math.sqrt(bd.toDouble), precision))
  }

  @tailrec
  private def loop(a: BigDecimal, g: BigDecimal, sum: BigDecimal, pow: BigDecimal): BigDecimal = {
    if (a == g) (bigFour * (a * a)) / (bigOne - sum)
    else {
      val (_a, _g, _pow) = ((a + g) / bigTwo, bigSqrt(a * g), pow * bigTwo)
      loop(_a, _g, sum + ((_a * _a - (_g * _g)) * _pow), _pow)
    }
  }

  println(precision)
  val pi = loop(bigOne, bigOne / bigSqrt(bigTwo), bigZero, bigTwo)
  println(s"This are ${pi.toString.length - 1} digits of π:")
  val lines = pi.toString().sliding(103, 103).mkString("\n")
  println(lines)

  println(s"Successfully completed without errors. [total ${currentTime - executionStart} ms]")
}


package main

import (
    "fmt"
    "math"
)

const ε = 1e-14

func agm(a, g float64) float64 {
    for math.Abs(a-g) > math.Abs(a)*ε {
        a, g = (a+g)*.5, math.Sqrt(a*g)
    }
    return a
}

func main() {
    fmt.Println(agm(1, 1/math.Sqrt2))
}


double agm (double a, double g) {
    double an = a, gn = g
    while ((an-gn).abs() >= 10.0**-14) { (an, gn) = [(an+gn)*0.5, (an*gn)**0.5] }
    an
}


-- Return an approximation to the arithmetic-geometric mean of two numbers.
-- The result is considered accurate when two successive approximations are
-- sufficiently close, as determined by "eq".
agm :: (Floating a) => a -> a -> ((a, a) -> Bool) -> a
agm a g eq = snd $ until eq step (a, g)
  where
    step (a, g) = ((a + g) / 2, sqrt (a * g))

-- Return the relative difference of the pair.  We assume that at least one of
-- the values is far enough from 0 to not cause problems.
relDiff :: (Fractional a) => (a, a) -> a
relDiff (x, y) =
  let n = abs (x - y)
      d = (abs x + abs y) / 2
  in n / d

main :: IO ()
main = do
  let equal = (< 0.000000001) . relDiff
  print $ agm 1 (1 / sqrt 2) equal


#include <stdio.h>
#include <stdlib.h>
#define FMT "%lld"
typedef long long int fr_int_t;
typedef struct { fr_int_t num, den; } frac;

fr_int_t gcd(fr_int_t m, fr_int_t n)
{
	fr_int_t t;
	while (n) { t = n; n = m % n; m = t; }
	return m;
}

frac frac_new(fr_int_t num, fr_int_t den)
{
	frac a;
	if (!den) {
		printf("divide by zero: "FMT"/"FMT"\n", num, den);
		abort();
	}

	int g = gcd(num, den);

	if (g)	{ num /= g; den /= g; }
	else	{ num = 0; den = 1;   }

	if (den < 0) {
		den = -den;
		num = -num;
	}
	a.num = num; a.den = den;
	return a;
}

#define BINOP(op, n, d) frac frac_##op(frac a, frac b) { return frac_new(n,d); }
BINOP(add, a.num * b.den + b.num * a.den, a.den * b.den);
BINOP(sub, a.num * b.den - b.num + a.den, a.den * b.den);
BINOP(mul, a.num * b.num, a.den * b.den);
BINOP(div, a.num * b.den, a.den * b.num);

int frac_cmp(frac a, frac b) {
	int l = a.num * b.den, r = a.den * b.num;
	return l < r ? -1 : l > r;
}
#define frac_cmp_int(a, b) frac_cmp(a, frac_new(b, 1))
int frtoi(frac a) { return a.den / a.num; }
double frtod(frac a) { return (double)a.den / a.num; }

int main()
{
	int n, k;
	frac sum, kf;

	for (n = 2; n < 1<<19; n++) {
		sum = frac_new(1, n);

		for (k = 2; k * k < n; k++) {
			if (n % k) continue;
			kf = frac_new(1, k);
			sum = frac_add(sum, kf);

			kf = frac_new(1, n / k);
			sum = frac_add(sum, kf);
		}
		if (frac_cmp_int(sum, 1) == 0) printf("%d\n", n);
	}

	return 0;
}


func agm_pi(digits) {
    var acc = (digits + 8);

    local Num!PREC = 4*digits;

    var an = 1;
    var bn = sqrt(0.5);
    var tn = 0.5**2;
    var pn = 1;

    while (pn < acc) {
        var prev_an = an;
        an = (bn+an / 2);
        bn = sqrt(bn * prev_an);
        prev_an -= an;
        tn -= (pn * prev_an**2);
        pn *= 2;
    }

    ((an+bn)**2 / 4*tn).to_s
}

say agm_pi(100);


package require math::bigfloat
namespace import math::bigfloat::*

proc agm/π {N {precision 8192}} {
    set 1 [int2float 1 $precision]
    set 2 [int2float 2 $precision]
    set n 1
    set a $1
    set g [div $1 [sqrt $2]]
    set z [div $1 [int2float 4 $precision]]
    for {set i 0} {$i <= $N} {incr i} {
	set x0 [div [add $a $g] $2]
	set x1 [sqrt [mul $a $g]]
	set var [sub $x0 $a]
	set z [sub $z [mul [mul $var $n] $var]]
	incr n $n
	set a $x0
	set g $x1
    }
    return [tostr [div [mul $a $a] $z]]
}

puts [agm/π 17]


Imports System, System.Numerics

Module Program
    Function IntSqRoot(ByVal valu As BigInteger, ByVal guess As BigInteger) As BigInteger
        Dim term As BigInteger : Do
            term = valu / guess
            If BigInteger.Abs(term - guess) <= 1 Then Exit Do
            guess += term : guess >>= 1
        Loop While True : Return guess
    End Function

    Function ISR(ByVal term As BigInteger, ByVal guess As BigInteger) As BigInteger
        Dim valu As BigInteger = term * guess : Do
            If BigInteger.Abs(term - guess) <= 1 Then Exit Do
            guess += term : guess >>= 1 : term = valu / guess
        Loop While True : Return guess
    End Function

    Function CalcAGM(ByVal lam As BigInteger, ByVal gm As BigInteger, ByRef z As BigInteger,
                     ByVal ep As BigInteger) As BigInteger
        Dim am, zi As BigInteger : Dim n As ULong = 1 : Do
            am = (lam + gm) >> 1 : gm = ISR(lam, gm)
            Dim v As BigInteger = am - lam
            zi = v * v * n : If zi < ep Then Exit Do
            z -= zi : n <<= 1 : lam = am
        Loop While True : Return am
    End Function

    Function BIP(ByVal exp As Integer, ByVal Optional man As ULong = 1) As BigInteger
        Dim rv As BigInteger = BigInteger.Pow(10, exp) : Return If(man = 1, rv, man * rv)
    End Function

    Sub Main(args As String())
        Dim d As Integer = 25000
        If args.Length > 0 Then
            Integer.TryParse(args(0), d)
            If d < 1 OrElse d > 999999 Then d = 25000
        End If
        Dim st As DateTime = DateTime.Now
        Dim am As BigInteger = BIP(d),
            gm As BigInteger = IntSqRoot(BIP(d + d - 1, 5),
                                         BIP(d - 15, Math.Sqrt(0.5) * 1.0E+15)),
             z As BigInteger = BIP(d + d - 2, 25),
             agm As BigInteger = CalcAGM(am, gm, z, BIP(d + 1)),
             pi As BigInteger = agm * agm * BIP(d - 2) / z
        Console.WriteLine("Computation time: {0:0.0000} seconds ",
                          (DateTime.Now - st).TotalMilliseconds / 1000)
        If args.Length > 1 OrElse d <= 1000 Then
            Dim s As String = pi.ToString()
            Console.WriteLine("{0}.{1}", s(0), s.Substring(1))
        End If
        If Diagnostics.Debugger.IsAttached Then Console.ReadKey()
    End Sub
End Module


procedure main(A)
    a := real(A[1]) | 1.0
    g := real(A[2]) | (1 / 2^0.5)
    epsilon := real(A[3])
    write("agm(",a,",",g,") = ",agm(a,g,epsilon))
end

procedure agm(an, gn, e)
    /e := 1e-15
    while abs(an-gn) > e do {
       ap := (an+gn)/2.0
       gn := (an*gn)^0.5
       an := ap
       }
    return an
end


/*
 * Arithmetic-Geometric Mean of 1 & 1/sqrt(2)
 * Brendan Shaklovitz
 * 5/29/12
 */
public class ArithmeticGeometricMean {

    public static double agm(double a, double g) {
        double a1 = a;
        double g1 = g;
        while (Math.abs(a1 - g1) >= 1.0e-14) {
            double arith = (a1 + g1) / 2.0;
            double geom = Math.sqrt(a1 * g1);
            a1 = arith;
            g1 = geom;
        }
        return a1;
    }

    public static void main(String[] args) {
        System.out.println(agm(1.0, 1.0 / Math.sqrt(2.0)));
    }
}


using System;

struct Fraction : IEquatable<Fraction>, IComparable<Fraction>
{
    public readonly long Num;
    public readonly long Denom;

    public Fraction(long num, long denom)
    {
        if (num == 0)
        {
            denom = 1;
        }
        else if (denom == 0)
        {
            throw new ArgumentException("Denominator may not be zero", "denom");
        }
        else if (denom < 0)
        {
            num = -num;
            denom = -denom;
        }

        long d = GCD(num, denom);
        this.Num = num / d;
        this.Denom = denom / d;
    }

    private static long GCD(long x, long y)
    {
        return y == 0 ? x : GCD(y, x % y);
    }

    private static long LCM(long x, long y)
    {
        return x / GCD(x, y) * y;
    }

    public Fraction Abs()
    {
        return new Fraction(Math.Abs(Num), Denom);
    }

    public Fraction Reciprocal()
    {
        return new Fraction(Denom, Num);
    }

    #region Conversion Operators

    public static implicit operator Fraction(long i)
    {
        return new Fraction(i, 1);
    }

    public static explicit operator double(Fraction f)
    {
        return f.Num == 0 ? 0 : (double)f.Num / f.Denom;
    }

    #endregion

    #region Arithmetic Operators

    public static Fraction operator -(Fraction f)
    {
        return new Fraction(-f.Num, f.Denom);
    }

    public static Fraction operator +(Fraction a, Fraction b)
    {
        long m = LCM(a.Denom, b.Denom);
        long na = a.Num * m / a.Denom;
        long nb = b.Num * m / b.Denom;
        return new Fraction(na + nb, m);
    }

    public static Fraction operator -(Fraction a, Fraction b)
    {
        return a + (-b);
    }

    public static Fraction operator *(Fraction a, Fraction b)
    {
        return new Fraction(a.Num * b.Num, a.Denom * b.Denom);
    }

    public static Fraction operator /(Fraction a, Fraction b)
    {
        return a * b.Reciprocal();
    }

    public static Fraction operator %(Fraction a, Fraction b)
    {
        long l = a.Num * b.Denom, r = a.Denom * b.Num;
        long n = l / r;
        return new Fraction(l - n * r, a.Denom * b.Denom);
    }

    #endregion

    #region Comparison Operators

    public static bool operator ==(Fraction a, Fraction b)
    {
        return a.Num == b.Num && a.Denom == b.Denom;
    }

    public static bool operator !=(Fraction a, Fraction b)
    {
        return a.Num != b.Num || a.Denom != b.Denom;
    }

    public static bool operator <(Fraction a, Fraction b)
    {
        return (a.Num * b.Denom) < (a.Denom * b.Num);
    }

    public static bool operator >(Fraction a, Fraction b)
    {
        return (a.Num * b.Denom) > (a.Denom * b.Num);
    }

    public static bool operator <=(Fraction a, Fraction b)
    {
        return !(a > b);
    }

    public static bool operator >=(Fraction a, Fraction b)
    {
        return !(a < b);
    }

    #endregion

    #region Object Members

    public override bool Equals(object obj)
    {
        if (obj is Fraction)
            return ((Fraction)obj) == this;
        else
            return false;
    }

    public override int GetHashCode()
    {
        return Num.GetHashCode() ^ Denom.GetHashCode();
    }

    public override string ToString()
    {
        return Num.ToString() + "/" + Denom.ToString();
    }

    #endregion

    #region IEquatable<Fraction> Members

    public bool Equals(Fraction other)
    {
        return other == this;
    }

    #endregion

    #region IComparable<Fraction> Members

    public int CompareTo(Fraction other)
    {
        return (this.Num * other.Denom).CompareTo(this.Denom * other.Num);
    }

    #endregion
}


import "/big" for BigRat

var digits = 500
var an = BigRat.one
var bn = BigRat.half.sqrt(digits)
var tn = BigRat.half.square
var pn = BigRat.one
while (pn <= digits) {
    var prevAn = an
    an = (bn + an) * BigRat.half
    bn = (bn * prevAn).sqrt(digits)
    prevAn = prevAn - an
    tn = tn - (prevAn.square * pn)
    pn = pn + pn
}
var pi = (an + bn).square / (tn * 4)
System.print(pi.toDecimal(digits, false))


function agm(a0, g0) {
    var an = (a0 + g0) / 2,
        gn = Math.sqrt(a0 * g0);
    while (Math.abs(an - gn) > tolerance) {
        an = (an + gn) / 2, gn = Math.sqrt(an * gn)
    }
    return an;
}

agm(1, 1 / Math.sqrt(2));


def naive_agm(a; g; tolerance):
  def abs: if . < 0 then -. else . end;
  def _agm:
     # state [an,gn]
     if ((.[0] - .[1])|abs) > tolerance
     then [add/2, ((.[0] * .[1])|sqrt)] | _agm
     else .
     end;
  [a, g] | _agm | .[0] ;


function agm(x, y, e::Real = 5)
    (x ≤ 0 || y ≤ 0 || e ≤ 0) && throw(DomainError("x, y must be strictly positive"))
    g, a = minmax(x, y)
    while e * eps(x) < a - g
        a, g = (a + g) / 2, sqrt(a * g)
    end
    a
end

x, y = 1.0, 1 / √2
println("# Using literal-precision float numbers:")
@show agm(x, y)

println("# Using half-precision float numbers:")
x, y = Float32(x), Float32(y)
@show agm(x, y)

println("# Using ", precision(BigFloat), "-bit float numbers:")
x, y = big(1.0), 1 / √big(2.0)
@show agm(x, y)


200000 n#
5 4 3 2 bfloat ^ ^ ^
"%.0f" s:strfmt
dup s:len . " digits" . cr
dup 20 s:lsub . "..." .  20 s:rsub . cr


(in-package "ACL2")

(include-book "arithmetic-3/floor-mod/floor-mod" :dir :system)

(set-print-length 0 state)

(defun arbitrary-precision ()
   (declare (xargs :mode :program))
   (let* ((x (expt 5 (expt 4 (expt 3 2))))
          (s (mv-let (col str)
                     (fmt1-to-string "~xx"
                                     (list (cons #\x x))
                                     0)
                (declare (ignore col))
                str)))
         (cw "~s0 ... ~x1 (~x2 digits)~%"
             (subseq s 0 20)
             (mod x (expt 10 20))
             (1- (length s)))))


with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.GMP; use GNATCOLL.GMP;
with GNATCOLL.GMP.Integers; use GNATCOLL.GMP.Integers;
procedure ArbitraryInt is
   type stracc is access String;
   BigInt : Big_Integer;
   len : Natural;
   str : stracc;
begin
   Set (BigInt, 5);
   Raise_To_N (BigInt, Unsigned_Long (4**(3**2)));
   str := new String'(Image (BigInt));
   len := str'Length;
   Put_Line ("Size is:"& Natural'Image (len));
   Put_Line (str (1 .. 20) & "....." & str (len - 19 .. len));
end ArbitraryInt;


#include <iostream>
#include "math.h"
#include "boost/rational.hpp"

typedef  boost::rational<int> frac;

bool is_perfect(int c)
{
    frac sum(1, c);
    for (int f = 2;f < sqrt(static_cast<float>(c)); ++f){

        if (c % f == 0) sum += frac(1,f) + frac(1, c/f);
    }
    if (sum.denominator() == 1){
 	return (sum == 1);
    }
    return false;
}

int main()
{
    for (int candidate = 2; candidate < 0x80000; ++candidate){
        if (is_perfect(candidate))
	        std::cout << candidate << " is perfect" << std::endl;
    }
    return 0;
}


include ..\Utilitys.tlhy

:agm [ over over + 2 / rot rot * sqrt ] [ over over tostr swap tostr # ] while drop ;

1 1 2 sqrt / agm

pstack

" " input


// version 1.0.5-2

fun agm(a: Double, g: Double): Double {
    var aa = a             // mutable 'a'
    var gg = g             // mutable 'g'
    var ta: Double         // temporary variable to hold next iteration of 'aa'
    val epsilon = 1.0e-16  // tolerance for checking if limit has been reached

    while (true) {
        ta = (aa + gg) / 2.0
        if (Math.abs(aa - ta) <= epsilon) return ta
        gg = Math.sqrt(aa * gg)
        aa = ta
    }
}

fun main(args: Array<String>) {
    println(agm(1.0, 1.0 / Math.sqrt(2.0)))
}


(defun agm (a g)
  (agm a g 1.0e-15))

(defun agm (a g tol)
  (if (=< (- a g) tol)
    a
    (agm (next-a a g)
         (next-g a g)
         tol)))

(defun next-a (a g)
  (/ (+ a g) 2))

(defun next-g (a g)
  (math:sqrt (* a g)))


BEGIN
COMMENT
   The task specifies

   "Strictly speaking, this should not be solved by fixed-precision
   numeric libraries where the precision has to be manually set to a
   large value; although if this is the only recourse then it may be
   used with a note explaining that the precision must be set manually
   to a large enough value."

   Now one should always speak strictly, especially to animals and
   small children and, strictly speaking, Algol 68 Genie requires that
   a non-default numeric precision for a LONG LONG INT be specified by
   "precision=<integral denotation>" either in a source code PRAGMAT
   or as a command line argument.  However, that specification need
   not be made manually.  This snippet of code outputs an appropriate
   PRAGMAT

   printf (($gg(0)xgl$, "PR precision=",
	    ENTIER (1.0 + log (5) * 4^(3^(2))), "PR"));

   and the technique shown in the "Call a foreign-language function"
   task used to write, compile and run an Algol 68 program in which
   the precision is programmatically determined.

   The default stack size on this machine is also inadequate but twice
   the default is sufficient.  The PRAGMAT below can be machine
   generated with

   printf (($gg(0)xgl$, "PR stack=", 2 * system stack size, "PR"));

COMMENT
   PR precision=183231 PR
   PR stack=16777216 PR
   INT digits = ENTIER (1.0 + log (5) * 4^(3^(2))), exponent = 4^(3^2);
   LONG LONG INT big = LONG LONG 5^exponent;
   printf (($gxg(0)l$, " First 20 digits:", big % LONG LONG 10 ^ (digits - 20)));
   printf (($gxg(0)l$, "  Last 20 digits:", big MOD LONG LONG 10 ^ 20));
   printf (($gxg(0)l$, "Number of digits:", digits))
END


def Main()
  var len as Int
  var result as Str
  result = Str(5**4**3**2)
  len = result.length()
  Print(len)
  Print(result[:20])
  Print(result[len-20:])
end


(loop for candidate from 2 below (expt 2 19)
      for sum = (+ (/ candidate)
                   (loop for factor from 2 to (isqrt candidate)
                         when (zerop (mod candidate factor))
                           sum (+ (/ factor) (/ (floor candidate factor)))))
      when (= sum 1)
        collect candidate)


print agm(1, 1/sqr(2))
print using("#.#################",agm(1, 1/sqr(2)))

function agm(a,g)
    do
        absdiff = abs(a-g)
        an=(a+g)/2
        gn=sqr(a*g)
        a=an
        g=gn
    loop while abs(an-gn)< absdiff
    agm = a
end function


function agm aa,g
    put abs(aa-g) into absdiff
    put (aa+g)/2 into aan
    put sqrt(aa*g) into gn
    repeat while abs(aan - gn) < absdiff
        put abs(aa-g) into absdiff
        put (aa+g)/2 into aan
        put sqrt(aa*g) into gn
        put aan into aa
        put gn into g
    end repeat
    return aa
end agm


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

; Additional comments have been inserted, as well as changes made from the output produced by clang such as putting more meaningful labels for the jumps

$"ASSERTION" = comdat any
$"OUTPUT" = comdat any

@"ASSERTION" = linkonce_odr unnamed_addr constant [48 x i8] c"arithmetic-geometric mean undefined when x*y<0\0A\00", comdat, align 1
@"OUTPUT" = linkonce_odr unnamed_addr constant [42 x i8] c"The arithmetic-geometric mean is %0.19lf\0A\00", comdat, align 1

;--- The declarations for the external C functions
declare i32 @printf(i8*, ...)
declare void @exit(i32) #1
declare double @sqrt(double) #1

declare double @llvm.fabs.f64(double) #2

;----------------------------------------------------------------
;-- arithmetic geometric mean
define double @agm(double, double) #0 {
    %3 = alloca double, align 8                     ; allocate local g
    %4 = alloca double, align 8                     ; allocate local a
    %5 = alloca double, align 8                     ; allocate iota
    %6 = alloca double, align 8                     ; allocate a1
    %7 = alloca double, align 8                     ; allocate g1
    store double %1, double* %3, align 8            ; store param g in local g
    store double %0, double* %4, align 8            ; store param a in local a
    store double 1.000000e-15, double* %5, align 8  ; store 1.0e-15 in iota (1.0e-16 was causing the program to hang)

    %8 = load double, double* %4, align 8           ; load a
    %9 = load double, double* %3, align 8           ; load g
    %10 = fmul double %8, %9                        ; a * g
    %11 = fcmp olt double %10, 0.000000e+00         ; a * g < 0.0
    br i1 %11, label %enforce, label %loop

enforce:
    %12 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([48 x i8], [48 x i8]* @"ASSERTION", i32 0, i32 0))
    call void @exit(i32 1) #6
    unreachable

loop:
    %13 = load double, double* %4, align 8          ; load a
    %14 = load double, double* %3, align 8          ; load g
    %15 = fsub double %13, %14                      ; a - g
    %16 = call double @llvm.fabs.f64(double %15)    ; fabs(a - g)
    %17 = load double, double* %5, align 8          ; load iota
    %18 = fcmp ogt double %16, %17                  ; fabs(a - g) > iota
    br i1 %18, label %loop_body, label %eom

loop_body:
    %19 = load double, double* %4, align 8          ; load a
    %20 = load double, double* %3, align 8          ; load g
    %21 = fadd double %19, %20                      ; a + g
    %22 = fdiv double %21, 2.000000e+00             ; (a + g) / 2.0
    store double %22, double* %6, align 8           ; store %22 in a1

    %23 = load double, double* %4, align 8          ; load a
    %24 = load double, double* %3, align 8          ; load g
    %25 = fmul double %23, %24                      ; a * g
    %26 = call double @sqrt(double %25) #4          ; sqrt(a * g)
    store double %26, double* %7, align 8           ; store %26 in g1

    %27 = load double, double* %6, align 8          ; load a1
    store double %27, double* %4, align 8           ; store a1 in a

    %28 = load double, double* %7, align 8          ; load g1
    store double %28, double* %3, align 8           ; store g1 in g

    br label %loop

eom:
    %29 = load double, double* %4, align 8          ; load a
    ret double %29                                  ; return a
}

;----------------------------------------------------------------
;-- main
define i32 @main() #0 {
    %1 = alloca double, align 8                     ; allocate x
    %2 = alloca double, align 8                     ; allocate y

    store double 1.000000e+00, double* %1, align 8  ; store 1.0 in x

    %3 = call double @sqrt(double 2.000000e+00) #4  ; calculate the square root of two
    %4 = fdiv double 1.000000e+00, %3               ; divide 1.0 by %3
    store double %4, double* %2, align 8            ; store %4 in y

    %5 = load double, double* %2, align 8           ; reload y
    %6 = load double, double* %1, align 8           ; reload x
    %7 = call double @agm(double %6, double %5)     ; agm(x, y)

    %8 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([42 x i8], [42 x i8]* @"OUTPUT", i32 0, i32 0), double %7)

    ret i32 0                                       ; finished
}

attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
attributes #1 = { noreturn "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
attributes #2 = { nounwind readnone speculatable }
attributes #4 = { nounwind }
attributes #6 = { noreturn }


num: to :string 5^4^3^2

print [first.n: 20 num ".." last.n: 20 num "=>" size num "digits"]


/* 5432.bc */

y = 5 ^ 4 ^ 3 ^ 2
c = length(y)
" First 20 digits: "; y / (10 ^ (c - 20))
"  Last 20 digits: "; y % (10 ^ 20)
"Number of digits: "; c
quit


import std.bigint, std.traits, std.conv;

// std.numeric.gcd doesn't work with BigInt.
T gcd(T)(in T a, in T b) pure nothrow {
    return (b != 0) ? gcd(b, a % b) : (a < 0) ? -a : a;
}

T lcm(T)(in T a, in T b) pure nothrow {
    return a / gcd(a, b) * b;
}

struct RationalT(T) if (!isUnsigned!T) {
    private T num, den; // Numerator & denominator.

    private enum Type { NegINF = -2,
                        NegDEN = -1,
                        NaRAT  =  0,
                        NORMAL =  1,
                        PosINF =  2 };

    this(U : RationalT)(U n) pure nothrow {
        num = n.num;
        den = n.den;
    }

    this(U)(in U n) pure nothrow if (isIntegral!U) {
        num = toT(n);
        den = 1UL;
    }

    this(U, V)(in U n, in V d) pure nothrow {
        num = toT(n);
        den = toT(d);
        const common = gcd(num, den);
        if (common != 0) {
            num /= common;
            den /= common;
        } else { // infinite or NOT a Number
            num = (num == 0) ? 0 : (num < 0) ? -1 : 1;
            den = 0;
        }
        if (den < 0) { // Assure den is non-negative.
            num = -num;
            den = -den;
        }
    }

    static T toT(U)(in ref U n) pure nothrow if (is(U == T)) {
        return n;
    }

    static T toT(U)(in ref U n) pure nothrow if (!is(U == T)) {
        T result = n;
        return result;
    }

    T numerator() const pure nothrow @property {
        return num;
    }

    T denominator() const pure nothrow @property {
        return den;
    }

    string toString() const /*pure nothrow*/ {
        if (den != 0)
            return num.text ~ (den == 1 ? "" : "/" ~ den.text);
        if (num == 0)
            return "NaRat";
        else
            return ((num < 0) ? "-" : "+") ~ "infRat";
    }

    real toReal() pure const nothrow {
        static if (is(T == BigInt))
            return num.toLong / real(den.toLong);
        else
            return num / real(den);
    }

    RationalT opBinary(string op)(in RationalT r)
    const pure nothrow if (op == "+" || op == "-") {
        T common = lcm(den, r.den);
        T n = mixin("common / den * num" ~ op ~
                    "common / r.den * r.num" );
        return RationalT(n, common);
    }

    RationalT opBinary(string op)(in RationalT r)
    const pure nothrow if (op == "*") {
        return RationalT(num * r.num, den * r.den);
    }

    RationalT opBinary(string op)(in RationalT r)
    const pure nothrow if (op == "/") {
        return RationalT(num * r.den, den * r.num);
    }

    RationalT opBinary(string op, U)(in U r)
    const pure nothrow if (isIntegral!U && (op == "+" ||
                           op == "-" || op == "*" || op == "/")) {
        return opBinary!op(RationalT(r));
    }

    RationalT opBinary(string op)(in size_t p)
    const pure nothrow if (op == "^^") {
        return RationalT(num ^^ p, den ^^ p);
    }

    RationalT opBinaryRight(string op, U)(in U l)
    const pure nothrow if (isIntegral!U) {
        return RationalT(l).opBinary!op(RationalT(num, den));
    }

    RationalT opOpAssign(string op, U)(in U l) pure /*nothrow*/ {
        mixin("this = this " ~ op ~ "l;");
        return this;
    }

    RationalT opUnary(string op)()
    const pure nothrow if (op == "+" || op == "-") {
        return RationalT(mixin(op ~ "num"), den);
    }

    bool opCast(U)() const if (is(U == bool)) {
        return num != 0;
    }

    bool opEquals(U)(in U r) const pure nothrow {
        RationalT rhs = RationalT(r);
        if (type() == Type.NaRAT || rhs.type() == Type.NaRAT)
            return false;
        return num == rhs.num && den == rhs.den;
    }

    int opCmp(U)(in U r) const pure nothrow {
        auto rhs = RationalT(r);
        if (type() == Type.NaRAT || rhs.type() == Type.NaRAT)
            throw new Error("Compare involve a NaRAT.");
        if (type() != Type.NORMAL ||
            rhs.type() != Type.NORMAL) // for infinite
            return (type() == rhs.type()) ? 0 :
                ((type() < rhs.type()) ? -1 : 1);
        auto diff = num * rhs.den - den * rhs.num;
        return (diff == 0) ? 0 : ((diff < 0) ? -1 : 1);
    }

    Type type() const pure nothrow {
        if (den > 0) return Type.NORMAL;
        if (den < 0) return Type.NegDEN;
        if (num > 0) return Type.PosINF;
        if (num < 0) return Type.NegINF;
        return Type.NaRAT;
    }
}

RationalT!U rational(U)(in U n) pure nothrow {
    return typeof(return)(n);
}

RationalT!(CommonType!(U1, U2))
rational(U1, U2)(in U1 n, in U2 d) pure nothrow {
    return typeof(return)(n, d);
}

alias Rational = RationalT!BigInt;

version (arithmetic_rational_main) { // Test.
    void main() {
        import std.stdio, std.math;
        alias RatL = RationalT!long;

        foreach (immutable p; 2 .. 2 ^^ 19) {
            auto sum = RatL(1, p);
            immutable limit = 1 + cast(uint)real(p).sqrt;
            foreach (immutable factor; 2 .. limit)
                if (p % factor == 0)
                    sum += RatL(1, factor) + RatL(factor, p);
            if (sum.denominator == 1)
                writefln("Sum of recipr. factors of %6s = %s exactly%s",
                         p, sum, (sum == 1) ? ", perfect." : ".");
        }
    }
}


to about :a :b
  output and [:a - :b < 1e-15] [:a - :b > -1e-15]
end
to agm :arith :geom
  if about :arith :geom [output :arith]
  output agm (:arith + :geom)/2  sqrt (:arith * :geom)
end

show agm 1 1/sqrt 2


function agm(a, b, tolerance)
    if not tolerance or tolerance < 1e-15 then
        tolerance = 1e-15
    end
    repeat
        a, b = (a + b) / 2, math.sqrt(a * b)
    until math.abs(a-b) < tolerance
    return a
end

print(string.format("%.15f", agm(1, 1 / math.sqrt(2))))


Module Checkit {
      Function Agm {
      \\ new stack constructed at calling the Agm() with two values
            Repeat {
                  Read a0, b0
                  Push  Sqrt(a0*b0), (a0+b0)/2
                  ' last pushed first read
            } Until Stackitem(1)==Stackitem(2)
            =Stackitem(1)
            \\ stack deconstructed at exit of function
      }
      Print Agm(1,1/Sqrt(2))
}
Checkit


with Ada.Numerics.Elementary_Functions;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;

procedure Archimedean_Spiral is

   Width      : constant := 800;
   Height     : constant := 800;
   A          : constant := 4.2;
   B          : constant := 3.2;
   T_First    : constant := 4.0;
   T_Last     : constant := 100.0;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   procedure Draw_Archimedean_Spiral is
      use type SDL.C.int;
      use Ada.Numerics.Elementary_Functions;
      Pi   : constant := Ada.Numerics.Pi;
      Step : constant := 0.002;
      T    : Float;
      R    : Float;
   begin
      T := T_First;
      loop
         R := A + B * T;
         Renderer.Draw
           (Point => (X => Width  / 2 + SDL.C.int (R * Cos (T, 2.0 * Pi)),
                      Y => Height / 2 - SDL.C.int (R * Sin (T, 2.0 * Pi))));
         exit when T >= T_Last;
         T := T + Step;
      end loop;
   end Draw_Archimedean_Spiral;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Archimedean spiral",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));
   Renderer.Set_Draw_Colour ((0, 220, 0, 255));

   Draw_Archimedean_Spiral;
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Archimedean_Spiral;


begin % draw an Archimedian spiral %
      % Translation of AWK which was a trnslation of Applesoft Basic program %
    integer procedure max ( integer x, y ) ; begin if x > y then x else y end;
    integer procedure min ( integer x, y ) ; begin if x < y then x else y end;
    integer x_min, y_min, x_max, y_max, a, b, x, y;
    string(255) array arr ( 1 :: 255 );
    real    h, w, m, s, t;
    x_min := y_min := 9999;
    x_max := y_max := 0;
    h := 96;
    w := h + h / 2;
    a := 1;
    b := 1;
    m := 6 * PI;
    s := .02;
    t := s;
    while t <= m do begin % build spiral %
      real r;
      r := a + b * t;
      x := round(r * cos(t) + w);
      y := round(r * sin(t) + h);
      if x <= 0 or y <= 0 then begin end
      else if x >= 280    then begin end
      else if y >= 192    then begin end
      else begin
        arr( x )( y // 1 ) := "*";
        x_min := min(x_min,x);
        x_max := max(x_max,x);
        y_min := min(y_min,y);
        y_max := max(y_max,y);
        t     := t + s
      end if__various_x_and_y_values__
    end while__t_le_m ;
    for i := x_min until x_max do begin
        for j := y_min until y_max do begin
            string(1) c;
            c := arr( i )( j // 1 );
            writeon( c, c )
        end for_j ;
        write()
    end for_i
end.


#include <gmp.h>
#include <stdio.h>
#include <string.h>

int main()
{
	mpz_t a;
	mpz_init_set_ui(a, 5);
	mpz_pow_ui(a, a, 1 << 18); /* 2**18 == 4**9 */

	int len = mpz_sizeinbase(a, 10);
	printf("GMP says size is: %d\n", len);

	/* because GMP may report size 1 too big; see doc */
	char *s = mpz_get_str(0, 10, a);
	printf("size really is %d\n", len = strlen(s));
	printf("Digits: %.20s...%s\n", s, s + len - 20);

	// free(s); /* we could, but we won't. we are exiting anyway */
	return 0;
}


using System;
using System.Diagnostics;
using System.Linq;
using System.Numerics;

static class Program {
    static void Main() {
        BigInteger n = BigInteger.Pow(5, (int)BigInteger.Pow(4, (int)BigInteger.Pow(3, 2)));
        string result = n.ToString();

        Debug.Assert(result.Length == 183231);
        Debug.Assert(result.StartsWith("62060698786608744707"));
        Debug.Assert(result.EndsWith("92256259918212890625"));

        Console.WriteLine("n = 5^4^3^2");
        Console.WriteLine("n = {0}...{1}",
            result.Substring(0, 20),
            result.Substring(result.Length - 20, 20)
            );

        Console.WriteLine("n digits = {0}", result.Length);
    }
}


program Arithmetic_Rational;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  Boost.Rational;

var
  sum: TFraction;
  max: Integer = 1 shl 19;
  candidate, max2, factor: Integer;

begin
  for candidate := 2 to max - 1 do
  begin
    sum := Fraction(1, candidate);
    max2 := Trunc(Sqrt(candidate));
    for factor := 2 to max2 do
    begin
      if (candidate mod factor) = 0 then
      begin
        sum := sum + Fraction(1, factor);
        sum := sum + Fraction(1, candidate div factor);
      end;
    end;
    if sum = Fraction(1) then
      Writeln(candidate, ' is perfect');
  end;
  Readln;
end.


PrecisionDigits = 85;
AGMean[a_, b_] := FixedPoint[{ [email protected]#/2, Sqrt[[email protected]@#] }&, N[{a,b}, PrecisionDigits]]〚1〛


function [a,g]=agm(a,g)
%%arithmetic_geometric_mean(a,g)
	while (1)
		a0=a;
		a=(a0+g)/2;
		g=sqrt(a0*g);
	if (abs(a0-a) < a*eps) break; end;
	end;
end


  'InitCauseway' 'View' ⎕CY 'sharpplot'
  InitCauseway ⍬   ⍝ initialise current namespace
  sp←⎕NEW Causeway.SharpPlot
  sp.DrawPolarChart {⍵(360|⍵)}⌽⍳720
      View sp


if !pToken := Gdip_Startup()
{
	MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
	ExitApp
}
OnExit, Exit
SysGet, MonitorPrimary, MonitorPrimary
SysGet, WA, MonitorWorkArea, %MonitorPrimary%
WAWidth	:= WARight-WALeft
WAHeight := WABottom-WATop
Gui, 1: -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs
Gui, 1: Show, NA
hwnd1 := WinExist()
hbm := CreateDIBSection(WAWidth, WAHeight)
hdc := CreateCompatibleDC()
obm := SelectObject(hdc, hbm)
G := Gdip_GraphicsFromHDC(hdc)
Gdip_SetSmoothingMode(G, 4)
pPen := Gdip_CreatePen(0xffff0000, 3)
;--------------------------------
a := 1, b := 4, th := 0.1, step := 0.1
loop, 720
{
	th += step
	r := a + b * th
	x1 := r * Cos(th)
	y1 := r * Sin(th)
	x1 += A_ScreenWidth/2
	y1 += A_ScreenHeight/2
	if (x2 && y2)
		Gdip_DrawLine(G, pPen, x1, y1, x2, y2)
	x2 := x1, 	y2 := y1
	if GetKeyState("Esc", "P")
		break
	; next two lines are optional to watch it draw
	; Sleep 10
	; UpdateLayeredWindow(hwnd1, hdc, WALeft, WATop, WAWidth, WAHeight)
}
UpdateLayeredWindow(hwnd1, hdc, WALeft, WATop, WAWidth, WAHeight)
;--------------------------------
return

Exit:
Gdip_DeletePen(pPen)
SelectObject(hdc, obm)
DeleteObject(hbm)
DeleteDC(hdc)
Gdip_DeleteGraphics(G)
Gdip_Shutdown(pToken)
ExitApp
Return


# syntax: GAWK -f ARCHIMEDEAN_SPIRAL.AWK
# converted from Applesoft BASIC
BEGIN {
    x_min = y_min = 9999
    x_max = y_max = 0
    h = 96
    w = h + h / 2
    a = 1
    b = 1
    m = 6 * 3.1415926
    step = .02
    for (t=step; t<=m; t+=step) { # build spiral
      r = a + b * t
      x = int(r * cos(t) + w)
      y = int(r * sin(t) + h)
      if (x <= 0 || y <= 0) { continue }
      if (x >= 280 ) { continue }
      if (y >= 192) { continue }
      arr[x,y] = "*"
      x_min = min(x_min,x)
      x_max = max(x_max,x)
      y_min = min(y_min,y)
      y_max = max(y_max,y)
    }
    for (i=x_min; i<=x_max; i++) { # print spiral
      rec = ""
      for (j=y_min; j<=y_max; j++) {
        rec = sprintf("%s%1s",rec,arr[i,j])
      }
      printf("%s\n",rec)
    }
    exit(0)
}
function max(x,y) { return((x > y) ? x : y) }
function min(x,y) { return((x < y) ? x : y) }


#include <iostream>
#include <boost/multiprecision/gmp.hpp>
#include <string>

namespace mp = boost::multiprecision;

int main(int argc, char const *argv[])
{
    // We could just use (1 << 18) instead of tmpres, but let's point out one
    // pecularity with gmp and hence boost::multiprecision: they won't accept
    // a second mpz_int with pow(). Therefore, if we stick to multiprecision
    // pow we need to convert_to<uint64_t>().
    uint64_t tmpres = mp::pow(mp::mpz_int(4)
                            , mp::pow(mp::mpz_int(3)
                                    , 2).convert_to<uint64_t>()
                                      ).convert_to<uint64_t>();
    mp::mpz_int res = mp::pow(mp::mpz_int(5), tmpres);
    std::string s = res.str();
    std::cout << s.substr(0, 20)
              << "..."
              << s.substr(s.length() - 20, 20) << std::endl;
    return 0;
}


import ceylon.whole {
    wholeNumber,
    two
}

shared void run() {

    value five = wholeNumber(5);
    value four = wholeNumber(4);
    value three = wholeNumber(3);

    value bigNumber = five ^ four ^ three ^ two;

    value firstTwenty = "62060698786608744707";
    value lastTwenty =  "92256259918212890625";
    value bigString = bigNumber.string;

    "The number must start with ``firstTwenty`` and end with ``lastTwenty``"
    assert(bigString.startsWith(firstTwenty), bigString.endsWith(lastTwenty));

    value bigSize = bigString.size;
    print("The first twenty digits are ``bigString[...19]``");
    print("The last twenty digits are ``bigString[(bigSize - 20)...]``");
    print("The number of digits in 5^4^3^2 is ``bigSize``");
}


(defn exp [n k] (reduce * (repeat k n)))

(def big (->> 2 (exp 3) (exp 4) (exp 5)))
(def sbig (str big))

(assert (= "62060698786608744707" (.substring sbig 0 20)))
(assert (= "92256259918212890625" (.substring sbig (- (count sbig) 20))))
(println (count sbig) "digits")

(println (str (.substring sbig 0 20) ".."
	      (.substring sbig (- (count sbig) 20)))
	 (str "(" (count sbig) " digits)"))


;; Finding perfect numbers
(define (sum/inv n) ;; look for div's in [2..sqrt(n)] and add 1/n
	(for/fold (acc (/ n)) [(i (in-range 2 (sqrt n)))]
		#:break (> acc 1) ; no hope
		(when (zero? (modulo n i ))
			(set! acc (+ acc (/ i) (/ i n))))))


component RationalNumbers;
  type Rational;
       Rational(Numerator = integer, Denominater = integer) -> Rational;

       Rational + Rational -> Rational;
       Rational - Rational -> Rational;
       Rational * Rational -> Rational;
       Rational / Rational -> Rational;

       Rational == Rational -> boolean;
       Rational <> Rational -> boolean;
       Rational >= Rational -> boolean;
       Rational <= Rational -> boolean;
       Rational >  Rational -> boolean;
       Rational <  Rational -> boolean;

       + Rational -> Rational;
       - Rational -> Rational;
       abs(Rational) -> Rational;

       Rational(integer) -> Rational;
       Numerator(Rational) -> integer;
       Denominator(Rational) -> integer;
  begin
       Rational(A,B) = Rational:[A;B];

       R1 + R2 = Normalize( R1.A * R2.B + R1.B * R2.A, R1.B * R2.B);
       R1 - R2 = Normalize( R1.A * R2.B - R1.B * R2.A, R1.B * R2.B);
       R1 * R2 = Normalize( R1.A * R2.A, R1.B * R2.B);
       R1 / R2 = Normalize( R1.A * R2.B, R1.B * R2.A);

       R1 == R2 = [ R = (R1 - R2); R.A == 0];
       R1 <> R2 = [ R = (R1 - R2); R.A <> 0];
       R1 >= R2 = [ R = (R1 - R2); R.A >= 0];
       R1 <= R2 = [ R = (R1 - R2); R.A <= 0];
       R1 > R2  = [ R = (R1 - R2); R.A > 0];
       R1 < R2  = [ R = (R1 - R2); R.A < 0];

       + R = R;
       - R = Rational(-R.A, R.B);

       abs(R) = Rational(abs(R.A), abs(R.B));
       Rational(I) = Rational (I, 1);
       Numerator(R) = R.A;
       Denominator(R) = R.B;

				<< internal definitions >>

       Normalize (A = integer, B = integer) -> Rational;
       Normalize (A, B) = [ exception( B == 0, "Illegal Rational Number");
	                    Common = GCD(abs(A), abs(B));
			    if B < 0 then Rational(-A / Common, -B / Common)
			             else Rational( A / Common,  B / Common) ];

       GCD (A = integer, B = integer) -> integer;
       GCD (A, B) = [ if A == 0 then return(B);
	              if B == 0 then return(A);
		      if A > B  then GCD (B, mod(A,B))
 		                else GCD (A, mod(B,A)) ];

end component RationalNumbers;


MODULE AGM;
FROM EXCEPTIONS IMPORT AllocateSource,ExceptionSource,GetMessage,RAISE;
FROM LongConv IMPORT ValueReal;
FROM LongMath IMPORT sqrt;
FROM LongStr IMPORT RealToStr;
FROM Terminal IMPORT ReadChar,Write,WriteString,WriteLn;

VAR
    TextWinExSrc : ExceptionSource;

PROCEDURE ReadReal() : LONGREAL;
VAR
    buffer : ARRAY[0..63] OF CHAR;
    i : CARDINAL;
    c : CHAR;
BEGIN
    i := 0;

    LOOP
        c := ReadChar();
        IF ((c >= '0') AND (c <= '9')) OR (c = '.') THEN
            buffer[i] := c;
            Write(c);
            INC(i)
        ELSE
            WriteLn;
            EXIT
        END
    END;

    buffer[i] := 0C;
    RETURN ValueReal(buffer)
END ReadReal;

PROCEDURE WriteReal(r : LONGREAL);
VAR
    buffer : ARRAY[0..63] OF CHAR;
BEGIN
    RealToStr(r, buffer);
    WriteString(buffer)
END WriteReal;

PROCEDURE AGM(a,g : LONGREAL) : LONGREAL;
CONST iota = 1.0E-16;
VAR a1, g1 : LONGREAL;
BEGIN
    IF a * g < 0.0 THEN
        RAISE(TextWinExSrc, 0, "arithmetic-geometric mean undefined when x*y<0")
    END;

    WHILE ABS(a - g) > iota DO
        a1 := (a + g) / 2.0;
        g1 := sqrt(a * g);

        a := a1;
        g := g1
    END;

    RETURN a
END AGM;

VAR
    x, y, z: LONGREAL;
BEGIN
    WriteString("Enter two numbers: ");
    x := ReadReal();
    y := ReadReal();
    WriteReal(AGM(x, y));
    WriteLn
END AGM.


{(•math.Sin •Plot○(⊢×↕∘≠) •math.Cos) -(2×π) × 𝕩⥊(↕÷-⟜1)100}


#include<graphics.h>
#include<stdio.h>
#include<math.h>

#define pi M_PI

int main(){
	double a,b,cycles,incr,i;

	int steps,x=500,y=500;

	printf("Enter the parameters a and b : ");
	scanf("%lf%lf",&a,&b);

	printf("Enter cycles : ");
	scanf("%lf",&cycles);

	printf("Enter divisional steps : ");
	scanf("%d",&steps);

	incr = 1.0/steps;

	initwindow(1000,1000,"Archimedean Spiral");

	for(i=0;i<=cycles*pi;i+=incr){
		putpixel(x + (a + b*i)*cos(i),x + (a + b*i)*sin(i),15);
	}

	getch();

	closegraph();
}


using System;
using System.Linq;
using System.Drawing;
using System.Diagnostics;
using System.Drawing.Drawing2D;

class Program
{
    const int width = 380;
    const int height = 380;
    static PointF archimedeanPoint(int degrees)
    {
        const double a = 1;
        const double b = 9;
        double t = degrees * Math.PI / 180;
        double r = a + b * t;
        return new PointF { X = (float)(width / 2 + r * Math.Cos(t)), Y = (float)(height / 2 + r * Math.Sin(t)) };
    }

    static void Main(string[] args)
    {
        var bm = new Bitmap(width, height);
        var g = Graphics.FromImage(bm);
        g.SmoothingMode = SmoothingMode.AntiAlias;
        g.FillRectangle(new SolidBrush(Color.White), new Rectangle { X = 0, Y = 0, Width = width, Height = height });
        var pen = new Pen(Color.OrangeRed, 1.5f);

        var spiral = Enumerable.Range(0, 360 * 3).AsParallel().AsOrdered().Select(archimedeanPoint);
        var p0 = new PointF(width / 2, height / 2);
        foreach (var p1 in spiral)
        {
            g.DrawLine(pen, p0, p1);
            p0 = p1;
        }
        g.Save(); // is this really necessary ?
        bm.Save("archimedes-csharp.png");
        Process.Start("archimedes-csharp.png"); // Launches default photo viewing app
    }
}


start_up = proc ()
    % Get bigint versions of 5, 4, 3 and 2
    five: bigint := bigint$i2bi(5)
    four: bigint := bigint$i2bi(4)
    three: bigint := bigint$i2bi(3)
    two: bigint := bigint$i2bi(2)

    % Calculate 5**4**3**2
    huge_no: bigint := five ** four ** three ** two

    % Turn answer into string
    huge_str: string := bigint$unparse(huge_no)

    % Scan for first digit (the string will have some leading whitespace)
    i: int := 1
    while huge_str[i] = ' ' do i := i + 1 end

    po: stream := stream$primary_output()
    stream$putl(po, "First 20 digits: "
            || string$substr(huge_str, i, 20))
    stream$putl(po, "Last  20 digits: "
            || string$substr(huge_str, string$size(huge_str)-19, 20))
    stream$putl(po, "Amount of digits: "
            || int$unparse(string$size(huge_str) - i + 1))
end start_up


       identification division.
       program-id. arbitrary-precision-integers.
       remarks. Uses opaque libgmp internals that are built into libcob.

       data division.
       working-storage section.
       01 gmp-number.
          05 mp-alloc          usage binary-long.
          05 mp-size           usage binary-long.
          05 mp-limb           usage pointer.
       01 gmp-build.
          05 mp-alloc          usage binary-long.
          05 mp-size           usage binary-long.
          05 mp-limb           usage pointer.

       01 the-int              usage binary-c-long unsigned.
       01 the-exponent         usage binary-c-long unsigned.
       01 valid-exponent       usage binary-long value 1.
          88 cant-use          value 0 when set to false 1.

       01 number-string        usage pointer.
       01 number-length        usage binary-long.

       01 window-width         constant as 20.
       01 limit-width          usage binary-long.
       01 number-buffer        pic x(window-width) based.

       procedure division.
       arbitrary-main.

      *> calculate 10 ** 19
       perform initialize-integers.
       display "10 ** 19        : " with no advancing
       move 10 to the-int
       move 19 to the-exponent
       perform raise-pow-accrete-exponent
       perform show-all-or-portion
       perform clean-up

      *> calculate 12345 ** 9
       perform initialize-integers.
       display "12345 ** 9      : " with no advancing
       move 12345 to the-int
       move 9 to the-exponent
       perform raise-pow-accrete-exponent
       perform show-all-or-portion
       perform clean-up

      *> calculate 5 ** 4 ** 3 ** 2
       perform initialize-integers.
       display "5 ** 4 ** 3 ** 2: " with no advancing
       move 3 to the-int
       move 2 to the-exponent
       perform raise-pow-accrete-exponent
       move 4 to the-int
       perform raise-pow-accrete-exponent
       move 5 to the-int
       perform raise-pow-accrete-exponent
       perform show-all-or-portion
       perform clean-up
       goback.
      *> **************************************************************

       initialize-integers.
       call "__gmpz_init" using gmp-number returning omitted
       call "__gmpz_init" using gmp-build returning omitted
       .

       raise-pow-accrete-exponent.
      *> check before using previously overflowed exponent intermediate
       if cant-use then
           display "Error: intermediate overflow occured at "
                   the-exponent upon syserr
           goback
       end-if
       call "__gmpz_set_ui" using gmp-number by value 0
           returning omitted
       call "__gmpz_set_ui" using gmp-build by value the-int
           returning omitted
       call "__gmpz_pow_ui" using gmp-number gmp-build
           by value the-exponent
           returning omitted
       call "__gmpz_set_ui" using gmp-build by value 0
           returning omitted
       call "__gmpz_get_ui" using gmp-number returning the-exponent
       call "__gmpz_fits_ulong_p" using gmp-number
           returning valid-exponent
       .

      *> get string representation, base 10
       show-all-or-portion.
       call "__gmpz_sizeinbase" using gmp-number
           by value 10
           returning number-length
       display "GMP length: " number-length ", " with no advancing

       call "__gmpz_get_str" using null by value 10
           by reference gmp-number
           returning number-string
       call "strlen" using by value number-string
           returning number-length
       display "strlen: " number-length

      *> slide based string across first and last of buffer
       move window-width to limit-width
       set address of number-buffer to number-string
       if number-length <= window-width then
           move number-length to limit-width
           display number-buffer(1:limit-width)
       else
           display number-buffer with no advancing
           subtract window-width from number-length
           move function max(0, number-length) to number-length
           if number-length <= window-width then
               move number-length to limit-width
           else
               display "..." with no advancing
           end-if
           set address of number-buffer up by
               function max(window-width, number-length)
           display number-buffer(1:limit-width)
       end-if
       .

       clean-up.
       call "free" using by value number-string returning omitted
       call "__gmpz_clear" using gmp-number returning omitted
       call "__gmpz_clear" using gmp-build returning omitted
       set address of number-buffer to null
       set cant-use to false
       .

       end program arbitrary-precision-integers.


defmodule Rational do
  import Kernel, except: [div: 2]

  defstruct numerator: 0, denominator: 1

  def new(numerator), do: %Rational{numerator: numerator, denominator: 1}

  def new(numerator, denominator) do
    sign = if numerator * denominator < 0, do: -1, else: 1
    {numerator, denominator} = {abs(numerator), abs(denominator)}
    gcd = gcd(numerator, denominator)
    %Rational{numerator: sign * Kernel.div(numerator, gcd),
              denominator: Kernel.div(denominator, gcd)}
  end

  def add(a, b) do
    {a, b} = convert(a, b)
    new(a.numerator * b.denominator + b.numerator * a.denominator,
        a.denominator * b.denominator)
  end

  def sub(a, b) do
    {a, b} = convert(a, b)
    new(a.numerator * b.denominator - b.numerator * a.denominator,
        a.denominator * b.denominator)
  end

  def mult(a, b) do
    {a, b} = convert(a, b)
    new(a.numerator * b.numerator, a.denominator * b.denominator)
  end

  def div(a, b) do
    {a, b} = convert(a, b)
    new(a.numerator * b.denominator, a.denominator * b.numerator)
  end

  defp convert(a), do: if is_integer(a), do: new(a), else: a

  defp convert(a, b), do: {convert(a), convert(b)}

  defp gcd(a, 0), do: a
  defp gcd(a, b), do: gcd(b, rem(a, b))
end

defimpl Inspect, for: Rational do
  def inspect(r, _opts) do
    "%Rational<#{r.numerator}/#{r.denominator}>"
  end
end

Enum.each(2..trunc(:math.pow(2,19)), fn candidate ->
  sum = 2 .. round(:math.sqrt(candidate))
        |> Enum.reduce(Rational.new(1, candidate), fn factor,sum ->
             if rem(candidate, factor) == 0 do
               Rational.add(sum, Rational.new(1, factor))
               |> Rational.add(Rational.new(1, div(candidate, factor)))
             else
               sum
             end
           end)
  if sum.denominator == 1 do
    :io.format "Sum of recipr. factors of ~6w = ~w exactly ~s~n",
           [candidate, sum.numerator, (if sum.numerator == 1, do: "perfect!", else: "")]
  end
end)


PROGRAM RATIONAL_ARITH

!
! for rosettacode.org
!

TYPE RATIONAL=(NUM,DEN)

DIM SUM:RATIONAL,ONE:RATIONAL,KF:RATIONAL

DIM A:RATIONAL,B:RATIONAL
PROCEDURE ABS(A.->A.)
      A.NUM=ABS(A.NUM)
END PROCEDURE

PROCEDURE NEG(A.->A.)
      A.NUM=-A.NUM
END PROCEDURE

PROCEDURE ADD(A.,B.->A.)
      LOCAL T
      T=A.DEN*B.DEN
      A.NUM=A.NUM*B.DEN+B.NUM*A.DEN
      A.DEN=T
END PROCEDURE

PROCEDURE SUB(A.,B.->A.)
      LOCAL T
      T=A.DEN*B.DEN
      A.NUM=A.NUM*B.DEN-B.NUM*A.DEN
      A.DEN=T
END PROCEDURE

PROCEDURE MULT(A.,B.->A.)
      A.NUM*=B.NUM  A.DEN*=B.DEN
END PROCEDURE

PROCEDURE DIVIDE(A.,B.->A.)
      A.NUM*=B.DEN
      A.DEN*=B.NUM
END PROCEDURE

PROCEDURE EQ(A.,B.->RES%)
      RES%=A.NUM*B.DEN=B.NUM*A.DEN
END PROCEDURE

PROCEDURE LT(A.,B.->RES%)
      RES%=A.NUM*B.DEN<B.NUM*A.DEN
END PROCEDURE

PROCEDURE GT(A.,B.->RES%)
      RES%=A.NUM*B.DEN>B.NUM*A.DEN
END PROCEDURE

PROCEDURE NE(A.,B.->RES%)
      RES%=A.NUM*B.DEN<>B.NUM*A.DEN
END PROCEDURE

PROCEDURE LE(A.,B.->RES%)
      RES%=A.NUM*B.DEN<=B.NUM*A.DEN
END PROCEDURE

PROCEDURE GE(A.,B.->RES%)
      RES%=A.NUM*B.DEN>=B.NUM*A.DEN
END PROCEDURE

PROCEDURE NORMALIZE(A.->A.)
      LOCAL A,B,T
      A=A.NUM   B=A.DEN
      WHILE B<>0 DO
        T=A
        A=B
        B=T-B*INT(T/B)
      END WHILE
      A.NUM/=A  A.DEN/=A
      IF A.DEN<0 THEN A.NUM*=-1 A.DEN*=-1 END IF
END PROCEDURE

BEGIN
    ONE.NUM=1 ONE.DEN=1
    FOR N=2 TO 2^19-1 DO
      SUM.NUM=1 SUM.DEN=N
      FOR K=2 TO SQR(N) DO
        IF N=K*INT(N/K) THEN
          KF.NUM=1 KF.DEN=K
          ADD(SUM.,KF.->SUM.)
          NORMALIZE(SUM.->SUM.)
          KF.DEN=INT(N/K)
          ADD(SUM.,KF.->SUM.)
          NORMALIZE(SUM.->SUM.)
        END IF
      END FOR
      EQ(SUM.,ONE.->RES%)
      IF RES% THEN PRINT(N;" is perfect") END IF
   END FOR
END PROGRAM


/* NetRexx */
options replace format comments java crossref symbols nobinary

numeric digits 18
parse arg a_ g_ .
if a_ = '' | a_ = '.' then a0 = 1
                      else a0 = a_
if g_ = '' | g_ = '.' then g0 = 1 / Math.sqrt(2)
                      else g0 = g_

say agm(a0, g0)

return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method agm(a0, g0) public static returns Rexx
  a1 = a0
  g1 = g0
  loop while (a1 - g1).abs() >= Math.pow(10, -14)
    temp = (a1 + g1) / 2
    g1 = Math.sqrt(a1 * g1)
    a1 = temp
    end
  return a1 + 0


(define (a-next a g) (mul 0.5 (add a g)))

(define (g-next a g) (sqrt (mul a g)))

(define (amg a g tolerance)
	(if (<= (sub a g) tolerance)
		a
		(amg (a-next a g) (g-next a g) tolerance)
	)
)

(define quadrillionth 0.000000000000001)

(define root-reciprocal-2 (div 1.0 (sqrt 2.0)))

(println
	"To the nearest one-quadrillionth, "
	"the arithmetic-geometric mean of "
	"1 and the reciprocal of the square root of 2 is "
	(amg 1.0 root-reciprocal-2 quadrillionth)
)


#include <windows.h>
#include <string>
#include <iostream>

const int BMP_SIZE = 600;

class myBitmap {
public:
    myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {}
    ~myBitmap() {
        DeleteObject( pen ); DeleteObject( brush );
        DeleteDC( hdc ); DeleteObject( bmp );
    }
    bool create( int w, int h ) {
        BITMAPINFO bi;
        ZeroMemory( &bi, sizeof( bi ) );
        bi.bmiHeader.biSize        = sizeof( bi.bmiHeader );
        bi.bmiHeader.biBitCount    = sizeof( DWORD ) * 8;
        bi.bmiHeader.biCompression = BI_RGB;
        bi.bmiHeader.biPlanes      = 1;
        bi.bmiHeader.biWidth       =  w;
        bi.bmiHeader.biHeight      = -h;
        HDC dc = GetDC( GetConsoleWindow() );
        bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
        if( !bmp ) return false;
        hdc = CreateCompatibleDC( dc );
        SelectObject( hdc, bmp );
        ReleaseDC( GetConsoleWindow(), dc );
        width = w; height = h;
        return true;
    }
    void clear( BYTE clr = 0 ) {
        memset( pBits, clr, width * height * sizeof( DWORD ) );
    }
    void setBrushColor( DWORD bClr ) {
        if( brush ) DeleteObject( brush );
        brush = CreateSolidBrush( bClr );
        SelectObject( hdc, brush );
    }
    void setPenColor( DWORD c ) {
        clr = c; createPen();
    }
    void setPenWidth( int w ) {
        wid = w; createPen();
    }
    void saveBitmap( std::string path ) {
        BITMAPFILEHEADER fileheader;
        BITMAPINFO       infoheader;
        BITMAP           bitmap;
        DWORD            wb;
        GetObject( bmp, sizeof( bitmap ), &bitmap );
        DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];
        ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
        ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
        ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );
        infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
        infoheader.bmiHeader.biCompression = BI_RGB;
        infoheader.bmiHeader.biPlanes = 1;
        infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
        infoheader.bmiHeader.biHeight = bitmap.bmHeight;
        infoheader.bmiHeader.biWidth = bitmap.bmWidth;
        infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );
        fileheader.bfType    = 0x4D42;
        fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
        fileheader.bfSize    = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;
        GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );
        HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
                                  FILE_ATTRIBUTE_NORMAL, NULL );
        WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
        WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
        WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
        CloseHandle( file );
        delete [] dwpBits;
    }
    HDC getDC() const     { return hdc; }
    int getWidth() const  { return width; }
    int getHeight() const { return height; }
private:
    void createPen() {
        if( pen ) DeleteObject( pen );
        pen = CreatePen( PS_SOLID, wid, clr );
        SelectObject( hdc, pen );
    }
    HBITMAP bmp; HDC    hdc;
    HPEN    pen; HBRUSH brush;
    void    *pBits; int    width, height, wid;
    DWORD    clr;
};
class spiral {
public:
    spiral() {
        bmp.create( BMP_SIZE, BMP_SIZE );
    }
    void draw( int c, int s ) {
        double a = .2, b = .3, r, x, y;
        int w = BMP_SIZE >> 1;
        HDC dc = bmp.getDC();
        for( double d = 0; d < c * 6.28318530718; d += .002 ) {
            r = a + b * d; x = r * cos( d ); y = r * sin( d );
            SetPixel( dc, ( int )( s * x + w ), ( int )( s * y + w ), 255 );
        }
        // saves the bitmap
        bmp.saveBitmap( "./spiral.bmp" );
    }
private:
    myBitmap bmp;
};
int main(int argc, char* argv[]) {
    spiral s; s.draw( 16, 8 ); return 0;
}


(let ((s (format () "~s" (expt 5 (expt 4 (expt 3 2))))))
  (format t "~a...~a, length ~a" (subseq s 0 20)
          (subseq s (- (length s) 20)) (length s)))


void main() {
  import std.stdio, std.bigint, std.conv;

  auto s = text(5.BigInt ^^ 4 ^^ 3 ^^ 2);
  writefln("5^4^3^2 = %s..%s (%d digits)", s[0..20], s[$-20..$], s.length);
}


import 'dart:math' show pow;

int fallingPowers(int base) =>
    base == 1 ? 1 : pow(base, fallingPowers(base - 1));

void main() {
  final exponent = fallingPowers(4),
      s = BigInt.from(5).pow(exponent).toString();
  print('First twenty:     ${s.substring(0, 20)}');
  print('Last twenty:      ${s.substring(s.length - 20)}');
  print('Number of digits: ${s.length}');


type frac = Microsoft.FSharp.Math.BigRational

let perf n = 1N = List.fold (+) 0N (List.map (fun i -> if n % i = 0 then 1N/frac.FromInt(i) else 0N) [2..n])

for i in 1..(1<<<19) do if (perf i) then printfn "%i is perfect" i


USING: generalizations io kernel math math.functions
math.primes.factors math.ranges prettyprint sequences ;
IN: rosetta-code.arithmetic-rational

2/5              ! literal syntax 2/5
2/4              ! automatically simplifies to 1/2
5/1              ! automatically coerced to 5
26/5             ! mixed fraction 5+1/5
13/178 >fraction ! get the numerator and denominator 13 178
8 recip          ! get the reciprocal 1/8

! ratios can be any size
12417829731289312/61237812937138912735712
8 ndrop ! clear the stack
! arithmetic works the same as any other number.

: perfect? ( n -- ? )
    divisors rest [ recip ] map-sum 1 = ;

"Perfect numbers <= 2^19: " print
2 19 ^ [1,b] [ perfect? ] filter .


import math

proc agm(a, g: float,delta: float = 1.0e-15): float =
  var
    aNew: float = 0
    aOld: float = a
    gOld: float = g
  while (abs(aOld - gOld) > delta):
    aNew = 0.5 * (aOld + gOld)
    gOld = sqrt(aOld * gOld)
    aOld = aNew
  result = aOld

echo agm(1.0,1.0/sqrt(2.0))


MODULE Agm;
IMPORT
  Math := LRealMath,
  Out;

CONST
  epsilon = 1.0E-15;

PROCEDURE Of*(a,g: LONGREAL): LONGREAL;
VAR
  na,ng,og: LONGREAL;
BEGIN
  na := a; ng := g;
  LOOP
    og := ng;
    ng := Math.sqrt(na * ng);
    na := (na + og) * 0.5;
    IF na - ng <= epsilon THEN EXIT END
  END;
  RETURN ng;
END Of;

BEGIN
  Out.LongReal(Of(1,1 / Math.sqrt(2)),0,0);Out.Ln
END Agm.


class ArithmeticMean {
  function : Amg(a : Float, g : Float) ~ Nil {
    a1 := a;
    g1 := g;
    while((a1-g1)->Abs() >= Float->Power(10, -14)) {
        tmp := (a1+g1)/2.0;
        g1 := Float->SquareRoot(a1*g1);
        a1 := tmp;
    };
    a1->PrintLine();
  }

  function : Main(args : String[]) ~ Nil {
    Amg(1,1/Float->SquareRoot(2));
  }
}


(use '(incanter core stats charts io))

(defn Arquimidean-function
  [a b theta]
  (+ a (* theta b)))

(defn transform-pl-xy [r theta]
  (let [x (* r (sin theta))
        y (* r (cos theta))]
    [x y]))

(defn arq-spiral [t] (transform-pl-xy (Arquimidean-function 0 7 t) t))

(view (parametric-plot arq-spiral 0 (* 10 Math/PI)))


(defun draw-coords-as-text (coords size fill-char)
  (let* ((min-x (apply #'min (mapcar #'car coords)))
         (min-y (apply #'min (mapcar #'cdr coords)))
         (max-x (apply #'max (mapcar #'car coords)))
         (max-y (apply #'max (mapcar #'cdr coords)))
         (real-size (max (+ (abs min-x) (abs max-x)) ; bounding square
                         (+ (abs min-y) (abs max-y))))
         (scale-factor (* (1- size) (/ 1 real-size)))
         (center-x (* scale-factor -1 min-x))
         (center-y (* scale-factor -1 min-y))
         (intermediate-result (make-array (list size size)
                                          :element-type 'char
                                          :initial-element #\space)))
    (dolist (c coords)
      (let ((final-x (floor (+ center-x (* scale-factor (car c)))))
            (final-y (floor (+ center-y (* scale-factor (cdr c))))))
        (setf (aref intermediate-result final-x final-y)
              fill-char)))
    ; print results to output
    (loop for i below (array-total-size intermediate-result) do
          (when (zerop (mod i size))
            (terpri))
          (princ (row-major-aref intermediate-result i)))))

(defun spiral (a b step-resolution step-count)
  "Returns a list of coordinates for r=a+b*theta stepping theta by step-resolution"
  (loop for theta
        from 0 upto (* step-count step-resolution)
        by step-resolution
        for r = (+ a (* b theta))
        for x = (* r (cos theta))
        for y = (* r (sin theta))
        collect (cons x y)))

(draw-coords-as-text (spiral 10 10 0.01 1500) 30 #\*)
; Output:
;
;                         *
;          ******          *
;       ****    ***        **
;     ***          **       *
;    **             **       *
;   **               **      *
;   *                 **     **
;  **                  *      *
; **       ******      *      *
; *       **    **     **     *
; *      **      *      *     *
; *     **       *      *     **
; *     *        *      *     *
; *     *     * **      *     *
; *     *     ***      **     *
; *     **             *      *
; *      *            **      *
; *      **          **      **
; **      **        **       *
;  *       **      **       **
;  **       ********        *
;   *                      **
;   **                    **
;    **                  **
;     **               ***
;       **            **
;        ****      ***
;           *******
;


[5432.dc]sz

5 4 3 2 ^ ^ ^ sy				[y = 5 ^ 4 ^ 3 ^ 2]sz
ly Z sc						[c = length of y]sz
[ First 20 digits: ]P ly 10 lc 20 - ^ / p sz	[y / (10 ^ (c - 20))]sz
[  Last 20 digits: ]P ly 10 20 ^ % p sz		[y % (10 ^ 20)]sz
[Number of digits: ]P lc p sz


program Arbitrary_precision_integers;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  Velthuis.BigIntegers;

var
  value: BigInteger;
  result: string;

begin
  value := BigInteger.pow(3, 2);
  value := BigInteger.pow(4, value.AsInteger);
  value := BigInteger.pow(5, value.AsInteger);
  result := value.tostring;
  Write('5^4^3^2 = ');
  Write(result.substring(0, 20), '...');
  Write(result.substring(result.length - 20, 20));
  Writeln(' (', result.Length,' digits)');
  readln;
end.


for n=2 to 2^19 by 2 do
    s:=3/n;
    m:=1;
    while m<=n/3 do
        if Divides(m,n) then s:=s+1/m; fi;
        m:=m+1;
    od;
    if s=2 then !!n fi;
od;


\ Rationals can use any double cell operations:  2!, [email protected], 2dup, 2swap, etc.
\ Uses the stack convention of the built-in "*/" for int * frac -> int

: numerator  drop ;
: denominator nip ;

: s>rat      1 ;		\ integer to rational  (n/1)
: rat>s      / ;		\ integer
: rat>frac   mod ;		\ fractional part
: rat>float  swap s>f s>f f/ ;

: rat.  swap 1 .r [char] / emit . ;

\ normalize: factors out gcd and puts sign into numerator
: gcd ( a b -- gcd ) begin ?dup while tuck mod repeat ;
: rat-normalize ( rat -- rat ) 2dup gcd tuck / >r / r> ;

: rat-abs     swap abs    swap ;
: rat-negate  swap negate swap ;
: 1/rat       over 0< if negate swap negate else swap then ;

: rat+ ( a b c d -- ad+bc bd )
  rot 2dup * >r
   rot * >r * r> +
  r> rat-normalize ;
: rat-  rat-negate rat+ ;

: rat* ( a b c d -- ac bd )
  rot * >r * r> rat-normalize ;
: rat/  swap rat* ;

: rat-equal  d= ;
: rat-less ( a b c d -- ad<bc )
  -rot * >r * r> < ;
: rat-more  2swap rat-less ;

: rat-inc  tuck + swap ;
: rat-dec  tuck - swap ;


let rec agm a g tol =
  if tol > abs_float (a -. g) then a else
  agm (0.5*.(a+.g)) (sqrt (a*.g)) tol

let _ = Printf.printf "%.16f\n" (agm 1.0 (sqrt 0.5) 1e-15)


: agm   \ a b -- m
   while( 2dup <> ) [ 2dup + 2 / -rot * sqrt ] drop ;


import math // import for sqrt() function

amean: func (x: Double, y: Double) -> Double {
  (x + y) / 2.
}
gmean: func (x: Double, y: Double) -> Double {
  sqrt(x * y)
}
agm: func (a: Double, g: Double) -> Double {
  while ((a - g) abs() > pow(10, -12)) {
    (a1, g1) := (amean(a, g), gmean(a, g))
    (a, g) = (a1, g1)
  }
  a
}

main: func {
  "%.16f" printfln(agm(1., sqrt(0.5)))
}


module Archimedean where

import Java.IO
import Prelude.Math

data BufferedImage = native java.awt.image.BufferedImage where
  pure native type_3byte_bgr "java.awt.image.BufferedImage.TYPE_3BYTE_BGR" :: Int
  native new :: Int -> Int -> Int -> STMutable s BufferedImage
  native createGraphics :: Mutable s BufferedImage -> STMutable s Graphics2D

data Color = pure native java.awt.Color where
  pure native orange "java.awt.Color.orange" :: Color
  pure native white "java.awt.Color.white" :: Color
  pure native new :: Int -> Color

data BasicStroke = pure native java.awt.BasicStroke where
  pure native new :: Float -> BasicStroke

data RenderingHints = native java.awt.RenderingHints where
  pure native key_antialiasing "java.awt.RenderingHints.KEY_ANTIALIASING" :: RenderingHints_Key
  pure native value_antialias_on "java.awt.RenderingHints.VALUE_ANTIALIAS_ON" :: Object

data RenderingHints_Key = pure native java.awt.RenderingHints.Key

data Graphics2D = native java.awt.Graphics2D where
  native drawLine :: Mutable s Graphics2D -> Int -> Int -> Int -> Int -> ST s ()
  native drawOval :: Mutable s Graphics2D -> Int -> Int -> Int -> Int -> ST s ()
  native fillRect :: Mutable s Graphics2D -> Int -> Int -> Int -> Int -> ST s ()
  native setColor :: Mutable s Graphics2D -> Color -> ST s ()
  native setRenderingHint :: Mutable s Graphics2D -> RenderingHints_Key -> Object -> ST s ()
  native setStroke :: Mutable s Graphics2D -> BasicStroke -> ST s ()

data ImageIO = mutable native javax.imageio.ImageIO where
  native write "javax.imageio.ImageIO.write" :: MutableIO BufferedImage -> String -> MutableIO File -> IO Bool throws IOException

width = 640
center = width `div` 2

roundi = fromIntegral . round

drawGrid :: Mutable s Graphics2D -> ST s ()
drawGrid g = do
  g.setColor $ Color.new 0xEEEEEE
  g.setStroke $ BasicStroke.new 2
  let angle = toRadians 45
      margin = 10
      numRings = 8
      spacing = (width - 2 * margin) `div` (numRings * 2)
  forM_ [0 .. numRings-1] $ \i -> do
    let pos = margin + i * spacing
        size = width - (2 * margin + i * 2 * spacing)
        ia = fromIntegral i * angle
        multiplier = fromIntegral $ (width - 2 * margin) `div` 2
        x2 = center + (roundi (cos ia * multiplier))
        y2 = center - (roundi (sin ia * multiplier))
    g.drawOval pos pos size size
    g.drawLine center center x2 y2

drawSpiral :: Mutable s Graphics2D -> ST s ()
drawSpiral g = do
  g.setStroke $ BasicStroke.new 2
  g.setColor $ Color.orange
  let degrees = toRadians 0.1
      end = 360 * 2 * 10 * degrees
      a = 0
      b = 20
      c = 1
      drSp theta = do
        let r = a + b * theta ** (1 / c)
            x = r * cos theta
            y = r * sin theta
            theta' = theta + degrees
        plot g (center + roundi x) (center - roundi y)
        when (theta' < end) (drSp (theta' + degrees))
  drSp 0

plot :: Mutable s Graphics2D -> Int -> Int -> ST s ()
plot g x y = g.drawOval x y 1 1

main = do
  buffy <- BufferedImage.new width width BufferedImage.type_3byte_bgr
  g <- buffy.createGraphics
  g.setRenderingHint RenderingHints.key_antialiasing RenderingHints.value_antialias_on
  g.setColor Color.white
  g.fillRect 0 0 width width
  drawGrid g
  drawSpiral g
  f <- File.new "SpiralFrege.png"
  void $ ImageIO.write buffy "png" f


package main

import (
	"image"
	"image/color"
	"image/draw"
	"image/png"
	"log"
	"math"
	"os"
)

func main() {
	const (
		width, height = 600, 600
		centre        = width / 2.0
		degreesIncr   = 0.1 * math.Pi / 180
		turns         = 2
		stop          = 360 * turns * 10 * degreesIncr
		fileName      = "spiral.png"
	)

	img := image.NewNRGBA(image.Rect(0, 0, width, height)) // create new image
	bg := image.NewUniform(color.RGBA{255, 255, 255, 255}) // prepare white for background
	draw.Draw(img, img.Bounds(), bg, image.ZP, draw.Src)   // fill the background
	fgCol := color.RGBA{255, 0, 0, 255}                    // red plot

	a := 1.0
	b := 20.0

	for theta := 0.0; theta < stop; theta += degreesIncr {
		r := a + b*theta
		x := r * math.Cos(theta)
		y := r * math.Sin(theta)
		img.Set(int(centre+x), int(centre-y), fgCol)
	}

	imgFile, err := os.Create(fileName)
	if err != nil {
		log.Fatal(err)
	}
	defer imgFile.Close()

	if err := png.Encode(imgFile, img); err != nil {
		imgFile.Close()
		log.Fatal(err)
	}
}


;; to save space and time, we do'nt stringify Ω = 5^4^3^2 ,
;; but directly extract tail and head and number of decimal digits

(lib 'bigint) ;; arbitrary size integers

(define e10000 (expt 10 10000)) ;; 10^10000

(define (last-n big (n 20))
(string-append "..." (number->string (modulo big (expt 10 n)))))

(define (first-n big (n 20))
	(while (> big e10000)
		(set! big (/ big e10000))) ;; cut 10000 digits at a time
	(string-append (take (number->string big) n) "..."))

;; faster than directly using (number-length big)
(define (digits big (digits 0))
	(while (> big e10000)
		(set! big (/ big e10000))
		(set! digits (1+ digits)))
	(+ (* digits 10000) (number-length big)))

(define Ω (expt 5 (expt 4 (expt 3 2))))

(last-n Ω )
    → "...92256259918212890625"
(first-n Ω )
    → "62060698786608744707..."
(digits Ω )
    → 183231