Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
2
Task/Arithmetic-geometric-mean/00-META.yaml
Normal file
2
Task/Arithmetic-geometric-mean/00-META.yaml
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
---
|
||||
from: http://rosettacode.org/wiki/Arithmetic-geometric_mean
|
||||
17
Task/Arithmetic-geometric-mean/00-TASK.txt
Normal file
17
Task/Arithmetic-geometric-mean/00-TASK.txt
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
;Task:
|
||||
Write a function to compute the [[wp:Arithmetic-geometric mean|arithmetic-geometric mean]] of two numbers.
|
||||
|
||||
|
||||
The arithmetic-geometric mean of two numbers can be (usefully) denoted as <math>\mathrm{agm}(a,g)</math>, and is equal to the limit of the sequence:
|
||||
: <math>a_0 = a; \qquad g_0 = g</math>
|
||||
: <math>a_{n+1} = \tfrac{1}{2}(a_n + g_n); \quad g_{n+1} = \sqrt{a_n g_n}.</math>
|
||||
Since the limit of <math>a_n-g_n</math> tends (rapidly) to zero with iterations, this is an efficient method.
|
||||
|
||||
Demonstrate the function by calculating:
|
||||
:<math>\mathrm{agm}(1,1/\sqrt{2})</math>
|
||||
|
||||
|
||||
;Also see:
|
||||
* [http://mathworld.wolfram.com/Arithmetic-GeometricMean.html mathworld.wolfram.com/Arithmetic-Geometric Mean]
|
||||
<br><br>
|
||||
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
F agm(a0, g0, tolerance = 1e-10)
|
||||
V an = (a0 + g0) / 2.0
|
||||
V gn = sqrt(a0 * g0)
|
||||
L abs(an - gn) > tolerance
|
||||
(an, gn) = ((an + gn) / 2.0, sqrt(an * gn))
|
||||
R an
|
||||
|
||||
print(agm(1, 1 / sqrt(2)))
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
AGM CSECT
|
||||
USING AGM,R13
|
||||
SAVEAREA B STM-SAVEAREA(R15)
|
||||
DC 17F'0'
|
||||
DC CL8'AGM'
|
||||
STM STM R14,R12,12(R13)
|
||||
ST R13,4(R15)
|
||||
ST R15,8(R13)
|
||||
LR R13,R15
|
||||
ZAP A,K a=1
|
||||
ZAP PWL8,K
|
||||
MP PWL8,K
|
||||
DP PWL8,=P'2'
|
||||
ZAP PWL8,PWL8(7)
|
||||
BAL R14,SQRT
|
||||
ZAP G,PWL8 g=sqrt(1/2)
|
||||
WHILE1 EQU * while a!=g
|
||||
ZAP PWL8,A
|
||||
SP PWL8,G
|
||||
CP PWL8,=P'0' (a-g)!=0
|
||||
BE EWHILE1
|
||||
ZAP PWL8,A
|
||||
AP PWL8,G
|
||||
DP PWL8,=P'2'
|
||||
ZAP AN,PWL8(7) an=(a+g)/2
|
||||
ZAP PWL8,A
|
||||
MP PWL8,G
|
||||
BAL R14,SQRT
|
||||
ZAP G,PWL8 g=sqrt(a*g)
|
||||
ZAP A,AN a=an
|
||||
B WHILE1
|
||||
EWHILE1 EQU *
|
||||
ZAP PWL8,A
|
||||
UNPK ZWL16,PWL8
|
||||
MVC CWL16,ZWL16
|
||||
OI CWL16+15,X'F0'
|
||||
MVI CWL16,C'+'
|
||||
CP PWL8,=P'0'
|
||||
BNM *+8
|
||||
MVI CWL16,C'-'
|
||||
MVC CWL80+0(15),CWL16
|
||||
MVC CWL80+9(1),=C'.' /k (15-6=9)
|
||||
XPRNT CWL80,80 display a
|
||||
L R13,4(0,R13)
|
||||
LM R14,R12,12(R13)
|
||||
XR R15,R15
|
||||
BR R14
|
||||
DS 0F
|
||||
K DC PL8'1000000' 10^6
|
||||
A DS PL8
|
||||
G DS PL8
|
||||
AN DS PL8
|
||||
* ****** SQRT *******************
|
||||
SQRT CNOP 0,4 function sqrt(x)
|
||||
ZAP X,PWL8
|
||||
ZAP X0,=P'0' x0=0
|
||||
ZAP X1,=P'1' x1=1
|
||||
WHILE2 EQU * while x0!=x1
|
||||
ZAP PWL8,X0
|
||||
SP PWL8,X1
|
||||
CP PWL8,=P'0' (x0-x1)!=0
|
||||
BE EWHILE2
|
||||
ZAP X0,X1 x0=x1
|
||||
ZAP PWL16,X
|
||||
DP PWL16,X1
|
||||
ZAP XW,PWL16(8) xw=x/x1
|
||||
ZAP PWL8,X1
|
||||
AP PWL8,XW
|
||||
DP PWL8,=P'2'
|
||||
ZAP PWL8,PWL8(7)
|
||||
ZAP X2,PWL8 x2=(x1+xw)/2
|
||||
ZAP X1,X2 x1=x2
|
||||
B WHILE2
|
||||
EWHILE2 EQU *
|
||||
ZAP PWL8,X1 return x1
|
||||
BR R14
|
||||
DS 0F
|
||||
X DS PL8
|
||||
X0 DS PL8
|
||||
X1 DS PL8
|
||||
X2 DS PL8
|
||||
XW DS PL8
|
||||
* end SQRT
|
||||
PWL8 DC PL8'0'
|
||||
PWL16 DC PL16'0'
|
||||
CWL80 DC CL80' '
|
||||
CWL16 DS CL16
|
||||
ZWL16 DS ZL16
|
||||
LTORG
|
||||
YREGS
|
||||
END AGM
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
: epsilon 1.0e-12 ;
|
||||
|
||||
with: n
|
||||
|
||||
: iter \ n1 n2 -- n1 n2
|
||||
2dup * sqrt >r + 2 / r> ;
|
||||
|
||||
: agn \ n1 n2 -- n
|
||||
repeat iter 2dup epsilon ~= not while! drop ;
|
||||
|
||||
"agn(1, 1/sqrt(2)) = " . 1 1 2 sqrt / agn "%.10f" s:strfmt . cr
|
||||
|
||||
;with
|
||||
bye
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
BEGIN
|
||||
PROC agm = (LONG REAL x, y) LONG REAL :
|
||||
BEGIN
|
||||
IF x < LONG 0.0 OR y < LONG 0.0 THEN -LONG 1.0
|
||||
ELIF x + y = LONG 0.0 THEN LONG 0.0 CO Edge cases CO
|
||||
ELSE
|
||||
LONG REAL a := x, g := y;
|
||||
LONG REAL epsilon := a + g;
|
||||
LONG REAL next a := (a + g) / LONG 2.0, next g := long sqrt (a * g);
|
||||
LONG REAL next epsilon := ABS (a - g);
|
||||
WHILE next epsilon < epsilon
|
||||
DO
|
||||
print ((epsilon, " ", next epsilon, newline));
|
||||
epsilon := next epsilon;
|
||||
a := next a; g := next g;
|
||||
next a := (a + g) / LONG 2.0; next g := long sqrt (a * g);
|
||||
next epsilon := ABS (a - g)
|
||||
OD;
|
||||
a
|
||||
FI
|
||||
END;
|
||||
printf (($l(-35,33)l$, agm (LONG 1.0, LONG 1.0 / long sqrt (LONG 2.0))))
|
||||
END
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
100 PROGRAM ArithmeticGeometricMean
|
||||
110 FUNCTION AGM (A, G)
|
||||
120 DO
|
||||
130 LET TA = (A + G) / 2
|
||||
140 LET G = SQR(A * G)
|
||||
150 LET Tmp = A
|
||||
160 LET A = TA
|
||||
170 LET TA = Tmp
|
||||
180 LOOP UNTIL A = TA
|
||||
190 LET AGM = A
|
||||
200 END FUNCTION
|
||||
210 REM ********************
|
||||
220 PRINT AGM(1, 1 / SQR(2))
|
||||
230 END
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
agd←{(⍺-⍵)<10*¯8:⍺⋄((⍺+⍵)÷2)∇(⍺×⍵)*÷2}
|
||||
1 agd ÷2*÷2
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
#!/usr/bin/awk -f
|
||||
BEGIN {
|
||||
printf "%.16g\n", agm(1.0,sqrt(0.5))
|
||||
}
|
||||
function agm(a,g) {
|
||||
while (1) {
|
||||
a0=a
|
||||
a=(a0+g)/2
|
||||
g=sqrt(a0*g)
|
||||
if (abs(a0-a) < abs(a)*1e-15) break
|
||||
}
|
||||
return a
|
||||
}
|
||||
function abs(x) {
|
||||
return (x<0 ? -x : x)
|
||||
}
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
INCLUDE "H6:REALMATH.ACT"
|
||||
|
||||
PROC Agm(REAL POINTER a0,g0,result)
|
||||
REAL a,g,prevA,tmp,r2
|
||||
|
||||
RealAssign(a0,a)
|
||||
RealAssign(g0,g)
|
||||
IntToReal(2,r2)
|
||||
DO
|
||||
RealAssign(a,prevA)
|
||||
RealAdd(a,g,tmp)
|
||||
RealDiv(tmp,r2,a)
|
||||
RealMult(prevA,g,tmp)
|
||||
Sqrt(tmp,g)
|
||||
IF RealGreaterOrEqual(a,prevA) THEN
|
||||
EXIT
|
||||
FI
|
||||
OD
|
||||
RealAssign(a,result)
|
||||
RETURN
|
||||
|
||||
PROC Main()
|
||||
REAL r1,r2,tmp,g,res
|
||||
|
||||
Put(125) PutE() ;clear screen
|
||||
|
||||
MathInit()
|
||||
IntToReal(1,r1)
|
||||
IntToReal(2,r2)
|
||||
Sqrt(r2,tmp)
|
||||
RealDiv(r1,tmp,g)
|
||||
Agm(r1,g,res)
|
||||
|
||||
Print("agm(") PrintR(r1)
|
||||
Print(",") PrintR(g)
|
||||
Print(")=") PrintRE(res)
|
||||
RETURN
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
with Ada.Text_IO, Ada.Numerics.Generic_Elementary_Functions;
|
||||
|
||||
procedure Arith_Geom_Mean is
|
||||
|
||||
type Num is digits 18; -- the largest value gnat/gcc allows
|
||||
package N_IO is new Ada.Text_IO.Float_IO(Num);
|
||||
package Math is new Ada.Numerics.Generic_Elementary_Functions(Num);
|
||||
|
||||
function AGM(A, G: Num) return Num is
|
||||
Old_G: Num;
|
||||
New_G: Num := G;
|
||||
New_A: Num := A;
|
||||
begin
|
||||
loop
|
||||
Old_G := New_G;
|
||||
New_G := Math.Sqrt(New_A*New_G);
|
||||
New_A := (Old_G + New_A) * 0.5;
|
||||
exit when (New_A - New_G) <= Num'Epsilon;
|
||||
-- Num'Epsilon denotes the relative error when performing arithmetic over Num
|
||||
end loop;
|
||||
return New_G;
|
||||
end AGM;
|
||||
|
||||
begin
|
||||
N_IO.Put(AGM(1.0, 1.0/Math.Sqrt(2.0)), Fore => 1, Aft => 17, Exp => 0);
|
||||
end Arith_Geom_Mean;
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
-- ARITHMETIC GEOMETRIC MEAN -------------------------------------------------
|
||||
|
||||
property tolerance : 1.0E-5
|
||||
|
||||
-- agm :: Num a => a -> a -> a
|
||||
on agm(a, g)
|
||||
script withinTolerance
|
||||
on |λ|(m)
|
||||
tell m to ((its an) - (its gn)) < tolerance
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
script nextRefinement
|
||||
on |λ|(m)
|
||||
tell m
|
||||
set {an, gn} to {its an, its gn}
|
||||
{an:(an + gn) / 2, gn:(an * gn) ^ 0.5}
|
||||
end tell
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
an of |until|(withinTolerance, ¬
|
||||
nextRefinement, {an:(a + g) / 2, gn:(a * g) ^ 0.5})
|
||||
end agm
|
||||
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
on run
|
||||
|
||||
agm(1, 1 / (2 ^ 0.5))
|
||||
|
||||
--> 0.847213084835
|
||||
|
||||
end run
|
||||
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
|
||||
-- until :: (a -> Bool) -> (a -> a) -> a -> a
|
||||
on |until|(p, f, x)
|
||||
set mp to mReturn(p)
|
||||
set v to x
|
||||
tell mReturn(f)
|
||||
repeat until mp's |λ|(v)
|
||||
set v to |λ|(v)
|
||||
end repeat
|
||||
end tell
|
||||
return v
|
||||
end |until|
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
agm: function [a,g][
|
||||
delta: 1e-15
|
||||
[aNew, aOld, gOld]: @[0, a, g]
|
||||
|
||||
while [delta < abs aOld - gOld][
|
||||
aNew: 0.5 * aOld + gOld
|
||||
gOld: sqrt aOld * gOld
|
||||
aOld: aNew
|
||||
]
|
||||
return aOld
|
||||
]
|
||||
|
||||
print agm 1.0 1.0/sqrt 2.0</lang>
|
||||
|
||||
{{out}}
|
||||
|
||||
<pre>0.8472130847939792</pre>
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
agm(a, g, tolerance=1.0e-15){
|
||||
While abs(a-g) > tolerance
|
||||
{
|
||||
an := .5 * (a + g)
|
||||
g := sqrt(a*g)
|
||||
a := an
|
||||
}
|
||||
return a
|
||||
}
|
||||
SetFormat, FloatFast, 0.15
|
||||
MsgBox % agm(1, 1/sqrt(2))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
print AGM(1, 1 / sqr(2))
|
||||
end
|
||||
|
||||
function AGM(a, g)
|
||||
Do
|
||||
ta = (a + g) / 2
|
||||
g = sqr(a * g)
|
||||
x = a
|
||||
a = ta
|
||||
ta = x
|
||||
until a = ta
|
||||
|
||||
return a
|
||||
end function
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
*FLOAT 64
|
||||
@% = &1010
|
||||
PRINT FNagm(1, 1/SQR(2))
|
||||
END
|
||||
|
||||
DEF FNagm(a,g)
|
||||
LOCAL ta
|
||||
REPEAT
|
||||
ta = a
|
||||
a = (a+g)/2
|
||||
g = SQR(ta*g)
|
||||
UNTIL a = ta
|
||||
= a
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
AGM ← {
|
||||
(|𝕨-𝕩) ≤ 1e¯15? 𝕨;
|
||||
(0.5×𝕨+𝕩) 𝕊 √𝕨×𝕩
|
||||
}
|
||||
|
||||
1 AGM 1÷√2
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
/* Calculate the arithmethic-geometric mean of two positive
|
||||
* numbers x and y.
|
||||
* Result will have d digits after the decimal point.
|
||||
*/
|
||||
define m(x, y, d) {
|
||||
auto a, g, o
|
||||
|
||||
o = scale
|
||||
scale = d
|
||||
d = 1 / 10 ^ d
|
||||
|
||||
a = (x + y) / 2
|
||||
g = sqrt(x * y)
|
||||
while ((a - g) > d) {
|
||||
x = (a + g) / 2
|
||||
g = sqrt(a * g)
|
||||
a = x
|
||||
}
|
||||
|
||||
scale = o
|
||||
return(a)
|
||||
}
|
||||
|
||||
scale = 20
|
||||
m(1, 1 / sqrt(2), 20)
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
#include<bits/stdc++.h>
|
||||
using namespace std;
|
||||
#define _cin ios_base::sync_with_stdio(0); cin.tie(0);
|
||||
#define rep(a, b) for(ll i =a;i<=b;++i)
|
||||
|
||||
double agm(double a, double g) //ARITHMETIC GEOMETRIC MEAN
|
||||
{ double epsilon = 1.0E-16,a1,g1;
|
||||
if(a*g<0.0)
|
||||
{ cout<<"Couldn't find arithmetic-geometric mean of these numbers\n";
|
||||
exit(1);
|
||||
}
|
||||
while(fabs(a-g)>epsilon)
|
||||
{ a1 = (a+g)/2.0;
|
||||
g1 = sqrt(a*g);
|
||||
a = a1;
|
||||
g = g1;
|
||||
}
|
||||
return a;
|
||||
}
|
||||
|
||||
int main()
|
||||
{ _cin; //fast input-output
|
||||
double x, y;
|
||||
cout<<"Enter X and Y: "; //Enter two numbers
|
||||
cin>>x>>y;
|
||||
cout<<"\nThe Arithmetic-Geometric Mean of "<<x<<" and "<<y<<" is "<<agm(x, y);
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
namespace RosettaCode.ArithmeticGeometricMean
|
||||
{
|
||||
using System;
|
||||
using System.Collections.Generic;
|
||||
using System.Globalization;
|
||||
|
||||
internal static class Program
|
||||
{
|
||||
private static double ArithmeticGeometricMean(double number,
|
||||
double otherNumber,
|
||||
IEqualityComparer<double>
|
||||
comparer)
|
||||
{
|
||||
return comparer.Equals(number, otherNumber)
|
||||
? number
|
||||
: ArithmeticGeometricMean(
|
||||
ArithmeticMean(number, otherNumber),
|
||||
GeometricMean(number, otherNumber), comparer);
|
||||
}
|
||||
|
||||
private static double ArithmeticMean(double number, double otherNumber)
|
||||
{
|
||||
return 0.5 * (number + otherNumber);
|
||||
}
|
||||
|
||||
private static double GeometricMean(double number, double otherNumber)
|
||||
{
|
||||
return Math.Sqrt(number * otherNumber);
|
||||
}
|
||||
|
||||
private static void Main()
|
||||
{
|
||||
Console.WriteLine(
|
||||
ArithmeticGeometricMean(1, 0.5 * Math.Sqrt(2),
|
||||
new RelativeDifferenceComparer(1e-5)).
|
||||
ToString(CultureInfo.InvariantCulture));
|
||||
}
|
||||
|
||||
private class RelativeDifferenceComparer : IEqualityComparer<double>
|
||||
{
|
||||
private readonly double _maximumRelativeDifference;
|
||||
|
||||
internal RelativeDifferenceComparer(double maximumRelativeDifference)
|
||||
{
|
||||
_maximumRelativeDifference = maximumRelativeDifference;
|
||||
}
|
||||
|
||||
public bool Equals(double number, double otherNumber)
|
||||
{
|
||||
return RelativeDifference(number, otherNumber) <=
|
||||
_maximumRelativeDifference;
|
||||
}
|
||||
|
||||
public int GetHashCode(double number)
|
||||
{
|
||||
return number.GetHashCode();
|
||||
}
|
||||
|
||||
private static double RelativeDifference(double number,
|
||||
double otherNumber)
|
||||
{
|
||||
return AbsoluteDifference(number, otherNumber) /
|
||||
Norm(number, otherNumber);
|
||||
}
|
||||
|
||||
private static double AbsoluteDifference(double number,
|
||||
double otherNumber)
|
||||
{
|
||||
return Math.Abs(number - otherNumber);
|
||||
}
|
||||
|
||||
private static double Norm(double number, double otherNumber)
|
||||
{
|
||||
return 0.5 * (Math.Abs(number) + Math.Abs(otherNumber));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
using System;
|
||||
|
||||
class Program {
|
||||
|
||||
static Decimal DecSqRoot(Decimal v) {
|
||||
Decimal r = (Decimal)Math.Sqrt((double)v), t = 0, d = 0, ld = 1;
|
||||
while (ld != d) { t = v / r; r = (r + t) / 2;
|
||||
ld = d; d = t - r; } return t; }
|
||||
|
||||
static Decimal CalcAGM(Decimal a, Decimal b) {
|
||||
Decimal c, d = 0, ld = 1; while (ld != d) { ld = d; c = a;
|
||||
d = (a = (a + b) / 2) - (b = DecSqRoot(c * b)); } return b; }
|
||||
|
||||
static void Main(string[] args) {
|
||||
Console.WriteLine(CalcAGM(1M, DecSqRoot(0.5M)));
|
||||
if (System.Diagnostics.Debugger.IsAttached) Console.ReadKey();
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
using static System.Math;
|
||||
using static System.Console;
|
||||
using BI = System.Numerics.BigInteger;
|
||||
|
||||
class Program {
|
||||
|
||||
static BI BIP(char leadDig, int numDigs) { // makes big constant
|
||||
return BI.Parse(leadDig + new string('0', numDigs)); }
|
||||
|
||||
static BI IntSqRoot(BI v, BI res) { // res is the initial guess
|
||||
BI term = 0, d = 0, dl = 1; while (dl != d) { term = v / res; res = (res + term) >> 1;
|
||||
dl = d; d = term - res; } return term; }
|
||||
|
||||
static BI CalcByAGM(int digs) { // note: a and b are hard-coded for this RC task
|
||||
BI a = BIP('1', digs), // value of 1, extended to required number of digits
|
||||
b = BI.Parse(string.Format("{0:0.00000000000000000}", Sqrt(0.5)).Substring(2) +
|
||||
new string('0', digs - 17)), // initial guess for square root of 0.5
|
||||
c, // temporary variable to swap a and b
|
||||
diff = 0, ldiff = 1; // difference of a and b, last difference
|
||||
b = IntSqRoot(BIP('5', (digs << 1) - 1), b); // value of square root of 0.5
|
||||
while (ldiff != diff) { ldiff = diff; c = a; a = (a + b) >> 1;
|
||||
diff = a - (b = IntSqRoot(c * b, a)); } return b; }
|
||||
|
||||
static void Main(string[] args) {
|
||||
int digits = 25000; if (args.Length > 0) {
|
||||
int.TryParse(args[0], out digits);
|
||||
if (digits < 1 || digits > 999999) digits = 25000; }
|
||||
WriteLine("0.{0}", CalcByAGM(digits));
|
||||
if (System.Diagnostics.Debugger.IsAttached) ReadKey(); }
|
||||
}
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
#include<math.h>
|
||||
#include<stdio.h>
|
||||
#include<stdlib.h>
|
||||
|
||||
double agm( double a, double g ) {
|
||||
/* arithmetic-geometric mean */
|
||||
double iota = 1.0E-16;
|
||||
double a1, g1;
|
||||
|
||||
if( a*g < 0.0 ) {
|
||||
printf( "arithmetic-geometric mean undefined when x*y<0\n" );
|
||||
exit(1);
|
||||
}
|
||||
|
||||
while( fabs(a-g)>iota ) {
|
||||
a1 = (a + g) / 2.0;
|
||||
g1 = sqrt(a * g);
|
||||
|
||||
a = a1;
|
||||
g = g1;
|
||||
}
|
||||
|
||||
return a;
|
||||
}
|
||||
|
||||
int main( void ) {
|
||||
double x, y;
|
||||
printf( "Enter two numbers: " );
|
||||
scanf( "%lf%lf", &x, &y );
|
||||
printf( "The arithmetic-geometric mean is %lf\n", agm(x, y) );
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
/*Arithmetic Geometric Mean of 1 and 1/sqrt(2)
|
||||
|
||||
Nigel_Galloway
|
||||
February 7th., 2012.
|
||||
*/
|
||||
|
||||
#include "gmp.h"
|
||||
|
||||
void agm (const mpf_t in1, const mpf_t in2, mpf_t out1, mpf_t out2) {
|
||||
mpf_add (out1, in1, in2);
|
||||
mpf_div_ui (out1, out1, 2);
|
||||
mpf_mul (out2, in1, in2);
|
||||
mpf_sqrt (out2, out2);
|
||||
}
|
||||
|
||||
int main (void) {
|
||||
mpf_set_default_prec (65568);
|
||||
mpf_t x0, y0, resA, resB;
|
||||
|
||||
mpf_init_set_ui (y0, 1);
|
||||
mpf_init_set_d (x0, 0.5);
|
||||
mpf_sqrt (x0, x0);
|
||||
mpf_init (resA);
|
||||
mpf_init (resB);
|
||||
|
||||
for(int i=0; i<7; i++){
|
||||
agm(x0, y0, resA, resB);
|
||||
agm(resA, resB, x0, y0);
|
||||
}
|
||||
gmp_printf ("%.20000Ff\n", x0);
|
||||
gmp_printf ("%.20000Ff\n\n", y0);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. ARITHMETIC-GEOMETRIC-MEAN-PROG.
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 AGM-VARS.
|
||||
05 A PIC 9V9(16).
|
||||
05 A-ZERO PIC 9V9(16).
|
||||
05 G PIC 9V9(16).
|
||||
05 DIFF PIC 9V9(16) VALUE 1.
|
||||
* Initialize DIFF with a non-zero value, otherwise AGM-PARAGRAPH
|
||||
* is never performed at all.
|
||||
PROCEDURE DIVISION.
|
||||
TEST-PARAGRAPH.
|
||||
MOVE 1 TO A.
|
||||
COMPUTE G = 1 / FUNCTION SQRT(2).
|
||||
* The program will run with the test values. If you would rather
|
||||
* calculate the AGM of numbers input at the console, comment out
|
||||
* TEST-PARAGRAPH and un-comment-out INPUT-A-AND-G-PARAGRAPH.
|
||||
* INPUT-A-AND-G-PARAGRAPH.
|
||||
* DISPLAY 'Enter two numbers.'
|
||||
* ACCEPT A.
|
||||
* ACCEPT G.
|
||||
CONTROL-PARAGRAPH.
|
||||
PERFORM AGM-PARAGRAPH UNTIL DIFF IS LESS THAN 0.000000000000001.
|
||||
DISPLAY A.
|
||||
STOP RUN.
|
||||
AGM-PARAGRAPH.
|
||||
MOVE A TO A-ZERO.
|
||||
COMPUTE A = (A-ZERO + G) / 2.
|
||||
MULTIPLY A-ZERO BY G GIVING G.
|
||||
COMPUTE G = FUNCTION SQRT(G).
|
||||
SUBTRACT A FROM G GIVING DIFF.
|
||||
COMPUTE DIFF = FUNCTION ABS(DIFF).
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
10 print agm(1,1/sqr(2))
|
||||
20 end
|
||||
100 sub agm(a,g)
|
||||
110 do
|
||||
120 let ta = (a+g)/2
|
||||
130 let g = sqr(a*g)
|
||||
140 let x = a
|
||||
150 let a = ta
|
||||
160 let ta = x
|
||||
170 loop until a = ta
|
||||
180 agm = a
|
||||
190 end sub
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
(ns agmcompute
|
||||
(:gen-class))
|
||||
|
||||
; Java Arbitray Precision Library
|
||||
(import '(org.apfloat Apfloat ApfloatMath))
|
||||
|
||||
(def precision 70)
|
||||
(def one (Apfloat. 1M precision))
|
||||
(def two (Apfloat. 2M precision))
|
||||
(def half (Apfloat. 0.5M precision))
|
||||
(def isqrt2 (.divide one (ApfloatMath/pow two half)))
|
||||
(def TOLERANCE (Apfloat. 0.000000M precision))
|
||||
|
||||
(defn agm [a g]
|
||||
" Simple AGM Loop calculation "
|
||||
(let [THRESH 1e-65 ; done when error less than threshold or we exceed max loops
|
||||
MAX-LOOPS 1000000]
|
||||
(loop [[an gn] [a g], cnt 0]
|
||||
(if (or (< (ApfloatMath/abs (.subtract an gn)) THRESH)
|
||||
(> cnt MAX-LOOPS))
|
||||
an
|
||||
(recur [(.multiply (.add an gn) half) (ApfloatMath/pow (.multiply an gn) half)]
|
||||
(inc cnt))))))
|
||||
|
||||
(println (agm one isqrt2))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
10 A = 1
|
||||
20 G = 1/SQR(2)
|
||||
30 GOSUB 100
|
||||
40 PRINT A
|
||||
50 END
|
||||
100 TA = A
|
||||
110 A = (A+G)/2
|
||||
120 G = SQR(TA*G)
|
||||
130 IF A<TA THEN 100
|
||||
140 RETURN
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
(defun agm (a0 g0 &optional (tolerance 1d-8))
|
||||
(loop for a = a0 then (* (+ a g) 5d-1)
|
||||
and g = g0 then (sqrt (* a g))
|
||||
until (< (abs (- a g)) tolerance)
|
||||
finally (return a)))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
let a = 1
|
||||
let g = 1 / sqrt(2)
|
||||
|
||||
do
|
||||
|
||||
let t = (a + g) / 2
|
||||
let g = sqrt(a * g)
|
||||
let x = a
|
||||
let a = t
|
||||
let t = x
|
||||
|
||||
loopuntil a = t
|
||||
|
||||
print a
|
||||
13
Task/Arithmetic-geometric-mean/D/arithmetic-geometric-mean.d
Normal file
13
Task/Arithmetic-geometric-mean/D/arithmetic-geometric-mean.d
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
import std.stdio, std.math, std.meta, std.typecons;
|
||||
|
||||
real agm(real a, real g, in int bitPrecision=60) pure nothrow @nogc @safe {
|
||||
do {
|
||||
//{a, g} = {(a + g) / 2.0, sqrt(a * g)};
|
||||
AliasSeq!(a, g) = tuple((a + g) / 2.0, sqrt(a * g));
|
||||
} while (feqrel(a, g) < bitPrecision);
|
||||
return a;
|
||||
}
|
||||
|
||||
void main() @safe {
|
||||
writefln("%0.19f", agm(1, 1 / sqrt(2.0)));
|
||||
}
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
program geometric_mean;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
function Fabs(value: Double): Double;
|
||||
begin
|
||||
Result := value;
|
||||
if Result < 0 then
|
||||
Result := -Result;
|
||||
end;
|
||||
|
||||
function agm(a, g: Double):Double;
|
||||
var
|
||||
iota, a1, g1: Double;
|
||||
begin
|
||||
iota := 1.0E-16;
|
||||
if a * g < 0.0 then
|
||||
begin
|
||||
Writeln('arithmetic-geometric mean undefined when x*y<0');
|
||||
exit(1);
|
||||
end;
|
||||
|
||||
while Fabs(a - g) > iota do
|
||||
begin
|
||||
a1 := (a + g) / 2.0;
|
||||
g1 := sqrt(a * g);
|
||||
a := a1;
|
||||
g := g1;
|
||||
end;
|
||||
Exit(a);
|
||||
end;
|
||||
|
||||
var
|
||||
x, y: Double;
|
||||
|
||||
begin
|
||||
Write('Enter two numbers:');
|
||||
Readln(x, y);
|
||||
writeln(format('The arithmetic-geometric mean is %.6f', [agm(x, y)]));
|
||||
readln;
|
||||
end.
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
%% 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).
|
||||
|
|
@ -0,0 +1 @@
|
|||
AGM = 0.8472130848351929
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
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 .
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
: 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
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
10 A = 1
|
||||
20 G = 1!/SQR(2!)
|
||||
30 FOR I=1 TO 20 'twenty iterations is plenty
|
||||
40 B = (A+G)/2
|
||||
50 G = SQR(A*G)
|
||||
60 A = B
|
||||
70 NEXT I
|
||||
80 PRINT A
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
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))
|
||||
}
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
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
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
println "agm(1, 0.5**0.5) = agm(1, ${0.5**0.5}) = ${agm(1, 0.5**0.5)}"
|
||||
assert (0.8472130847939792 - agm(1, 0.5**0.5)).abs() <= 10.0**-14
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
-- 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
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
100 PRINT AGM(1,1/SQR(2))
|
||||
110 DEF AGM(A,G)
|
||||
120 DO
|
||||
130 LET TA=A
|
||||
140 LET A=(A+G)/2:LET G=SQR(TA*G)
|
||||
150 LOOP UNTIL A=TA
|
||||
160 LET AGM=A
|
||||
170 END DEF
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
mean=: +/ % #
|
||||
(mean , */ %:~ #)^:_] 1,%%:2
|
||||
0.8472130847939792 0.8472130847939791
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
~.(mean , */ %:~ #)^:_] 1,%%:2
|
||||
0.8472130847939792
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(mean, */ %:~ #)^:a: 1,%%:2
|
||||
1 0.7071067811865475
|
||||
0.8535533905932737 0.8408964152537145
|
||||
0.8472249029234942 0.8472012667468915
|
||||
0.8472130848351929 0.8472130847527654
|
||||
0.8472130847939792 0.8472130847939791
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
DP=:101
|
||||
|
||||
round=: DP&$: : (4 : 0)
|
||||
b %~ <.1r2+y*b=. 10x^x
|
||||
)
|
||||
|
||||
sqrt=: DP&$: : (4 : 0) " 0
|
||||
assert. 0<:y
|
||||
%/ <.@%: (2 x: (2*x) round y)*10x^2*x+0>.>.10^.y
|
||||
)
|
||||
|
||||
ln=: DP&$: : (4 : 0) " 0
|
||||
assert. 0<y
|
||||
m=. <.0.5+2^.y
|
||||
t=. (<:%>:) (x:!.0 y)%2x^m
|
||||
if. x<-:#":t do. t=. (1+x) round t end.
|
||||
ln2=. 2*+/1r3 (^%]) 1+2*i.>.0.5*(%3)^.0.5*0.1^x+>.10^.1>.m
|
||||
lnr=. 2*+/t (^%]) 1+2*i.>.0.5*(|t)^.0.5*0.1^x
|
||||
lnr + m * ln2
|
||||
)
|
||||
|
||||
exp=: DP&$: : (4 : 0) " 0
|
||||
m=. <.0.5+y%^.2
|
||||
xm=. x+>.m*10^.2
|
||||
d=. (x:!.0 y)-m*xm ln 2
|
||||
if. xm<-:#":d do. d=. xm round d end.
|
||||
e=. 0.1^xm
|
||||
n=. e (>i.1:) a (^%!@]) i.>.a^.e [ a=. |y-m*^.2
|
||||
(2x^m) * 1++/*/\d%1+i.n
|
||||
)
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
fmt=:[: ;:inv DP&$: : (4 :0)&.>
|
||||
x{.deb (x*2j1)":y
|
||||
)
|
||||
|
||||
root=: ln@] exp@% [
|
||||
|
||||
epsilon=: 1r9^DP
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
fmt sqrt 2
|
||||
1.414213562373095048801688724209698078569671875376948073176679737990732478462107038850387534327641572
|
||||
fmt *~sqrt 2
|
||||
2.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
|
||||
fmt epsilon
|
||||
0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000418
|
||||
fmt 2 root 2
|
||||
1.414213562373095048801688724209698078569671875376948073176679737990732478462107038850387534327641572
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
geomean=: */ root~ #
|
||||
geomean2=: [: sqrt */
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
fmt geomean 3 5
|
||||
3.872983346207416885179265399782399610832921705291590826587573766113483091936979033519287376858673517
|
||||
fmt geomean2 3 5
|
||||
3.872983346207416885179265399782399610832921705291590826587573766113483091936979033519287376858673517
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
fmt (mean, geomean2)^:(epsilon <&| -/)^:a: 1,%sqrt 2
|
||||
1.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 0.707106781186547524400844362104849039284835937688474036588339868995366239231053519425193767163820786
|
||||
0.853553390593273762200422181052424519642417968844237018294169934497683119615526759712596883581910393 0.840896415253714543031125476233214895040034262356784510813226085974924754953902239814324004199292536
|
||||
0.847224902923494152615773828642819707341226115600510764553698010236303937284714499763460443890601464 0.847201266746891460403631453693352397963981013612000500823295747923488191871327668107581434542353536
|
||||
0.847213084835192806509702641168086052652603564606255632688496879079896064578021083935520939216477500 0.847213084752765366704298051779902070392110656059452583317776227659438896688518556753569298762449381
|
||||
0.847213084793979086607000346473994061522357110332854108003136553369667480633269820344545118989463440 0.847213084793979086605997900490389211440534858586261300461413929971399281619068666682569108141224710
|
||||
0.847213084793979086606499123482191636481445984459557704232275241670533381126169243513557113565344075 0.847213084793979086606499123482191636481445836194326665888883503648934628542100275932846717790147361
|
||||
0.847213084793979086606499123482191636481445910326942185060579372659734004834134759723201915677745718 0.847213084793979086606499123482191636481445910326942185060579372659734004834134759723198672311476741
|
||||
0.847213084793979086606499123482191636481445910326942185060579372659734004834134759723200293994611229 0.847213084793979086606499123482191636481445910326942185060579372659734004834134759723200293994611229
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
/*
|
||||
* 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)));
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
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));
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
(() => {
|
||||
'use strict';
|
||||
|
||||
// ARITHMETIC-GEOMETRIC MEAN
|
||||
|
||||
// agm :: Num a => a -> a -> a
|
||||
let agm = (a, g) => {
|
||||
let abs = Math.abs,
|
||||
sqrt = Math.sqrt;
|
||||
|
||||
return until(
|
||||
m => abs(m.an - m.gn) < tolerance,
|
||||
m => {
|
||||
return {
|
||||
an: (m.an + m.gn) / 2,
|
||||
gn: sqrt(m.an * m.gn)
|
||||
};
|
||||
}, {
|
||||
an: (a + g) / 2,
|
||||
gn: sqrt(a * g)
|
||||
}
|
||||
)
|
||||
.an;
|
||||
},
|
||||
|
||||
// GENERIC
|
||||
|
||||
// until :: (a -> Bool) -> (a -> a) -> a -> a
|
||||
until = (p, f, x) => {
|
||||
let v = x;
|
||||
while (!p(v)) v = f(v);
|
||||
return v;
|
||||
};
|
||||
|
||||
|
||||
// TEST
|
||||
|
||||
let tolerance = 0.000001;
|
||||
|
||||
|
||||
return agm(1, 1 / Math.sqrt(2));
|
||||
|
||||
})();
|
||||
|
|
@ -0,0 +1 @@
|
|||
0.8472130848351929
|
||||
|
|
@ -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] ;
|
||||
|
|
@ -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)
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
include ..\Utilitys.tlhy
|
||||
|
||||
:agm [ over over + 2 / rot rot * sqrt ] [ over over tostr swap tostr # ] while drop ;
|
||||
|
||||
1 1 2 sqrt / agm
|
||||
|
||||
pstack
|
||||
|
||||
" " input
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
include ..\Utilitys.tlhy
|
||||
|
||||
:agm %a %g %p !p !g !a
|
||||
$p $a $g - abs > ( [$a] [.5 $a $g + * $a $g * sqrt $p agm] ) if ;
|
||||
|
||||
1 .5 sqrt 1e-15 agm
|
||||
|
||||
pstack
|
||||
|
||||
" " input
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
// 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)))
|
||||
}
|
||||
|
|
@ -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)))
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
; 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 }
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
{def eps 1e-15}
|
||||
-> eps
|
||||
|
||||
{def agm
|
||||
{lambda {:a :g}
|
||||
{if {> {abs {- :a :g}} {eps}}
|
||||
then {agm {/ {+ :a :g} 2}
|
||||
{sqrt {* :a :g}}}
|
||||
else :a }}}
|
||||
-> agm
|
||||
|
||||
{agm 1 {/ 1 {sqrt 2}}}
|
||||
-> 0.8472130847939792
|
||||
|
||||
Multi-precision version using the lib_BN library
|
||||
|
||||
{BN.DEC 70}
|
||||
-> 70 digits
|
||||
{def EPS {BN./ 1 {BN.pow 10 45}}}
|
||||
-> EPS
|
||||
|
||||
{def AGM
|
||||
{lambda {:a :g}
|
||||
{if {= {BN.compare {BN.abs {BN.- :a :g}} {EPS}} 1}
|
||||
then {AGM {BN./ {BN.+ :a :g} 2}
|
||||
{BN.sqrt {BN.* :a :g}}}
|
||||
else :a }}}
|
||||
-> AGM
|
||||
|
||||
{AGM 1 {BN./ 1 {BN.sqrt 2}}}
|
||||
-> 0.8472130847939790866064991234821916364814459103269421850605793726597339
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
print agm(1, 1/sqr(2))
|
||||
print using("#.#################",agm(1, 1/sqr(2)))
|
||||
end
|
||||
|
||||
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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
put agm(1, 1/sqrt(2))
|
||||
-- ouput
|
||||
-- 0.847213
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
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))))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
> evalf( GaussAGM( 1, 1 / sqrt( 2 ) ) ); # default precision is 10 digits
|
||||
0.8472130847
|
||||
|
||||
> evalf[100]( GaussAGM( 1, 1 / sqrt( 2 ) ) ); # to 100 digits
|
||||
0.847213084793979086606499123482191636481445910326942185060579372659\
|
||||
7340048341347597232002939946112300
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
> GaussAGM( 1.0, 1 / sqrt( 2 ) );
|
||||
0.8472130847
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
PrecisionDigits = 85;
|
||||
AGMean[a_, b_] := FixedPoint[{ Tr@#/2, Sqrt[Times@@#] }&, N[{a,b}, PrecisionDigits]]〚1〛
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
agm(a, b) := %pi/4*(a + b)/elliptic_kc(((a - b)/(a + b))^2)$
|
||||
|
||||
agm(1, 1/sqrt(2)), bfloat, fpprec: 85;
|
||||
/* 8.472130847939790866064991234821916364814459103269421850605793726597340048341347597232b-1 */
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
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.
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
(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)
|
||||
)
|
||||
|
|
@ -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.0))
|
||||
|
|
@ -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.0))
|
||||
|
||||
echo("Result A: " & formatFloat(t.resA, ffDecimal, 24))
|
||||
echo("Result G: " & formatFloat(t.resG, ffDecimal, 24))
|
||||
|
|
@ -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)
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
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)))
|
||||
}
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
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.
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
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));
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
: agm \ a b -- m
|
||||
while( 2dup <> ) [ 2dup + 2 / -rot * sqrt ] drop ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
1 2 sqrt inv agm
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
numeric digits 20
|
||||
say agm(1, 1/rxcalcsqrt(2,16))
|
||||
|
||||
::routine agm
|
||||
use strict arg a, g
|
||||
numeric digits 20
|
||||
|
||||
a1 = a
|
||||
g1 = g
|
||||
|
||||
loop while abs(a1 - g1) >= 1e-14
|
||||
temp = (a1 + g1)/2
|
||||
g1 = rxcalcsqrt(a1*g1,16)
|
||||
a1 = temp
|
||||
end
|
||||
return a1+0
|
||||
|
||||
::requires rxmath LIBRARY
|
||||
|
|
@ -0,0 +1 @@
|
|||
agm(1,1/sqrt(2))
|
||||
|
|
@ -0,0 +1 @@
|
|||
agm2(x,y)=if(x==y,x,agm2((x+y)/2,sqrt(x*y))
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
define('PRECISION', 13);
|
||||
|
||||
function agm($a0, $g0, $tolerance = 1e-10)
|
||||
{
|
||||
// the bc extension deals in strings and cannot convert
|
||||
// floats in scientific notation by itself - hence
|
||||
// this manual conversion to a string
|
||||
$limit = number_format($tolerance, PRECISION, '.', '');
|
||||
$an = $a0;
|
||||
$gn = $g0;
|
||||
do {
|
||||
list($an, $gn) = array(
|
||||
bcdiv(bcadd($an, $gn), 2),
|
||||
bcsqrt(bcmul($an, $gn)),
|
||||
);
|
||||
} while (bccomp(bcsub($an, $gn), $limit) > 0);
|
||||
|
||||
return $an;
|
||||
}
|
||||
|
||||
bcscale(PRECISION);
|
||||
echo agm(1, 1 / bcsqrt(2));
|
||||
|
|
@ -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;
|
||||
|
|
@ -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.
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue