aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Add all the A tasks

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 14:58:50 -07:00
parent 2dd7375f96
commit 051504d65b
1608 changed files with 18584 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

10
Task/Arithmetic-geometric-mean/0DESCRIPTION Normal file
View file

@ -0,0 +1,10 @@
{{wikipedia|Arithmetic-geometric mean}}
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:
: <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>

26
Task/Arithmetic-geometric-mean/Ada/arithmetic-geometric-mean.ada Normal file
View file

@ -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;

11
Task/Arithmetic-geometric-mean/AutoHotkey/arithmetic-geometric-mean.ahk Normal file
View file

@ -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))

32
Task/Arithmetic-geometric-mean/C/arithmetic-geometric-mean.c Normal file
View file

@ -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;
}

19
Task/Arithmetic-geometric-mean/Erlang/arithmetic-geometric-mean-1.erl Normal file
View file

@ -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).

1
Task/Arithmetic-geometric-mean/Erlang/arithmetic-geometric-mean-2.erl Normal file
View file

@ -0,0 +1 @@
AGM = 0.8472130848351929

15
Task/Arithmetic-geometric-mean/Fortran/arithmetic-geometric-mean.f Normal file
View file

@ -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

19
Task/Arithmetic-geometric-mean/Go/arithmetic-geometric-mean-1.go Normal file
View file

@ -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))
}

21
Task/Arithmetic-geometric-mean/Go/arithmetic-geometric-mean-2.go Normal file
View file

@ -0,0 +1,21 @@
package main
import (
"fmt"
"math"
"math/cmplx"
)
const ε = 1e-14
func agm(a, g complex128) complex128 {
for cmplx.Abs(a-g) > cmplx.Abs(a)*ε {
a, g = (a+g)*.5, cmplx.Rect(math.Sqrt(cmplx.Abs(a)*cmplx.Abs(g)),
(cmplx.Phase(a)+cmplx.Phase(g))*.5)
}
return a
}
func main() {
fmt.Println(agm(1, 1/math.Sqrt2))
}

17
Task/Arithmetic-geometric-mean/Haskell/arithmetic-geometric-mean.hs Normal file
View file

@ -0,0 +1,17 @@
-- 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 . head . dropWhile (not . eq) $ iterate 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 = do
let equal = (< 0.000000001) . relDiff
print $ agm 1 (1 / sqrt 2) equal

25
Task/Arithmetic-geometric-mean/Java/arithmetic-geometric-mean.java Normal file
View file

@ -0,0 +1,25 @@
/*
Arithmetic-Geometric Mean of 1 & 1/sqrt(2)
Brendan Shaklovitz
5/29/12
*/
public class ArithmeticMean {
public static void agm (double a, double g){
double a1 = a;
double g1 = g;
while (Math.abs(a1-g1) >= Math.pow(10, -14)){
double aTemp = (a1+g1)/2.0;
g1 = Math.sqrt(a1*g1);
a1 = aTemp;
}
System.out.println(a1);
}
public static void main(String[] args){
agm(1,1/Math.sqrt(2));
}
}

22
Task/Arithmetic-geometric-mean/PHP/arithmetic-geometric-mean.php Normal file
View file

@ -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));

17
Task/Arithmetic-geometric-mean/Perl/arithmetic-geometric-mean.pl Normal file
View file

@ -0,0 +1,17 @@
#!/usr/bin/perl -w
my ($a0, $g0, $a1, $g1);
sub agm($$) {
$a0 = shift;
$g0 = shift;
do {
$a1 = ($a0 + $g0)/2;
$g1 = sqrt($a0 * $g0);
$a0 = ($a1 + $g1)/2;
$g0 = sqrt($a1 * $g1);
} while ($a0 != $a1);
return $a0;
}
print agm(1, 1/sqrt(2))."\n";

10
Task/Arithmetic-geometric-mean/PicoLisp/arithmetic-geometric-mean.l Normal file
View file

@ -0,0 +1,10 @@
(scl 80)
(de agm (A G)
(do 7
(prog1 (/ (+ A G) 2)
(setq G (sqrt (* A G)) A @) ) ) )
(round
(agm 1.0 (*/ 1.0 1.0 (sqrt (* 2.0 1.0))))
70 )

16
Task/Arithmetic-geometric-mean/Python/arithmetic-geometric-mean-1.py Normal file
View file

@ -0,0 +1,16 @@
from math import sqrt
def agm(a0, g0, tolerance=1e-10):
"""
Calculating the arithmetic-geometric mean of two numbers a0, g0.
tolerance the tolerance for the converged
value of the arithmetic-geometric mean
(default value = 1e-10)
"""
[an, gn] = [(a0 + g0) / 2.0, sqrt(a0 * g0)]
while abs(an - gn) > tolerance:
[an, gn] = [(an + gn) / 2.0, sqrt(an * gn)]
return an
print agm(1, 1 / sqrt(2))

10
Task/Arithmetic-geometric-mean/Python/arithmetic-geometric-mean-2.py Normal file
View file

@ -0,0 +1,10 @@
from decimal import Decimal, getcontext
def agm(a, g, tolerance=Decimal("1e-65")):
while True:
a, g = ((a + g) / 2, (a * g).sqrt())
if abs(a - g) < tolerance:
return a
getcontext().prec = 70
print agm(Decimal(1), 1 / Decimal(2).sqrt())

