langs a-z

Task/Arithmetic-geometric-mean/NetRexx/arithmetic-geometric-mean.netrexx

@@ -0,0 +1,24 @@
+/* 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

Task/Arithmetic-geometric-mean/OCaml/arithmetic-geometric-mean.ocaml

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

Task/Arithmetic-geometric-mean/PARI-GP/arithmetic-geometric-mean-1.pari

@@ -0,0 +1 @@
+agm(1,1/sqrt(2))

Task/Arithmetic-geometric-mean/PARI-GP/arithmetic-geometric-mean-2.pari

@@ -0,0 +1 @@
+agm2(x,y)=if(x==y,x,agm2((x+y)/2,sqrt(x*y))

Task/Arithmetic-geometric-mean/PL-I/arithmetic-geometric-mean.pli

@@ -0,0 +1,13 @@
+arithmetic_geometric_mean:           /* 31 August 2012 */
+   procedure options (main);
+   declare (a, g, t) float (18);
+
+   a = 1; g = 1/sqrt(2.0q0);
+   put skip list ('The arithmetic-geometric mean of ' || a || ' and ' || g || ':');
+   do until (abs(a-g) < 1e-15*a);
+      t = (a + g)/2; g = sqrt(a*g);
+      a = t;
+      put skip data (a, g);
+   end;
+   put skip list ('The result is:', a);
+end arithmetic_geometric_mean;

Task/Arithmetic-geometric-mean/Pascal/arithmetic-geometric-mean.pascal

@@ -0,0 +1,35 @@
+Program ArithmeticGeometricMean;
+
+uses
+  gmp;
+
+procedure agm (in1, in2: mpf_t; var out1, out2: mpf_t);
+begin
+  mpf_add (out1, in1, in2);
+  mpf_div_ui (out1, out1, 2);
+  mpf_mul (out2, in1, in2);
+  mpf_sqrt (out2, out2);
+end;
+
+const
+  nl = chr(13)+chr(10);
+var
+  x0, y0, resA, resB: mpf_t;
+  i: integer;
+begin
+  mpf_set_default_prec (65568);
+
+  mpf_init_set_ui (y0, 1);
+  mpf_init_set_d (x0, 0.5);
+  mpf_sqrt (x0, x0);
+  mpf_init (resA);
+  mpf_init (resB);
+
+  for i := 0 to 6 do
+  begin
+    agm(x0, y0, resA, resB);
+    agm(resA, resB, x0, y0);
+  end;
+  mp_printf ('%.20000Ff'+nl, @x0);
+  mp_printf ('%.20000Ff'+nl+nl, @y0);
+end.

Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean.pl6

@@ -0,0 +1,11 @@
+sub agm ($a, $g) {
+    sub iter ($old) {
+        my $new := [ 0.5 * [+](@$old), sqrt [*](@$old) ];
+        last if $new ~~ $old;
+        $new;
+    }
+
+    ([$a,$g], &iter ... 0)[*-1][0];
+}
+
+say agm 1, 1/sqrt 2;

Task/Arithmetic-geometric-mean/PureBasic/arithmetic-geometric-mean.purebasic

@@ -0,0 +1,15 @@
+Procedure.d AGM(a.d, g.d, ErrLim.d=1e-15)
+  Protected.d ta=a+1, tg
+  While ta <> a
+    ta=a: tg=g
+    a=(ta+tg)*0.5
+    g=Sqr(ta*tg)
+  Wend
+  ProcedureReturn a
+EndProcedure
+
+If OpenConsole()
+  PrintN(StrD(AGM(1, 1/Sqr(2)), 16))
+  Input()
+  CloseConsole()
+EndIf

Task/Arithmetic-geometric-mean/Run-BASIC/arithmetic-geometric-mean.run

@@ -0,0 +1,13 @@
+print agm(1, 1/sqr(2))
+print agm(1,1/2^.5)
+print using("#.############################",agm(1, 1/sqr(2)))
+
+function agm(agm,g)
+ while agm
+   an  = (agm + g)/2
+   gn  = sqr(agm*g)
+   if abs(agm-g) <= abs(an-gn) then exit while
+   agm = an
+   g   = gn
+ wend
+end function

Task/Arithmetic-geometric-mean/XPL0/arithmetic-geometric-mean.xpl0

@@ -0,0 +1,10 @@
+include c:\cxpl\codesi;
+real A, A1, G;
+[Format(0, 16);
+A:= 1.0;  G:= 1.0/sqrt(2.0);
+repeat	A1:= (A+G)/2.0;
+	G:= sqrt(A*G);
+	A:= A1;
+	RlOut(0, A);  RlOut(0, G);  RlOut(0, A-G);  CrLf(0);
+until	A=G;
+]