2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,4 +1,8 @@
|
|||
{{wikipedia|Arithmetic-geometric mean}}
|
||||
|
||||
|
||||
;task:
|
||||
|
||||
Write a function to compute the [[wp:Arithmetic-geometric mean|arithmetic-geometric mean]] of two numbers.
|
||||
[http://mathworld.wolfram.com/Arithmetic-GeometricMean.html]
|
||||
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:
|
||||
|
|
@ -8,3 +12,8 @@ Since the limit of <math>a_n-g_n</math> tends (rapidly) to zero with iterations,
|
|||
|
||||
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,66 @@
|
|||
property tolerance : 1.0E-5
|
||||
|
||||
-- agm :: Num a => a -> a -> a
|
||||
on agm(a, g)
|
||||
script withinTolerance
|
||||
on lambda(m)
|
||||
tell m to ((its an) - (its gn)) < tolerance
|
||||
end lambda
|
||||
end script
|
||||
|
||||
script nextRefinement
|
||||
on lambda(m)
|
||||
tell m
|
||||
set {an, gn} to {its an, its gn}
|
||||
{an:(an + gn) / 2, gn:(an * gn) ^ 0.5}
|
||||
end tell
|
||||
end lambda
|
||||
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))
|
||||
|
||||
end run
|
||||
|
||||
|
||||
|
||||
-- GENERIC
|
||||
|
||||
-- until :: (a -> Bool) -> (a -> a) -> a -> a
|
||||
on |until|(p, f, x)
|
||||
set mp to mReturn(p)
|
||||
set mf to mReturn(f)
|
||||
|
||||
script
|
||||
property p : mp's lambda
|
||||
property f : mf's lambda
|
||||
|
||||
on lambda(v)
|
||||
repeat until p(v)
|
||||
set v to f(v)
|
||||
end repeat
|
||||
return v
|
||||
end lambda
|
||||
end script
|
||||
|
||||
result's lambda(x)
|
||||
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 lambda : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
|
@ -1,34 +1,28 @@
|
|||
/*Arithmetic Geometric Mean of 1 and 1/sqrt(2)
|
||||
#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)
|
||||
|
||||
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);
|
||||
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);
|
||||
}
|
||||
gmp_printf ("%.20000Ff\n", x0);
|
||||
gmp_printf ("%.20000Ff\n\n", y0);
|
||||
|
||||
return 0;
|
||||
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,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,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 @@
|
|||
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
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
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,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.
|
||||
|
|
@ -1,10 +1,6 @@
|
|||
sub agm( $a is copy, $g is copy ) {
|
||||
loop {
|
||||
given ($a + $g)/2, sqrt $a * $g {
|
||||
return $a if @$_ ~~ ($a, $g);
|
||||
($a, $g) = @$_;
|
||||
}
|
||||
}
|
||||
($a, $g) = ($a + $g)/2, sqrt $a * $g until $a ≅ $g;
|
||||
return $a;
|
||||
}
|
||||
|
||||
say agm 1, 1/sqrt 2;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
sub agm( $a, $g ) {
|
||||
@$_ ~~ ($a, $g) ?? $a !! agm(|@$_)
|
||||
$a ≅ $g ?? $a !! agm(|@$_)
|
||||
given ($a + $g)/2, sqrt $a * $g;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,30 +1,28 @@
|
|||
/*REXX program calculates the AGM (arithmetic─geometric mean) of two numbers.*/
|
||||
parse arg a b digs . /*obtain optional numbers from the C.L.*/
|
||||
if digs=='' | digs==',' then digs=100 /*No DIGS specified? Then use default.*/
|
||||
numeric digits digs /*REXX will use lots of decimal digits.*/
|
||||
if a=='' | a==',' then a=1 /*No A specified? Then use default.*/
|
||||
if b=='' | b==',' then b=1/sqrt(2) /*No B specified? " " " */
|
||||
say '1st # =' a /*display the A value. */
|
||||
say '2nd # =' b /* " " B " */
|
||||
say ' AGM =' agm(a, b) /* " " AGM " */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
agm: procedure: parse arg x,y; if x=y then return x /*equality case?*/
|
||||
if y=0 then return 0 /*is Y zero? */
|
||||
if x=0 then return y/2 /* " X " */
|
||||
d=digits(); numeric digits d+5 /*add 5 more digs to ensure convergence*/
|
||||
tiny='1e-' || (digits()-1); /*construct a pretty tiny REXX number. */
|
||||
/*REXX program calculates the AGM (arithmetic─geometric mean) of two (real) numbers. */
|
||||
parse arg a b digs . /*obtain optional numbers from the C.L.*/
|
||||
if digs=='' | digs=="," then digs=110 /*No DIGS specified? Then use default.*/
|
||||
numeric digits digs /*REXX will use lots of decimal digits.*/
|
||||
if a=='' | a=="," then a=1 /*No A specified? Then use the default*/
|
||||
if b=='' | b=="," then b=1/sqrt(2) /* " B " " " " " */
|
||||
call AGM a,b /*invoke the AGM function. */
|
||||
say '1st # =' a /*display the A value. */
|
||||
say '2nd # =' b /* " " B " */
|
||||
say ' AGM =' agm(a, b) /* " " AGM " */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
agm: procedure: parse arg x,y; if x=y then return x /*is this an equality case?*/
|
||||
if y=0 then return 0 /*is Y equal to zero ? */
|
||||
if x=0 then return y/2 /* " X " " " */
|
||||
d=digits(); numeric digits d+5 /*add 5 more digs to ensure convergence*/
|
||||
tiny='1e-' || ( digits() -1 ) /*construct a pretty tiny REXX number. */
|
||||
ox=x+1
|
||||
do while ox\=x & abs(ox)>tiny; ox=x; oy=y
|
||||
x=(ox+oy)/2; y=sqrt(ox*oy)
|
||||
end /*while ··· */
|
||||
|
||||
numeric digits d /*restore numeric digits to original.*/
|
||||
return x/1 /*normalize X to the new digits. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
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)i /*make complex if X < 0.*/
|
||||
do #=1 while ox\=x & abs(ox)>tiny; ox=x; oy=y
|
||||
x=(ox+oy)/2; y=sqrt(ox*oy)
|
||||
end /*#*/
|
||||
numeric digits d; return x/1 /*restore digs, normalize X to new digs*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6
|
||||
numeric digits; 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*/
|
||||
return g
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
10 LET a=1: LET g=1/SQR 2
|
||||
20 LET ta=a
|
||||
30 LET a=(a+g)/2
|
||||
40 LET g=SQR (ta*g)
|
||||
50 IF a<ta THEN GO TO 20
|
||||
60 PRINT a
|
||||
Loading…
Add table
Add a link
Reference in a new issue