14
Task/Arithmetic-geometric-mean/R/arithmetic-geometric-mean-1.r Normal file
View file

@ -0,0 +1,14 @@
arithmeticMean <- function(a, b) { (a + b)/2 }
geometricMean <- function(a, b) { sqrt(a * b) }
arithmeticGeometricMean <- function(a, b) {
rel_error <- abs(a - b) / pmax(a, b)
if (all(rel_error < .Machine$double.eps, na.rm=TRUE)) {
agm <- a
return(data.frame(agm, rel_error));
}
Recall(arithmeticMean(a, b), geometricMean(a, b))
}
agm <- arithmeticGeometricMean(1, 1/sqrt(2))
print(format(agm, digits=16))

4
Task/Arithmetic-geometric-mean/R/arithmetic-geometric-mean-2.r Normal file
View file

@ -0,0 +1,4 @@
a <- c(1, 1, 1)
b <- c(1/sqrt(2), 1/sqrt(3), 1/2)
agm <- arithmeticGeometricMean(a, b)
print(format(agm, digits=16))

29
Task/Arithmetic-geometric-mean/REXX/arithmetic-geometric-mean.rexx Normal file
View file

@ -0,0 +1,29 @@
/*REXX program calculates AGM (arithmetric-geometric mean) of 2 numbers.*/
parse arg a b digs . /*obtain numbers from the command line.*/
if digs=='' then digs=100 /*no DIGS specified? Then use default.*/
numeric digits digs /*Now, REXX will use lots of digits. */
if a=='' then a=1 /*no A specified? Then use default. */
if b=='' then b=1/sqrt(2) /*no B specified? " " " */
say '1st # =' a
say '2nd # =' b
say ' AGM =' agm(a,b)/1 /*divide by 1; goes from 105──►100 digs*/
say ' AGM =' agm(a,b)/1 /*dividing by 1 normalizes the REXX num*/
exit /*stick a fork in it, we're done.*/
/*────────────────────────────AGM subroutine────────────────────────────*/
agm: procedure: parse arg x,y; if x=y then return x /*equality case.*/
if y=0 then return 0; if x=0 then return .5*y /*two "0" cases.*/
numeric digits digits()+5 /*add 5 more digs to ensure convergence*/
!='1e-' || (digits()-1); _x=x+1
do while _x\=x & abs(_x)>!; _x=x; _y=y; x=(_x+_y)*.5
y=sqrt(_x*_y)
end /*while*/
return x
/*────────────────────────────SQRT subroutine───────────────────────────*/
sqrt: procedure; parse arg x;if x=0 then return 0;d=digits();numeric digits 11
g=.sqrtGuess(); do j=0 while p>9; m.j=p; p=p%2+1; end
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k
g=.5*(g+x/g); end; numeric digits d; return g/1
.sqrtGuess: numeric form scientific; m.=11; p=d+d%4+2
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; return g*.5'E'_%2

7
Task/Arithmetic-geometric-mean/Racket/arithmetic-geometric-mean-1.rkt Normal file
View file

@ -0,0 +1,7 @@
#lang racket
(define (agm a g [ε 1e-15])
(if (<= (- a g) ε)
a
(agm (/ (+ a g) 2) (sqrt (* a g)) ε)))
(agm 1 (/ 1 (sqrt 2)))

4
Task/Arithmetic-geometric-mean/Racket/arithmetic-geometric-mean-2.rkt Normal file
View file

@ -0,0 +1,4 @@
#lang racket
(require math/bigfloat)
(bf-precision 200)
(bfagm 1.bf (bf/ (bfsqrt 2.bf)))

22
Task/Arithmetic-geometric-mean/Ruby/arithmetic-geometric-mean.rb Normal file
View file

@ -0,0 +1,22 @@
#
# The flt package (http://flt.rubyforge.org/) is useful for high-precision floating-point math.
# It lets us control 'context' of numbers, individually or collectively -- including precision
# (which adjusts the context's value of epsilon accordingly).
require 'flt'
include Flt
BinNum.Context.precision = 512 # default 53 (bits)
def AGM(a,g)
new_a = BinNum a
new_g = BinNum g
while new_a - new_g > new_a.class.Context.epsilon do
old_g = new_g
new_g = (new_a * new_g).sqrt
new_a = (old_g + new_a) * 0.5
end
new_g
end
puts AGM 1, 1 / BinNum(2).sqrt

6
Task/Arithmetic-geometric-mean/Scala/arithmetic-geometric-mean.scala Normal file
View file

@ -0,0 +1,6 @@
def agm(a: Double, g: Double, eps: Double): Double = {
if (math.abs(a - g) < eps) (a + g) / 2
else agm((a + g) / 2, math.sqrt(a * g), eps)
}
agm(1, math.sqrt(2)/2, 1e-15)

10
Task/Arithmetic-geometric-mean/Tcl/arithmetic-geometric-mean.tcl Normal file
View file

@ -0,0 +1,10 @@
proc agm {a b} {
set old_b [expr {$b<0?inf:-inf}]
while {$a != $b && $b != $old_b} {
set old_b $b
lassign [list [expr {0.5*($a+$b)}] [expr {sqrt($a*$b)}]] a b
}
return $a
}
puts [agm 1 [expr 1/sqrt(2)]]