Add tasks for all the new languages

Task/Arithmetic-geometric-mean/ERRE/arithmetic-geometric-mean.erre

@@ -0,0 +1,21 @@
+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

Task/Arithmetic-geometric-mean/EchoLisp/arithmetic-geometric-mean.echolisp

@@ -0,0 +1,14 @@
+(lib 'math)
+
+(define (agm a g)
+    (if (~= a g) a
+       (agm (// (+ a g ) 2) (sqrt (* a g)))))
+
+(math-precision)
+    → 0.000001 ;; default
+(agm 1 (/ 1 (sqrt 2)))
+    → 0.8472130848351929
+(math-precision 1.e-15)
+    → 1e-15
+(agm 1 (/ 1 (sqrt 2)))
+    → 0.8472130847939792

Task/Arithmetic-geometric-mean/FreeBASIC/arithmetic-geometric-mean.freebasic

@@ -0,0 +1,26 @@
+' 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

Task/Arithmetic-geometric-mean/Futhark/arithmetic-geometric-mean.futhark

@@ -0,0 +1,6 @@
+fun agm(a: f64, g: f64): f64 =
+  let eps = 1.0E-16
+  loop ((a,g)) = while abs(a-g) > eps do
+    ((a+g) / 2.0,
+     sqrt64 (a*g))
+  in a

Task/Arithmetic-geometric-mean/LFE/arithmetic-geometric-mean.lfe

@@ -0,0 +1,15 @@
+(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)))

Task/Arithmetic-geometric-mean/LiveCode/arithmetic-geometric-mean-1.livecode

@@ -0,0 +1,13 @@
+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

Task/Arithmetic-geometric-mean/LiveCode/arithmetic-geometric-mean-2.livecode

@@ -0,0 +1,3 @@
+put agm(1, 1/sqrt(2))
+-- ouput
+-- 0.847213

Task/Arithmetic-geometric-mean/Nim/arithmetic-geometric-mean-1.nim

@@ -0,0 +1,14 @@
+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)))

Task/Arithmetic-geometric-mean/Nim/arithmetic-geometric-mean-2.nim

@@ -0,0 +1,20 @@
+from math import sqrt
+from strutils import parseFloat, formatFloat, ffDecimal
+
+proc agm(x,y: float): tuple[resA,resG: float] =
+  var
+    a,g: array[0 .. 23,float]
+
+  a[0] = x
+  g[0] = y
+
+  for n in 1 .. 23:
+    a[n] = 0.5 * (a[n - 1] + g[n - 1])
+    g[n] = sqrt(a[n - 1] * g[n - 1])
+
+  (a[23], g[23])
+
+var t = agm(1, 1/sqrt(2))
+
+echo("Result A: " & formatFloat(t.resA, ffDecimal, 24))
+echo("Result G: " & formatFloat(t.resG, ffDecimal, 24))

Task/Arithmetic-geometric-mean/Oforth/arithmetic-geometric-mean-1.oforth

@@ -0,0 +1 @@
+: agm  while(2dup <>) [ 2dup + 2 / tor * sqrt ] drop ;

Task/Arithmetic-geometric-mean/Oforth/arithmetic-geometric-mean-2.oforth

@@ -0,0 +1 @@
+1 2 sqrt inv agm

Task/Arithmetic-geometric-mean/Phix/arithmetic-geometric-mean.phix

@@ -0,0 +1,8 @@
+function agm(atom a, atom g, atom tolerance=1.0e-15)
+    while abs(a-g)>tolerance do
+        {a,g} = {(a + g)/2,sqrt(a*g)}
+        printf(1,"%0.15g\n",a)
+    end while
+    return a
+end function
+?agm(1,1/sqrt(2))   -- (rounds to 10 d.p.)

Task/Arithmetic-geometric-mean/Potion/arithmetic-geometric-mean.potion

@@ -0,0 +1,17 @@
+sqrt = (x) :
+   xi = 1
+   7 times :
+      xi = (xi + x / xi) / 2
+   .
+   xi
+.
+
+agm = (x, y) :
+   7 times :
+      a = (x + y) / 2
+      g = sqrt(x * y)
+      x = a
+      y = g
+   .
+   x
+.

Task/Arithmetic-geometric-mean/Ring/arithmetic-geometric-mean.ring

@@ -0,0 +1,13 @@
+decimals(9)
+see agm(1, 1/sqrt(2)) + nl
+see agm(1,1/pow(2,0.5)) + nl
+
+func agm agm,g
+       while agm
+             an  = (agm + g)/2
+             gn  = sqrt(agm*g)
+             if fabs(agm-g) <= fabs(an-gn) exit ok
+             agm = an
+             g   = gn
+       end
+       return gn

Task/Arithmetic-geometric-mean/Sidef/arithmetic-geometric-mean.sidef

@@ -0,0 +1,9 @@
+func agm(a, g) {
+    loop {
+        var x = [float(a+g / 2), sqrt(a*g)]
+        x == [a, g] && return a
+        x >> \(a, g)
+    }
+}
+
+say agm(1, 1/sqrt(2))

Task/Arithmetic-geometric-mean/jq/arithmetic-geometric-mean-1.jq

@@ -0,0 +1,9 @@
+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] ;

Task/Arithmetic-geometric-mean/jq/arithmetic-geometric-mean-2.jq

@@ -0,0 +1,16 @@
+def agm(a; g; tolerance):
+  def abs: if . < 0 then -. else . end;
+  def _agm:
+     # state [an,gn, delta]
+     ((.[0] - .[1])|abs) as $delta
+     | if $delta == .[2] and $delta < 10e-16 then .
+       elif $delta > tolerance
+       then [ .[0:2]|add / 2, ((.[0] * .[1])|sqrt), $delta] | _agm
+       else .
+       end;
+  if tolerance <= 0 then error("specified tolerance must be > 0")
+  else [a, g, 0] | _agm | .[0]
+  end ;
+
+# Example:
+agm(1; 1/(2|sqrt); 1e-100)